{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Kempe.Asm.Arm.Type ( Label
                          , ArmReg (..)
                          , AbsReg (..)
                          , Arm (..)
                          , Cond (..)
                          , Addr (..)
                          , prettyAsm
                          , prettyDebugAsm
                          ) where

import           Control.DeepSeq    (NFData)
import qualified Data.ByteString    as BS
import           Data.Copointed
import           Data.Int           (Int64, Int8)
import           Data.Semigroup     ((<>))
import           Data.Text.Encoding (decodeUtf8)
import           Data.Word          (Word16)
import           GHC.Generics       (Generic)
import           Kempe.Asm.Pretty
import           Kempe.Asm.Type
import           Prettyprinter      (Doc, Pretty (..), brackets, colon, concatWith, hardline, (<+>))
import           Prettyprinter.Ext  (prettyHex, prettyLines, (<#>), (<~>))

-- | Sort of silly class that prints the 32-bit equivalent of a register.
class As32 reg where
    as32b :: reg -> Doc ann

-- r0-r7 result registers

data AbsReg = DataPointer
            | AllocReg !Int
            | CArg0 -- x0
            | CArg1
            | CArg2
            | CArg3
            | CArg4
            | CArg5
            | CArg6
            | CArg7 -- x7
            | LinkReg -- so we can save before/after branch-links
            | StackPtr -- so we can save in translation phase
            deriving ((forall x. AbsReg -> Rep AbsReg x)
-> (forall x. Rep AbsReg x -> AbsReg) -> Generic AbsReg
forall x. Rep AbsReg x -> AbsReg
forall x. AbsReg -> Rep AbsReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsReg x -> AbsReg
$cfrom :: forall x. AbsReg -> Rep AbsReg x
Generic, AbsReg -> ()
(AbsReg -> ()) -> NFData AbsReg
forall a. (a -> ()) -> NFData a
rnf :: AbsReg -> ()
$crnf :: AbsReg -> ()
NFData)

instance Pretty AbsReg where
    pretty :: AbsReg -> Doc ann
pretty AbsReg
DataPointer  = Doc ann
"datapointer"
    pretty (AllocReg Int
i) = Doc ann
"Abs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i
    pretty AbsReg
CArg0        = Doc ann
"X0"
    pretty AbsReg
CArg1        = Doc ann
"X1"
    pretty AbsReg
CArg2        = Doc ann
"X2"
    pretty AbsReg
CArg3        = Doc ann
"X3"
    pretty AbsReg
CArg4        = Doc ann
"X4"
    pretty AbsReg
CArg5        = Doc ann
"X5"
    pretty AbsReg
CArg6        = Doc ann
"X6"
    pretty AbsReg
CArg7        = Doc ann
"X7"
    pretty AbsReg
LinkReg      = Doc ann
"X30"
    pretty AbsReg
StackPtr     = Doc ann
"SP"

instance As32 AbsReg where
    as32b :: AbsReg -> Doc ann
as32b = AbsReg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

type Label = Word

data ArmReg = X0
            | X1
            | X2
            | X3
            | X4
            | X5
            | X6
            | X7
            | X8
            | X9
            | X10
            | X11
            | X12
            | X13
            | X14
            | X15
            | X16
            | X17
            | X18
            | X19
            | X20
            | X21
            | X22
            | X23
            | X24
            | X25
            | X26
            | X27
            | X28
            | X29
            | X30 -- ^ This is the link register?
            | SP -- ^ Don't use this
            deriving (Int -> ArmReg
ArmReg -> Int
ArmReg -> [ArmReg]
ArmReg -> ArmReg
ArmReg -> ArmReg -> [ArmReg]
ArmReg -> ArmReg -> ArmReg -> [ArmReg]
(ArmReg -> ArmReg)
-> (ArmReg -> ArmReg)
-> (Int -> ArmReg)
-> (ArmReg -> Int)
-> (ArmReg -> [ArmReg])
-> (ArmReg -> ArmReg -> [ArmReg])
-> (ArmReg -> ArmReg -> [ArmReg])
-> (ArmReg -> ArmReg -> ArmReg -> [ArmReg])
-> Enum ArmReg
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ArmReg -> ArmReg -> ArmReg -> [ArmReg]
$cenumFromThenTo :: ArmReg -> ArmReg -> ArmReg -> [ArmReg]
enumFromTo :: ArmReg -> ArmReg -> [ArmReg]
$cenumFromTo :: ArmReg -> ArmReg -> [ArmReg]
enumFromThen :: ArmReg -> ArmReg -> [ArmReg]
$cenumFromThen :: ArmReg -> ArmReg -> [ArmReg]
enumFrom :: ArmReg -> [ArmReg]
$cenumFrom :: ArmReg -> [ArmReg]
fromEnum :: ArmReg -> Int
$cfromEnum :: ArmReg -> Int
toEnum :: Int -> ArmReg
$ctoEnum :: Int -> ArmReg
pred :: ArmReg -> ArmReg
$cpred :: ArmReg -> ArmReg
succ :: ArmReg -> ArmReg
$csucc :: ArmReg -> ArmReg
Enum, ArmReg -> ArmReg -> Bool
(ArmReg -> ArmReg -> Bool)
-> (ArmReg -> ArmReg -> Bool) -> Eq ArmReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArmReg -> ArmReg -> Bool
$c/= :: ArmReg -> ArmReg -> Bool
== :: ArmReg -> ArmReg -> Bool
$c== :: ArmReg -> ArmReg -> Bool
Eq, Eq ArmReg
Eq ArmReg
-> (ArmReg -> ArmReg -> Ordering)
-> (ArmReg -> ArmReg -> Bool)
-> (ArmReg -> ArmReg -> Bool)
-> (ArmReg -> ArmReg -> Bool)
-> (ArmReg -> ArmReg -> Bool)
-> (ArmReg -> ArmReg -> ArmReg)
-> (ArmReg -> ArmReg -> ArmReg)
-> Ord ArmReg
ArmReg -> ArmReg -> Bool
ArmReg -> ArmReg -> Ordering
ArmReg -> ArmReg -> ArmReg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArmReg -> ArmReg -> ArmReg
$cmin :: ArmReg -> ArmReg -> ArmReg
max :: ArmReg -> ArmReg -> ArmReg
$cmax :: ArmReg -> ArmReg -> ArmReg
>= :: ArmReg -> ArmReg -> Bool
$c>= :: ArmReg -> ArmReg -> Bool
> :: ArmReg -> ArmReg -> Bool
$c> :: ArmReg -> ArmReg -> Bool
<= :: ArmReg -> ArmReg -> Bool
$c<= :: ArmReg -> ArmReg -> Bool
< :: ArmReg -> ArmReg -> Bool
$c< :: ArmReg -> ArmReg -> Bool
compare :: ArmReg -> ArmReg -> Ordering
$ccompare :: ArmReg -> ArmReg -> Ordering
$cp1Ord :: Eq ArmReg
Ord, (forall x. ArmReg -> Rep ArmReg x)
-> (forall x. Rep ArmReg x -> ArmReg) -> Generic ArmReg
forall x. Rep ArmReg x -> ArmReg
forall x. ArmReg -> Rep ArmReg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArmReg x -> ArmReg
$cfrom :: forall x. ArmReg -> Rep ArmReg x
Generic, ArmReg -> ()
(ArmReg -> ()) -> NFData ArmReg
forall a. (a -> ()) -> NFData a
rnf :: ArmReg -> ()
$crnf :: ArmReg -> ()
NFData)

instance Pretty ArmReg where
    pretty :: ArmReg -> Doc ann
pretty ArmReg
X0  = Doc ann
"x0"
    pretty ArmReg
X1  = Doc ann
"x1"
    pretty ArmReg
X2  = Doc ann
"x2"
    pretty ArmReg
X3  = Doc ann
"x3"
    pretty ArmReg
X4  = Doc ann
"x4"
    pretty ArmReg
X5  = Doc ann
"x5"
    pretty ArmReg
X6  = Doc ann
"x6"
    pretty ArmReg
X7  = Doc ann
"x7"
    pretty ArmReg
X8  = Doc ann
"x8"
    pretty ArmReg
X9  = Doc ann
"x9"
    pretty ArmReg
X10 = Doc ann
"x10"
    pretty ArmReg
X11 = Doc ann
"x11"
    pretty ArmReg
X12 = Doc ann
"x12"
    pretty ArmReg
X13 = Doc ann
"x13"
    pretty ArmReg
X14 = Doc ann
"x14"
    pretty ArmReg
X15 = Doc ann
"x15"
    pretty ArmReg
X16 = Doc ann
"x16"
    pretty ArmReg
X17 = Doc ann
"x17"
    pretty ArmReg
X18 = Doc ann
"x18"
    pretty ArmReg
X19 = Doc ann
"x19"
    pretty ArmReg
X20 = Doc ann
"x20"
    pretty ArmReg
X21 = Doc ann
"x21"
    pretty ArmReg
X22 = Doc ann
"x22"
    pretty ArmReg
X23 = Doc ann
"x23"
    pretty ArmReg
X24 = Doc ann
"x24"
    pretty ArmReg
X25 = Doc ann
"x25"
    pretty ArmReg
X26 = Doc ann
"x26"
    pretty ArmReg
X27 = Doc ann
"x27"
    pretty ArmReg
X28 = Doc ann
"x28"
    pretty ArmReg
X29 = Doc ann
"x29"
    pretty ArmReg
X30 = Doc ann
"x30"
    pretty ArmReg
SP  = Doc ann
"sp"

instance As32 ArmReg where
    as32b :: ArmReg -> Doc ann
as32b ArmReg
X0  = Doc ann
"w0"
    as32b ArmReg
X1  = Doc ann
"w1"
    as32b ArmReg
X2  = Doc ann
"w2"
    as32b ArmReg
X3  = Doc ann
"w3"
    as32b ArmReg
X4  = Doc ann
"w4"
    as32b ArmReg
X5  = Doc ann
"w5"
    as32b ArmReg
X6  = Doc ann
"w6"
    as32b ArmReg
X7  = Doc ann
"w7"
    as32b ArmReg
X8  = Doc ann
"w8"
    as32b ArmReg
X9  = Doc ann
"w9"
    as32b ArmReg
X10 = Doc ann
"w10"
    as32b ArmReg
X11 = Doc ann
"w11"
    as32b ArmReg
X12 = Doc ann
"w12"
    as32b ArmReg
X13 = Doc ann
"w13"
    as32b ArmReg
X14 = Doc ann
"w14"
    as32b ArmReg
X15 = Doc ann
"w15"
    as32b ArmReg
X16 = Doc ann
"w16"
    as32b ArmReg
X17 = Doc ann
"w17"
    as32b ArmReg
X18 = Doc ann
"w18"
    as32b ArmReg
X19 = Doc ann
"w19"
    as32b ArmReg
X20 = Doc ann
"w20"
    as32b ArmReg
X21 = Doc ann
"w21"
    as32b ArmReg
X22 = Doc ann
"w22"
    as32b ArmReg
X23 = Doc ann
"w23"
    as32b ArmReg
X24 = Doc ann
"w24"
    as32b ArmReg
X25 = Doc ann
"w25"
    as32b ArmReg
X26 = Doc ann
"w26"
    as32b ArmReg
X27 = Doc ann
"w27"
    as32b ArmReg
X28 = Doc ann
"w28"
    as32b ArmReg
X29 = Doc ann
"w29"
    as32b ArmReg
X30 = Doc ann
"w30"
    as32b ArmReg
SP  = [Char] -> Doc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error: as32b sp should not happen!!"

data Addr reg = Reg reg
              | AddRRPlus reg reg
              | AddRCPlus reg Int64
              deriving (Addr reg -> Addr reg -> Bool
(Addr reg -> Addr reg -> Bool)
-> (Addr reg -> Addr reg -> Bool) -> Eq (Addr reg)
forall reg. Eq reg => Addr reg -> Addr reg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr reg -> Addr reg -> Bool
$c/= :: forall reg. Eq reg => Addr reg -> Addr reg -> Bool
== :: Addr reg -> Addr reg -> Bool
$c== :: forall reg. Eq reg => Addr reg -> Addr reg -> Bool
Eq, (forall x. Addr reg -> Rep (Addr reg) x)
-> (forall x. Rep (Addr reg) x -> Addr reg) -> Generic (Addr reg)
forall x. Rep (Addr reg) x -> Addr reg
forall x. Addr reg -> Rep (Addr reg) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall reg x. Rep (Addr reg) x -> Addr reg
forall reg x. Addr reg -> Rep (Addr reg) x
$cto :: forall reg x. Rep (Addr reg) x -> Addr reg
$cfrom :: forall reg x. Addr reg -> Rep (Addr reg) x
Generic, Addr reg -> ()
(Addr reg -> ()) -> NFData (Addr reg)
forall reg. NFData reg => Addr reg -> ()
forall a. (a -> ()) -> NFData a
rnf :: Addr reg -> ()
$crnf :: forall reg. NFData reg => Addr reg -> ()
NFData)

instance (Pretty reg) => Pretty (Addr reg) where
    pretty :: Addr reg -> Doc ann
pretty (Reg reg
reg)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
reg)
    pretty (AddRRPlus reg
r0 reg
r1) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AddRCPlus reg
r Int64
i)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Int64 -> Doc ann
forall a b. Pretty a => a -> Doc b
prettyInt Int64
i)

