{-# LANGUAGE OverloadedStrings #-}

module CodeGen.RiscV.Lib
  ( compileT,
    compile,
    ppCodeLines,
    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 CodeGen.RiscV.Lib.Monad
import CodeGen.RiscV.Lib.Types
import Control.Monad (replicateM, void)
import Control.Monad.Identity (Identity (..))
import Control.Monad.State (execStateT)
import Data.Int (Int64)
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 :: forall (m :: * -> *) a. Monad m => AsmBuilderT m a -> m [CodeLine]
compileT AsmBuilderT m a
m = BuilderState -> [CodeLine]
concatCode (BuilderState -> [CodeLine]) -> m BuilderState -> m [CodeLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsmBuilderT m a -> m BuilderState
forall (m :: * -> *) a.
Monad m =>
AsmBuilderT m a -> m BuilderState
execAsmBuilderT AsmBuilderT m a
m
  where
    execAsmBuilderT :: (Monad m) => AsmBuilderT m a -> m BuilderState
    execAsmBuilderT :: forall (m :: * -> *) a.
Monad m =>
AsmBuilderT m a -> m BuilderState
execAsmBuilderT AsmBuilderT m a
m' = StateT BuilderState m a -> BuilderState -> m BuilderState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (AsmBuilderT m a -> StateT BuilderState m a
forall (m :: * -> *) a. AsmBuilderT m a -> StateT BuilderState m a
unAsmBuilderT AsmBuilderT m a
m') BuilderState
emptyBS

    concatCode :: BuilderState -> [CodeLine]
    concatCode :: BuilderState -> [CodeLine]
concatCode (BS (PBS [[CodeLine]]
txt [CodeLine]
dat) FunctionBuilderState
_ Integer
_) =
      let txtCL :: [CodeLine]
txtCL = Directive -> CodeLine
DirectiveCodeLine Directive
DirText CodeLine -> [CodeLine] -> [CodeLine]
forall a. a -> [a] -> [a]
: [[CodeLine]] -> [CodeLine]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CodeLine]] -> [[CodeLine]]
forall a. [a] -> [a]
reverse [[CodeLine]]
txt)
          datCL :: [CodeLine]
datCL = Directive -> CodeLine
DirectiveCodeLine Directive
DirData CodeLine -> [CodeLine] -> [CodeLine]
forall a. a -> [a] -> [a]
: [CodeLine]
dat
       in [CodeLine]
