{-# LANGUAGE OverloadedStrings #-}

module Kempe.Asm.Arm.Trans ( irToAarch64
                           ) where

import           Data.Bits          (rotateR, (.&.))
import           Data.Foldable.Ext  (foldMapA)
import           Data.Int           (Int64)
import           Data.List          (scanl')
import           Kempe.AST.Size
import           Kempe.Asm.Arm.Type
import           Kempe.IR.Monad
import qualified Kempe.IR.Type      as IR

irToAarch64 :: SizeEnv -> IR.WriteSt -> [IR.Stmt] -> [Arm AbsReg ()]
irToAarch64 :: SizeEnv -> WriteSt -> [Stmt] -> [Arm AbsReg ()]
irToAarch64 SizeEnv
env WriteSt
w = WriteSt -> WriteM [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. WriteSt -> WriteM a -> a
runWriteM WriteSt
w (WriteM [Arm AbsReg ()] -> [Arm AbsReg ()])
-> ([Stmt] -> WriteM [Arm AbsReg ()]) -> [Stmt] -> [Arm AbsReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stmt -> WriteM [Arm AbsReg ()])
-> [Stmt] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) (t :: * -> *) m a.
(Applicative f, Traversable t, Monoid m) =>
(a -> f m) -> t a -> f m
foldMapA (SizeEnv -> Stmt -> WriteM [Arm AbsReg ()]
irEmit SizeEnv
env)

toAbsReg :: IR.Temp -> AbsReg
toAbsReg :: Temp -> AbsReg
toAbsReg (IR.Temp8 Int
i)   = Int -> AbsReg
AllocReg Int
i
toAbsReg (IR.Temp64 Int
i)  = Int -> AbsReg
AllocReg Int
i
toAbsReg Temp
IR.DataPointer = AbsReg
DataPointer

storeSize :: Int64 -> (reg -> Addr reg -> Arm reg ())
storeSize :: Int64 -> reg -> Addr reg -> Arm reg ()
storeSize Int64
1 = () -> reg -> Addr reg -> Arm reg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
StoreByte ()
storeSize Int64
8 = () -> reg -> Addr reg -> Arm reg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store ()
storeSize Int64
_ = [Char] -> reg -> Addr reg -> Arm reg ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Load not supported or incoherent."

loadSize :: Int64 -> (reg -> Addr reg -> Arm reg ())
loadSize :: Int64 -> reg -> Addr reg -> Arm reg ()
loadSize Int64
1 = () -> reg -> Addr reg -> Arm reg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
LoadByte ()
loadSize Int64
8 = () -> reg -> Addr reg -> Arm reg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load ()
loadSize Int64
_ = [Char] -> reg -> Addr reg -> Arm reg ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Load not supported or incoherent."

pushLink :: [Arm AbsReg ()]
pushLink :: [Arm AbsReg ()]
pushLink = [() -> AbsReg -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Int64 -> Arm reg a
SubRC () AbsReg
StackPtr AbsReg
StackPtr Int64
16, () -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () AbsReg
LinkReg (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg AbsReg
StackPtr)]

popLink :: [Arm AbsReg ()]
popLink :: [Arm AbsReg ()]
popLink = [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () AbsReg
LinkReg (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg AbsReg
StackPtr), () -> AbsReg -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Int64 -> Arm reg a
AddRC () AbsReg
StackPtr AbsReg
StackPtr Int64
16]

irEmit :: SizeEnv -> IR.Stmt -> WriteM [Arm AbsReg ()]
irEmit :: SizeEnv -> Stmt -> WriteM [Arm AbsReg ()]
irEmit SizeEnv
_ (IR.Jump Label
l)                    = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
Branch () Label
l]
irEmit SizeEnv
_ Stmt
IR.Ret                         = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Arm AbsReg ()
forall reg a. a -> Arm reg a
Ret ()]
irEmit SizeEnv
_ (IR.KCall Label
l)                   = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()]
pushLink [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ () -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
BranchLink () Label
l Arm AbsReg () -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. a -> [a] -> [a]
: [Arm AbsReg ()]
popLink) -- TODO: think more?
irEmit SizeEnv
_ (IR.Labeled Label
l)                 = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
Label () Label
l]
irEmit SizeEnv
_ (IR.WrapKCall ABI
Kabi ([KempeTy ()]
_, [KempeTy ()]
_) ByteString
n Label
l) = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [() -> ByteString -> Arm AbsReg ()
forall reg a. a -> ByteString -> Arm reg a
BSLabel () ByteString
n] [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
pushLink [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
BranchLink () Label
l] [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
popLink [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Arm AbsReg ()
forall reg a. a -> Arm reg a
Ret ()]
irEmit SizeEnv
env (IR.WrapKCall ABI
Cabi ([KempeTy ()]
is, [KempeTy ()
o]) ByteString
n Label
l) | (KempeTy () -> Bool) -> [KempeTy ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\KempeTy ()
i -> SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8) [KempeTy ()]
is Bool -> Bool -> Bool
&& SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
8 Bool -> Bool -> Bool
&& [KempeTy ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [KempeTy ()]
is Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 = do
    { let sizes :: [Int64]
sizes = (KempeTy () -> Int64) -> [KempeTy ()] -> [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env) [KempeTy ()]
is
    ; let offs :: [Int64]
offs = (Int64 -> Int64 -> Int64) -> Int64 -> [Int64] -> [Int64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+) Int64
0 [Int64]
sizes
    ; let totalSize :: Int64
totalSize = SizeEnv -> [KempeTy ()] -> Int64
forall a. SizeEnv -> [KempeTy a] -> Int64
sizeStack SizeEnv
env [KempeTy ()]
is
    ; let argRegs :: [AbsReg]
argRegs = [AbsReg
CArg0, AbsReg
CArg1, AbsReg
CArg2, AbsReg
CArg3, AbsReg
CArg4, AbsReg
CArg5, AbsReg
CArg6, AbsReg
CArg7]
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [() -> ByteString -> Arm AbsReg ()
forall reg a. a -> ByteString -> Arm reg a
BSLabel () ByteString
n] [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
pushLink [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> ByteString -> Arm AbsReg ()
forall reg a. a -> reg -> ByteString -> Arm reg a
LoadLabel () AbsReg
DataPointer ByteString
"kempe_data", () -> ByteString -> Arm AbsReg ()
forall reg a. a -> ByteString -> Arm reg a
GnuMacro () ByteString
"calleesave"] [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ (AbsReg -> Int64 -> Int64 -> Arm AbsReg ())
-> [AbsReg] -> [Int64] -> [Int64] -> [Arm AbsReg ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\AbsReg
r Int64
sz Int64
i -> Int64 -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg. Int64 -> reg -> Addr reg -> Arm reg ()
storeSize Int64
sz AbsReg
r (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus AbsReg
DataPointer Int64
i)) [AbsReg]
argRegs [Int64]
sizes [Int64]
offs [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Int64 -> Arm reg a
AddRC () AbsReg
DataPointer AbsReg
DataPointer Int64
totalSize, () -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
BranchLink () Label
l, Int64 -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg. Int64 -> reg -> Addr reg -> Arm reg ()
loadSize (SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o) AbsReg
CArg0 (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus AbsReg
DataPointer (Int64 -> Int64
forall a. Num a => a -> a
negate (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ SizeEnv -> KempeTy () -> Int64
forall a. SizeEnv -> KempeTy a -> Int64
size' SizeEnv
env KempeTy ()
o)), () -> ByteString -> Arm AbsReg ()
forall reg a. a -> ByteString -> Arm reg a
GnuMacro () ByteString
"calleerestore"] [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
popLink [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> Arm AbsReg ()
forall reg a. a -> Arm reg a
Ret ()]
    }
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
8 (IR.Reg Temp
r')) =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () (Temp -> AbsReg
toAbsReg Temp
r') (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r)]
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
8 Exp
e) = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
put <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
put [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () (Temp -> AbsReg
toAbsReg Temp
r') (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r)]
    }
irEmit SizeEnv
_ (IR.MovMem Exp
e Int64
8 Exp
e') = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
    ; [Arm AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e' Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
e'Eval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () (Temp -> AbsReg
toAbsReg Temp
r') (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r)])
    }
irEmit SizeEnv
_ (IR.MovTemp Temp
r Exp
e) = Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
irEmit SizeEnv
_ (IR.MovMem (IR.Reg Temp
r) Int64
1 Exp
e) = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
put <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
put [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
StoreByte () (Temp -> AbsReg
toAbsReg Temp
r') (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r)]
    }
irEmit SizeEnv
_ (IR.MovMem Exp
e Int64
1 Exp
e') = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
    ; [Arm AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e' Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
e'Eval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
StoreByte () (Temp -> AbsReg
toAbsReg Temp
r') (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r)])
    }
irEmit SizeEnv
_ (IR.CJump Exp
e Label
l0 Label
l1) = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Label -> Arm AbsReg ()
forall reg a. a -> reg -> Label -> Arm reg a
BranchZero () (Temp -> AbsReg
toAbsReg Temp
r) Label
l1, () -> Label -> Arm AbsReg ()
forall reg a. a -> Label -> Arm reg a
Branch () Label
l0]
    }
-- handles e.g. (mjump (=b (mem [1] (+ (reg datapointer) (int 0))) (tag 0x0)) kmp2)
irEmit SizeEnv
_ (IR.MJump (IR.EqByte Exp
e (IR.ConstTag Word8
0)) Label
l) = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Label -> Arm AbsReg ()
forall reg a. a -> reg -> Label -> Arm reg a
BranchZero () (Temp -> AbsReg
toAbsReg Temp
r) Label
l]
    }
irEmit SizeEnv
_ (IR.MJump Exp
e Label
l) = do
    { Temp
r <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Label -> Arm AbsReg ()
forall reg a. a -> reg -> Label -> Arm reg a
BranchNonzero () (Temp -> AbsReg
toAbsReg Temp
r) Label
l] -- this is acceptable since in theory e is only 0 or 1
    }
-- example function call (arm) https://www.cs.princeton.edu/courses/archive/spr19/cos217/lectures/15_AssemblyFunctions.pdf
--
-- try https://thinkingeek.com/2017/05/29/exploring-aarch64-assembler-chapter-8/

-- see here:
-- https://stackoverflow.com/questions/27938768/moving-a-32-bit-constant-in-arm-arch64-register
-- and here:
-- https://developer.arm.com/documentation/dui0802/a/A64-General-Instructions/MOVK
--
-- Basically, arm only allows 16-bit immediates so when we load a 64-bit value
-- into a register we have to split it into 4 16-bit loads (shifted)
movRWord :: AbsReg -> Word -> [Arm AbsReg ()]
movRWord :: AbsReg -> Label -> [Arm AbsReg ()]
movRWord AbsReg
r Label
w = [() -> AbsReg -> Word16 -> Arm AbsReg ()
forall reg a. a -> reg -> Word16 -> Arm reg a
MovRWord () AbsReg
r (Label -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Label
b0), () -> AbsReg -> Word16 -> Int8 -> Arm AbsReg ()
forall reg a. a -> reg -> Word16 -> Int8 -> Arm reg a
MovRK () AbsReg
r (Label -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Label
b1) Int8
16, () -> AbsReg -> Word16 -> Int8 -> Arm AbsReg ()
forall reg a. a -> reg -> Word16 -> Int8 -> Arm reg a
MovRK () AbsReg
r (Label -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Label
b2) Int8
32, () -> AbsReg -> Word16 -> Int8 -> Arm AbsReg ()
forall reg a. a -> reg -> Word16 -> Int8 -> Arm reg a
MovRK () AbsReg
r (Label -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Label
b3) Int8
48]
    where b0 :: Label
b0 = Label
w Label -> Label -> Label
forall a. Bits a => a -> a -> a
.&. Label
0xFFFF
          b1 :: Label
b1 = (Label
w Label -> Label -> Label
forall a. Bits a => a -> a -> a
.&. Label
0xFFFF0000) Label -> Int -> Label
forall a. Bits a => a -> Int -> a
`rotateR` Int
16
          b2 :: Label
b2 = (Label
w Label -> Label -> Label
forall a. Bits a => a -> a -> a
.&. Label
0xFFFF00000000) Label -> Int -> Label
forall a. Bits a => a -> Int -> a
`rotateR` Int
32
          b3 :: Label
b3 = (Label
w Label -> Label -> Label
forall a. Bits a => a -> a -> a
.&. Label
0xFFFF000000000000) Label -> Int -> Label
forall a. Bits a => a -> Int -> a
`rotateR` Int
48
          -- TODO: only MovRK if nonzero

evalE :: IR.Exp -> IR.Temp -> WriteM [Arm AbsReg ()]
evalE :: Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE (IR.ConstInt Int64
i) Temp
r                                                        = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> Int64 -> Arm reg a
MovRC () (Temp -> AbsReg
toAbsReg Temp
r) Int64
i]
evalE (IR.ConstWord Label
w) Temp
r                                                       = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ AbsReg -> Label -> [Arm AbsReg ()]
movRWord (Temp -> AbsReg
toAbsReg Temp
r) Label
w
evalE (IR.ConstTag Word8
b) Temp
r                                                        = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> Int64 -> Arm reg a
MovRC () (Temp -> AbsReg
toAbsReg Temp
r) (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                 = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
AddRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
SubRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntTimesIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
MulRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntDivIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                  = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
SignedDivRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.WordDivIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                 = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
UnsignedDivRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftRIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r              = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
LShiftRRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.WordShiftLIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r              = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
LShiftLRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntXorIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                  = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
XorRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.BoolBinOp BoolBinOp
IR.BoolXor (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                      = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
XorRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.BoolBinOp BoolBinOp
IR.BoolAnd (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                      = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
AndRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.BoolBinOp BoolBinOp
IR.BoolOr (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r                       = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
OrRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2)]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i)) Temp
r             = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Int64 -> Arm reg a
AddRC () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i]
evalE (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r1) (IR.ConstInt Int64
i)) Temp
r            = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Int64 -> Arm reg a
SubRC () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r1) Int64
i]
evalE (IR.Mem Int64
8 (IR.Reg Temp
r0)) Temp
r                                                 = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r0)]
evalE (IR.Mem Int64
1 (IR.Reg Temp
r0)) Temp
r                                                 = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
LoadByte () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r0)]
evalE (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i))) Temp
r  = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
LoadByte () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i)]
evalE (IR.Mem Int64
1 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i))) Temp
r = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
LoadByte () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) (Int64 -> Int64
forall a. Num a => a -> a
negate Int64
i))]
evalE (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntPlusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i))) Temp
r  = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) Int64
i)]
evalE (IR.Mem Int64
8 (IR.ExprIntBinOp IntBinOp
IR.IntMinusIR (IR.Reg Temp
r0) (IR.ConstInt Int64
i))) Temp
r = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Int64 -> Addr AbsReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus (Temp -> AbsReg
toAbsReg Temp
r0) (Int64 -> Int64
forall a. Num a => a -> a
negate Int64
i))]
evalE (IR.Mem Int64
8 Exp
e) Temp
r                                                           = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
placeE <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
placeE [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r')]
    }