-- | See: https://developer.arm.com/documentation/dui0068/b/arm-instruction-reference/conditional-execution?lang=en
data Cond = Eq
          | Neq
          | UnsignedLeq
          | UnsignedGeq
          | UnsignedLt
          | Geq
          | Lt
          | Gt
          | Leq
          deriving ((forall x. Cond -> Rep Cond x)
-> (forall x. Rep Cond x -> Cond) -> Generic Cond
forall x. Rep Cond x -> Cond
forall x. Cond -> Rep Cond x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cond x -> Cond
$cfrom :: forall x. Cond -> Rep Cond x
Generic, Cond -> ()
(Cond -> ()) -> NFData Cond
forall a. (a -> ()) -> NFData a
rnf :: Cond -> ()
$crnf :: Cond -> ()
NFData)

instance Pretty Cond where
    pretty :: Cond -> Doc ann
pretty Cond
Eq          = Doc ann
"EQ"
    pretty Cond
Neq         = Doc ann
"NE"
    pretty Cond
UnsignedLeq = Doc ann
"LS"
    pretty Cond
Geq         = Doc ann
"GE"
    pretty Cond
Lt          = Doc ann
"LT"
    pretty Cond
Gt          = Doc ann
"GT"
    pretty Cond
Leq         = Doc ann
"LE"
    pretty Cond