datCL [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ [CodeLine]
txtCL

-- | Compile the code
compile :: AsmBuilder a -> [CodeLine]
compile :: forall a. AsmBuilder a -> [CodeLine]
compile = Identity [CodeLine] -> [CodeLine]
forall a. Identity a -> a
runIdentity (Identity [CodeLine] -> [CodeLine])
-> (AsmBuilder a -> Identity [CodeLine])
-> AsmBuilder a
-> [CodeLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsmBuilder a -> Identity [CodeLine]
forall (m :: * -> *) a. Monad m => AsmBuilderT m a -> m [CodeLine]
compileT

-- | Emit main function (entry point routine)
mainFunction :: (MonadAsmBuilder m) => (() -> m ()) -> m ()
mainFunction :: forall (m :: * -> *). MonadAsmBuilder m => (() -> m ()) -> m ()
mainFunction () -> m ()
body = do
  m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
body ()

  BS ProgramBuilderState
_ (FBS [[CodeLine]]
cls Int64
spo) Integer
_ <- m BuilderState
forall (m :: * -> *). MonadAsmBuilder m => m BuilderState
getAsmBuilderState

  let globalDir :: CodeLine
globalDir = Directive -> CodeLine
DirectiveCodeLine (Directive -> CodeLine) -> Directive -> CodeLine
forall a b. (a -> b) -> a -> b
$ Text -> Directive
DirGlobl Text
"_start"
  let funLabel :: CodeLine
funLabel = Label -> CodeLine
LabelCodeLine (Label -> CodeLine) -> Label -> CodeLine
forall a b. (a -> b) -> a -> b
$ Text -> Label
Label Text
"_start"
  let spPush :: CodeLine
spPush = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Addi [Register -> Operand
Register Register
Sp, Register -> Operand
Register Register
Sp, Int64 -> Operand
Immediate (Int64 -> Operand) -> Int64 -> Operand
forall a b. (a -> b) -> a -> b
$ -(Int64
dword Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
spo)]
  let loadRetVal :: CodeLine
loadRetVal = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Li [Register -> Operand
Register Register
A0, Int64 -> Operand
Immediate Int64
0]
  let spPop :: CodeLine
spPop = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Addi [Register -> Operand
Register Register
Sp, Register -> Operand
Register Register
Sp, Int64 -> Operand
Immediate (Int64 -> Operand) -> Int64 -> Operand
forall a b. (a -> b) -> a -> b
$ Int64
dword Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
spo]

  let ret :: [CodeLine]
ret =
        [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Li [Register -> Operand
Register Register
A0, Int64 -> Operand
Immediate Int64
0],
          OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Call [Text -> Operand
Symbol Text
"exit"]
        ]

  let funCode :: [CodeLine]
funCode = [CodeLine
globalDir, CodeLine
funLabel, CodeLine
spPush] [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ ([[CodeLine]] -> [CodeLine]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CodeLine]] -> [CodeLine])
-> ([[CodeLine]] -> [[CodeLine]]) -> [[CodeLine]] -> [CodeLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[CodeLine]] -> [[CodeLine]]
forall a. [a] -> [a]
reverse ([[CodeLine]] -> [CodeLine]) -> [[CodeLine]] -> [CodeLine]
forall a b. (a -> b) -> a -> b
$ ([CodeLine
loadRetVal, CodeLine
spPop] [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ [CodeLine]
ret) [CodeLine] -> [[CodeLine]] -> [[CodeLine]]
forall a. a -> [a] -> [a]
: [[CodeLine]]
cls)

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushProgramCodeLines [CodeLine]
funCode
  (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$ \BuilderState
bs -> BuilderState
bs {functionBS :: FunctionBuilderState
functionBS = FunctionBuilderState
emptyFBS}

-- | Emit main function (entry point routine)
function :: (MonadAsmBuilder m) => Text -> Int64 -> ([Operand] -> m Operand) -> m Operand
function :: forall (m :: * -> *).
MonadAsmBuilder m =>
Text -> Int64 -> ([Operand] -> m Operand) -> m Operand
function Text
name Int64
paramCount [Operand] -> m Operand
body = do
  let args :: [Operand]
args = Register -> Operand
Register (Register -> Operand) -> [Register] -> [Operand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Register] -> [Register]
forall a. Int -> [a] -> [a]
take (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
paramCount) [Register
A0, Register
A1, Register
A2, Register
A3, Register
A4, Register
A5, Register
A6]
  [Operand]
memArgs <- Int -> m Operand -> m [Operand]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Operand] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Operand]
args) (Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1)
  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines ([CodeLine] -> m ()) -> [CodeLine] -> m ()
forall a b. (a -> b) -> a -> b
$
    (\(Operand
reg, Operand
mem) -> OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
reg, Operand
mem]) ((Operand, Operand) -> CodeLine)
-> [(Operand, Operand)] -> [CodeLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Operand]
args [Operand] -> [Operand] -> [(Operand, Operand)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Operand]
memArgs

  Operand
retVal <- [Operand] -> m Operand
body [Operand]
memArgs

  BS ProgramBuilderState
_ (FBS [[CodeLine]]
cls Int64
spo) Integer
_ <- m BuilderState
forall (m :: * -> *). MonadAsmBuilder m => m BuilderState
getAsmBuilderState

  let funLabel :: CodeLine
funLabel = Label -> CodeLine
LabelCodeLine (Label -> CodeLine) -> Label -> CodeLine
forall a b. (a -> b) -> a -> b
$ Text -> Label
Label Text
name
  let spPush :: CodeLine