evalE (IR.Mem Int64
1 Exp
e) Temp
r = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
placeE <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
placeE [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Addr AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
LoadByte () (Temp -> AbsReg
toAbsReg Temp
r) (AbsReg -> Addr AbsReg
forall reg. reg -> Addr reg
Reg (AbsReg -> Addr AbsReg) -> AbsReg -> Addr AbsReg
forall a b. (a -> b) -> a -> b
$ Temp -> AbsReg
toAbsReg Temp
r')]
    }
evalE (IR.Reg Temp
r) Temp
r' = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
MovRR () (Temp -> AbsReg
toAbsReg Temp
r') (Temp -> AbsReg
toAbsReg Temp
r)]
evalE (IR.ExprIntRel RelBinOp
IR.IntLeqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Leq]
evalE (IR.ExprIntRel RelBinOp
IR.IntLtIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Lt]
evalE (IR.ExprIntRel RelBinOp
IR.IntGtIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Gt]
evalE (IR.ExprIntRel RelBinOp
IR.IntEqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Eq]
evalE (IR.ExprIntRel RelBinOp
IR.IntNeqIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r =
    [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Neq]
evalE (IR.ExprIntRel RelBinOp
IR.IntEqIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Eq
evalE (IR.ExprIntRel RelBinOp
IR.IntNeqIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Neq
evalE (IR.ExprIntRel RelBinOp
IR.IntLtIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Lt
evalE (IR.ExprIntRel RelBinOp
IR.IntGtIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Gt
evalE (IR.ExprIntRel RelBinOp
IR.IntLeqIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Leq
evalE (IR.ExprIntRel RelBinOp
IR.IntGeqIR Exp
e Exp
e') Temp
r = Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
Geq
evalE (IR.EqByte Exp
e (IR.ConstTag Word8
b)) Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r0
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> Int64 -> Arm reg a
CmpRC () (Temp -> AbsReg
toAbsReg Temp
r0) (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Eq]
    }
evalE (IR.EqByte Exp
e Exp
e') Temp
r = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r0
    ; [Arm AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e' Temp
r1
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
e'Eval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r0) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
Eq]
    }
evalE (IR.IntNegIR (IR.Reg Temp
r')) Temp
r = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
Neg () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')]
evalE (IR.IntNegIR Exp
e) Temp
r = do
    { Temp
r' <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r'
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
Neg () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
r')]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntModIR (IR.Reg Temp
r1) (IR.Reg Temp
r2)) Temp
r = do
    { Temp
rTrash <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ () -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
UnsignedDivRR () (Temp -> AbsReg
toAbsReg Temp
rTrash) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r2), () -> AbsReg -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> reg -> Arm reg a
MulSubRRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
rTrash) (Temp -> AbsReg
toAbsReg Temp
r2) (Temp -> AbsReg
toAbsReg Temp
r1) ]
    }
evalE (IR.ExprIntBinOp IntBinOp
IR.IntModIR Exp
e Exp
e') Temp
r = do
    { Temp
rTrash <- WriteM Temp
allocTemp64
    ; Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r0
    ; [Arm AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e' Temp
r1
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
e'Eval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [ () -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> Arm reg a
UnsignedDivRR () (Temp -> AbsReg
toAbsReg Temp
rTrash) (Temp -> AbsReg
toAbsReg Temp
r0) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> AbsReg -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> reg -> reg -> Arm reg a
MulSubRRR () (Temp -> AbsReg
toAbsReg Temp
r) (Temp -> AbsReg
toAbsReg Temp
rTrash) (Temp -> AbsReg
toAbsReg Temp
r1) (Temp -> AbsReg
toAbsReg Temp
r0) ]
    }
evalE (IR.ConstBool Bool
b) Temp
r = [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> AbsReg -> Int64 -> Arm AbsReg ()
forall reg a. a -> reg -> Int64 -> Arm reg a
MovRC () (Temp -> AbsReg
toAbsReg Temp
r) (Bool -> Int64
toInt Bool
b)]

-- | Helper for <, >, etc. used by 'evalE'
cmpE :: IR.Exp -> IR.Exp -> IR.Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE :: Exp -> Exp -> Temp -> Cond -> WriteM [Arm AbsReg ()]
cmpE Exp
e Exp
e' Temp
r Cond
c = do
    { Temp
r0 <- WriteM Temp
allocTemp64
    ; Temp
r1 <- WriteM Temp
allocTemp64
    ; [Arm AbsReg ()]
eEval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e Temp
r0
    ; [Arm AbsReg ()]
e'Eval <- Exp -> Temp -> WriteM [Arm AbsReg ()]
evalE Exp
e' Temp
r1
    ; [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arm AbsReg ()] -> WriteM [Arm AbsReg ()])
-> [Arm AbsReg ()] -> WriteM [Arm AbsReg ()]
forall a b. (a -> b) -> a -> b
$ [Arm AbsReg ()]
eEval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [Arm AbsReg ()]
e'Eval [Arm AbsReg ()] -> [Arm AbsReg ()] -> [Arm AbsReg ()]
forall a. [a] -> [a] -> [a]
++ [() -> AbsReg -> AbsReg -> Arm AbsReg ()
forall reg a. a -> reg -> reg -> Arm reg a
CmpRR () (Temp -> AbsReg
toAbsReg Temp
r0) (Temp -> AbsReg
toAbsReg Temp
r1), () -> AbsReg -> Cond -> Arm AbsReg ()
forall reg a. a -> reg -> Cond -> Arm reg a
CSet () (Temp -> AbsReg
toAbsReg Temp
r) Cond
c]
    }

-- | Just use 64-bit integers here
toInt :: Bool -> Int64
toInt :: Bool -> Int64
toInt Bool
False = Int64
0
toInt Bool
True  = Int64
1