UnsignedLt  = Doc ann
"LO"

-- | For reference: https://static.docs.arm.com/100898/0100/the_a64_Instruction_set_100898_0100.pdf
--
-- https://developer.arm.com/documentation/ddi0596/2020-12/Base-Instructions?lang=en
data Arm reg a = Branch { Arm reg a -> a
ann :: a, Arm reg a -> Label
label :: Label } -- like jump
               | BranchLink { ann :: a, label :: Label } -- like @call@
               | BranchCond { ann :: a, label :: Label, Arm reg a -> Cond
cond :: Cond }
               | BranchZero { ann :: a, Arm reg a -> reg
condReg :: reg, label :: Label }
               | BranchNonzero { ann :: a, condReg :: reg, label :: Label }
               | AddRR { ann :: a, Arm reg a -> reg
res :: reg, Arm reg a -> reg
inp1 :: reg, Arm reg a -> reg
inp2 :: reg }
               | AddRC { ann :: a, res :: reg, inp1 :: reg, Arm reg a -> Int64
int :: Int64 }
               | SubRC { ann :: a, res :: reg, inp1 :: reg, int :: Int64 }
               | SubRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg }
               | MulRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg }
               | MulSubRRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg, Arm reg a -> reg
inp3 :: reg }
               | MovRC { ann :: a, Arm reg a -> reg
dest :: reg, Arm reg a -> Int64
iSrc :: Int64 } -- TODO: change this to a Word16
               | SignedDivRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg }
               | UnsignedDivRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg }
               | MovRWord { ann :: a, dest :: reg, Arm reg a -> Word16
wSrc :: Word16 }
               | MovRK { ann :: a, dest :: reg, wSrc :: Word16, Arm reg a -> Int8
lShift :: Int8 }
               | MovRR { ann :: a, dest :: reg, Arm reg a -> reg
src :: reg }
               | AndRR { ann :: a, dest :: reg, inp1 :: reg, inp2 :: reg }
               | OrRR { ann :: a, dest :: reg, inp1 :: reg, inp2 :: reg }
               | XorRR { ann :: a, dest :: reg, inp1 :: reg, inp2 :: reg }
               | Load { ann :: a, dest :: reg, Arm reg a -> Addr reg
addrSrc :: Addr reg }
               | LoadByte { ann :: a, dest :: reg, addrSrc :: Addr reg }
               | LoadLabel { ann :: a, dest :: reg, Arm reg a -> ByteString
srcLabel :: BS.ByteString }
               | Store { ann :: a, src :: reg, Arm reg a -> Addr reg
addrDest :: Addr reg }
               | StoreByte { ann :: a, src :: reg, addrDest :: Addr reg } -- ^ @strb@ in Aarch64 assembly, "store byte"
               | CmpRR { ann :: a, inp1 :: reg, inp2 :: reg }
               | CmpRC { ann :: a, inp1 :: reg, int :: Int64 }
               | CSet { ann :: a, dest :: reg, cond :: Cond }
               | Ret { ann :: a }
               | Label { ann :: a, label :: Label }
               | BSLabel { ann :: a, Arm reg a -> ByteString
bsLabel :: BS.ByteString }
               | LShiftLRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg } -- LShift - logical shift
               | LShiftRRR { ann :: a, res :: reg, inp1 :: reg, inp2 :: reg }
               | GnuMacro { ann :: a, Arm reg a -> ByteString
macroName :: BS.ByteString }
               | Neg { ann :: a, dest :: reg, src :: reg }
               deriving (a -> Arm reg b -> Arm reg a
(a -> b) -> Arm reg a -> Arm reg b
(forall a b. (a -> b) -> Arm reg a -> Arm reg b)
-> (forall a b. a -> Arm reg b -> Arm reg a) -> Functor (Arm reg)
forall a b. a -> Arm reg b -> Arm reg a
forall a b. (a -> b) -> Arm reg a -> Arm reg b
forall reg a b. a -> Arm reg b -> Arm reg a
forall reg a b. (a -> b) -> Arm reg a -> Arm reg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Arm reg b -> Arm reg a
$c<$ :: forall reg a b. a -> Arm reg b -> Arm reg a
fmap :: (a -> b) -> Arm reg a -> Arm reg b
$cfmap :: forall reg a b. (a -> b) -> Arm reg a -> Arm reg b
Functor, (forall x. Arm reg a -> Rep (Arm reg a) x)
-> (forall x. Rep (Arm reg a) x -> Arm reg a)
-> Generic (Arm reg a)
forall x. Rep (Arm reg a) x -> Arm reg a
forall x. Arm reg a -> Rep (Arm reg a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall reg a x. Rep (Arm reg a) x -> Arm reg a
forall reg a x. Arm reg a -> Rep (Arm reg a) x
$cto :: forall reg a x. Rep (Arm reg a) x -> Arm reg a
$cfrom :: forall reg a x. Arm reg a -> Rep (Arm reg a) x
Generic, Arm reg a -> ()
(Arm reg a -> ()) -> NFData (Arm reg a)
forall a. (a -> ()) -> NFData a
forall reg a. (NFData a, NFData reg) => Arm reg a -> ()
rnf :: Arm reg a -> ()
$crnf :: forall reg a. (NFData a, NFData reg) => Arm reg a -> ()
NFData)

-- | Don't call this on a negative number!
prettyUInt :: (Integral a, Show a) => a -> Doc b
prettyUInt :: a -> Doc b
prettyUInt a
i = Doc b
"#" Doc b -> Doc b -> Doc b
forall a. Semigroup a => a -> a -> a
<> a -> Doc b
forall a ann. (Integral a, Show a) => a -> Doc ann
prettyHex a
i

prettyInt :: (Pretty a) => a -> Doc b
prettyInt :: a -> Doc b
prettyInt = (Doc b
"#" Doc b -> Doc b -> Doc b
forall a. Semigroup a => a -> a -> a
<>) (Doc b -> Doc b) -> (a -> Doc b) -> a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc b
forall a ann. Pretty a => a -> Doc ann
pretty

instance (Pretty reg, As32 reg) => Pretty (Arm reg a) where
    pretty :: Arm reg a -> Doc ann
pretty (Branch a
_ Label
l)              = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"b" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (BranchLink a
_ Label
l)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"bl" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (BranchCond a
_ Label
l Cond
c)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"b." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Cond -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Cond
c Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (BranchZero a
_ reg
r Label
l)        = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cbz" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty (BranchNonzero a
_ reg
r Label
l)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cbnz" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l)
    pretty Ret{}                     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"ret"
    pretty (BSLabel a
_ ByteString
b)             = let pl :: Doc ann
pl = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b) in Doc ann
".globl" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
forall ann. Doc ann
pl Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
pl Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon
    pretty (MovRWord a
_ reg
r Word16
c)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Word16 -> Doc ann
forall a ann. (Integral a, Show a) => a -> Doc ann
prettyUInt Word16
c)
    pretty (MovRK a
_ reg
r Word16
c Int8
l)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"movk" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Word16 -> Doc ann
forall a ann. (Integral a, Show a) => a -> Doc ann
prettyUInt Word16
c Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Doc ann
"lsl" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Int8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int8
l)
    pretty (LShiftLRR a
_ reg
r reg
r0 reg
r1)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"lsl" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (LShiftRRR a
_ reg
r reg
r0 reg
r1)     = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"lsr" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AddRR a
_ reg
r reg
r0 reg
r1)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"add" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (SubRR a
_ reg
r reg
r0 reg
r1)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"sub" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (MulRR a
_ reg
r reg
r0 reg
r1)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mul" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (MulSubRRR a
_ reg
r reg
r0 reg
r1 reg
r2)  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"msub" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r2)
    pretty (SignedDivRR a
_ reg
r reg
r0 reg
r1)   = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"sdiv" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (UnsignedDivRR a
_ reg
r reg
r0 reg
r1) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"udiv" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (Load a
_ reg
r Addr reg
a)              = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"ldr" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (LoadByte a
_ reg
r Addr reg
a)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"ldrb" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall reg ann. As32 reg => reg -> Doc ann
as32b reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (LoadLabel a
_ reg
r ByteString
l)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"ldr" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Doc ann
"=" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
l))
    pretty (Store a
_ reg
r Addr reg
a)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"str" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (StoreByte a
_ reg
r Addr reg
a)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"strb" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall reg ann. As32 reg => reg -> Doc ann
as32b reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Addr reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Addr reg
a)
    pretty (MovRR a
_ reg
r0 reg
r1)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (AndRR a
_ reg
r reg
r0 reg
r1)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"and" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (OrRR a
_ reg
r reg
r0 reg
r1)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"orr" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (XorRR a
_ reg
r reg
r0 reg
r1)         = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"eor" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (CSet a
_ reg
r Cond
c)              = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cset" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Cond -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Cond
c)
    pretty (MovRC a
_ reg
r Int64
i)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"mov" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Int64 -> Doc ann
forall a b. Pretty a => a -> Doc b
prettyInt Int64
i)
    pretty (CmpRR a
_ reg
r0 reg
r1)           = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)
    pretty (Label a
_ Label
l)               = Label -> Doc ann
forall ann. Label -> Doc ann
prettyLabel Label
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon
    pretty (GnuMacro a
_ ByteString
b)            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
decodeUtf8 ByteString
b))
    pretty (AddRC a
_ reg
r reg
r0 Int64
i)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"add" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (SubRC a
_ reg
r reg
r0 Int64
i)          = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"sub" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (CmpRC a
_ reg
r0 Int64
i)            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"cmp" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i)
    pretty (Neg a
_ reg
r0 reg
r1)             = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 (Doc ann
"neg" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r0 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<~> reg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty reg
r1)

