From aacee8aba6aa0b8fde235320c9b9ea183569c576 Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 1/7] Add RISC-V code generation --- lib/CodeGen/RiscV/RiscVGen.hs | 165 +++++++++ lib/CodeGen/RiscV/RiscVLib.hs | 560 +++++++++++++++++++++++++++++ miniml.cabal | 2 + test/Sample/Factorial/FacRec.s | 91 +++++ test/Sample/Factorial/FacRecCps.s | 178 +++++++++ test/Sample/Factorial/FacRecLoop.s | 136 +++++++ test/Sample/Fibonacci/FibRec.s | 108 ++++++ test/Sample/Fibonacci/FibRecCps.s | 238 ++++++++++++ test/Sample/Fibonacci/FibRecLoop.s | 139 +++++++ test/Sample/Simple/SimpleTest.s | 69 ++++ test/Sample/Utils.hs | 17 +- test/Utils.hs | 5 + 12 files changed, 1706 insertions(+), 2 deletions(-) create mode 100644 lib/CodeGen/RiscV/RiscVGen.hs create mode 100644 lib/CodeGen/RiscV/RiscVLib.hs create mode 100644 test/Sample/Factorial/FacRec.s create mode 100644 test/Sample/Factorial/FacRecCps.s create mode 100644 test/Sample/Factorial/FacRecLoop.s create mode 100644 test/Sample/Fibonacci/FibRec.s create mode 100644 test/Sample/Fibonacci/FibRecCps.s create mode 100644 test/Sample/Fibonacci/FibRecLoop.s create mode 100644 test/Sample/Simple/SimpleTest.s diff --git a/lib/CodeGen/RiscV/RiscVGen.hs b/lib/CodeGen/RiscV/RiscVGen.hs new file mode 100644 index 0000000..270c907 --- /dev/null +++ b/lib/CodeGen/RiscV/RiscVGen.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecursiveDo #-} + +module CodeGen.RiscV.RiscVGen (ppRiscVAsm) where + +import CodeGen.Module (Module (..)) +import qualified CodeGen.RiscV.RiscVLib as Asm +import Control.Monad.State (MonadState, State, evalState, gets, modify) +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as Txt +import Foreign (fromBool) +import MonadUtils (locally) +import qualified StdLib +import Transformations.Anf.Anf +import Trees.Common + +ppRiscVAsm :: Module -> String +ppRiscVAsm m = unlines $ show <$> genModule m + +-- The Code + +type CodeGenM = Asm.AsmBuilderT (State Env) + +data Env = Env + { locVars :: Map Identifier' Asm.Operand, + globVars :: Map Identifier' Asm.Operand, + funs :: Map Identifier' (Asm.Operand, Arity) + } + +genModule :: Module -> [Asm.CodeLine] +genModule (Module (Program decls)) = flip evalState (Env Map.empty Map.empty Map.empty) $ + Asm.compileT $ do + mapM_ genStdLibDecl StdLib.allDeclsWithArity + mapM_ genGlobDecl decls + + -- In the `main` we define our global variables. + Asm.mainFunction $ \_ -> mapM_ gVarDef decls + where + gVarDef :: GlobalDeclaration -> CodeGenM () + gVarDef = \case + GlobVarDecl ident value -> do + addr <- findGlobVar ident + value' <- genExpr value + Asm.storeToLabeledAddr addr value' + _ -> return () + +genStdLibDecl :: StdLib.DeclarationWithArity -> CodeGenM () +genStdLibDecl decl = declareAsExtern decl >>= register decl + where + declareAsExtern :: StdLib.DeclarationWithArity -> CodeGenM Asm.Operand + declareAsExtern (ident, _) = Asm.externFunction ident + + register :: StdLib.DeclarationWithArity -> Asm.Operand -> CodeGenM () + register (ident, arity) fun = regFun (Txt ident) fun arity + +genGlobDecl :: GlobalDeclaration -> CodeGenM () +genGlobDecl = \case + GlobVarDecl ident _ -> do + var <- Asm.globalVar (Txt.pack $ genId ident) + regGlobVar ident var + GlobFunDecl ident params body -> mdo + regFun ident fun (length params) + fun <- locally $ do + Asm.function + (Txt.pack $ genId ident) + (fromIntegral $ length params) + $ \args -> do + mapM_ (uncurry regLocVar) (params `zip` args) + genExpr body + return () + +genId :: Identifier' -> String +genId = \case + Txt txt -> Txt.unpack txt + Gen n txt -> Txt.unpack txt <> "_" <> show n + +genExpr :: Expression -> CodeGenM Asm.Operand +genExpr = \case + ExprAtom atom -> genAtom atom + ExprComp ce -> genComp ce + ExprLetIn (ident, val) expr -> do + val' <- genExpr val + regLocVar ident val' + genExpr expr + +genAtom :: AtomicExpression -> CodeGenM Asm.Operand +genAtom = \case + AtomId ident -> findAny ident + AtomUnit -> Asm.immediate 0 + AtomBool bool -> Asm.immediate $ fromBool bool + AtomInt int -> Asm.immediate int + +genComp :: ComplexExpression -> CodeGenM Asm.Operand +genComp = \case + CompApp f arg -> do + f' <- findAny f + arg' <- genAtom arg + applyF <- findFun (Txt "miniml_apply") + Asm.call applyF [f', arg'] + CompIte c t e -> do + c' <- genAtom c + Asm.ite c' (\_ -> genExpr t) (\_ -> genExpr e) + CompBinOp op lhs rhs -> do + lhs' <- genAtom lhs + rhs' <- genAtom rhs + let opF = case op of + BoolOp AndOp -> Asm.and + BoolOp OrOp -> Asm.or + ArithOp PlusOp -> Asm.add + ArithOp MinusOp -> Asm.sub + ArithOp MulOp -> Asm.mul + ArithOp DivOp -> + ( \lhs'' rhs'' -> do + divF <- findFun (Txt "miniml_div") + Asm.call divF [lhs'', rhs''] + ) + CompOp EqOp -> Asm.eq + CompOp NeOp -> Asm.ne + CompOp LtOp -> Asm.lt + CompOp LeOp -> Asm.le + CompOp GtOp -> Asm.gt + CompOp GeOp -> Asm.ge + opF lhs' rhs' + CompUnOp op x -> do + x' <- genAtom x + let opF = case op of + UnMinusOp -> Asm.neg + opF x' + +-- Vars & Funs + +findAny :: Identifier' -> CodeGenM Asm.Operand +findAny ident = do + maybeLocVar <- gets ((Map.!? ident) . locVars) + case maybeLocVar of + Just locVar -> return locVar + Nothing -> do + maybeFun <- gets ((Map.!? ident) . funs) + case maybeFun of + Just (fun, arity) -> do + funToPafF <- findFun (Txt "miniml_fun_to_paf") + arity' <- Asm.immediate $ fromIntegral arity + Asm.call funToPafF [fun, arity'] + Nothing -> findGlobVar ident + +findGlobVar :: (MonadState Env m) => Identifier' -> m Asm.Operand +findGlobVar ident = gets ((Map.! ident) . globVars) + +findFun :: Identifier' -> CodeGenM Asm.Operand +findFun ident = gets (fst . (Map.! ident) . funs) + +regLocVar :: (MonadState Env m) => Identifier' -> Asm.Operand -> m () +regLocVar ident var = modify $ + \env -> env {locVars = Map.insert ident var (locVars env)} + +regGlobVar :: (MonadState Env m) => Identifier' -> Asm.Operand -> m () +regGlobVar ident gVar = modify $ + \env -> env {globVars = Map.insert ident gVar (globVars env)} + +regFun :: (MonadState Env m) => Identifier' -> Asm.Operand -> Arity -> m () +regFun ident fun paramsCnt = modify $ + \env -> env {funs = Map.insert ident (fun, paramsCnt) (funs env)} diff --git a/lib/CodeGen/RiscV/RiscVLib.hs b/lib/CodeGen/RiscV/RiscVLib.hs new file mode 100644 index 0000000..8768276 --- /dev/null +++ b/lib/CodeGen/RiscV/RiscVLib.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module CodeGen.RiscV.RiscVLib + ( compileT, + compile, + mainFunction, + function, + globalVar, + externFunction, + AsmBuilderT, + AsmBuilder, + Operand, + CodeLine, + immediate, + and, + or, + add, + sub, + mul, + neg, + eq, + ne, + lt, + le, + gt, + ge, + call, + ite, + storeToLabeledAddr, + ) +where + +import Control.Monad (replicateM, void) +import Control.Monad.Fix (MonadFix) +import Control.Monad.Identity (Identity (..)) +import Control.Monad.State (MonadState (..), StateT (..), execStateT, get, modify) +import Control.Monad.Trans (MonadTrans (..)) +import Data.Char (isSpace) +import Data.Int (Int64) +import Data.List (intercalate) +import Data.Text (Text) +import qualified Data.Text as Txt +import Prelude hiding (and, or) + +-- | Compile the code +compileT :: (Monad m) => AsmBuilderT m a -> m [CodeLine] +compileT m = concatCode <$> execAsmBuilderT m + where + execAsmBuilderT :: (Monad m) => AsmBuilderT m a -> m BuilderState + execAsmBuilderT m' = execStateT (unAsmBuilderT m') emptyBS + + concatCode :: BuilderState -> [CodeLine] + concatCode (BS (PBS txt dat) _ _) = + let txtCL = DirectiveCodeLine DirText : concat (reverse txt) + datCL = DirectiveCodeLine DirData : dat + in datCL ++ txtCL + +-- | Compile the code +compile :: AsmBuilder a -> [CodeLine] +compile = runIdentity . compileT + +-- | Emit main function (entry point routine) +mainFunction :: (MonadAsmBuilder m) => (() -> m ()) -> m () +mainFunction body = do + void $ body () + + BS _ (FBS cls spo) _ <- getAsmBuilderState + + let globalDir = DirectiveCodeLine $ DirGlobl "_start" + let funLabel = LabelCodeLine $ Label "_start" + let spPush = instructionCodeLine Addi [Register Sp, Register Sp, Immediate $ -(dword * spo)] + let loadRetVal = instructionCodeLine Li [Register A0, Immediate 0] + let spPop = instructionCodeLine Addi [Register Sp, Register Sp, Immediate $ dword * spo] + + let ret = + [ instructionCodeLine Li [Register A0, Immediate 0], + instructionCodeLine Jal [Symbol "exit"] + ] + + let funCode = [globalDir, funLabel, spPush] ++ (concat . reverse $ ([loadRetVal, spPop] ++ ret) : cls) + + pushProgramCodeLines funCode + modifyAsmBuilderState $ \bs -> bs {functionBS = emptyFBS} + +-- | Emit main function (entry point routine) +function :: (MonadAsmBuilder m) => Text -> Int64 -> ([Operand] -> m Operand) -> m Operand +function name paramCount body = do + let args = Register <$> take (fromIntegral paramCount) [A0, A1, A2, A3, A4, A5, A6] + memArgs <- replicateM (length args) (Memory <$> incAndGetSpo 1) + pushFunctionCodeLines $ + (\(reg, mem) -> instructionCodeLine Sd [reg, mem]) <$> args `zip` memArgs + + retVal <- body memArgs + + BS _ (FBS cls spo) _ <- getAsmBuilderState + + let funLabel = LabelCodeLine $ Label name + let spPush = instructionCodeLine Addi [Register Sp, Register Sp, Immediate $ -(dword * spo)] + let loadRetVal = instructionCodeLine Ld [Register A0, retVal] + let spPop = instructionCodeLine Addi [Register Sp, Register Sp, Immediate $ dword * spo] + let ret = instructionCodeLine Ret [] + + let funCode = [funLabel, spPush] ++ (concat . reverse $ [loadRetVal, spPop, ret] : cls) + + pushProgramCodeLines funCode + modifyAsmBuilderState $ \bs -> bs {functionBS = emptyFBS} + + return $ Symbol name + +-- | Emit uninitialized global variable +globalVar :: (MonadAsmBuilder m) => Text -> m Operand +globalVar name = do + let gVarDir = LabeledDirectiveCodeLine (Label name) (DirDWord 0) + modifyAsmBuilderState $ + \bs@(BS pbs _ _) -> + bs {programBS = pbs {sectionData = gVarDir : sectionData pbs}} + return $ Symbol name + +-- | Get external function operand +externFunction :: (MonadAsmBuilder m) => Text -> m Operand +externFunction = return . Symbol + +storeToLabeledAddr :: (MonadAsmBuilder m) => Operand -> Operand -> m () +storeToLabeledAddr addr value = do + let regA = T0 + let ra = Register regA + let rb = Register T1 + + pushFunctionCodeLines + [ instructionCodeLine La [ra, addr], + instructionCodeLine Ld [rb, value], + instructionCodeLine Sd [rb, RegisterWithOffset regA 0] + ] + + return () + +-- MONADS : START + +newtype AsmBuilderT m a = AsmBuilderT {unAsmBuilderT :: StateT BuilderState m a} + deriving (Functor, Applicative, Monad, MonadFix) via StateT BuilderState m + +data BuilderState = BS + { programBS :: ProgramBuilderState, + functionBS :: FunctionBuilderState, + idCnt :: Integer + } + +data ProgramBuilderState = PBS + { sectionText :: [[CodeLine]], + sectionData :: [CodeLine] + } + +data FunctionBuilderState = FBS + { functionCodeLines :: [[CodeLine]], + stackPointerOffset :: Int64 -- In double words + } + +emptyBS :: BuilderState +emptyBS = BS emptyPBS emptyFBS 0 + +emptyPBS :: ProgramBuilderState +emptyPBS = PBS [] [] + +emptyFBS :: FunctionBuilderState +emptyFBS = FBS [] 0 + +instance (MonadState s m) => MonadState s (AsmBuilderT m) where + state = lift . state + +instance MonadTrans AsmBuilderT where + lift = AsmBuilderT . lift + +type AsmBuilder = AsmBuilderT Identity + +class (Monad m) => MonadAsmBuilder m where + getAsmBuilderState :: m BuilderState + + modifyAsmBuilderState :: (BuilderState -> BuilderState) -> m () + + default getAsmBuilderState :: + (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => + m BuilderState + getAsmBuilderState = lift getAsmBuilderState + + default modifyAsmBuilderState :: + (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => + (BuilderState -> BuilderState) -> + m () + modifyAsmBuilderState = lift . modifyAsmBuilderState + +instance (Monad m) => MonadAsmBuilder (AsmBuilderT m) where + getAsmBuilderState = AsmBuilderT get + + modifyAsmBuilderState = AsmBuilderT . modify + +instance (MonadAsmBuilder m) => MonadAsmBuilder (StateT s m) + +-- MONADS : END + +data Operand + = Immediate Int64 + | Register Register + | Memory Offset + | RegisterWithOffset Register Offset + | Symbol Text + deriving (Eq, Ord) + +instance Show Operand where + show :: Operand -> String + show (Immediate i) = show i + show (Register r) = show r + show (Memory o) = show (dword * o) ++ "(sp)" + show (RegisterWithOffset r o) = show (dword * o) ++ "(" ++ show r ++ ")" + show (Symbol t) = Txt.unpack t + +type Offset = Int64 + +immediate :: (MonadAsmBuilder m) => Int64 -> m Operand +immediate value = do + let rd = Register T0 + + rdMem <- Memory <$> incAndGetSpo 1 + + pushFunctionCodeLines + [ instructionCodeLine Li [rd, Immediate value], + instructionCodeLine Sd [rd, rdMem] + ] + + return rdMem + +data CodeLine + = LabeledDirectiveCodeLine Label Directive + | LabelCodeLine Label + | InstructionCodeLine Instruction + | DirectiveCodeLine Directive + +instance Show CodeLine where + show :: CodeLine -> String + show (LabeledDirectiveCodeLine l d) = spaceSep [show l, show d] + show (LabelCodeLine l) = show l + show (InstructionCodeLine i) = " " ++ show i + show (DirectiveCodeLine d) = show d + +newtype Label = Label Text + +instance Show Label where + show :: Label -> String + show (Label txt) = Txt.unpack txt ++ ":" + +data Instruction = Instruction OpCode [Operand] + +instance Show Instruction where + show :: Instruction -> String + show (Instruction opCode args) = spaceSep [show opCode, commaSep $ show <$> args] + +data Directive + = DirText + | DirData + | DirDWord Int64 + | DirGlobl Text + +instance Show Directive where + show :: Directive -> String + show DirText = ".section .text" + show DirData = ".section .data" + show (DirDWord initVal) = spaceSep [".dword", show initVal] + show (DirGlobl name) = spaceSep [".globl", Txt.unpack name] + +data OpCode + = Add + | Sub + | Mul + | And + | Or + | Not + | Seqz + | Snez + | Slt + | Ld + | Sd + | Addi + | Li + | La + | Neg + | Ret + | Jal + | Beqz + | J + +instance Show OpCode where + show :: OpCode -> String + show Add = "add" + show Sub = "sub" + show Mul = "mul" + show And = "and" + show Or = "or" + show Not = "not" + show Seqz = "seqz" + show Snez = "snez" + show Slt = "slt" + show Ld = "ld" + show Sd = "sd" + show Addi = "addi" + show Li = "li" + show La = "la" + show Neg = "neg" + show Ret = "ret" + show Jal = "jal" + show Beqz = "beqz" + show J = "j" + +data Register + = Zero -- zero == x0 + | Ra -- ra == x1 + | Sp -- sp == x2 + | Gp -- gp == x3 + | Tp -- tp == x4 + | T0 -- t0 == x5 + | T1 -- t1 == x6 + | T2 -- t2 == x7 + | S0 -- s0 == x8 + | S1 -- s1 == x9 + | A0 -- a0 == x10 + | A1 -- a1 == x11 + | A2 -- a2 == x12 + | A3 -- a3 == x13 + | A4 -- a4 == x14 + | A5 -- a5 == x15 + | A6 -- a6 == x16 + | A7 -- a7 == x17 + | S2 -- s2 == x18 + | S3 -- s3 == x19 + | S4 -- s4 == x20 + | S5 -- s5 == x21 + | S6 -- s6 == x22 + | S7 -- s7 == x23 + | S8 -- s8 == x24 + | S9 -- s9 == x25 + | S10 -- s10 == x26 + | S11 -- s11 == x27 + | T3 -- t3 == x28 + | T4 -- t4 == x29 + | T5 -- t5 == x30 + | T6 -- t6 == x31 + deriving (Eq, Ord) + +instance Show Register where + show :: Register -> String + show Zero = "zero" + show Ra = "ra" + show Sp = "sp" + show Gp = "gp" + show Tp = "tp" + show T0 = "t0" + show T1 = "t1" + show T2 = "t2" + show S0 = "s0" + show S1 = "s1" + show A0 = "a0" + show A1 = "a1" + show A2 = "a2" + show A3 = "a3" + show A4 = "a4" + show A5 = "a5" + show A6 = "a6" + show A7 = "a7" + show S2 = "s2" + show S3 = "s3" + show S4 = "s4" + show S5 = "s5" + show S6 = "s6" + show S7 = "s7" + show S8 = "s8" + show S9 = "s9" + show S10 = "s10" + show S11 = "s11" + show T3 = "t3" + show T4 = "t4" + show T5 = "t5" + show T6 = "t6" + +-- boolean +and, or :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand +and = genOpCodeInstruction1 And +or = genOpCodeInstruction1 Or + +-- arithmetic +add, sub, mul :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand +add = genOpCodeInstruction1 Add +sub = genOpCodeInstruction1 Sub +mul = genOpCodeInstruction1 Mul + +neg :: (MonadAsmBuilder m) => Operand -> m Operand +neg a = do + let rd = Register T0 + let rs = Register T0 + + rdMem <- Memory <$> incAndGetSpo 1 + + pushFunctionCodeLines + [ instructionCodeLine Ld [rs, a], + instructionCodeLine Neg [rd, rs], + instructionCodeLine Sd [rd, rdMem] + ] + + return rdMem + +-- comparison +eq, ne, lt, le, gt, ge :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand +eq = genOpCodeInstruction2 Sub Seqz +ne = genOpCodeInstruction2 Sub Snez +lt = genOpCodeInstruction1 Slt +le = flip ge +gt = flip lt +ge = genOpCodeInstruction2 Slt Seqz + +call :: (MonadAsmBuilder m) => Operand -> [Operand] -> m Operand +call fun args = do + let argRegs = Register <$> [A0, A1, A2, A3, A4, A5, A6] + let loadArguments = uncurry loadArgCL <$> argRegs `zip` args + + let retVal = Register A0 + retValMem <- Memory <$> incAndGetSpo 1 + raMem <- Memory <$> incAndGetSpo 1 + + pushFunctionCodeLines $ + loadArguments + ++ [ instructionCodeLine Sd [Register Ra, raMem], + instructionCodeLine Jal [fun], + instructionCodeLine Ld [Register Ra, raMem], + instructionCodeLine Sd [retVal, retValMem] + ] + + return retValMem + where + loadArgCL reg arg = case arg of + Symbol _ -> instructionCodeLine La [reg, arg] + _ -> instructionCodeLine Ld [reg, arg] + +ite :: (MonadAsmBuilder m) => Operand -> (() -> m Operand) -> (() -> m Operand) -> m Operand +ite c t e = do + let retVal = Register T0 + retValMem <- Memory <$> incAndGetSpo 1 + + elseLabelName <- Txt.pack . ("else_" ++) . show <$> genId + endLabelName <- Txt.pack . ("end_" ++) . show <$> genId + + -- condition + let condReg = Register T1 + let loadCond = instructionCodeLine Ld [condReg, c] + let br = instructionCodeLine Beqz [condReg, Symbol elseLabelName] + + pushFunctionCodeLines [loadCond, br] + + -- then + storeThenRes <- (\op -> [instructionCodeLine Ld [retVal, op], instructionCodeLine Sd [retVal, retValMem]]) <$> t () + let jumpFromThenToEnd = instructionCodeLine J [Symbol endLabelName] + + pushFunctionCodeLines $ storeThenRes ++ [jumpFromThenToEnd] + + -- else + let elseLabel = LabelCodeLine $ Label elseLabelName + pushFunctionCodeLines [elseLabel] + + storeElseRes <- (\op -> [instructionCodeLine Ld [retVal, op], instructionCodeLine Sd [retVal, retValMem]]) <$> e () + + pushFunctionCodeLines storeElseRes + + -- end + let endLabel = LabelCodeLine $ Label endLabelName + + pushFunctionCodeLines [endLabel] + + return retValMem + +-- Utils + +genOpCodeInstruction1 :: (MonadAsmBuilder m) => OpCode -> Operand -> Operand -> m Operand +genOpCodeInstruction1 opCode a b = do + let rd = Register T0 + let rs1 = Register T0 + let rs2 = Register T1 + + rdMem <- Memory <$> incAndGetSpo 1 + + pushFunctionCodeLines + [ instructionCodeLine Ld [rs1, a], + instructionCodeLine Ld [rs2, b], + instructionCodeLine opCode [rd, rs1, rs2], + instructionCodeLine Sd [rd, rdMem] + ] + + return rdMem + +genOpCodeInstruction2 :: (MonadAsmBuilder m) => OpCode -> OpCode -> Operand -> Operand -> m Operand +genOpCodeInstruction2 opCode1 opCode2 a b = do + let rd = Register T0 + let rs1 = Register T0 + let rs2 = Register T1 + + rdMem <- Memory <$> incAndGetSpo 1 + + pushFunctionCodeLines + [ instructionCodeLine Ld [rs1, a], + instructionCodeLine Ld [rs2, b], + instructionCodeLine opCode1 [rd, rs1, rs2], + instructionCodeLine opCode2 [rd, rd], + instructionCodeLine Sd [rd, rdMem] + ] + + return rdMem + +pushProgramCodeLines :: (MonadAsmBuilder m) => [CodeLine] -> m () +pushProgramCodeLines newCodeLines = modifyAsmBuilderState $ + \bs@(BS pbs@(PBS currCodeLines _) _ _) -> + bs {programBS = pbs {sectionText = newCodeLines : currCodeLines}} + +pushFunctionCodeLines :: (MonadAsmBuilder m) => [CodeLine] -> m () +pushFunctionCodeLines newCodeLines = modifyAsmBuilderState $ + \bs@(BS _ fbs@(FBS currCodeLines _) _) -> + bs {functionBS = fbs {functionCodeLines = newCodeLines : currCodeLines}} + +incAndGetSpo :: (MonadAsmBuilder m) => Int64 -> m Int64 +incAndGetSpo amount = do + spo <- stackPointerOffset . functionBS <$> getAsmBuilderState + let newSpo = spo + amount + + modifyAsmBuilderState $ + \bs@(BS _ fbs _) -> + bs {functionBS = fbs {stackPointerOffset = newSpo}} + + return newSpo + +instructionCodeLine :: OpCode -> [Operand] -> CodeLine +instructionCodeLine opCode ops = InstructionCodeLine $ Instruction opCode ops + +genId :: (MonadAsmBuilder m) => m Integer +genId = do + cnt <- idCnt <$> getAsmBuilderState + modifyAsmBuilderState $ \bs -> bs {idCnt = cnt + 1} + return cnt + +dword :: Int64 +dword = 8 + +commaSep :: [String] -> String +commaSep = intercalate ", " . filterOutBlankStrings + +spaceSep :: [String] -> String +spaceSep = unwords . filterOutBlankStrings + +filterOutBlankStrings :: [String] -> [String] +filterOutBlankStrings = filter (not . all isSpace) diff --git a/miniml.cabal b/miniml.cabal index 1d4a74d..386e3a8 100644 --- a/miniml.cabal +++ b/miniml.cabal @@ -32,6 +32,8 @@ library CodeGen.Llvm.LlvmIrGen CodeGen.Llvm.Runner CodeGen.Module + CodeGen.RiscV.RiscVGen + CodeGen.RiscV.RiscVLib CodeGen.RunResult CodeGen.TimedValue MonadUtils diff --git a/test/Sample/Factorial/FacRec.s b/test/Sample/Factorial/FacRec.s new file mode 100644 index 0000000..434c7b9 --- /dev/null +++ b/test/Sample/Factorial/FacRec.s @@ -0,0 +1,91 @@ +.section .data +simp_3: .dword 0 +.section .text +factorial_1: + addi sp, sp, -104 + sd a0, 8(sp) + li t0, 0 + sd t0, 16(sp) + ld t0, 16(sp) + ld t1, 8(sp) + slt t0, t0, t1 + seqz t0, t0 + sd t0, 24(sp) + ld t1, 24(sp) + beqz t1, else_0 + li t0, 1 + sd t0, 40(sp) + ld t0, 40(sp) + sd t0, 32(sp) + j end_1 +else_0: + li t0, 1 + sd t0, 48(sp) + ld t0, 8(sp) + ld t1, 48(sp) + sub t0, t0, t1 + sd t0, 56(sp) + li t0, 1 + sd t0, 64(sp) + la a0, factorial_1 + ld a1, 64(sp) + sd ra, 80(sp) + jal miniml_fun_to_paf + ld ra, 80(sp) + sd a0, 72(sp) + ld a0, 72(sp) + ld a1, 56(sp) + sd ra, 96(sp) + jal miniml_apply + ld ra, 96(sp) + sd a0, 88(sp) + ld t0, 8(sp) + ld t1, 88(sp) + mul t0, t0, t1 + sd t0, 104(sp) + ld t0, 104(sp) + sd t0, 32(sp) +end_1: + ld a0, 32(sp) + addi sp, sp, 104 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, factorial_1 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 5 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_3 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Factorial/FacRecCps.s b/test/Sample/Factorial/FacRecCps.s new file mode 100644 index 0000000..b46b328 --- /dev/null +++ b/test/Sample/Factorial/FacRecCps.s @@ -0,0 +1,178 @@ +.section .data +simp_9: .dword 0 +.section .text +id_2: + addi sp, sp, -8 + sd a0, 8(sp) + ld a0, 8(sp) + addi sp, sp, 8 + ret +ll_10: + addi sp, sp, -48 + sd a0, 8(sp) + sd a1, 16(sp) + sd a2, 24(sp) + ld t0, 8(sp) + ld t1, 24(sp) + mul t0, t0, t1 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + ld a0, 40(sp) + addi sp, sp, 48 + ret +cps_factorial_3: + addi sp, sp, -192 + sd a0, 8(sp) + sd a1, 16(sp) + li t0, 0 + sd t0, 24(sp) + ld t0, 8(sp) + ld t1, 24(sp) + sub t0, t0, t1 + seqz t0, t0 + sd t0, 32(sp) + ld t1, 32(sp) + beqz t1, else_0 + li t0, 1 + sd t0, 48(sp) + ld a0, 16(sp) + ld a1, 48(sp) + sd ra, 64(sp) + jal miniml_apply + ld ra, 64(sp) + sd a0, 56(sp) + ld t0, 56(sp) + sd t0, 40(sp) + j end_1 +else_0: + li t0, 1 + sd t0, 72(sp) + ld t0, 8(sp) + ld t1, 72(sp) + sub t0, t0, t1 + sd t0, 80(sp) + li t0, 2 + sd t0, 88(sp) + la a0, cps_factorial_3 + ld a1, 88(sp) + sd ra, 104(sp) + jal miniml_fun_to_paf + ld ra, 104(sp) + sd a0, 96(sp) + ld a0, 96(sp) + ld a1, 80(sp) + sd ra, 120(sp) + jal miniml_apply + ld ra, 120(sp) + sd a0, 112(sp) + li t0, 3 + sd t0, 128(sp) + la a0, ll_10 + ld a1, 128(sp) + sd ra, 144(sp) + jal miniml_fun_to_paf + ld ra, 144(sp) + sd a0, 136(sp) + ld a0, 136(sp) + ld a1, 8(sp) + sd ra, 160(sp) + jal miniml_apply + ld ra, 160(sp) + sd a0, 152(sp) + ld a0, 152(sp) + ld a1, 16(sp) + sd ra, 176(sp) + jal miniml_apply + ld ra, 176(sp) + sd a0, 168(sp) + ld a0, 112(sp) + ld a1, 168(sp) + sd ra, 192(sp) + jal miniml_apply + ld ra, 192(sp) + sd a0, 184(sp) + ld t0, 184(sp) + sd t0, 40(sp) +end_1: + ld a0, 40(sp) + addi sp, sp, 192 + ret +factorial_8: + addi sp, sp, -88 + sd a0, 8(sp) + li t0, 2 + sd t0, 16(sp) + la a0, cps_factorial_3 + ld a1, 16(sp) + sd ra, 32(sp) + jal miniml_fun_to_paf + ld ra, 32(sp) + sd a0, 24(sp) + ld a0, 24(sp) + ld a1, 8(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, id_2 + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 40(sp) + ld a1, 64(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + ld a0, 80(sp) + addi sp, sp, 88 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, factorial_8 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 5 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_9 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Factorial/FacRecLoop.s b/test/Sample/Factorial/FacRecLoop.s new file mode 100644 index 0000000..cd19e48 --- /dev/null +++ b/test/Sample/Factorial/FacRecLoop.s @@ -0,0 +1,136 @@ +.section .data +simp_6: .dword 0 +.section .text +loop_2: + addi sp, sp, -136 + sd a0, 8(sp) + sd a1, 16(sp) + sd a2, 24(sp) + ld t0, 8(sp) + ld t1, 16(sp) + slt t0, t0, t1 + sd t0, 32(sp) + ld t1, 32(sp) + beqz t1, else_0 + ld t0, 24(sp) + sd t0, 40(sp) + j end_1 +else_0: + li t0, 3 + sd t0, 48(sp) + la a0, loop_2 + ld a1, 48(sp) + sd ra, 64(sp) + jal miniml_fun_to_paf + ld ra, 64(sp) + sd a0, 56(sp) + ld a0, 56(sp) + ld a1, 8(sp) + sd ra, 80(sp) + jal miniml_apply + ld ra, 80(sp) + sd a0, 72(sp) + li t0, 1 + sd t0, 88(sp) + ld t0, 16(sp) + ld t1, 88(sp) + add t0, t0, t1 + sd t0, 96(sp) + ld a0, 72(sp) + ld a1, 96(sp) + sd ra, 112(sp) + jal miniml_apply + ld ra, 112(sp) + sd a0, 104(sp) + ld t0, 24(sp) + ld t1, 16(sp) + mul t0, t0, t1 + sd t0, 120(sp) + ld a0, 104(sp) + ld a1, 120(sp) + sd ra, 136(sp) + jal miniml_apply + ld ra, 136(sp) + sd a0, 128(sp) + ld t0, 128(sp) + sd t0, 40(sp) +end_1: + ld a0, 40(sp) + addi sp, sp, 136 + ret +factorial_5: + addi sp, sp, -96 + sd a0, 8(sp) + li t0, 3 + sd t0, 16(sp) + la a0, loop_2 + ld a1, 16(sp) + sd ra, 32(sp) + jal miniml_fun_to_paf + ld ra, 32(sp) + sd a0, 24(sp) + ld a0, 24(sp) + ld a1, 8(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + ld a0, 40(sp) + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_apply + ld ra, 72(sp) + sd a0, 64(sp) + li t0, 1 + sd t0, 80(sp) + ld a0, 64(sp) + ld a1, 80(sp) + sd ra, 96(sp) + jal miniml_apply + ld ra, 96(sp) + sd a0, 88(sp) + ld a0, 88(sp) + addi sp, sp, 96 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, factorial_5 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 5 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_6 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Fibonacci/FibRec.s b/test/Sample/Fibonacci/FibRec.s new file mode 100644 index 0000000..fd78d77 --- /dev/null +++ b/test/Sample/Fibonacci/FibRec.s @@ -0,0 +1,108 @@ +.section .data +simp_3: .dword 0 +.section .text +fib_1: + addi sp, sp, -152 + sd a0, 8(sp) + li t0, 2 + sd t0, 16(sp) + ld t0, 8(sp) + ld t1, 16(sp) + slt t0, t0, t1 + sd t0, 24(sp) + ld t1, 24(sp) + beqz t1, else_0 + ld t0, 8(sp) + sd t0, 32(sp) + j end_1 +else_0: + li t0, 1 + sd t0, 40(sp) + ld t0, 8(sp) + ld t1, 40(sp) + sub t0, t0, t1 + sd t0, 48(sp) + li t0, 1 + sd t0, 56(sp) + la a0, fib_1 + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 48(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + li t0, 2 + sd t0, 96(sp) + ld t0, 8(sp) + ld t1, 96(sp) + sub t0, t0, t1 + sd t0, 104(sp) + li t0, 1 + sd t0, 112(sp) + la a0, fib_1 + ld a1, 112(sp) + sd ra, 128(sp) + jal miniml_fun_to_paf + ld ra, 128(sp) + sd a0, 120(sp) + ld a0, 120(sp) + ld a1, 104(sp) + sd ra, 144(sp) + jal miniml_apply + ld ra, 144(sp) + sd a0, 136(sp) + ld t0, 80(sp) + ld t1, 136(sp) + add t0, t0, t1 + sd t0, 152(sp) + ld t0, 152(sp) + sd t0, 32(sp) +end_1: + ld a0, 32(sp) + addi sp, sp, 152 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, fib_1 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 10 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_3 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Fibonacci/FibRecCps.s b/test/Sample/Fibonacci/FibRecCps.s new file mode 100644 index 0000000..8742e25 --- /dev/null +++ b/test/Sample/Fibonacci/FibRecCps.s @@ -0,0 +1,238 @@ +.section .data +simp_10: .dword 0 +.section .text +id_2: + addi sp, sp, -8 + sd a0, 8(sp) + ld a0, 8(sp) + addi sp, sp, 8 + ret +ll_12: + addi sp, sp, -48 + sd a0, 8(sp) + sd a1, 16(sp) + sd a2, 24(sp) + ld t0, 16(sp) + ld t1, 24(sp) + add t0, t0, t1 + sd t0, 32(sp) + ld a0, 8(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + ld a0, 40(sp) + addi sp, sp, 48 + ret +ll_11: + addi sp, sp, -136 + sd a0, 8(sp) + sd a1, 16(sp) + sd a2, 24(sp) + sd a3, 32(sp) + li t0, 2 + sd t0, 40(sp) + ld t0, 16(sp) + ld t1, 40(sp) + sub t0, t0, t1 + sd t0, 48(sp) + ld a0, 8(sp) + ld a1, 48(sp) + sd ra, 64(sp) + jal miniml_apply + ld ra, 64(sp) + sd a0, 56(sp) + li t0, 3 + sd t0, 72(sp) + la a0, ll_12 + ld a1, 72(sp) + sd ra, 88(sp) + jal miniml_fun_to_paf + ld ra, 88(sp) + sd a0, 80(sp) + ld a0, 80(sp) + ld a1, 24(sp) + sd ra, 104(sp) + jal miniml_apply + ld ra, 104(sp) + sd a0, 96(sp) + ld a0, 96(sp) + ld a1, 32(sp) + sd ra, 120(sp) + jal miniml_apply + ld ra, 120(sp) + sd a0, 112(sp) + ld a0, 56(sp) + ld a1, 112(sp) + sd ra, 136(sp) + jal miniml_apply + ld ra, 136(sp) + sd a0, 128(sp) + ld a0, 128(sp) + addi sp, sp, 136 + ret +fib_cps_4: + addi sp, sp, -232 + sd a0, 8(sp) + sd a1, 16(sp) + li t0, 3 + sd t0, 24(sp) + ld t0, 8(sp) + ld t1, 24(sp) + slt t0, t0, t1 + sd t0, 32(sp) + ld t1, 32(sp) + beqz t1, else_0 + li t0, 1 + sd t0, 48(sp) + ld a0, 16(sp) + ld a1, 48(sp) + sd ra, 64(sp) + jal miniml_apply + ld ra, 64(sp) + sd a0, 56(sp) + ld t0, 56(sp) + sd t0, 40(sp) + j end_1 +else_0: + li t0, 1 + sd t0, 72(sp) + ld t0, 8(sp) + ld t1, 72(sp) + sub t0, t0, t1 + sd t0, 80(sp) + li t0, 2 + sd t0, 88(sp) + la a0, fib_cps_4 + ld a1, 88(sp) + sd ra, 104(sp) + jal miniml_fun_to_paf + ld ra, 104(sp) + sd a0, 96(sp) + ld a0, 96(sp) + ld a1, 80(sp) + sd ra, 120(sp) + jal miniml_apply + ld ra, 120(sp) + sd a0, 112(sp) + li t0, 4 + sd t0, 128(sp) + la a0, ll_11 + ld a1, 128(sp) + sd ra, 144(sp) + jal miniml_fun_to_paf + ld ra, 144(sp) + sd a0, 136(sp) + li t0, 2 + sd t0, 152(sp) + la a0, fib_cps_4 + ld a1, 152(sp) + sd ra, 168(sp) + jal miniml_fun_to_paf + ld ra, 168(sp) + sd a0, 160(sp) + ld a0, 136(sp) + ld a1, 160(sp) + sd ra, 184(sp) + jal miniml_apply + ld ra, 184(sp) + sd a0, 176(sp) + ld a0, 176(sp) + ld a1, 8(sp) + sd ra, 200(sp) + jal miniml_apply + ld ra, 200(sp) + sd a0, 192(sp) + ld a0, 192(sp) + ld a1, 16(sp) + sd ra, 216(sp) + jal miniml_apply + ld ra, 216(sp) + sd a0, 208(sp) + ld a0, 112(sp) + ld a1, 208(sp) + sd ra, 232(sp) + jal miniml_apply + ld ra, 232(sp) + sd a0, 224(sp) + ld t0, 224(sp) + sd t0, 40(sp) +end_1: + ld a0, 40(sp) + addi sp, sp, 232 + ret +fib_9: + addi sp, sp, -88 + sd a0, 8(sp) + li t0, 2 + sd t0, 16(sp) + la a0, fib_cps_4 + ld a1, 16(sp) + sd ra, 32(sp) + jal miniml_fun_to_paf + ld ra, 32(sp) + sd a0, 24(sp) + ld a0, 24(sp) + ld a1, 8(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, id_2 + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 40(sp) + ld a1, 64(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + ld a0, 80(sp) + addi sp, sp, 88 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, fib_9 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 10 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_10 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Fibonacci/FibRecLoop.s b/test/Sample/Fibonacci/FibRecLoop.s new file mode 100644 index 0000000..f512ceb --- /dev/null +++ b/test/Sample/Fibonacci/FibRecLoop.s @@ -0,0 +1,139 @@ +.section .data +simp_7: .dword 0 +.section .text +loop_2: + addi sp, sp, -144 + sd a0, 8(sp) + sd a1, 16(sp) + sd a2, 24(sp) + li t0, 0 + sd t0, 32(sp) + ld t0, 8(sp) + ld t1, 32(sp) + sub t0, t0, t1 + seqz t0, t0 + sd t0, 40(sp) + ld t1, 40(sp) + beqz t1, else_0 + ld t0, 16(sp) + sd t0, 48(sp) + j end_1 +else_0: + li t0, 1 + sd t0, 56(sp) + ld t0, 8(sp) + ld t1, 56(sp) + sub t0, t0, t1 + sd t0, 64(sp) + li t0, 3 + sd t0, 72(sp) + la a0, loop_2 + ld a1, 72(sp) + sd ra, 88(sp) + jal miniml_fun_to_paf + ld ra, 88(sp) + sd a0, 80(sp) + ld a0, 80(sp) + ld a1, 64(sp) + sd ra, 104(sp) + jal miniml_apply + ld ra, 104(sp) + sd a0, 96(sp) + ld a0, 96(sp) + ld a1, 24(sp) + sd ra, 120(sp) + jal miniml_apply + ld ra, 120(sp) + sd a0, 112(sp) + ld t0, 16(sp) + ld t1, 24(sp) + add t0, t0, t1 + sd t0, 128(sp) + ld a0, 112(sp) + ld a1, 128(sp) + sd ra, 144(sp) + jal miniml_apply + ld ra, 144(sp) + sd a0, 136(sp) + ld t0, 136(sp) + sd t0, 48(sp) +end_1: + ld a0, 48(sp) + addi sp, sp, 144 + ret +fib_6: + addi sp, sp, -96 + sd a0, 8(sp) + li t0, 3 + sd t0, 16(sp) + la a0, loop_2 + ld a1, 16(sp) + sd ra, 32(sp) + jal miniml_fun_to_paf + ld ra, 32(sp) + sd a0, 24(sp) + ld a0, 24(sp) + ld a1, 8(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 0 + sd t0, 56(sp) + ld a0, 40(sp) + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_apply + ld ra, 72(sp) + sd a0, 64(sp) + li t0, 1 + sd t0, 80(sp) + ld a0, 64(sp) + ld a1, 80(sp) + sd ra, 96(sp) + jal miniml_apply + ld ra, 96(sp) + sd a0, 88(sp) + ld a0, 88(sp) + addi sp, sp, 96 + ret +.globl _start +_start: + addi sp, sp, -88 + li t0, 1 + sd t0, 8(sp) + la a0, fib_6 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 10 + sd t0, 32(sp) + ld a0, 16(sp) + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_apply + ld ra, 48(sp) + sd a0, 40(sp) + li t0, 1 + sd t0, 56(sp) + la a0, print_int + ld a1, 56(sp) + sd ra, 72(sp) + jal miniml_fun_to_paf + ld ra, 72(sp) + sd a0, 64(sp) + ld a0, 64(sp) + ld a1, 40(sp) + sd ra, 88(sp) + jal miniml_apply + ld ra, 88(sp) + sd a0, 80(sp) + la t0, simp_7 + ld t1, 80(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 88 + li a0, 0 + jal exit diff --git a/test/Sample/Simple/SimpleTest.s b/test/Sample/Simple/SimpleTest.s new file mode 100644 index 0000000..d723a5e --- /dev/null +++ b/test/Sample/Simple/SimpleTest.s @@ -0,0 +1,69 @@ +.section .data +simp_5: .dword 0 +.section .text +id_2: + addi sp, sp, -8 + sd a0, 8(sp) + ld a0, 8(sp) + addi sp, sp, 8 + ret +k_4: + addi sp, sp, -32 + sd a0, 8(sp) + li t0, 42 + sd t0, 16(sp) + ld a0, 8(sp) + ld a1, 16(sp) + sd ra, 32(sp) + jal miniml_apply + ld ra, 32(sp) + sd a0, 24(sp) + ld a0, 24(sp) + addi sp, sp, 32 + ret +.globl _start +_start: + addi sp, sp, -104 + li t0, 1 + sd t0, 8(sp) + la a0, k_4 + ld a1, 8(sp) + sd ra, 24(sp) + jal miniml_fun_to_paf + ld ra, 24(sp) + sd a0, 16(sp) + li t0, 1 + sd t0, 32(sp) + la a0, id_2 + ld a1, 32(sp) + sd ra, 48(sp) + jal miniml_fun_to_paf + ld ra, 48(sp) + sd a0, 40(sp) + ld a0, 16(sp) + ld a1, 40(sp) + sd ra, 64(sp) + jal miniml_apply + ld ra, 64(sp) + sd a0, 56(sp) + li t0, 1 + sd t0, 72(sp) + la a0, print_int + ld a1, 72(sp) + sd ra, 88(sp) + jal miniml_fun_to_paf + ld ra, 88(sp) + sd a0, 80(sp) + ld a0, 80(sp) + ld a1, 56(sp) + sd ra, 104(sp) + jal miniml_apply + ld ra, 104(sp) + sd a0, 96(sp) + la t0, simp_5 + ld t1, 96(sp) + sd t1, 0(t0) + li a0, 0 + addi sp, sp, 104 + li a0, 0 + jal exit diff --git a/test/Sample/Utils.hs b/test/Sample/Utils.hs index 9075424..ad1631f 100644 --- a/test/Sample/Utils.hs +++ b/test/Sample/Utils.hs @@ -1,6 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module Sample.Utils where +module Sample.Utils + ( testPhases, + TestFileProvider, + ) +where import qualified Data.ByteString.Lazy.Char8 as LBSC8 import qualified Data.Text.IO as TxtIO @@ -11,6 +15,7 @@ import Test.Tasty.HUnit (testCase, (@?=)) import Text.Pretty.Simple (pShowNoColor) import Utils ( processTillAnfGen, + processTillAsm, processTillLlvmIr, processTillLlvmRunOutput, processTillParser, @@ -27,7 +32,8 @@ testPhases name testFileProvider = testTypeCheck testFileProvider, testAstToAnf testFileProvider, testLlvm testFileProvider, - testLlvmRun testFileProvider + testLlvmRun testFileProvider, + testAsm testFileProvider ] testParsing :: TestFileProvider -> TestTree @@ -63,3 +69,10 @@ testLlvmRun testFileProvider = "LLVM run" (testFileProvider "out") (LBSC8.pack . processTillLlvmRunOutput <$> TxtIO.readFile (testFileProvider "ml")) + +testAsm :: TestFileProvider -> TestTree +testAsm testFileProvider = + goldenVsString + "RISC-V ASM" + (testFileProvider "s") + (LBSC8.pack . processTillAsm <$> TxtIO.readFile (testFileProvider "ml")) diff --git a/test/Utils.hs b/test/Utils.hs index a9d1628..3fdd08c 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -11,12 +11,14 @@ module Utils processTillAnfGen, processTillLlvmIr, processTillLlvmRunOutput, + processTillAsm, ) where import CodeGen.Llvm.LlvmIrGen (genLlvmIrModule, ppLlvmModule) import CodeGen.Llvm.Runner (run) import CodeGen.Module (Module (Module)) +import CodeGen.RiscV.RiscVGen (ppRiscVAsm) import CodeGen.RunResult (RunResult (Success)) import Data.Either (isRight) import Data.Maybe (fromJust) @@ -70,6 +72,9 @@ processTillLlvmRunOutput program = let Success out _ _ = unsafePerformIO $ run program in Txt.unpack out +processTillAsm :: Text -> String +processTillAsm program = ppRiscVAsm $ Module (processTillAnfGen' program) + -- Combinators processTillParser' :: Text -> Maybe Ast.Program From 3a1e4219e419e858dd57b2aeb9c0386c3d6507d4 Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 2/7] Integrate RISC-V code generation into the app --- app/Commands/Compile.hs | 4 +++ app/Commands/PrintCRuntime.hs | 16 ++++++++++ app/Configuration/AppConfiguration.hs | 14 +++++++-- app/Configuration/Commands/MiniMl.hs | 3 +- app/Configuration/Commands/PrintCRuntime.hs | 34 +++++++++++++++++++++ app/Main.hs | 2 ++ lib/CodeGen/RiscV/Runner.hs | 20 ++++++++++++ lib/CodeGen/Runtime/PrintRuntime.hs | 14 +++++++++ miniml.cabal | 4 +++ 9 files changed, 107 insertions(+), 4 deletions(-) create mode 100644 app/Commands/PrintCRuntime.hs create mode 100644 app/Configuration/Commands/PrintCRuntime.hs create mode 100644 lib/CodeGen/RiscV/Runner.hs create mode 100644 lib/CodeGen/Runtime/PrintRuntime.hs diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index 1d634bc..16434e4 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -4,6 +4,7 @@ module Commands.Compile (compile) where import CodeGen.Llvm.Runner (compileToBinary, compileToLlvmIr) +import CodeGen.RiscV.Runner (compileToRiscVAsm) import CodeGen.TimedValue (TimedValue (TimedValue)) import Configuration.AppConfiguration (CompilationTarget (..), Compile (..), Debug (Yes), Input (..), Output (..)) import Control.Monad (when) @@ -26,6 +27,9 @@ compile (Compile input target output) debug = do TargetLlvmIr -> do let outputFilePath = outputToFilePath output moduleName "ll" compileToLlvmIr text outputFilePath + TargetRiscVAsm -> do + let outputFilePath = outputToFilePath output moduleName "s" + compileToRiscVAsm text outputFilePath when (debug == Yes) $ do putStrLn $ Printf.printf "Finished compiling in %0.5f sec" (ns2s compTime) diff --git a/app/Commands/PrintCRuntime.hs b/app/Commands/PrintCRuntime.hs new file mode 100644 index 0000000..4d85c94 --- /dev/null +++ b/app/Commands/PrintCRuntime.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Commands.PrintCRuntime (printCRuntime) where + +import qualified CodeGen.Runtime.PrintRuntime as R +import Configuration.AppConfiguration (Output (..), PrintCRuntime (..)) + +printCRuntime :: PrintCRuntime -> IO () +printCRuntime (PrintCRuntime output) = do + R.printCRuntime $ outputToFilePath output + +outputToFilePath :: Output -> FilePath +outputToFilePath = \case + FileOutput filePath -> filePath + AutoFileOutput -> "runtime.c" diff --git a/app/Configuration/AppConfiguration.hs b/app/Configuration/AppConfiguration.hs index 4acf56b..2a85b32 100644 --- a/app/Configuration/AppConfiguration.hs +++ b/app/Configuration/AppConfiguration.hs @@ -8,6 +8,7 @@ data MiniMl = MiniMl Command Debug data Command = CmdRun Run | CmdCompile Compile + | CmdPrintCRuntime PrintCRuntime deriving (Show) data Debug @@ -28,15 +29,17 @@ data Compile = Compile Input CompilationTarget Output data CompilationTarget = TargetBinary | TargetLlvmIr + | TargetRiscVAsm deriving (Enum, Bounded) instance Show CompilationTarget where show TargetBinary = "binary" show TargetLlvmIr = "llvm-ir" + show TargetRiscVAsm = "risc-v-asm" -data Output - = FileOutput FilePath - | AutoFileOutput +-- ** Print C Runtime Configuration + +newtype PrintCRuntime = PrintCRuntime Output deriving (Show) -- ** Common Configuration @@ -45,3 +48,8 @@ data Input = StdInput | FileInput FilePath deriving (Show) + +data Output + = FileOutput FilePath + | AutoFileOutput + deriving (Show) diff --git a/app/Configuration/Commands/MiniMl.hs b/app/Configuration/Commands/MiniMl.hs index 8f1b96a..41dd1ad 100644 --- a/app/Configuration/Commands/MiniMl.hs +++ b/app/Configuration/Commands/MiniMl.hs @@ -2,6 +2,7 @@ module Configuration.Commands.MiniMl (miniMl) where import Configuration.AppConfiguration (Debug (..), MiniMl (MiniMl)) import Configuration.Commands.Compile (compile) +import Configuration.Commands.PrintCRuntime (printCRuntime) import Configuration.Commands.Run (run) import Options.Applicative @@ -20,7 +21,7 @@ miniMlParserInfo :: ParserInfo MiniMl miniMlParserInfo = info (miniMlParser <**> helper) miniMlInfoMod miniMlParser :: Parser MiniMl -miniMlParser = MiniMl <$> hsubparser (run <> compile) <*> debugParser +miniMlParser = MiniMl <$> hsubparser (run <> compile <> printCRuntime) <*> debugParser miniMlInfoMod :: InfoMod a miniMlInfoMod = diff --git a/app/Configuration/Commands/PrintCRuntime.hs b/app/Configuration/Commands/PrintCRuntime.hs new file mode 100644 index 0000000..365ad7c --- /dev/null +++ b/app/Configuration/Commands/PrintCRuntime.hs @@ -0,0 +1,34 @@ +module Configuration.Commands.PrintCRuntime (printCRuntime) where + +import Configuration.AppConfiguration +import Options.Applicative + +printCRuntime :: Mod CommandFields Command +printCRuntime = command "print-c-runtime" compileParserInfo + +compileParserInfo :: ParserInfo Command +compileParserInfo = info printCRuntimeParser printCRuntimeInfoMod + +printCRuntimeParser :: Parser Command +printCRuntimeParser = + CmdPrintCRuntime . PrintCRuntime <$> outputParser + +printCRuntimeInfoMod :: InfoMod a +printCRuntimeInfoMod = + fullDesc + <> header "Print C runtime" + <> progDesc "Print C runtime" + +outputParser :: Parser Output +outputParser = fileOutputP <|> defaultP + where + fileOutputP = + FileOutput + <$> strOption + ( long "output" + <> short 'o' + <> metavar "OUTPUT" + <> help "Output file path (default: runtime.c)" + ) + + defaultP = pure AutoFileOutput diff --git a/app/Main.hs b/app/Main.hs index b18bdbb..50876f5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,7 @@ module Main where import Commands.Compile (compile) +import Commands.PrintCRuntime (printCRuntime) import Commands.Run (run) import Configuration.AppConfiguration (Command (..), Debug (Yes), MiniMl (MiniMl)) import Configuration.Commands.MiniMl (miniMl) @@ -19,3 +20,4 @@ main = do case cmd of CmdRun r -> run r d CmdCompile c -> compile c d + CmdPrintCRuntime pcr -> printCRuntime pcr diff --git a/lib/CodeGen/RiscV/Runner.hs b/lib/CodeGen/RiscV/Runner.hs new file mode 100644 index 0000000..b9d9a0b --- /dev/null +++ b/lib/CodeGen/RiscV/Runner.hs @@ -0,0 +1,20 @@ +module CodeGen.RiscV.Runner (compileToRiscVAsm) where + +import CodeGen.Module (compileToModule) +import CodeGen.RiscV.RiscVGen (ppRiscVAsm) +import CodeGen.TimedValue (TimedValue, measureTimedValue) +import Control.Monad.Except (runExcept) +import Data.Text (Text) +import qualified Data.Text as Txt +import qualified Data.Text.IO as Txt +import System.IO (IOMode (WriteMode), withFile) + +compileToRiscVAsm :: Text -> FilePath -> IO (TimedValue (Either Text ())) +compileToRiscVAsm text outputFilePath = measureTimedValue $ + sequenceA $ + runExcept $ do + m <- compileToModule text + let riscVText = Txt.pack $ ppRiscVAsm m + return $ + withFile outputFilePath WriteMode $ \handle -> do + Txt.hPutStr handle riscVText diff --git a/lib/CodeGen/Runtime/PrintRuntime.hs b/lib/CodeGen/Runtime/PrintRuntime.hs new file mode 100644 index 0000000..1e25fbe --- /dev/null +++ b/lib/CodeGen/Runtime/PrintRuntime.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} + +module CodeGen.Runtime.PrintRuntime (printCRuntime) where + +import Data.FileEmbed (embedFile, makeRelativeToProject) +import qualified Data.Text.Encoding as Txt +import qualified Data.Text.IO as Txt +import System.IO (IOMode (WriteMode), withFile) + +printCRuntime :: FilePath -> IO () +printCRuntime outputFilePath = do + let runtimeFileText = Txt.decodeUtf8 $(makeRelativeToProject "lib/CodeGen/Runtime/runtime.c" >>= embedFile) + withFile outputFilePath WriteMode $ \handle -> do + Txt.hPutStr handle runtimeFileText diff --git a/miniml.cabal b/miniml.cabal index 386e3a8..aafb451 100644 --- a/miniml.cabal +++ b/miniml.cabal @@ -34,7 +34,9 @@ library CodeGen.Module CodeGen.RiscV.RiscVGen CodeGen.RiscV.RiscVLib + CodeGen.RiscV.Runner CodeGen.RunResult + CodeGen.Runtime.PrintRuntime CodeGen.TimedValue MonadUtils Parser.Ast @@ -81,10 +83,12 @@ executable miniml main-is: Main.hs other-modules: Commands.Compile + Commands.PrintCRuntime Commands.Run Configuration.AppConfiguration Configuration.Commands.Compile Configuration.Commands.MiniMl + Configuration.Commands.PrintCRuntime Configuration.Commands.Run Configuration.CommonParsers Utils From e54019d0cbf7e640ff5ae9697aaa384fd6c6868a Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 3/7] Update dependencies --- cabal.project | 4 ++-- cabal.project.freeze | 22 +++++++++++----------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/cabal.project b/cabal.project index ffadd11..97d152c 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,6 @@ source-repository-package type: git - location: https://github.com/luc-tielen/llvm-codegen.git - tag: 83b04cb576208ea74ddd62016e4fa03f0df138ac + location: https://github.com/AzimMuradov/llvm-codegen.git + tag: f77d7cd82b40004d7eadc6fcc1ff536db599206e packages: . diff --git a/cabal.project.freeze b/cabal.project.freeze index edc8d7f..da73ed7 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -16,7 +16,7 @@ constraints: any.Cabal ==3.8.1.0, bifunctors +tagged, any.binary ==0.8.9.1, any.bytestring ==0.11.5.3, - any.cabal-doctest ==1.0.9, + any.cabal-doctest ==1.0.10, any.call-stack ==0.4.0, any.case-insensitive ==1.2.1.0, any.clock ==0.8.4, @@ -27,7 +27,7 @@ constraints: any.Cabal ==3.8.1.0, any.containers ==0.6.7, any.contravariant ==1.5.5, contravariant +semigroups +statevar +tagged, - any.data-fix ==0.3.3, + any.data-fix ==0.3.4, any.deepseq ==1.4.8.0, any.directory ==1.3.7.1, any.distributive ==0.6.2.1, @@ -45,20 +45,20 @@ constraints: any.Cabal ==3.8.1.0, any.ghc-bignum ==1.3, any.ghc-boot-th ==9.4.8, any.ghc-prim ==0.9.1, - any.hashable ==1.4.6.0, - hashable +arch-native +integer-gmp -random-initial-seed, + any.hashable ==1.4.7.0, + hashable -arch-native +integer-gmp -random-initial-seed, any.indexed-traversable ==0.1.4, any.integer-logarithms ==1.0.3.1, integer-logarithms -check-bounds +integer-gmp, any.llvm-codegen ==0.1.0.0, - any.logict ==0.8.0.0, + any.logict ==0.8.1.0, any.megaparsec ==9.6.1, megaparsec -dev, any.mmorph ==1.2.0, any.mtl ==2.2.2 || ==2.3.1, any.optparse-applicative ==0.18.1.0, optparse-applicative +process, - any.os-string ==2.0.3, + any.os-string ==2.0.6, any.parsec ==3.1.16.1, any.parser-combinators ==1.3.0, parser-combinators -dev, @@ -91,11 +91,11 @@ constraints: any.Cabal ==3.8.1.0, tasty +unix, any.tasty-golden ==2.3.5, tasty-golden -build-example, - any.tasty-hunit ==0.10.1, + any.tasty-hunit ==0.10.2, any.template-haskell ==2.19.0.0, any.temporary ==1.3, any.text ==2.0.2, - any.text-builder-linear ==0.1.2, + any.text-builder-linear ==0.1.3, any.th-abstraction ==0.7.0.0, any.time ==1.12.2, any.transformers ==0.5.6.2, @@ -103,11 +103,11 @@ constraints: any.Cabal ==3.8.1.0, transformers-base +orphaninstances, any.transformers-compat ==0.7.2, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, - any.typed-process ==0.2.11.1, - any.unification-fd ==0.11.2, + any.typed-process ==0.2.12.0, + any.unification-fd ==0.11.2.2, any.unix ==2.7.3, any.unliftio-core ==0.2.1.0, any.unordered-containers ==0.2.20, unordered-containers -debug, any.utf8-string ==1.0.2 -index-state: hackage.haskell.org 2024-06-20T07:22:15Z +index-state: hackage.haskell.org 2024-09-30T23:17:41Z From daf436700b8db97b2866920b5177d617edc99226 Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 4/7] Reorganize the code --- lib/CodeGen/RiscV/{RiscVGen.hs => AsmGen.hs} | 4 +- lib/CodeGen/RiscV/{RiscVLib.hs => Lib.hs} | 261 +------------------ lib/CodeGen/RiscV/Lib/Monad.hs | 74 ++++++ lib/CodeGen/RiscV/Lib/Types.hs | 181 +++++++++++++ lib/CodeGen/RiscV/Runner.hs | 2 +- miniml.cabal | 6 +- test/Utils.hs | 2 +- 7 files changed, 267 insertions(+), 263 deletions(-) rename lib/CodeGen/RiscV/{RiscVGen.hs => AsmGen.hs} (98%) rename lib/CodeGen/RiscV/{RiscVLib.hs => Lib.hs} (61%) create mode 100644 lib/CodeGen/RiscV/Lib/Monad.hs create mode 100644 lib/CodeGen/RiscV/Lib/Types.hs diff --git a/lib/CodeGen/RiscV/RiscVGen.hs b/lib/CodeGen/RiscV/AsmGen.hs similarity index 98% rename from lib/CodeGen/RiscV/RiscVGen.hs rename to lib/CodeGen/RiscV/AsmGen.hs index 270c907..b168f10 100644 --- a/lib/CodeGen/RiscV/RiscVGen.hs +++ b/lib/CodeGen/RiscV/AsmGen.hs @@ -3,10 +3,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecursiveDo #-} -module CodeGen.RiscV.RiscVGen (ppRiscVAsm) where +module CodeGen.RiscV.AsmGen (ppRiscVAsm) where import CodeGen.Module (Module (..)) -import qualified CodeGen.RiscV.RiscVLib as Asm +import qualified CodeGen.RiscV.Lib as Asm import Control.Monad.State (MonadState, State, evalState, gets, modify) import Data.Map (Map) import qualified Data.Map as Map diff --git a/lib/CodeGen/RiscV/RiscVLib.hs b/lib/CodeGen/RiscV/Lib.hs similarity index 61% rename from lib/CodeGen/RiscV/RiscVLib.hs rename to lib/CodeGen/RiscV/Lib.hs index 8768276..f90f2fd 100644 --- a/lib/CodeGen/RiscV/RiscVLib.hs +++ b/lib/CodeGen/RiscV/Lib.hs @@ -1,13 +1,6 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -module CodeGen.RiscV.RiscVLib +module CodeGen.RiscV.Lib ( compileT, compile, mainFunction, @@ -37,14 +30,12 @@ module CodeGen.RiscV.RiscVLib ) where +import CodeGen.RiscV.Lib.Monad +import CodeGen.RiscV.Lib.Types import Control.Monad (replicateM, void) -import Control.Monad.Fix (MonadFix) import Control.Monad.Identity (Identity (..)) -import Control.Monad.State (MonadState (..), StateT (..), execStateT, get, modify) -import Control.Monad.Trans (MonadTrans (..)) -import Data.Char (isSpace) +import Control.Monad.State (execStateT) import Data.Int (Int64) -import Data.List (intercalate) import Data.Text (Text) import qualified Data.Text as Txt import Prelude hiding (and, or) @@ -141,87 +132,6 @@ storeToLabeledAddr addr value = do return () --- MONADS : START - -newtype AsmBuilderT m a = AsmBuilderT {unAsmBuilderT :: StateT BuilderState m a} - deriving (Functor, Applicative, Monad, MonadFix) via StateT BuilderState m - -data BuilderState = BS - { programBS :: ProgramBuilderState, - functionBS :: FunctionBuilderState, - idCnt :: Integer - } - -data ProgramBuilderState = PBS - { sectionText :: [[CodeLine]], - sectionData :: [CodeLine] - } - -data FunctionBuilderState = FBS - { functionCodeLines :: [[CodeLine]], - stackPointerOffset :: Int64 -- In double words - } - -emptyBS :: BuilderState -emptyBS = BS emptyPBS emptyFBS 0 - -emptyPBS :: ProgramBuilderState -emptyPBS = PBS [] [] - -emptyFBS :: FunctionBuilderState -emptyFBS = FBS [] 0 - -instance (MonadState s m) => MonadState s (AsmBuilderT m) where - state = lift . state - -instance MonadTrans AsmBuilderT where - lift = AsmBuilderT . lift - -type AsmBuilder = AsmBuilderT Identity - -class (Monad m) => MonadAsmBuilder m where - getAsmBuilderState :: m BuilderState - - modifyAsmBuilderState :: (BuilderState -> BuilderState) -> m () - - default getAsmBuilderState :: - (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => - m BuilderState - getAsmBuilderState = lift getAsmBuilderState - - default modifyAsmBuilderState :: - (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => - (BuilderState -> BuilderState) -> - m () - modifyAsmBuilderState = lift . modifyAsmBuilderState - -instance (Monad m) => MonadAsmBuilder (AsmBuilderT m) where - getAsmBuilderState = AsmBuilderT get - - modifyAsmBuilderState = AsmBuilderT . modify - -instance (MonadAsmBuilder m) => MonadAsmBuilder (StateT s m) - --- MONADS : END - -data Operand - = Immediate Int64 - | Register Register - | Memory Offset - | RegisterWithOffset Register Offset - | Symbol Text - deriving (Eq, Ord) - -instance Show Operand where - show :: Operand -> String - show (Immediate i) = show i - show (Register r) = show r - show (Memory o) = show (dword * o) ++ "(sp)" - show (RegisterWithOffset r o) = show (dword * o) ++ "(" ++ show r ++ ")" - show (Symbol t) = Txt.unpack t - -type Offset = Int64 - immediate :: (MonadAsmBuilder m) => Int64 -> m Operand immediate value = do let rd = Register T0 @@ -235,157 +145,6 @@ immediate value = do return rdMem -data CodeLine - = LabeledDirectiveCodeLine Label Directive - | LabelCodeLine Label - | InstructionCodeLine Instruction - | DirectiveCodeLine Directive - -instance Show CodeLine where - show :: CodeLine -> String - show (LabeledDirectiveCodeLine l d) = spaceSep [show l, show d] - show (LabelCodeLine l) = show l - show (InstructionCodeLine i) = " " ++ show i - show (DirectiveCodeLine d) = show d - -newtype Label = Label Text - -instance Show Label where - show :: Label -> String - show (Label txt) = Txt.unpack txt ++ ":" - -data Instruction = Instruction OpCode [Operand] - -instance Show Instruction where - show :: Instruction -> String - show (Instruction opCode args) = spaceSep [show opCode, commaSep $ show <$> args] - -data Directive - = DirText - | DirData - | DirDWord Int64 - | DirGlobl Text - -instance Show Directive where - show :: Directive -> String - show DirText = ".section .text" - show DirData = ".section .data" - show (DirDWord initVal) = spaceSep [".dword", show initVal] - show (DirGlobl name) = spaceSep [".globl", Txt.unpack name] - -data OpCode - = Add - | Sub - | Mul - | And - | Or - | Not - | Seqz - | Snez - | Slt - | Ld - | Sd - | Addi - | Li - | La - | Neg - | Ret - | Jal - | Beqz - | J - -instance Show OpCode where - show :: OpCode -> String - show Add = "add" - show Sub = "sub" - show Mul = "mul" - show And = "and" - show Or = "or" - show Not = "not" - show Seqz = "seqz" - show Snez = "snez" - show Slt = "slt" - show Ld = "ld" - show Sd = "sd" - show Addi = "addi" - show Li = "li" - show La = "la" - show Neg = "neg" - show Ret = "ret" - show Jal = "jal" - show Beqz = "beqz" - show J = "j" - -data Register - = Zero -- zero == x0 - | Ra -- ra == x1 - | Sp -- sp == x2 - | Gp -- gp == x3 - | Tp -- tp == x4 - | T0 -- t0 == x5 - | T1 -- t1 == x6 - | T2 -- t2 == x7 - | S0 -- s0 == x8 - | S1 -- s1 == x9 - | A0 -- a0 == x10 - | A1 -- a1 == x11 - | A2 -- a2 == x12 - | A3 -- a3 == x13 - | A4 -- a4 == x14 - | A5 -- a5 == x15 - | A6 -- a6 == x16 - | A7 -- a7 == x17 - | S2 -- s2 == x18 - | S3 -- s3 == x19 - | S4 -- s4 == x20 - | S5 -- s5 == x21 - | S6 -- s6 == x22 - | S7 -- s7 == x23 - | S8 -- s8 == x24 - | S9 -- s9 == x25 - | S10 -- s10 == x26 - | S11 -- s11 == x27 - | T3 -- t3 == x28 - | T4 -- t4 == x29 - | T5 -- t5 == x30 - | T6 -- t6 == x31 - deriving (Eq, Ord) - -instance Show Register where - show :: Register -> String - show Zero = "zero" - show Ra = "ra" - show Sp = "sp" - show Gp = "gp" - show Tp = "tp" - show T0 = "t0" - show T1 = "t1" - show T2 = "t2" - show S0 = "s0" - show S1 = "s1" - show A0 = "a0" - show A1 = "a1" - show A2 = "a2" - show A3 = "a3" - show A4 = "a4" - show A5 = "a5" - show A6 = "a6" - show A7 = "a7" - show S2 = "s2" - show S3 = "s3" - show S4 = "s4" - show S5 = "s5" - show S6 = "s6" - show S7 = "s7" - show S8 = "s8" - show S9 = "s9" - show S10 = "s10" - show S11 = "s11" - show T3 = "t3" - show T4 = "t4" - show T5 = "t5" - show T6 = "t6" - -- boolean and, or :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand and = genOpCodeInstruction1 And @@ -546,15 +305,3 @@ genId = do cnt <- idCnt <$> getAsmBuilderState modifyAsmBuilderState $ \bs -> bs {idCnt = cnt + 1} return cnt - -dword :: Int64 -dword = 8 - -commaSep :: [String] -> String -commaSep = intercalate ", " . filterOutBlankStrings - -spaceSep :: [String] -> String -spaceSep = unwords . filterOutBlankStrings - -filterOutBlankStrings :: [String] -> [String] -filterOutBlankStrings = filter (not . all isSpace) diff --git a/lib/CodeGen/RiscV/Lib/Monad.hs b/lib/CodeGen/RiscV/Lib/Monad.hs new file mode 100644 index 0000000..f9c7df8 --- /dev/null +++ b/lib/CodeGen/RiscV/Lib/Monad.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module CodeGen.RiscV.Lib.Monad where + +import CodeGen.RiscV.Lib.Types (CodeLine) +import Control.Monad.Fix (MonadFix) +import Control.Monad.Identity (Identity (..)) +import Control.Monad.State (MonadState (..), StateT (..), get, modify) +import Control.Monad.Trans (MonadTrans (..)) +import Data.Int (Int64) + +newtype AsmBuilderT m a = AsmBuilderT {unAsmBuilderT :: StateT BuilderState m a} + deriving (Functor, Applicative, Monad, MonadFix) via StateT BuilderState m + +data BuilderState = BS + { programBS :: ProgramBuilderState, + functionBS :: FunctionBuilderState, + idCnt :: Integer + } + +data ProgramBuilderState = PBS + { sectionText :: [[CodeLine]], + sectionData :: [CodeLine] + } + +data FunctionBuilderState = FBS + { functionCodeLines :: [[CodeLine]], + stackPointerOffset :: Int64 -- In double words + } + +emptyBS :: BuilderState +emptyBS = BS emptyPBS emptyFBS 0 + +emptyPBS :: ProgramBuilderState +emptyPBS = PBS [] [] + +emptyFBS :: FunctionBuilderState +emptyFBS = FBS [] 0 + +instance (MonadState s m) => MonadState s (AsmBuilderT m) where + state = lift . state + +instance MonadTrans AsmBuilderT where + lift = AsmBuilderT . lift + +type AsmBuilder = AsmBuilderT Identity + +class (Monad m) => MonadAsmBuilder m where + getAsmBuilderState :: m BuilderState + + modifyAsmBuilderState :: (BuilderState -> BuilderState) -> m () + + default getAsmBuilderState :: + (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => + m BuilderState + getAsmBuilderState = lift getAsmBuilderState + + default modifyAsmBuilderState :: + (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) => + (BuilderState -> BuilderState) -> + m () + modifyAsmBuilderState = lift . modifyAsmBuilderState + +instance (Monad m) => MonadAsmBuilder (AsmBuilderT m) where + getAsmBuilderState = AsmBuilderT get + + modifyAsmBuilderState = AsmBuilderT . modify + +instance (MonadAsmBuilder m) => MonadAsmBuilder (StateT s m) diff --git a/lib/CodeGen/RiscV/Lib/Types.hs b/lib/CodeGen/RiscV/Lib/Types.hs new file mode 100644 index 0000000..f0c05f4 --- /dev/null +++ b/lib/CodeGen/RiscV/Lib/Types.hs @@ -0,0 +1,181 @@ +module CodeGen.RiscV.Lib.Types where + +import Data.Char (isSpace) +import Data.Int (Int64) +import Data.List (intercalate) +import Data.Text (Text) +import qualified Data.Text as Txt + +data CodeLine + = LabeledDirectiveCodeLine Label Directive + | LabelCodeLine Label + | InstructionCodeLine Instruction + | DirectiveCodeLine Directive + +instance Show CodeLine where + show (LabeledDirectiveCodeLine l d) = spaceSep [show l, show d] + show (LabelCodeLine l) = show l + show (InstructionCodeLine i) = " " ++ show i + show (DirectiveCodeLine d) = show d + +newtype Label = Label Text + +instance Show Label where + show (Label txt) = Txt.unpack txt ++ ":" + +data Instruction = Instruction OpCode [Operand] + +instance Show Instruction where + show (Instruction opCode args) = spaceSep [show opCode, commaSep $ show <$> args] + +data Directive + = DirText + | DirData + | DirDWord Int64 + | DirGlobl Text + +instance Show Directive where + show DirText = ".section .text" + show DirData = ".section .data" + show (DirDWord initVal) = spaceSep [".dword", show initVal] + show (DirGlobl name) = spaceSep [".globl", Txt.unpack name] + +data OpCode + = Add + | Sub + | Mul + | And + | Or + | Not + | Seqz + | Snez + | Slt + | Ld + | Sd + | Addi + | Li + | La + | Neg + | Ret + | Jal + | Beqz + | J + +instance Show OpCode where + show Add = "add" + show Sub = "sub" + show Mul = "mul" + show And = "and" + show Or = "or" + show Not = "not" + show Seqz = "seqz" + show Snez = "snez" + show Slt = "slt" + show Ld = "ld" + show Sd = "sd" + show Addi = "addi" + show Li = "li" + show La = "la" + show Neg = "neg" + show Ret = "ret" + show Jal = "jal" + show Beqz = "beqz" + show J = "j" + +data Operand + = Immediate Int64 + | Register Register + | Memory Offset + | RegisterWithOffset Register Offset + | Symbol Text + deriving (Eq, Ord) + +instance Show Operand where + show (Immediate i) = show i + show (Register r) = show r + show (Memory o) = show (dword * o) ++ "(sp)" + show (RegisterWithOffset r o) = show (dword * o) ++ "(" ++ show r ++ ")" + show (Symbol t) = Txt.unpack t + +type Offset = Int64 + +data Register + = Zero -- zero == x0 + | Ra -- ra == x1 + | Sp -- sp == x2 + | Gp -- gp == x3 + | Tp -- tp == x4 + | T0 -- t0 == x5 + | T1 -- t1 == x6 + | T2 -- t2 == x7 + | S0 -- s0 == x8 + | S1 -- s1 == x9 + | A0 -- a0 == x10 + | A1 -- a1 == x11 + | A2 -- a2 == x12 + | A3 -- a3 == x13 + | A4 -- a4 == x14 + | A5 -- a5 == x15 + | A6 -- a6 == x16 + | A7 -- a7 == x17 + | S2 -- s2 == x18 + | S3 -- s3 == x19 + | S4 -- s4 == x20 + | S5 -- s5 == x21 + | S6 -- s6 == x22 + | S7 -- s7 == x23 + | S8 -- s8 == x24 + | S9 -- s9 == x25 + | S10 -- s10 == x26 + | S11 -- s11 == x27 + | T3 -- t3 == x28 + | T4 -- t4 == x29 + | T5 -- t5 == x30 + | T6 -- t6 == x31 + deriving (Eq, Ord) + +instance Show Register where + show Zero = "zero" + show Ra = "ra" + show Sp = "sp" + show Gp = "gp" + show Tp = "tp" + show T0 = "t0" + show T1 = "t1" + show T2 = "t2" + show S0 = "s0" + show S1 = "s1" + show A0 = "a0" + show A1 = "a1" + show A2 = "a2" + show A3 = "a3" + show A4 = "a4" + show A5 = "a5" + show A6 = "a6" + show A7 = "a7" + show S2 = "s2" + show S3 = "s3" + show S4 = "s4" + show S5 = "s5" + show S6 = "s6" + show S7 = "s7" + show S8 = "s8" + show S9 = "s9" + show S10 = "s10" + show S11 = "s11" + show T3 = "t3" + show T4 = "t4" + show T5 = "t5" + show T6 = "t6" + +dword :: Int64 +dword = 8 + +commaSep :: [String] -> String +commaSep = intercalate ", " . filterOutBlankStrings + +spaceSep :: [String] -> String +spaceSep = unwords . filterOutBlankStrings + +filterOutBlankStrings :: [String] -> [String] +filterOutBlankStrings = filter (not . all isSpace) diff --git a/lib/CodeGen/RiscV/Runner.hs b/lib/CodeGen/RiscV/Runner.hs index b9d9a0b..e1f6551 100644 --- a/lib/CodeGen/RiscV/Runner.hs +++ b/lib/CodeGen/RiscV/Runner.hs @@ -1,7 +1,7 @@ module CodeGen.RiscV.Runner (compileToRiscVAsm) where import CodeGen.Module (compileToModule) -import CodeGen.RiscV.RiscVGen (ppRiscVAsm) +import CodeGen.RiscV.AsmGen (ppRiscVAsm) import CodeGen.TimedValue (TimedValue, measureTimedValue) import Control.Monad.Except (runExcept) import Data.Text (Text) diff --git a/miniml.cabal b/miniml.cabal index aafb451..52ee89f 100644 --- a/miniml.cabal +++ b/miniml.cabal @@ -32,8 +32,10 @@ library CodeGen.Llvm.LlvmIrGen CodeGen.Llvm.Runner CodeGen.Module - CodeGen.RiscV.RiscVGen - CodeGen.RiscV.RiscVLib + CodeGen.RiscV.AsmGen + CodeGen.RiscV.Lib + CodeGen.RiscV.Lib.Monad + CodeGen.RiscV.Lib.Types CodeGen.RiscV.Runner CodeGen.RunResult CodeGen.Runtime.PrintRuntime diff --git a/test/Utils.hs b/test/Utils.hs index 3fdd08c..335ba33 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -18,7 +18,7 @@ where import CodeGen.Llvm.LlvmIrGen (genLlvmIrModule, ppLlvmModule) import CodeGen.Llvm.Runner (run) import CodeGen.Module (Module (Module)) -import CodeGen.RiscV.RiscVGen (ppRiscVAsm) +import CodeGen.RiscV.AsmGen (ppRiscVAsm) import CodeGen.RunResult (RunResult (Success)) import Data.Either (isRight) import Data.Maybe (fromJust) From 8822a1a62d4679a710493314e28732db564fed26 Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 5/7] Use `prettyprinter` library --- lib/CodeGen/RiscV/AsmGen.hs | 5 +- lib/CodeGen/RiscV/Lib.hs | 1 + lib/CodeGen/RiscV/Lib/Types.hs | 128 +++++++++-------------------- lib/CodeGen/RiscV/Runner.hs | 5 +- miniml.cabal | 1 + test/Sample/Factorial/FacRec.s | 2 +- test/Sample/Factorial/FacRecCps.s | 2 +- test/Sample/Factorial/FacRecLoop.s | 2 +- test/Sample/Fibonacci/FibRec.s | 2 +- test/Sample/Fibonacci/FibRecCps.s | 2 +- test/Sample/Fibonacci/FibRecLoop.s | 2 +- test/Sample/Simple/SimpleTest.s | 2 +- test/Utils.hs | 2 +- 13 files changed, 56 insertions(+), 100 deletions(-) diff --git a/lib/CodeGen/RiscV/AsmGen.hs b/lib/CodeGen/RiscV/AsmGen.hs index b168f10..d6886a4 100644 --- a/lib/CodeGen/RiscV/AsmGen.hs +++ b/lib/CodeGen/RiscV/AsmGen.hs @@ -10,6 +10,7 @@ import qualified CodeGen.RiscV.Lib as Asm import Control.Monad.State (MonadState, State, evalState, gets, modify) import Data.Map (Map) import qualified Data.Map as Map +import Data.Text (Text) import qualified Data.Text as Txt import Foreign (fromBool) import MonadUtils (locally) @@ -17,8 +18,8 @@ import qualified StdLib import Transformations.Anf.Anf import Trees.Common -ppRiscVAsm :: Module -> String -ppRiscVAsm m = unlines $ show <$> genModule m +ppRiscVAsm :: Module -> Text +ppRiscVAsm m = Asm.ppCodeLines $ genModule m -- The Code diff --git a/lib/CodeGen/RiscV/Lib.hs b/lib/CodeGen/RiscV/Lib.hs index f90f2fd..0092851 100644 --- a/lib/CodeGen/RiscV/Lib.hs +++ b/lib/CodeGen/RiscV/Lib.hs @@ -3,6 +3,7 @@ module CodeGen.RiscV.Lib ( compileT, compile, + ppCodeLines, mainFunction, function, globalVar, diff --git a/lib/CodeGen/RiscV/Lib/Types.hs b/lib/CodeGen/RiscV/Lib/Types.hs index f0c05f4..fa42c67 100644 --- a/lib/CodeGen/RiscV/Lib/Types.hs +++ b/lib/CodeGen/RiscV/Lib/Types.hs @@ -1,10 +1,20 @@ +{-# LANGUAGE PatternSynonyms #-} + module CodeGen.RiscV.Lib.Types where -import Data.Char (isSpace) +import Control.Arrow ((>>>)) +import Data.Char (toLower) import Data.Int (Int64) -import Data.List (intercalate) import Data.Text (Text) -import qualified Data.Text as Txt +import Prettyprinter (Pretty (pretty), colon, comma, hsep, indent, layoutCompact, parens, punctuate, vsep, (<+>)) +import Prettyprinter.Render.Text (renderStrict) + +ppCodeLines :: [CodeLine] -> Text +ppCodeLines = + map pretty + >>> vsep + >>> layoutCompact + >>> renderStrict data CodeLine = LabeledDirectiveCodeLine Label Directive @@ -12,21 +22,21 @@ data CodeLine | InstructionCodeLine Instruction | DirectiveCodeLine Directive -instance Show CodeLine where - show (LabeledDirectiveCodeLine l d) = spaceSep [show l, show d] - show (LabelCodeLine l) = show l - show (InstructionCodeLine i) = " " ++ show i - show (DirectiveCodeLine d) = show d +instance Pretty CodeLine where + pretty (LabeledDirectiveCodeLine l d) = pretty l <+> pretty d + pretty (LabelCodeLine l) = pretty l + pretty (InstructionCodeLine i) = indent 4 (pretty i) + pretty (DirectiveCodeLine d) = pretty d newtype Label = Label Text -instance Show Label where - show (Label txt) = Txt.unpack txt ++ ":" +instance Pretty Label where + pretty (Label txt) = pretty txt <> colon data Instruction = Instruction OpCode [Operand] -instance Show Instruction where - show (Instruction opCode args) = spaceSep [show opCode, commaSep $ show <$> args] +instance Pretty Instruction where + pretty (Instruction opCode args) = hsep $ pretty opCode : punctuate comma (pretty <$> args) data Directive = DirText @@ -34,11 +44,11 @@ data Directive | DirDWord Int64 | DirGlobl Text -instance Show Directive where - show DirText = ".section .text" - show DirData = ".section .data" - show (DirDWord initVal) = spaceSep [".dword", show initVal] - show (DirGlobl name) = spaceSep [".globl", Txt.unpack name] +instance Pretty Directive where + pretty DirText = pretty ".section .text" + pretty DirData = pretty ".section .data" + pretty (DirDWord initVal) = pretty ".dword" <+> pretty initVal + pretty (DirGlobl name) = pretty ".globl" <+> pretty name data OpCode = Add @@ -60,42 +70,26 @@ data OpCode | Jal | Beqz | J + deriving (Show) -instance Show OpCode where - show Add = "add" - show Sub = "sub" - show Mul = "mul" - show And = "and" - show Or = "or" - show Not = "not" - show Seqz = "seqz" - show Snez = "snez" - show Slt = "slt" - show Ld = "ld" - show Sd = "sd" - show Addi = "addi" - show Li = "li" - show La = "la" - show Neg = "neg" - show Ret = "ret" - show Jal = "jal" - show Beqz = "beqz" - show J = "j" +instance Pretty OpCode where + pretty opCode = pretty $ toLower <$> show opCode data Operand = Immediate Int64 | Register Register - | Memory Offset | RegisterWithOffset Register Offset | Symbol Text deriving (Eq, Ord) -instance Show Operand where - show (Immediate i) = show i - show (Register r) = show r - show (Memory o) = show (dword * o) ++ "(sp)" - show (RegisterWithOffset r o) = show (dword * o) ++ "(" ++ show r ++ ")" - show (Symbol t) = Txt.unpack t +pattern Memory :: Offset -> Operand +pattern Memory offset = RegisterWithOffset Sp offset + +instance Pretty Operand where + pretty (Immediate i) = pretty i + pretty (Register r) = pretty r + pretty (RegisterWithOffset r o) = pretty (dword * o) <> parens (pretty r) + pretty (Symbol t) = pretty t type Offset = Int64 @@ -132,50 +126,10 @@ data Register | T4 -- t4 == x29 | T5 -- t5 == x30 | T6 -- t6 == x31 - deriving (Eq, Ord) + deriving (Eq, Ord, Show) -instance Show Register where - show Zero = "zero" - show Ra = "ra" - show Sp = "sp" - show Gp = "gp" - show Tp = "tp" - show T0 = "t0" - show T1 = "t1" - show T2 = "t2" - show S0 = "s0" - show S1 = "s1" - show A0 = "a0" - show A1 = "a1" - show A2 = "a2" - show A3 = "a3" - show A4 = "a4" - show A5 = "a5" - show A6 = "a6" - show A7 = "a7" - show S2 = "s2" - show S3 = "s3" - show S4 = "s4" - show S5 = "s5" - show S6 = "s6" - show S7 = "s7" - show S8 = "s8" - show S9 = "s9" - show S10 = "s10" - show S11 = "s11" - show T3 = "t3" - show T4 = "t4" - show T5 = "t5" - show T6 = "t6" +instance Pretty Register where + pretty opCode = pretty $ toLower <$> show opCode dword :: Int64 dword = 8 - -commaSep :: [String] -> String -commaSep = intercalate ", " . filterOutBlankStrings - -spaceSep :: [String] -> String -spaceSep = unwords . filterOutBlankStrings - -filterOutBlankStrings :: [String] -> [String] -filterOutBlankStrings = filter (not . all isSpace) diff --git a/lib/CodeGen/RiscV/Runner.hs b/lib/CodeGen/RiscV/Runner.hs index e1f6551..5866ccc 100644 --- a/lib/CodeGen/RiscV/Runner.hs +++ b/lib/CodeGen/RiscV/Runner.hs @@ -5,7 +5,6 @@ import CodeGen.RiscV.AsmGen (ppRiscVAsm) import CodeGen.TimedValue (TimedValue, measureTimedValue) import Control.Monad.Except (runExcept) import Data.Text (Text) -import qualified Data.Text as Txt import qualified Data.Text.IO as Txt import System.IO (IOMode (WriteMode), withFile) @@ -14,7 +13,7 @@ compileToRiscVAsm text outputFilePath = measureTimedValue $ sequenceA $ runExcept $ do m <- compileToModule text - let riscVText = Txt.pack $ ppRiscVAsm m + let riscVText = ppRiscVAsm m return $ withFile outputFilePath WriteMode $ \handle -> do - Txt.hPutStr handle riscVText + Txt.hPutStrLn handle riscVText diff --git a/miniml.cabal b/miniml.cabal index 52ee89f..274f3ba 100644 --- a/miniml.cabal +++ b/miniml.cabal @@ -70,6 +70,7 @@ library , megaparsec >=9.2 , mtl >=2.3.0 , parser-combinators >=1.3.0 + , prettyprinter , process , recursion-schemes , string-conversions diff --git a/test/Sample/Factorial/FacRec.s b/test/Sample/Factorial/FacRec.s index 434c7b9..721ff8a 100644 --- a/test/Sample/Factorial/FacRec.s +++ b/test/Sample/Factorial/FacRec.s @@ -88,4 +88,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Factorial/FacRecCps.s b/test/Sample/Factorial/FacRecCps.s index b46b328..29f59cc 100644 --- a/test/Sample/Factorial/FacRecCps.s +++ b/test/Sample/Factorial/FacRecCps.s @@ -175,4 +175,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Factorial/FacRecLoop.s b/test/Sample/Factorial/FacRecLoop.s index cd19e48..3749eac 100644 --- a/test/Sample/Factorial/FacRecLoop.s +++ b/test/Sample/Factorial/FacRecLoop.s @@ -133,4 +133,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRec.s b/test/Sample/Fibonacci/FibRec.s index fd78d77..deb1559 100644 --- a/test/Sample/Fibonacci/FibRec.s +++ b/test/Sample/Fibonacci/FibRec.s @@ -105,4 +105,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRecCps.s b/test/Sample/Fibonacci/FibRecCps.s index 8742e25..3d926cb 100644 --- a/test/Sample/Fibonacci/FibRecCps.s +++ b/test/Sample/Fibonacci/FibRecCps.s @@ -235,4 +235,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRecLoop.s b/test/Sample/Fibonacci/FibRecLoop.s index f512ceb..8d6bae0 100644 --- a/test/Sample/Fibonacci/FibRecLoop.s +++ b/test/Sample/Fibonacci/FibRecLoop.s @@ -136,4 +136,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Sample/Simple/SimpleTest.s b/test/Sample/Simple/SimpleTest.s index d723a5e..69df31b 100644 --- a/test/Sample/Simple/SimpleTest.s +++ b/test/Sample/Simple/SimpleTest.s @@ -66,4 +66,4 @@ _start: li a0, 0 addi sp, sp, 104 li a0, 0 - jal exit + jal exit \ No newline at end of file diff --git a/test/Utils.hs b/test/Utils.hs index 335ba33..25eed87 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -73,7 +73,7 @@ processTillLlvmRunOutput program = in Txt.unpack out processTillAsm :: Text -> String -processTillAsm program = ppRiscVAsm $ Module (processTillAnfGen' program) +processTillAsm program = Txt.unpack $ ppRiscVAsm $ Module (processTillAnfGen' program) -- Combinators From ed921ccf9f4dff5a1777be5689c25c955ceac39d Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 6/7] Rename "Asm" to "Rv" --- lib/CodeGen/RiscV/AsmGen.hs | 88 ++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/lib/CodeGen/RiscV/AsmGen.hs b/lib/CodeGen/RiscV/AsmGen.hs index d6886a4..b45a5d9 100644 --- a/lib/CodeGen/RiscV/AsmGen.hs +++ b/lib/CodeGen/RiscV/AsmGen.hs @@ -6,7 +6,7 @@ module CodeGen.RiscV.AsmGen (ppRiscVAsm) where import CodeGen.Module (Module (..)) -import qualified CodeGen.RiscV.Lib as Asm +import qualified CodeGen.RiscV.Lib as Rv import Control.Monad.State (MonadState, State, evalState, gets, modify) import Data.Map (Map) import qualified Data.Map as Map @@ -19,53 +19,53 @@ import Transformations.Anf.Anf import Trees.Common ppRiscVAsm :: Module -> Text -ppRiscVAsm m = Asm.ppCodeLines $ genModule m +ppRiscVAsm m = Rv.ppCodeLines $ genModule m -- The Code -type CodeGenM = Asm.AsmBuilderT (State Env) +type CodeGenM = Rv.AsmBuilderT (State Env) data Env = Env - { locVars :: Map Identifier' Asm.Operand, - globVars :: Map Identifier' Asm.Operand, - funs :: Map Identifier' (Asm.Operand, Arity) + { locVars :: Map Identifier' Rv.Operand, + globVars :: Map Identifier' Rv.Operand, + funs :: Map Identifier' (Rv.Operand, Arity) } -genModule :: Module -> [Asm.CodeLine] +genModule :: Module -> [Rv.CodeLine] genModule (Module (Program decls)) = flip evalState (Env Map.empty Map.empty Map.empty) $ - Asm.compileT $ do + Rv.compileT $ do mapM_ genStdLibDecl StdLib.allDeclsWithArity mapM_ genGlobDecl decls -- In the `main` we define our global variables. - Asm.mainFunction $ \_ -> mapM_ gVarDef decls + Rv.mainFunction $ \_ -> mapM_ gVarDef decls where gVarDef :: GlobalDeclaration -> CodeGenM () gVarDef = \case GlobVarDecl ident value -> do addr <- findGlobVar ident value' <- genExpr value - Asm.storeToLabeledAddr addr value' + Rv.storeToLabeledAddr addr value' _ -> return () genStdLibDecl :: StdLib.DeclarationWithArity -> CodeGenM () genStdLibDecl decl = declareAsExtern decl >>= register decl where - declareAsExtern :: StdLib.DeclarationWithArity -> CodeGenM Asm.Operand - declareAsExtern (ident, _) = Asm.externFunction ident + declareAsExtern :: StdLib.DeclarationWithArity -> CodeGenM Rv.Operand + declareAsExtern (ident, _) = Rv.externFunction ident - register :: StdLib.DeclarationWithArity -> Asm.Operand -> CodeGenM () + register :: StdLib.DeclarationWithArity -> Rv.Operand -> CodeGenM () register (ident, arity) fun = regFun (Txt ident) fun arity genGlobDecl :: GlobalDeclaration -> CodeGenM () genGlobDecl = \case GlobVarDecl ident _ -> do - var <- Asm.globalVar (Txt.pack $ genId ident) + var <- Rv.globalVar (Txt.pack $ genId ident) regGlobVar ident var GlobFunDecl ident params body -> mdo regFun ident fun (length params) fun <- locally $ do - Asm.function + Rv.function (Txt.pack $ genId ident) (fromIntegral $ length params) $ \args -> do @@ -78,7 +78,7 @@ genId = \case Txt txt -> Txt.unpack txt Gen n txt -> Txt.unpack txt <> "_" <> show n -genExpr :: Expression -> CodeGenM Asm.Operand +genExpr :: Expression -> CodeGenM Rv.Operand genExpr = \case ExprAtom atom -> genAtom atom ExprComp ce -> genComp ce @@ -87,53 +87,53 @@ genExpr = \case regLocVar ident val' genExpr expr -genAtom :: AtomicExpression -> CodeGenM Asm.Operand +genAtom :: AtomicExpression -> CodeGenM Rv.Operand genAtom = \case AtomId ident -> findAny ident - AtomUnit -> Asm.immediate 0 - AtomBool bool -> Asm.immediate $ fromBool bool - AtomInt int -> Asm.immediate int + AtomUnit -> Rv.immediate 0 + AtomBool bool -> Rv.immediate $ fromBool bool + AtomInt int -> Rv.immediate int -genComp :: ComplexExpression -> CodeGenM Asm.Operand +genComp :: ComplexExpression -> CodeGenM Rv.Operand genComp = \case CompApp f arg -> do f' <- findAny f arg' <- genAtom arg applyF <- findFun (Txt "miniml_apply") - Asm.call applyF [f', arg'] + Rv.call applyF [f', arg'] CompIte c t e -> do c' <- genAtom c - Asm.ite c' (\_ -> genExpr t) (\_ -> genExpr e) + Rv.ite c' (\_ -> genExpr t) (\_ -> genExpr e) CompBinOp op lhs rhs -> do lhs' <- genAtom lhs rhs' <- genAtom rhs let opF = case op of - BoolOp AndOp -> Asm.and - BoolOp OrOp -> Asm.or - ArithOp PlusOp -> Asm.add - ArithOp MinusOp -> Asm.sub - ArithOp MulOp -> Asm.mul + BoolOp AndOp -> Rv.and + BoolOp OrOp -> Rv.or + ArithOp PlusOp -> Rv.add + ArithOp MinusOp -> Rv.sub + ArithOp MulOp -> Rv.mul ArithOp DivOp -> ( \lhs'' rhs'' -> do divF <- findFun (Txt "miniml_div") - Asm.call divF [lhs'', rhs''] + Rv.call divF [lhs'', rhs''] ) - CompOp EqOp -> Asm.eq - CompOp NeOp -> Asm.ne - CompOp LtOp -> Asm.lt - CompOp LeOp -> Asm.le - CompOp GtOp -> Asm.gt - CompOp GeOp -> Asm.ge + CompOp EqOp -> Rv.eq + CompOp NeOp -> Rv.ne + CompOp LtOp -> Rv.lt + CompOp LeOp -> Rv.le + CompOp GtOp -> Rv.gt + CompOp GeOp -> Rv.ge opF lhs' rhs' CompUnOp op x -> do x' <- genAtom x let opF = case op of - UnMinusOp -> Asm.neg + UnMinusOp -> Rv.neg opF x' -- Vars & Funs -findAny :: Identifier' -> CodeGenM Asm.Operand +findAny :: Identifier' -> CodeGenM Rv.Operand findAny ident = do maybeLocVar <- gets ((Map.!? ident) . locVars) case maybeLocVar of @@ -143,24 +143,24 @@ findAny ident = do case maybeFun of Just (fun, arity) -> do funToPafF <- findFun (Txt "miniml_fun_to_paf") - arity' <- Asm.immediate $ fromIntegral arity - Asm.call funToPafF [fun, arity'] + arity' <- Rv.immediate $ fromIntegral arity + Rv.call funToPafF [fun, arity'] Nothing -> findGlobVar ident -findGlobVar :: (MonadState Env m) => Identifier' -> m Asm.Operand +findGlobVar :: (MonadState Env m) => Identifier' -> m Rv.Operand findGlobVar ident = gets ((Map.! ident) . globVars) -findFun :: Identifier' -> CodeGenM Asm.Operand +findFun :: Identifier' -> CodeGenM Rv.Operand findFun ident = gets (fst . (Map.! ident) . funs) -regLocVar :: (MonadState Env m) => Identifier' -> Asm.Operand -> m () +regLocVar :: (MonadState Env m) => Identifier' -> Rv.Operand -> m () regLocVar ident var = modify $ \env -> env {locVars = Map.insert ident var (locVars env)} -regGlobVar :: (MonadState Env m) => Identifier' -> Asm.Operand -> m () +regGlobVar :: (MonadState Env m) => Identifier' -> Rv.Operand -> m () regGlobVar ident gVar = modify $ \env -> env {globVars = Map.insert ident gVar (globVars env)} -regFun :: (MonadState Env m) => Identifier' -> Asm.Operand -> Arity -> m () +regFun :: (MonadState Env m) => Identifier' -> Rv.Operand -> Arity -> m () regFun ident fun paramsCnt = modify $ \env -> env {funs = Map.insert ident (fun, paramsCnt) (funs env)} From 6535501687fedcc60d07eede193d5ebb19c86ecb Mon Sep 17 00:00:00 2001 From: Azim Muradov Date: Fri, 4 Oct 2024 20:14:20 +0300 Subject: [PATCH 7/7] Refactor `OpCode` --- lib/CodeGen/RiscV/Lib.hs | 4 +-- lib/CodeGen/RiscV/Lib/Types.hs | 17 +++++------ test/Sample/Factorial/FacRec.s | 14 ++++----- test/Sample/Factorial/FacRecCps.s | 34 ++++++++++----------- test/Sample/Factorial/FacRecLoop.s | 26 ++++++++-------- test/Sample/Fibonacci/FibRec.s | 18 +++++------ test/Sample/Fibonacci/FibRecCps.s | 48 +++++++++++++++--------------- test/Sample/Fibonacci/FibRecLoop.s | 26 ++++++++-------- test/Sample/Simple/SimpleTest.s | 14 ++++----- 9 files changed, 100 insertions(+), 101 deletions(-) diff --git a/lib/CodeGen/RiscV/Lib.hs b/lib/CodeGen/RiscV/Lib.hs index 0092851..da01a72 100644 --- a/lib/CodeGen/RiscV/Lib.hs +++ b/lib/CodeGen/RiscV/Lib.hs @@ -73,7 +73,7 @@ mainFunction body = do let ret = [ instructionCodeLine Li [Register A0, Immediate 0], - instructionCodeLine Jal [Symbol "exit"] + instructionCodeLine Call [Symbol "exit"] ] let funCode = [globalDir, funLabel, spPush] ++ (concat . reverse $ ([loadRetVal, spPop] ++ ret) : cls) @@ -193,7 +193,7 @@ call fun args = do pushFunctionCodeLines $ loadArguments ++ [ instructionCodeLine Sd [Register Ra, raMem], - instructionCodeLine Jal [fun], + instructionCodeLine Call [fun], instructionCodeLine Ld [Register Ra, raMem], instructionCodeLine Sd [retVal, retValMem] ] diff --git a/lib/CodeGen/RiscV/Lib/Types.hs b/lib/CodeGen/RiscV/Lib/Types.hs index fa42c67..8824df3 100644 --- a/lib/CodeGen/RiscV/Lib/Types.hs +++ b/lib/CodeGen/RiscV/Lib/Types.hs @@ -51,25 +51,24 @@ instance Pretty Directive where pretty (DirGlobl name) = pretty ".globl" <+> pretty name data OpCode - = Add + = And + | Or + | Add | Sub | Mul - | And - | Or - | Not + | Neg | Seqz | Snez | Slt - | Ld | Sd - | Addi + | Ld | Li | La - | Neg - | Ret - | Jal + | Addi | Beqz | J + | Call + | Ret deriving (Show) instance Pretty OpCode where diff --git a/test/Sample/Factorial/FacRec.s b/test/Sample/Factorial/FacRec.s index 721ff8a..a8a3298 100644 --- a/test/Sample/Factorial/FacRec.s +++ b/test/Sample/Factorial/FacRec.s @@ -30,13 +30,13 @@ else_0: la a0, factorial_1 ld a1, 64(sp) sd ra, 80(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 80(sp) sd a0, 72(sp) ld a0, 72(sp) ld a1, 56(sp) sd ra, 96(sp) - jal miniml_apply + call miniml_apply ld ra, 96(sp) sd a0, 88(sp) ld t0, 8(sp) @@ -57,7 +57,7 @@ _start: la a0, factorial_1 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 5 @@ -65,7 +65,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -73,13 +73,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_3 @@ -88,4 +88,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Factorial/FacRecCps.s b/test/Sample/Factorial/FacRecCps.s index 29f59cc..0217fb7 100644 --- a/test/Sample/Factorial/FacRecCps.s +++ b/test/Sample/Factorial/FacRecCps.s @@ -19,7 +19,7 @@ ll_10: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) ld a0, 40(sp) @@ -43,7 +43,7 @@ cps_factorial_3: ld a0, 16(sp) ld a1, 48(sp) sd ra, 64(sp) - jal miniml_apply + call miniml_apply ld ra, 64(sp) sd a0, 56(sp) ld t0, 56(sp) @@ -61,13 +61,13 @@ else_0: la a0, cps_factorial_3 ld a1, 88(sp) sd ra, 104(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 104(sp) sd a0, 96(sp) ld a0, 96(sp) ld a1, 80(sp) sd ra, 120(sp) - jal miniml_apply + call miniml_apply ld ra, 120(sp) sd a0, 112(sp) li t0, 3 @@ -75,25 +75,25 @@ else_0: la a0, ll_10 ld a1, 128(sp) sd ra, 144(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 144(sp) sd a0, 136(sp) ld a0, 136(sp) ld a1, 8(sp) sd ra, 160(sp) - jal miniml_apply + call miniml_apply ld ra, 160(sp) sd a0, 152(sp) ld a0, 152(sp) ld a1, 16(sp) sd ra, 176(sp) - jal miniml_apply + call miniml_apply ld ra, 176(sp) sd a0, 168(sp) ld a0, 112(sp) ld a1, 168(sp) sd ra, 192(sp) - jal miniml_apply + call miniml_apply ld ra, 192(sp) sd a0, 184(sp) ld t0, 184(sp) @@ -110,13 +110,13 @@ factorial_8: la a0, cps_factorial_3 ld a1, 16(sp) sd ra, 32(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 32(sp) sd a0, 24(sp) ld a0, 24(sp) ld a1, 8(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -124,13 +124,13 @@ factorial_8: la a0, id_2 ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 40(sp) ld a1, 64(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) ld a0, 80(sp) @@ -144,7 +144,7 @@ _start: la a0, factorial_8 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 5 @@ -152,7 +152,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -160,13 +160,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_9 @@ -175,4 +175,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Factorial/FacRecLoop.s b/test/Sample/Factorial/FacRecLoop.s index 3749eac..1c4b493 100644 --- a/test/Sample/Factorial/FacRecLoop.s +++ b/test/Sample/Factorial/FacRecLoop.s @@ -21,13 +21,13 @@ else_0: la a0, loop_2 ld a1, 48(sp) sd ra, 64(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 64(sp) sd a0, 56(sp) ld a0, 56(sp) ld a1, 8(sp) sd ra, 80(sp) - jal miniml_apply + call miniml_apply ld ra, 80(sp) sd a0, 72(sp) li t0, 1 @@ -39,7 +39,7 @@ else_0: ld a0, 72(sp) ld a1, 96(sp) sd ra, 112(sp) - jal miniml_apply + call miniml_apply ld ra, 112(sp) sd a0, 104(sp) ld t0, 24(sp) @@ -49,7 +49,7 @@ else_0: ld a0, 104(sp) ld a1, 120(sp) sd ra, 136(sp) - jal miniml_apply + call miniml_apply ld ra, 136(sp) sd a0, 128(sp) ld t0, 128(sp) @@ -66,13 +66,13 @@ factorial_5: la a0, loop_2 ld a1, 16(sp) sd ra, 32(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 32(sp) sd a0, 24(sp) ld a0, 24(sp) ld a1, 8(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -80,7 +80,7 @@ factorial_5: ld a0, 40(sp) ld a1, 56(sp) sd ra, 72(sp) - jal miniml_apply + call miniml_apply ld ra, 72(sp) sd a0, 64(sp) li t0, 1 @@ -88,7 +88,7 @@ factorial_5: ld a0, 64(sp) ld a1, 80(sp) sd ra, 96(sp) - jal miniml_apply + call miniml_apply ld ra, 96(sp) sd a0, 88(sp) ld a0, 88(sp) @@ -102,7 +102,7 @@ _start: la a0, factorial_5 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 5 @@ -110,7 +110,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -118,13 +118,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_6 @@ -133,4 +133,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRec.s b/test/Sample/Fibonacci/FibRec.s index deb1559..2db0ee7 100644 --- a/test/Sample/Fibonacci/FibRec.s +++ b/test/Sample/Fibonacci/FibRec.s @@ -27,13 +27,13 @@ else_0: la a0, fib_1 ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 48(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) li t0, 2 @@ -47,13 +47,13 @@ else_0: la a0, fib_1 ld a1, 112(sp) sd ra, 128(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 128(sp) sd a0, 120(sp) ld a0, 120(sp) ld a1, 104(sp) sd ra, 144(sp) - jal miniml_apply + call miniml_apply ld ra, 144(sp) sd a0, 136(sp) ld t0, 80(sp) @@ -74,7 +74,7 @@ _start: la a0, fib_1 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 10 @@ -82,7 +82,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -90,13 +90,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_3 @@ -105,4 +105,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRecCps.s b/test/Sample/Fibonacci/FibRecCps.s index 3d926cb..3130004 100644 --- a/test/Sample/Fibonacci/FibRecCps.s +++ b/test/Sample/Fibonacci/FibRecCps.s @@ -19,7 +19,7 @@ ll_12: ld a0, 8(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) ld a0, 40(sp) @@ -40,7 +40,7 @@ ll_11: ld a0, 8(sp) ld a1, 48(sp) sd ra, 64(sp) - jal miniml_apply + call miniml_apply ld ra, 64(sp) sd a0, 56(sp) li t0, 3 @@ -48,25 +48,25 @@ ll_11: la a0, ll_12 ld a1, 72(sp) sd ra, 88(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 88(sp) sd a0, 80(sp) ld a0, 80(sp) ld a1, 24(sp) sd ra, 104(sp) - jal miniml_apply + call miniml_apply ld ra, 104(sp) sd a0, 96(sp) ld a0, 96(sp) ld a1, 32(sp) sd ra, 120(sp) - jal miniml_apply + call miniml_apply ld ra, 120(sp) sd a0, 112(sp) ld a0, 56(sp) ld a1, 112(sp) sd ra, 136(sp) - jal miniml_apply + call miniml_apply ld ra, 136(sp) sd a0, 128(sp) ld a0, 128(sp) @@ -89,7 +89,7 @@ fib_cps_4: ld a0, 16(sp) ld a1, 48(sp) sd ra, 64(sp) - jal miniml_apply + call miniml_apply ld ra, 64(sp) sd a0, 56(sp) ld t0, 56(sp) @@ -107,13 +107,13 @@ else_0: la a0, fib_cps_4 ld a1, 88(sp) sd ra, 104(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 104(sp) sd a0, 96(sp) ld a0, 96(sp) ld a1, 80(sp) sd ra, 120(sp) - jal miniml_apply + call miniml_apply ld ra, 120(sp) sd a0, 112(sp) li t0, 4 @@ -121,7 +121,7 @@ else_0: la a0, ll_11 ld a1, 128(sp) sd ra, 144(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 144(sp) sd a0, 136(sp) li t0, 2 @@ -129,31 +129,31 @@ else_0: la a0, fib_cps_4 ld a1, 152(sp) sd ra, 168(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 168(sp) sd a0, 160(sp) ld a0, 136(sp) ld a1, 160(sp) sd ra, 184(sp) - jal miniml_apply + call miniml_apply ld ra, 184(sp) sd a0, 176(sp) ld a0, 176(sp) ld a1, 8(sp) sd ra, 200(sp) - jal miniml_apply + call miniml_apply ld ra, 200(sp) sd a0, 192(sp) ld a0, 192(sp) ld a1, 16(sp) sd ra, 216(sp) - jal miniml_apply + call miniml_apply ld ra, 216(sp) sd a0, 208(sp) ld a0, 112(sp) ld a1, 208(sp) sd ra, 232(sp) - jal miniml_apply + call miniml_apply ld ra, 232(sp) sd a0, 224(sp) ld t0, 224(sp) @@ -170,13 +170,13 @@ fib_9: la a0, fib_cps_4 ld a1, 16(sp) sd ra, 32(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 32(sp) sd a0, 24(sp) ld a0, 24(sp) ld a1, 8(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -184,13 +184,13 @@ fib_9: la a0, id_2 ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 40(sp) ld a1, 64(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) ld a0, 80(sp) @@ -204,7 +204,7 @@ _start: la a0, fib_9 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 10 @@ -212,7 +212,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -220,13 +220,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_10 @@ -235,4 +235,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Fibonacci/FibRecLoop.s b/test/Sample/Fibonacci/FibRecLoop.s index 8d6bae0..cac822e 100644 --- a/test/Sample/Fibonacci/FibRecLoop.s +++ b/test/Sample/Fibonacci/FibRecLoop.s @@ -30,19 +30,19 @@ else_0: la a0, loop_2 ld a1, 72(sp) sd ra, 88(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 88(sp) sd a0, 80(sp) ld a0, 80(sp) ld a1, 64(sp) sd ra, 104(sp) - jal miniml_apply + call miniml_apply ld ra, 104(sp) sd a0, 96(sp) ld a0, 96(sp) ld a1, 24(sp) sd ra, 120(sp) - jal miniml_apply + call miniml_apply ld ra, 120(sp) sd a0, 112(sp) ld t0, 16(sp) @@ -52,7 +52,7 @@ else_0: ld a0, 112(sp) ld a1, 128(sp) sd ra, 144(sp) - jal miniml_apply + call miniml_apply ld ra, 144(sp) sd a0, 136(sp) ld t0, 136(sp) @@ -69,13 +69,13 @@ fib_6: la a0, loop_2 ld a1, 16(sp) sd ra, 32(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 32(sp) sd a0, 24(sp) ld a0, 24(sp) ld a1, 8(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 0 @@ -83,7 +83,7 @@ fib_6: ld a0, 40(sp) ld a1, 56(sp) sd ra, 72(sp) - jal miniml_apply + call miniml_apply ld ra, 72(sp) sd a0, 64(sp) li t0, 1 @@ -91,7 +91,7 @@ fib_6: ld a0, 64(sp) ld a1, 80(sp) sd ra, 96(sp) - jal miniml_apply + call miniml_apply ld ra, 96(sp) sd a0, 88(sp) ld a0, 88(sp) @@ -105,7 +105,7 @@ _start: la a0, fib_6 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 10 @@ -113,7 +113,7 @@ _start: ld a0, 16(sp) ld a1, 32(sp) sd ra, 48(sp) - jal miniml_apply + call miniml_apply ld ra, 48(sp) sd a0, 40(sp) li t0, 1 @@ -121,13 +121,13 @@ _start: la a0, print_int ld a1, 56(sp) sd ra, 72(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 72(sp) sd a0, 64(sp) ld a0, 64(sp) ld a1, 40(sp) sd ra, 88(sp) - jal miniml_apply + call miniml_apply ld ra, 88(sp) sd a0, 80(sp) la t0, simp_7 @@ -136,4 +136,4 @@ _start: li a0, 0 addi sp, sp, 88 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file diff --git a/test/Sample/Simple/SimpleTest.s b/test/Sample/Simple/SimpleTest.s index 69df31b..4f044ec 100644 --- a/test/Sample/Simple/SimpleTest.s +++ b/test/Sample/Simple/SimpleTest.s @@ -15,7 +15,7 @@ k_4: ld a0, 8(sp) ld a1, 16(sp) sd ra, 32(sp) - jal miniml_apply + call miniml_apply ld ra, 32(sp) sd a0, 24(sp) ld a0, 24(sp) @@ -29,7 +29,7 @@ _start: la a0, k_4 ld a1, 8(sp) sd ra, 24(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 24(sp) sd a0, 16(sp) li t0, 1 @@ -37,13 +37,13 @@ _start: la a0, id_2 ld a1, 32(sp) sd ra, 48(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 48(sp) sd a0, 40(sp) ld a0, 16(sp) ld a1, 40(sp) sd ra, 64(sp) - jal miniml_apply + call miniml_apply ld ra, 64(sp) sd a0, 56(sp) li t0, 1 @@ -51,13 +51,13 @@ _start: la a0, print_int ld a1, 72(sp) sd ra, 88(sp) - jal miniml_fun_to_paf + call miniml_fun_to_paf ld ra, 88(sp) sd a0, 80(sp) ld a0, 80(sp) ld a1, 56(sp) sd ra, 104(sp) - jal miniml_apply + call miniml_apply ld ra, 104(sp) sd a0, 96(sp) la t0, simp_5 @@ -66,4 +66,4 @@ _start: li a0, 0 addi sp, sp, 104 li a0, 0 - jal exit \ No newline at end of file + call exit \ No newline at end of file