spPush = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Addi [Register -> Operand
Register Register
Sp, Register -> Operand
Register Register
Sp, Int64 -> Operand
Immediate (Int64 -> Operand) -> Int64 -> Operand
forall a b. (a -> b) -> a -> b
$ -(Int64
dword Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
spo)]
  let loadRetVal :: CodeLine
loadRetVal = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Register -> Operand
Register Register
A0, Operand
retVal]
  let spPop :: CodeLine
spPop = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Addi [Register -> Operand
Register Register
Sp, Register -> Operand
Register Register
Sp, Int64 -> Operand
Immediate (Int64 -> Operand) -> Int64 -> Operand
forall a b. (a -> b) -> a -> b
$ Int64
dword Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
spo]
  let ret :: CodeLine
ret = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ret []

  let funCode :: [CodeLine]
funCode = [CodeLine
funLabel, CodeLine
spPush] [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ ([[CodeLine]] -> [CodeLine]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CodeLine]] -> [CodeLine])
-> ([[CodeLine]] -> [[CodeLine]]) -> [[CodeLine]] -> [CodeLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[CodeLine]] -> [[CodeLine]]
forall a. [a] -> [a]
reverse ([[CodeLine]] -> [CodeLine]) -> [[CodeLine]] -> [CodeLine]
forall a b. (a -> b) -> a -> b
$ [CodeLine
loadRetVal, CodeLine
spPop, CodeLine
ret] [CodeLine] -> [[CodeLine]] -> [[CodeLine]]
forall a. a -> [a] -> [a]
: [[CodeLine]]
cls)

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushProgramCodeLines [CodeLine]
funCode
  (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$ \BuilderState
bs -> BuilderState
bs {functionBS :: FunctionBuilderState
functionBS = FunctionBuilderState
emptyFBS}

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Text -> Operand
Symbol Text
name

-- | Emit uninitialized global variable
globalVar :: (MonadAsmBuilder m) => Text -> m Operand
globalVar :: forall (m :: * -> *). MonadAsmBuilder m => Text -> m Operand
globalVar Text
name = do
  let gVarDir :: CodeLine
gVarDir = Label -> Directive -> CodeLine
LabeledDirectiveCodeLine (Text -> Label
Label Text
name) (Int64 -> Directive
DirDWord Int64
0)
  (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$
    \bs :: BuilderState
bs@(BS ProgramBuilderState
pbs FunctionBuilderState
_ Integer
_) ->
      BuilderState
bs {programBS :: ProgramBuilderState
programBS = ProgramBuilderState
pbs {sectionData :: [CodeLine]
sectionData = CodeLine
gVarDir CodeLine -> [CodeLine] -> [CodeLine]
forall a. a -> [a] -> [a]
: ProgramBuilderState -> [CodeLine]
sectionData ProgramBuilderState
pbs}}
  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> m Operand) -> Operand -> m Operand
forall a b. (a -> b) -> a -> b
$ Text -> Operand
Symbol Text
name

-- | Get external function operand
externFunction :: (MonadAsmBuilder m) => Text -> m Operand
externFunction :: forall (m :: * -> *). MonadAsmBuilder m => Text -> m Operand
externFunction = Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> m Operand) -> (Text -> Operand) -> Text -> m Operand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Operand
Symbol

storeToLabeledAddr :: (MonadAsmBuilder m) => Operand -> Operand -> m ()
storeToLabeledAddr :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m ()
storeToLabeledAddr Operand
addr Operand
value = do
  let regA :: Register
regA = Register
T0
  let ra :: Operand
ra = Register -> Operand
Register Register
regA
  let rb :: Operand
rb = Register -> Operand
Register Register
T1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines
    [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
La [Operand
ra, Operand
addr],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rb, Operand
value],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
rb, Register -> Int64 -> Operand
RegisterWithOffset Register
regA Int64
0]
    ]

  () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

immediate :: (MonadAsmBuilder m) => Int64 -> m Operand
immediate :: forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Operand
immediate Int64
value = do
  let rd :: Operand