instance Copointed (Arm reg) where
    copoint :: Arm reg a -> a
copoint = Arm reg a -> a
forall reg a. Arm reg a -> a
ann

prettyAsm :: (Pretty reg, As32 reg) => [Arm reg a] -> Doc ann
prettyAsm :: [Arm reg a] -> Doc ann
prettyAsm = (Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline) (Doc ann -> Doc ann)
-> ([Arm reg a] -> Doc ann) -> [Arm reg a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Doc ann
forall ann. Doc ann
prolegomena Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
forall ann. Doc ann
macros Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
".text" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann)
-> ([Arm reg a] -> Doc ann) -> [Arm reg a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ([Doc ann] -> Doc ann)
-> ([Arm reg a] -> [Doc ann]) -> [Arm reg a] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arm reg a -> Doc ann) -> [Arm reg a] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm reg a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

-- http://www.mathcs.emory.edu/~cheung/Courses/255/Syl-ARM/7-ARM/array-define.html
prolegomena :: Doc ann
prolegomena :: Doc ann
prolegomena = Doc ann
".data" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
"kempe_data: .skip 32768" -- 32kb

macros :: Doc ann
macros :: Doc ann
macros = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines
    [ Doc ann
forall ann. Doc ann
calleeSave
    , Doc ann
forall ann. Doc ann
calleeRestore
    , Doc ann
forall ann. Doc ann
callerSave
    , Doc ann
forall ann. Doc ann
callerRestore
    ]