rd = Register -> Operand
Register Register
T0

  Operand
rdMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines
    [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Li [Operand
rd, Int64 -> Operand
Immediate Int64
value],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
rd, Operand
rdMem]
    ]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
rdMem

-- boolean
and, or :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand
and :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
and = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
And
or :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
or = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
Or

-- arithmetic
add, sub, mul :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand
add :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
add = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
Add
sub :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
sub = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
Sub
mul :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
mul = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
Mul

neg :: (MonadAsmBuilder m) => Operand -> m Operand
neg :: forall (m :: * -> *). MonadAsmBuilder m => Operand -> m Operand
neg Operand
a = do
  let rd :: Operand
rd = Register -> Operand
Register Register
T0
  let rs :: Operand
rs = Register -> Operand
Register Register
T0

  Operand
rdMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines
    [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rs, Operand
a],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Neg [Operand
rd, Operand
rs],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
rd, Operand
rdMem]
    ]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
rdMem

-- comparison
eq, ne, lt, le, gt, ge :: (MonadAsmBuilder m) => Operand -> Operand -> m Operand
eq :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
eq = OpCode -> OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction2 OpCode
Sub OpCode
Seqz
ne :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
ne = OpCode -> OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction2 OpCode
Sub OpCode
Snez
lt :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
lt = OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
Slt
le :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
le = (Operand -> Operand -> m Operand)
-> Operand -> Operand -> m Operand
forall a b c. (a -> b -> c) -> b -> a -> c
flip Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
ge
gt :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
gt = (Operand -> Operand -> m Operand)
-> Operand -> Operand -> m Operand
forall a b c. (a -> b -> c) -> b -> a -> c
flip Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
lt
ge :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> Operand -> m Operand
ge = OpCode -> OpCode -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction2 OpCode
Slt OpCode
Seqz

call :: (MonadAsmBuilder m) => Operand -> [Operand] -> m Operand
call :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> [Operand] -> m Operand
call Operand
fun [Operand]
args = do
  let argRegs :: [Operand]
argRegs = Register -> Operand
Register (Register -> Operand) -> [Register] -> [Operand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Register
A0, Register
A1, Register
A2, Register
A3, Register
A4, Register
A5, Register
A6]
  let loadArguments :: [CodeLine]
loadArguments = (Operand -> Operand -> CodeLine) -> (Operand, Operand) -> CodeLine
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Operand -> Operand -> CodeLine
loadArgCL ((Operand, Operand) -> CodeLine)
-> [(Operand, Operand)] -> [CodeLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Operand]
argRegs [Operand] -> [Operand] -> [(Operand, Operand)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Operand]
args

  let retVal :: Operand
retVal = Register -> Operand
Register Register
A0
  Operand
retValMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1
  Operand
raMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines ([CodeLine] -> m ()) -> [CodeLine] -> m ()
forall a b. (a -> b) -> a -> b
$
    [CodeLine]
loadArguments
      [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Register -> Operand
Register Register
Ra, Operand
raMem],
           OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Call [Operand
fun],
           OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Register -> Operand
Register Register
Ra, Operand
raMem],
           OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
retVal, Operand
retValMem]
         ]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
retValMem
  where
    loadArgCL :: Operand -> Operand -> CodeLine
loadArgCL Operand
reg Operand
arg = case Operand
arg of
      Symbol Text
_ -> OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
La [Operand
reg, Operand
arg]
      Operand
_ -> OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
reg, Operand
arg]

ite :: (MonadAsmBuilder m) => Operand -> (() -> m Operand) -> (() -> m Operand) -> m Operand
ite :: forall (m :: * -> *).
MonadAsmBuilder m =>
Operand -> (() -> m Operand) -> (() -> m Operand) -> m Operand
ite Operand
c () -> m Operand
t () -> m Operand
e = do
  let retVal :: Operand
retVal = Register -> Operand
Register Register
T0
  Operand
retValMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  Text
elseLabelName <- String -> Text
Txt.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"else_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> m Integer -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). MonadAsmBuilder m => m Integer
genId
  Text
endLabelName <- String -> Text
Txt.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"end_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> m Integer -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). MonadAsmBuilder m => m Integer
genId

  -- condition
  let condReg :: Operand
condReg = Register -> Operand
Register Register
T1
  let loadCond :: CodeLine
loadCond = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
condReg, Operand
c]
  let br :: CodeLine
br = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Beqz [Operand
condReg, Text -> Operand
Symbol Text
elseLabelName]

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines [CodeLine
loadCond, CodeLine
br]

  -- then
  [CodeLine]
storeThenRes <- (\Operand
op -> [OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
retVal, Operand
op], OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
retVal, Operand
retValMem]]) (Operand -> [CodeLine]) -> m Operand -> m [CodeLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> m Operand
t ()
  let jumpFromThenToEnd :: CodeLine
jumpFromThenToEnd = OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
J [Text -> Operand
Symbol Text
endLabelName]

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines ([CodeLine] -> m ()) -> [CodeLine] -> m ()
forall a b. (a -> b) -> a -> b
$ [CodeLine]
storeThenRes [CodeLine] -> [CodeLine] -> [CodeLine]
forall a. [a] -> [a] -> [a]
++ [CodeLine
jumpFromThenToEnd]

  -- else
  let elseLabel :: CodeLine
elseLabel = Label -> CodeLine
LabelCodeLine (Label -> CodeLine) -> Label -> CodeLine
forall a b. (a -> b) -> a -> b
$ Text -> Label
Label Text
elseLabelName
  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines [CodeLine
elseLabel]

  [CodeLine]
storeElseRes <- (\Operand
op -> [OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
retVal, Operand
op], OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
retVal, Operand
retValMem]]) (Operand -> [CodeLine]) -> m Operand -> m [CodeLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> m Operand
e ()

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines [CodeLine]
storeElseRes

  -- end
  let endLabel :: CodeLine
endLabel = Label -> CodeLine
LabelCodeLine (Label -> CodeLine) -> Label -> CodeLine
forall a b. (a -> b) -> a -> b
$ Text -> Label
Label Text
endLabelName

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines [CodeLine
endLabel]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
retValMem

-- Utils

genOpCodeInstruction1 :: (MonadAsmBuilder m) => OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 :: forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction1 OpCode
opCode Operand
a Operand
b = do
  let rd :: Operand
rd = Register -> Operand
Register Register
T0
  let rs1 :: Operand
rs1 = Register -> Operand
Register Register
T0
  let rs2 :: Operand
rs2 = Register -> Operand
Register Register
T1

  Operand
rdMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines
    [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rs1, Operand
a],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rs2, Operand
b],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
opCode [Operand
rd, Operand
rs1, Operand
rs2],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
rd, Operand
rdMem]
    ]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
rdMem

genOpCodeInstruction2 :: (MonadAsmBuilder m) => OpCode -> OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction2 :: forall (m :: * -> *).
MonadAsmBuilder m =>
OpCode -> OpCode -> Operand -> Operand -> m Operand
genOpCodeInstruction2 OpCode
opCode1 OpCode
opCode2 Operand
a Operand
b = do
  let rd :: Operand
rd = Register -> Operand
Register Register
T0
  let rs1 :: Operand
rs1 = Register -> Operand
Register Register
T0
  let rs2 :: Operand
rs2 = Register -> Operand
Register Register
T1

  Operand
rdMem <- Int64 -> Operand
Memory (Int64 -> Operand) -> m Int64 -> m Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> m Int64
forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
1

  [CodeLine] -> m ()
forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines
    [ OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rs1, Operand
a],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Ld [Operand
rs2, Operand
b],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
opCode1 [Operand
rd, Operand
rs1, Operand
rs2],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
opCode2 [Operand
rd, Operand
rd],
      OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
Sd [Operand
rd, Operand
rdMem]
    ]

  Operand -> m Operand
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
rdMem