-- see:
-- https://community.arm.com/developer/ip-products/processors/b/processors-ip-blog/posts/using-the-stack-in-aarch64-implementing-push-and-pop

calleeSave :: Doc ann
calleeSave :: Doc ann
calleeSave =
    Doc ann
".macro calleesave"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"sub sp, sp, #(8 * 10)" -- allocate space on stack
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((Arm ArmReg () -> Doc ann) -> [Arm ArmReg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm ArmReg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arm ArmReg ()]
stores)
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
".endm"
    where toPush :: [ArmReg]
toPush = [ArmReg
X19 .. ArmReg
X28]
          stores :: [Arm ArmReg ()]
stores = (ArmReg -> Int64 -> Arm ArmReg ())
-> [ArmReg] -> [Int64] -> [Arm ArmReg ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArmReg
r Int64
o -> () -> ArmReg -> Addr ArmReg -> Arm ArmReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () ArmReg
r (ArmReg -> Int64 -> Addr ArmReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus ArmReg
SP (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
o))) [ArmReg]
toPush [Int64
0..]

calleeRestore :: Doc ann
calleeRestore :: Doc ann
calleeRestore =
    Doc ann
".macro calleerestore"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((Arm ArmReg () -> Doc ann) -> [Arm ArmReg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm ArmReg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arm ArmReg ()]
loads)
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"add sp, sp, #(8 * 10)" -- free stack space
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
".endm"
    where toPop :: [ArmReg]