pushProgramCodeLines :: (MonadAsmBuilder m) => [CodeLine] -> m ()
pushProgramCodeLines :: forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushProgramCodeLines [CodeLine]
newCodeLines = (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$
  \bs :: BuilderState
bs@(BS pbs :: ProgramBuilderState
pbs@(PBS [[CodeLine]]
currCodeLines [CodeLine]
_) FunctionBuilderState
_ Integer
_) ->
    BuilderState
bs {programBS :: ProgramBuilderState
programBS = ProgramBuilderState
pbs {sectionText :: [[CodeLine]]
sectionText = [CodeLine]
newCodeLines [CodeLine] -> [[CodeLine]] -> [[CodeLine]]
forall a. a -> [a] -> [a]
: [[CodeLine]]
currCodeLines}}

pushFunctionCodeLines :: (MonadAsmBuilder m) => [CodeLine] -> m ()
pushFunctionCodeLines :: forall (m :: * -> *). MonadAsmBuilder m => [CodeLine] -> m ()
pushFunctionCodeLines [CodeLine]
newCodeLines = (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$
  \bs :: BuilderState
bs@(BS ProgramBuilderState
_ fbs :: FunctionBuilderState
fbs@(FBS [[CodeLine]]
currCodeLines Int64
_) Integer
_) ->
    BuilderState
bs {functionBS :: FunctionBuilderState
functionBS = FunctionBuilderState
fbs {functionCodeLines :: [[CodeLine]]
functionCodeLines = [CodeLine]
newCodeLines [CodeLine] -> [[CodeLine]] -> [[CodeLine]]
forall a. a -> [a] -> [a]
: [[CodeLine]]
currCodeLines}}

incAndGetSpo :: (MonadAsmBuilder m) => Int64 -> m Int64
incAndGetSpo :: forall (m :: * -> *). MonadAsmBuilder m => Int64 -> m Int64
incAndGetSpo Int64
amount = do
  Int64
spo <- FunctionBuilderState -> Int64
stackPointerOffset (FunctionBuilderState -> Int64)
-> (BuilderState -> FunctionBuilderState) -> BuilderState -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuilderState -> FunctionBuilderState
functionBS (BuilderState -> Int64) -> m BuilderState -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BuilderState
forall (m :: * -> *). MonadAsmBuilder m => m BuilderState
getAsmBuilderState
  let newSpo :: Int64
newSpo = Int64
spo Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
amount

  (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$
    \bs :: BuilderState
bs@(BS ProgramBuilderState
_ FunctionBuilderState
fbs Integer
_) ->
      BuilderState
bs {functionBS :: FunctionBuilderState
functionBS = FunctionBuilderState
fbs {stackPointerOffset :: Int64
stackPointerOffset = Int64
newSpo}}

  Int64 -> m Int64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
newSpo

instructionCodeLine :: OpCode -> [Operand] -> CodeLine
instructionCodeLine :: OpCode -> [Operand] -> CodeLine
instructionCodeLine OpCode
opCode [Operand]
ops = Instruction -> CodeLine
InstructionCodeLine (Instruction -> CodeLine) -> Instruction -> CodeLine
forall a b. (a -> b) -> a -> b
$ OpCode -> [Operand] -> Instruction
Instruction OpCode
opCode [Operand]
ops

genId :: (MonadAsmBuilder m) => m Integer
genId :: forall (m :: * -> *). MonadAsmBuilder m => m Integer
genId = do
  Integer
cnt <- BuilderState -> Integer
idCnt (BuilderState -> Integer) -> m BuilderState -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BuilderState
forall (m :: * -> *). MonadAsmBuilder m => m BuilderState
getAsmBuilderState
  (BuilderState -> BuilderState) -> m ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState ((BuilderState -> BuilderState) -> m ())
-> (BuilderState -> BuilderState) -> m ()
forall a b. (a -> b) -> a -> b
$ \BuilderState
bs -> BuilderState
bs {idCnt :: Integer
idCnt = Integer
cnt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1}
  Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
cnt