toPop = [ArmReg
X19 .. ArmReg
X28]
          loads :: [Arm ArmReg ()]
loads = (ArmReg -> Int64 -> Arm ArmReg ())
-> [ArmReg] -> [Int64] -> [Arm ArmReg ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArmReg
r Int64
o -> () -> ArmReg -> Addr ArmReg -> Arm ArmReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () ArmReg
r (ArmReg -> Int64 -> Addr ArmReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus ArmReg
SP (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
o))) [ArmReg]
toPop [Int64
0..]

callerSave :: Doc ann
callerSave :: Doc ann
callerSave =
    Doc ann
".macro callersave"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"sub sp, sp, #(8 * 8)"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((Arm ArmReg () -> Doc ann) -> [Arm ArmReg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm ArmReg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arm ArmReg ()]
stores)
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
".endm"
    where toPush :: [ArmReg]
toPush = ArmReg
X30 ArmReg -> [ArmReg] -> [ArmReg]
forall a. a -> [a] -> [a]
: [ArmReg
X9 .. ArmReg
X15]
          stores :: [Arm ArmReg ()]
stores = (ArmReg -> Int64 -> Arm ArmReg ())
-> [ArmReg] -> [Int64] -> [Arm ArmReg ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArmReg
r Int64
o -> () -> ArmReg -> Addr ArmReg -> Arm ArmReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Store () ArmReg
r (ArmReg -> Int64 -> Addr ArmReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus ArmReg
SP (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
o))) [ArmReg]
toPush [Int64
0..]

callerRestore :: Doc ann
callerRestore :: Doc ann
callerRestore =
    Doc ann
".macro callerrestore"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
prettyLines ((Arm ArmReg () -> Doc ann) -> [Arm ArmReg ()] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm ArmReg () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arm ArmReg ()]
loads)
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
i4 Doc ann
"add sp, sp, #(8 * 8)"
    Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<#> Doc ann
".endm"
    where toPop :: [ArmReg]
toPop = ArmReg
X30 ArmReg -> [ArmReg] -> [ArmReg]
forall a. a -> [a] -> [a]
: [ArmReg
X9 .. ArmReg
X15]
          loads :: [Arm ArmReg ()]
loads = (ArmReg -> Int64 -> Arm ArmReg ())
-> [ArmReg] -> [Int64] -> [Arm ArmReg ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ArmReg
r Int64
o -> () -> ArmReg -> Addr ArmReg -> Arm ArmReg ()
forall reg a. a -> reg -> Addr reg -> Arm reg a
Load () ArmReg
r (ArmReg -> Int64 -> Addr ArmReg
forall reg. reg -> Int64 -> Addr reg
AddRCPlus ArmReg
SP (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
o))) [ArmReg]
toPop [Int64
0..]

prettyLive :: (As32 reg, Pretty reg) => Arm reg Liveness -> Doc ann
prettyLive :: Arm reg Liveness -> Doc ann
prettyLive Arm reg Liveness
r = Arm reg Liveness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Arm reg Liveness
r Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Liveness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Arm reg Liveness -> Liveness
forall reg a. Arm reg a -> a
ann Arm reg Liveness
r)

prettyDebugAsm :: (As32 reg, Pretty reg) => [Arm reg Liveness] -> Doc ann
prettyDebugAsm :: [Arm reg Liveness] -> Doc ann
prettyDebugAsm = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
(<#>) ([Doc ann] -> Doc ann)
-> ([Arm reg Liveness] -> [Doc ann])
-> [Arm reg Liveness]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arm reg Liveness -> Doc ann) -> [Arm reg Liveness] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Arm reg Liveness -> Doc ann
forall reg ann.
(As32 reg, Pretty reg) =>
Arm reg Liveness -> Doc ann
prettyLive