{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.RV64.Instr where
import Data.Maybe
import GHC.Cmm
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Label
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Instr (RegUsage (..))
import GHC.CmmToAsm.RV64.Cond
import GHC.CmmToAsm.RV64.Regs
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.Data.FastString (LexicalFastString)
import GHC.Platform
import GHC.Platform.Reg
import GHC.Platform.Regs
import GHC.Platform.Reg.Class.Separate
import GHC.Prelude
import GHC.Stack
import GHC.Types.Unique.DSM
import GHC.Utils.Outputable
import GHC.Utils.Panic
stackFrameHeaderSize :: Int
= RegNo
2 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
spillSlotSize
spillSlotSize :: Int
spillSlotSize :: RegNo
spillSlotSize = RegNo
8
stackAlign :: Int
stackAlign :: RegNo
stackAlign = RegNo
16
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots :: NCGConfig -> RegNo
maxSpillSlots NCGConfig
config =
( (NCGConfig -> RegNo
ncgSpillPreallocSize NCGConfig
config RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
stackFrameHeaderSize)
RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`div` RegNo
spillSlotSize
)
RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
1
spillSlotToOffset :: Int -> Int
spillSlotToOffset :: RegNo -> RegNo
spillSlotToOffset RegNo
slot =
RegNo
stackFrameHeaderSize RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
spillSlotSize RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
slot
instance Outputable RegUsage where
ppr :: RegUsage -> SDoc
ppr (RU [RegWithFormat]
reads [RegWithFormat]
writes) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RegUsage(reads:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [RegWithFormat] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [RegWithFormat]
reads SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"writes:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [RegWithFormat] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [RegWithFormat]
writes SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
')'
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr Platform
platform Instr
instr = case Instr
instr of
ANN SDoc
_ Instr
i -> Platform -> Instr -> RegUsage
regUsageOfInstr Platform
platform Instr
i
COMMENT {} -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
MULTILINE_COMMENT {} -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
Instr
PUSH_STACK_FRAME -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
Instr
POP_STACK_FRAME -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
LOCATION {} -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
DELTA {} -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
ADD Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
MUL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
NEG Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
MULH Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
DIV Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
REM Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
REMU Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SUB Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
DIVU Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
AND Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
OR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SRA Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
XOR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SLL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SRL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
MOV Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
ORI Operand
dst Operand
src1 Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1, Operand -> [Reg]
regOp Operand
dst)
XORI Operand
dst Operand
src1 Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1, Operand -> [Reg]
regOp Operand
dst)
J_TBL [Maybe BlockId]
_ Maybe CLabel
_ Reg
t -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
t], [])
B Target
t -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t, [])
BCOND Cond
_ Operand
l Operand
r Target
t -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
l [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
r, [])
BL Reg
t [Reg]
ps -> ([Reg], [Reg]) -> RegUsage
usage (Reg
t Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: [Reg]
ps, [Reg]
callerSavedRegisters)
CSET Operand
dst Operand
l Operand
r Cond
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
l [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
r, Operand -> [Reg]
regOp Operand
dst)
STR Format
_ Operand
src Operand
dst -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
dst, [])
LDR Format
_ Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
LDRU Format
_ Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
FENCE FenceType
_ FenceType
_ -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
FCVT FcvtVariant
_variant Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
FABS Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
FMIN Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
FMAX Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
FMA FMASign
_ Operand
dst Operand
src1 Operand
src2 Operand
src3 ->
([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2 [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src3, Operand -> [Reg]
regOp Operand
dst)
Instr
_ -> String -> RegUsage
forall a. HasCallStack => String -> a
panic (String -> RegUsage) -> String -> RegUsage
forall a b. (a -> b) -> a -> b
$ String
"regUsageOfInstr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Instr -> String
instrCon Instr
instr
where
usage :: ([Reg], [Reg]) -> RegUsage
usage :: ([Reg], [Reg]) -> RegUsage
usage ([Reg]
srcRegs, [Reg]
dstRegs) =
[RegWithFormat] -> [RegWithFormat] -> RegUsage
RU
((Reg -> RegWithFormat) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> RegWithFormat
mkFmt ([Reg] -> [RegWithFormat]) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ (Reg -> Bool) -> [Reg] -> [Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
srcRegs)
((Reg -> RegWithFormat) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> RegWithFormat
mkFmt ([Reg] -> [RegWithFormat]) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ (Reg -> Bool) -> [Reg] -> [Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
dstRegs)
mkFmt :: Reg -> RegWithFormat
mkFmt Reg
r = Reg -> Format -> RegWithFormat
RegWithFormat Reg
r Format
fmt
where
fmt :: Format
fmt = case RegClass
cls of
RegClass
RcInteger -> Format
II64
RegClass
RcFloat -> Format
FF64
RegClass
RcVector -> String -> Format
forall a. HasCallStack => String -> a
sorry String
"The RISCV64 NCG does not (yet) support vectors; please use -fllvm."
cls :: RegClass
cls = case Reg
r of
RegVirtual VirtualReg
vr -> Arch -> VirtualReg -> RegClass
classOfVirtualReg (Platform -> Arch
platformArch Platform
platform) VirtualReg
vr
RegReal RealReg
rr -> RealReg -> RegClass
classOfRealReg RealReg
rr
regAddr :: AddrMode -> [Reg]
regAddr :: AddrMode -> [Reg]
regAddr (AddrRegImm Reg
r1 Imm
_imm) = [Reg
r1]
regAddr (AddrReg Reg
r1) = [Reg
r1]
regOp :: Operand -> [Reg]
regOp :: Operand -> [Reg]
regOp (OpReg Width
_w Reg
r1) = [Reg
r1]
regOp (OpAddr AddrMode
a) = AddrMode -> [Reg]
regAddr AddrMode
a
regOp (OpImm Imm
_imm) = []
regTarget :: Target -> [Reg]
regTarget :: Target -> [Reg]
regTarget (TBlock BlockId
_bid) = []
regTarget (TReg Reg
r1) = [Reg
r1]
interesting :: Platform -> Reg -> Bool
interesting :: Platform -> Reg -> Bool
interesting Platform
_ (RegVirtual VirtualReg
_) = Bool
True
interesting Platform
platform (RegReal (RealRegSingle RegNo
i)) = Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
i
callerSavedRegisters :: [Reg]
callerSavedRegisters :: [Reg]
callerSavedRegisters =
[RegNo -> Reg
regSingle RegNo
raRegNo]
[Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
t0RegNo .. RegNo
t2RegNo]
[Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
a0RegNo .. RegNo
a7RegNo]
[Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
t3RegNo .. RegNo
t6RegNo]
[Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
ft0RegNo .. RegNo
ft7RegNo]
[Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
fa0RegNo .. RegNo
fa7RegNo]
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
instr Reg -> Reg
env = case Instr
instr of
ANN SDoc
d Instr
i -> SDoc -> Instr -> Instr
ANN SDoc
d (Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
i Reg -> Reg
env)
COMMENT {} -> Instr
instr
MULTILINE_COMMENT {} -> Instr
instr
Instr
PUSH_STACK_FRAME -> Instr
instr
Instr
POP_STACK_FRAME -> Instr
instr
LOCATION {} -> Instr
instr
DELTA {} -> Instr
instr
ADD Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ADD (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
MUL Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
MUL (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
NEG Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
NEG (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
MULH Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
MULH (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
DIV Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
DIV (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
REM Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
REM (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
REMU Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
REMU (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SUB Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SUB (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
DIVU Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
DIVU (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
AND Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
AND (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
OR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
OR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SRA Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SRA (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
XOR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
XOR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SLL Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SLL (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SRL Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SRL (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
MOV Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
MOV (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
ORI Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ORI (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
XORI Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
XORI (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
J_TBL [Maybe BlockId]
ids Maybe CLabel
mbLbl Reg
t -> [Maybe BlockId] -> Maybe CLabel -> Reg -> Instr
J_TBL [Maybe BlockId]
ids Maybe CLabel
mbLbl (Reg -> Reg
env Reg
t)
B Target
t -> Target -> Instr
B (Target -> Target
patchTarget Target
t)
BL Reg
t [Reg]
ps -> Reg -> [Reg] -> Instr
BL (Reg -> Reg
patchReg Reg
t) [Reg]
ps
BCOND Cond
c Operand
o1 Operand
o2 Target
t -> Cond -> Operand -> Operand -> Target -> Instr
BCOND Cond
c (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Target -> Target
patchTarget Target
t)
CSET Operand
o Operand
l Operand
r Cond
c -> Operand -> Operand -> Operand -> Cond -> Instr
CSET (Operand -> Operand
patchOp Operand
o) (Operand -> Operand
patchOp Operand
l) (Operand -> Operand
patchOp Operand
r) Cond
c
STR Format
f Operand
o1 Operand
o2 -> Format -> Operand -> Operand -> Instr
STR Format
f (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
LDR Format
f Operand
o1 Operand
o2 -> Format -> Operand -> Operand -> Instr
LDR Format
f (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
LDRU Format
f Operand
o1 Operand
o2 -> Format -> Operand -> Operand -> Instr
LDRU Format
f (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
FENCE FenceType
o1 FenceType
o2 -> FenceType -> FenceType -> Instr
FENCE FenceType
o1 FenceType
o2
FCVT FcvtVariant
variant Operand
o1 Operand
o2 -> FcvtVariant -> Operand -> Operand -> Instr
FCVT FcvtVariant
variant (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
FABS Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
FABS (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
FMIN Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
FMIN (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
FMAX Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
FMAX (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
FMA FMASign
s Operand
o1 Operand
o2 Operand
o3 Operand
o4 ->
FMASign -> Operand -> Operand -> Operand -> Operand -> Instr
FMA FMASign
s (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
Instr
_ -> String -> Instr
forall a. HasCallStack => String -> a
panic (String -> Instr) -> String -> Instr
forall a b. (a -> b) -> a -> b
$ String
"patchRegsOfInstr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Instr -> String
instrCon Instr
instr
where
patchOp :: Operand -> Operand
patchOp :: Operand -> Operand
patchOp (OpReg Width
w Reg
r) = Width -> Reg -> Operand
OpReg Width
w (Reg -> Reg
env Reg
r)
patchOp (OpAddr AddrMode
a) = AddrMode -> Operand
OpAddr (AddrMode -> AddrMode
patchAddr AddrMode
a)
patchOp Operand
opImm = Operand
opImm
patchTarget :: Target -> Target
patchTarget :: Target -> Target
patchTarget (TReg Reg
r) = Reg -> Target
TReg (Reg -> Reg
env Reg
r)
patchTarget Target
tBlock = Target
tBlock
patchAddr :: AddrMode -> AddrMode
patchAddr :: AddrMode -> AddrMode
patchAddr (AddrRegImm Reg
r1 Imm
imm) = Reg -> Imm -> AddrMode
AddrRegImm (Reg -> Reg
env Reg
r1) Imm
imm
patchAddr (AddrReg Reg
r) = Reg -> AddrMode
AddrReg (Reg -> Reg
env Reg
r)
patchReg :: Reg -> Reg
patchReg :: Reg -> Reg
patchReg = Reg -> Reg
env
isJumpishInstr :: Instr -> Bool
isJumpishInstr :: Instr -> Bool
isJumpishInstr Instr
instr = case Instr
instr of
ANN SDoc
_ Instr
i -> Instr -> Bool
isJumpishInstr Instr
i
J_TBL {} -> Bool
True
B {} -> Bool
True
BL {} -> Bool
True
BCOND {} -> Bool
True
Instr
_ -> Bool
False
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo Instr
insn BlockId
bid =
case Instr
insn of
B (TBlock BlockId
target) -> BlockId
bid BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
target
BCOND Cond
_ Operand
_ Operand
_ (TBlock BlockId
target) -> BlockId
bid BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
target
J_TBL [Maybe BlockId]
targets Maybe CLabel
_ Reg
_ -> (Maybe BlockId -> Bool) -> [Maybe BlockId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe BlockId -> Bool
isTargetBid [Maybe BlockId]
targets
Instr
_ -> Bool
False
where
isTargetBid :: Maybe BlockId -> Bool
isTargetBid Maybe BlockId
target = case Maybe BlockId
target of
Maybe BlockId
Nothing -> Bool
True
Just BlockId
target -> BlockId
target BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
bid
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN SDoc
_ Instr
i) = Instr -> [BlockId]
jumpDestsOfInstr Instr
i
jumpDestsOfInstr (J_TBL [Maybe BlockId]
ids Maybe CLabel
_mbLbl Reg
_r) = [Maybe BlockId] -> [BlockId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe BlockId]
ids
jumpDestsOfInstr (B Target
t) = [BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (BCOND Cond
_ Operand
_ Operand
_ Target
t) = [BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr Instr
_ = []
patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
instr BlockId -> BlockId
patchF =
case Instr
instr of
ANN SDoc
d Instr
i -> SDoc -> Instr -> Instr
ANN SDoc
d (Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
i BlockId -> BlockId
patchF)
J_TBL [Maybe BlockId]
ids Maybe CLabel
mbLbl Reg
r -> [Maybe BlockId] -> Maybe CLabel -> Reg -> Instr
J_TBL ((Maybe BlockId -> Maybe BlockId)
-> [Maybe BlockId] -> [Maybe BlockId]
forall a b. (a -> b) -> [a] -> [b]
map ((BlockId -> BlockId) -> Maybe BlockId -> Maybe BlockId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockId -> BlockId
patchF) [Maybe BlockId]
ids) Maybe CLabel
mbLbl Reg
r
B (TBlock BlockId
bid) -> Target -> Instr
B (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
BCOND Cond
c Operand
o1 Operand
o2 (TBlock BlockId
bid) -> Cond -> Operand -> Operand -> Target -> Instr
BCOND Cond
c Operand
o1 Operand
o2 (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
Instr
_ -> String -> Instr
forall a. HasCallStack => String -> a
panic (String -> Instr) -> String -> Instr
forall a b. (a -> b) -> a -> b
$ String
"patchJumpInstr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Instr -> String
instrCon Instr
instr
mkSpillInstr ::
(HasCallStack) =>
NCGConfig ->
RegWithFormat ->
Int ->
Int ->
[Instr]
mkSpillInstr :: HasCallStack =>
NCGConfig -> RegWithFormat -> RegNo -> RegNo -> [Instr]
mkSpillInstr NCGConfig
_config (RegWithFormat Reg
reg Format
_fmt) RegNo
delta RegNo
slot =
case RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta of
RegNo
imm | RegNo -> Bool
forall a. (Num a, Ord a) => a -> Bool
fitsIn12bitImm RegNo
imm -> [RegNo -> Instr
mkStrSpImm RegNo
imm]
RegNo
imm ->
[ RegNo -> Instr
movImmToTmp RegNo
imm,
Instr
addSpToTmp,
Instr
mkStrTmp
]
where
fmt :: Format
fmt = case Reg
reg of
RegReal (RealRegSingle RegNo
n) | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
d0RegNo -> Format
II64
Reg
_ -> Format
FF64
mkStrSpImm :: RegNo -> Instr
mkStrSpImm RegNo
imm =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Spill@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int (RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta))
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
STR Format
fmt (Width -> Reg -> Operand
OpReg Width
W64 Reg
reg) (AddrMode -> Operand
OpAddr (Reg -> Imm -> AddrMode
AddrRegImm Reg
spMachReg (RegNo -> Imm
ImmInt RegNo
imm)))
movImmToTmp :: RegNo -> Instr
movImmToTmp RegNo
imm =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Spill: TMP <- " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int RegNo
imm)
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV Operand
tmp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
imm))
addSpToTmp :: Instr
addSpToTmp =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Spill: TMP <- SP + TMP ")
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
tmp Operand
tmp Operand
sp
mkStrTmp :: Instr
mkStrTmp =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Spill@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int (RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta))
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
STR Format
fmt (Width -> Reg -> Operand
OpReg Width
W64 Reg
reg) (AddrMode -> Operand
OpAddr (Reg -> AddrMode
AddrReg Reg
tmpReg))
off :: RegNo
off = RegNo -> RegNo
spillSlotToOffset RegNo
slot
mkLoadInstr ::
NCGConfig ->
RegWithFormat ->
Int ->
Int ->
[Instr]
mkLoadInstr :: NCGConfig -> RegWithFormat -> RegNo -> RegNo -> [Instr]
mkLoadInstr NCGConfig
_config (RegWithFormat Reg
reg Format
_fmt) RegNo
delta RegNo
slot =
case RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta of
RegNo
imm | RegNo -> Bool
forall a. (Num a, Ord a) => a -> Bool
fitsIn12bitImm RegNo
imm -> [RegNo -> Instr
mkLdrSpImm RegNo
imm]
RegNo
imm ->
[ RegNo -> Instr
movImmToTmp RegNo
imm,
Instr
addSpToTmp,
Instr
mkLdrTmp
]
where
fmt :: Format
fmt = case Reg
reg of
RegReal (RealRegSingle RegNo
n) | RegNo
n RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
d0RegNo -> Format
II64
Reg
_ -> Format
FF64
mkLdrSpImm :: RegNo -> Instr
mkLdrSpImm RegNo
imm =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reload@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int (RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta))
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
LDR Format
fmt (Width -> Reg -> Operand
OpReg Width
W64 Reg
reg) (AddrMode -> Operand
OpAddr (Reg -> Imm -> AddrMode
AddrRegImm Reg
spMachReg (RegNo -> Imm
ImmInt RegNo
imm)))
movImmToTmp :: RegNo -> Instr
movImmToTmp RegNo
imm =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reload: TMP <- " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int RegNo
imm)
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV Operand
tmp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
imm))
addSpToTmp :: Instr
addSpToTmp =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reload: TMP <- SP + TMP ")
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
tmp Operand
tmp Operand
sp
mkLdrTmp :: Instr
mkLdrTmp =
SDoc -> Instr -> Instr
ANN (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reload@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int (RegNo
off RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
delta))
(Instr -> Instr) -> Instr -> Instr
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
LDR Format
fmt (Width -> Reg -> Operand
OpReg Width
W64 Reg
reg) (AddrMode -> Operand
OpAddr (Reg -> AddrMode
AddrReg Reg
tmpReg))
off :: RegNo
off = RegNo -> RegNo
spillSlotToOffset RegNo
slot
takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr :: Instr -> Maybe RegNo
takeDeltaInstr (ANN SDoc
_ Instr
i) = Instr -> Maybe RegNo
takeDeltaInstr Instr
i
takeDeltaInstr (DELTA RegNo
i) = RegNo -> Maybe RegNo
forall a. a -> Maybe a
Just RegNo
i
takeDeltaInstr Instr
_ = Maybe RegNo
forall a. Maybe a
Nothing
isMetaInstr :: Instr -> Bool
isMetaInstr :: Instr -> Bool
isMetaInstr Instr
instr =
case Instr
instr of
ANN SDoc
_ Instr
i -> Instr -> Bool
isMetaInstr Instr
i
COMMENT {} -> Bool
True
MULTILINE_COMMENT {} -> Bool
True
LOCATION {} -> Bool
True
LDATA {} -> Bool
True
NEWBLOCK {} -> Bool
True
DELTA {} -> Bool
True
Instr
PUSH_STACK_FRAME -> Bool
True
Instr
POP_STACK_FRAME -> Bool
True
Instr
_ -> Bool
False
mkRegRegMoveInstr :: Reg -> Reg -> Instr
mkRegRegMoveInstr :: Reg -> Reg -> Instr
mkRegRegMoveInstr Reg
src Reg
dst = SDoc -> Instr -> Instr
ANN SDoc
desc Instr
instr
where
desc :: SDoc
desc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reg->Reg Move: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
src SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" -> " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
dst
instr :: Instr
instr = Operand -> Operand -> Instr
MOV (Reg -> Operand
operandFromReg Reg
dst) (Reg -> Operand
operandFromReg Reg
src)
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr (MOV (OpReg Width
width Reg
dst) (OpReg Width
width' Reg
src))
| Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
width' Bool -> Bool -> Bool
&& (Reg -> Bool
isFloatReg Reg
dst Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Reg -> Bool
isFloatReg Reg
src) = (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reg
src, Reg
dst)
takeRegRegMoveInstr Instr
_ = Maybe (Reg, Reg)
forall a. Maybe a
Nothing
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr = Instr -> [Instr]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instr -> [Instr]) -> (BlockId -> Instr) -> BlockId -> [Instr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> Instr
B (Target -> Instr) -> (BlockId -> Target) -> BlockId -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> Target
TBlock
mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr :: Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
_platform = RegNo -> [Instr]
moveSp (RegNo -> [Instr]) -> (RegNo -> RegNo) -> RegNo -> [Instr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RegNo
forall a. Num a => a -> a
negate
mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr :: Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
_platform = RegNo -> [Instr]
moveSp
moveSp :: Int -> [Instr]
moveSp :: RegNo -> [Instr]
moveSp RegNo
n
| RegNo
n RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0 = []
| RegNo
n RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
/= RegNo
0 Bool -> Bool -> Bool
&& RegNo -> Bool
forall a. (Num a, Ord a) => a -> Bool
fitsIn12bitImm RegNo
n = Instr -> [Instr]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instr -> [Instr]) -> (Instr -> Instr) -> Instr -> [Instr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> Instr -> Instr
ANN SDoc
desc (Instr -> [Instr]) -> Instr -> [Instr]
forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
sp Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
n))
| Bool
otherwise =
[ SDoc -> Instr -> Instr
ANN SDoc
desc (Operand -> Operand -> Instr
MOV Operand
tmp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
n))),
Operand -> Operand -> Operand -> Instr
ADD Operand
sp Operand
sp Operand
tmp
]
where
desc :: SDoc
desc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Move SP:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int RegNo
n
allocMoreStack ::
Platform ->
Int ->
NatCmmDecl statics GHC.CmmToAsm.RV64.Instr.Instr ->
UniqDSM (NatCmmDecl statics GHC.CmmToAsm.RV64.Instr.Instr, [(BlockId, BlockId)])
allocMoreStack :: forall statics.
Platform
-> RegNo
-> NatCmmDecl statics Instr
-> UniqDSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
allocMoreStack Platform
_ RegNo
_ top :: NatCmmDecl statics Instr
top@(CmmData Section
_ statics
_) = (NatCmmDecl statics Instr, [(BlockId, BlockId)])
-> UniqDSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NatCmmDecl statics Instr
top, [])
allocMoreStack Platform
platform RegNo
slots proc :: NatCmmDecl statics Instr
proc@(CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalRegUse]
live (ListGraph [GenBasicBlock Instr]
code)) = do
let entries :: [BlockId]
entries = NatCmmDecl statics Instr -> [BlockId]
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks NatCmmDecl statics Instr
proc
retargetList <- (BlockId -> UniqDSM (BlockId, BlockId))
-> [BlockId] -> UniqDSM [(BlockId, BlockId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\BlockId
e -> (BlockId
e,) (BlockId -> (BlockId, BlockId))
-> UniqDSM BlockId -> UniqDSM (BlockId, BlockId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqDSM BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId) [BlockId]
entries
let delta = ((RegNo
x RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
stackAlign RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
1) RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`quot` RegNo
stackAlign) RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
stackAlign
where
x :: RegNo
x = RegNo
slots RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
spillSlotSize
alloc = Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
platform RegNo
delta
dealloc = Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
platform RegNo
delta
new_blockmap :: LabelMap BlockId
new_blockmap = [(BlockId, BlockId)] -> LabelMap BlockId
forall v. [(BlockId, v)] -> LabelMap v
mapFromList [(BlockId, BlockId)]
retargetList
insert_stack_insn (BasicBlock BlockId
id [Instr]
insns)
| Just BlockId
new_blockid <- BlockId -> LabelMap BlockId -> Maybe BlockId
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
id LabelMap BlockId
new_blockmap =
[ BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id ([Instr] -> GenBasicBlock Instr) -> [Instr] -> GenBasicBlock Instr
forall a b. (a -> b) -> a -> b
$ [Instr]
alloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ [Target -> Instr
B (BlockId -> Target
TBlock BlockId
new_blockid)],
BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
new_blockid [Instr]
block'
]
| Bool
otherwise =
[BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
block']
where
block' :: [Instr]
block' = (Instr -> [Instr] -> [Instr]) -> [Instr] -> [Instr] -> [Instr]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Instr -> [Instr] -> [Instr]
insert_dealloc [] [Instr]
insns
insert_dealloc Instr
insn [Instr]
r = case Instr
insn of
J_TBL {} -> [Instr]
dealloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ (Instr
insn Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r)
ANN SDoc
_ Instr
e -> Instr -> [Instr] -> [Instr]
insert_dealloc Instr
e [Instr]
r
Instr
_other
| Instr -> [BlockId]
jumpDestsOfInstr Instr
insn [BlockId] -> [BlockId] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] ->
Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
insn BlockId -> BlockId
retarget Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
Instr
_other -> Instr
insn Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
where
retarget :: BlockId -> BlockId
retarget BlockId
b = BlockId -> Maybe BlockId -> BlockId
forall a. a -> Maybe a -> a
fromMaybe BlockId
b (BlockId -> LabelMap BlockId -> Maybe BlockId
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
b LabelMap BlockId
new_blockmap)
new_code = (GenBasicBlock Instr -> [GenBasicBlock Instr])
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insn [GenBasicBlock Instr]
code
return (CmmProc info lbl live (ListGraph new_code), retargetList)
data Instr
=
SDoc
|
SDoc
|
ANN SDoc Instr
|
LOCATION Int Int Int LexicalFastString
|
LDATA Section RawCmmStatics
|
NEWBLOCK BlockId
|
DELTA Int
|
PUSH_STACK_FRAME
|
POP_STACK_FRAME
|
ADD Operand Operand Operand
|
SUB Operand Operand Operand
|
AND Operand Operand Operand
|
OR Operand Operand Operand
|
SLL Operand Operand Operand
|
SRL Operand Operand Operand
|
SRA Operand Operand Operand
|
STR Format Operand Operand
|
LDR Format Operand Operand
|
LDRU Format Operand Operand
|
MUL Operand Operand Operand
|
NEG Operand Operand
|
DIV Operand Operand Operand
|
REM Operand Operand Operand
|
REMU Operand Operand Operand
|
MULH Operand Operand Operand
|
DIVU Operand Operand Operand
|
XOR Operand Operand Operand
|
ORI Operand Operand Operand
|
XORI Operand Operand Operand
|
MOV Operand Operand
|
CSET Operand Operand Operand Cond
|
J_TBL [Maybe BlockId] (Maybe CLabel) Reg
|
B Target
|
BL Reg [Reg]
|
BCOND Cond Operand Operand Target
|
FENCE FenceType FenceType
|
FCVT FcvtVariant Operand Operand
|
FABS Operand Operand
|
FMIN Operand Operand Operand
|
FMAX Operand Operand Operand
|
FMA FMASign Operand Operand Operand Operand
data FenceType = FenceRead | FenceWrite | FenceReadWrite
data FcvtVariant = FloatToFloat | IntToFloat | FloatToInt
instrCon :: Instr -> String
instrCon :: Instr -> String
instrCon Instr
i =
case Instr
i of
COMMENT {} -> String
"COMMENT"
MULTILINE_COMMENT {} -> String
"COMMENT"
ANN {} -> String
"ANN"
LOCATION {} -> String
"LOCATION"
LDATA {} -> String
"LDATA"
NEWBLOCK {} -> String
"NEWBLOCK"
DELTA {} -> String
"DELTA"
PUSH_STACK_FRAME {} -> String
"PUSH_STACK_FRAME"
POP_STACK_FRAME {} -> String
"POP_STACK_FRAME"
ADD {} -> String
"ADD"
OR {} -> String
"OR"
MUL {} -> String
"MUL"
NEG {} -> String
"NEG"
DIV {} -> String
"DIV"
REM {} -> String
"REM"
REMU {} -> String
"REMU"
MULH {} -> String
"MULH"
SUB {} -> String
"SUB"
DIVU {} -> String
"DIVU"
AND {} -> String
"AND"
SRA {} -> String
"SRA"
XOR {} -> String
"XOR"
SLL {} -> String
"SLL"
SRL {} -> String
"SRL"
MOV {} -> String
"MOV"
ORI {} -> String
"ORI"
XORI {} -> String
"ORI"
STR {} -> String
"STR"
LDR {} -> String
"LDR"
LDRU {} -> String
"LDRU"
CSET {} -> String
"CSET"
J_TBL {} -> String
"J_TBL"
B {} -> String
"B"
BL {} -> String
"BL"
BCOND {} -> String
"BCOND"
FENCE {} -> String
"FENCE"
FCVT {} -> String
"FCVT"
FABS {} -> String
"FABS"
FMIN {} -> String
"FMIN"
FMAX {} -> String
"FMAX"
FMA FMASign
variant Operand
_ Operand
_ Operand
_ Operand
_ ->
case FMASign
variant of
FMASign
FMAdd -> String
"FMADD"
FMASign
FMSub -> String
"FMSUB"
FMASign
FNMAdd -> String
"FNMADD"
FMASign
FNMSub -> String
"FNMSUB"
data Target
= TBlock BlockId
| TReg Reg
data Operand
=
OpReg Width Reg
|
OpImm Imm
|
OpAddr AddrMode
deriving (Operand -> Operand -> Bool
(Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool) -> Eq Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
/= :: Operand -> Operand -> Bool
Eq, RegNo -> Operand -> String -> String
[Operand] -> String -> String
Operand -> String
(RegNo -> Operand -> String -> String)
-> (Operand -> String)
-> ([Operand] -> String -> String)
-> Show Operand
forall a.
(RegNo -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: RegNo -> Operand -> String -> String
showsPrec :: RegNo -> Operand -> String -> String
$cshow :: Operand -> String
show :: Operand -> String
$cshowList :: [Operand] -> String -> String
showList :: [Operand] -> String -> String
Show)
operandFromReg :: Reg -> Operand
operandFromReg :: Reg -> Operand
operandFromReg = Width -> Reg -> Operand
OpReg Width
W64
operandFromRegNo :: RegNo -> Operand
operandFromRegNo :: RegNo -> Operand
operandFromRegNo = Reg -> Operand
operandFromReg (Reg -> Operand) -> (RegNo -> Reg) -> RegNo -> Operand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> Reg
regSingle
zero, ra, sp, gp, tp, fp, tmp :: Operand
zero :: Operand
zero = Reg -> Operand
operandFromReg Reg
zeroReg
ra :: Operand
ra = Reg -> Operand
operandFromReg Reg
raReg
sp :: Operand
sp = Reg -> Operand
operandFromReg Reg
spMachReg
gp :: Operand
gp = RegNo -> Operand
operandFromRegNo RegNo
3
tp :: Operand
tp = RegNo -> Operand
operandFromRegNo RegNo
4
fp :: Operand
fp = RegNo -> Operand
operandFromRegNo RegNo
8
tmp :: Operand
tmp = Reg -> Operand
operandFromReg Reg
tmpReg
x0, x1, x2, x3, x4, x5, x6, x7 :: Operand
x8, x9, x10, x11, x12, x13, x14, x15 :: Operand
x16, x17, x18, x19, x20, x21, x22, x23 :: Operand
x24, x25, x26, x27, x28, x29, x30, x31 :: Operand
x0 :: Operand
x0 = RegNo -> Operand
operandFromRegNo RegNo
x0RegNo
x1 :: Operand
x1 = RegNo -> Operand
operandFromRegNo RegNo
1
x2 :: Operand
x2 = RegNo -> Operand
operandFromRegNo RegNo
2
x3 :: Operand
x3 = RegNo -> Operand
operandFromRegNo RegNo
3
x4 :: Operand
x4 = RegNo -> Operand
operandFromRegNo RegNo
4
x5 :: Operand
x5 = RegNo -> Operand
operandFromRegNo RegNo
x5RegNo
x6 :: Operand
x6 = RegNo -> Operand
operandFromRegNo RegNo
6
x7 :: Operand
x7 = RegNo -> Operand
operandFromRegNo RegNo
x7RegNo
x8 :: Operand
x8 = RegNo -> Operand
operandFromRegNo RegNo
8
x9 :: Operand
x9 = RegNo -> Operand
operandFromRegNo RegNo
9
x10 :: Operand
x10 = RegNo -> Operand
operandFromRegNo RegNo
x10RegNo
x11 :: Operand
x11 = RegNo -> Operand
operandFromRegNo RegNo
11
x12 :: Operand
x12 = RegNo -> Operand
operandFromRegNo RegNo
12
x13 :: Operand
x13 = RegNo -> Operand
operandFromRegNo RegNo
13
x14 :: Operand
x14 = RegNo -> Operand
operandFromRegNo RegNo
14
x15 :: Operand
x15 = RegNo -> Operand
operandFromRegNo RegNo
15
x16 :: Operand
x16 = RegNo -> Operand
operandFromRegNo RegNo
16
x17 :: Operand
x17 = RegNo -> Operand
operandFromRegNo RegNo
x17RegNo
x18 :: Operand
x18 = RegNo -> Operand
operandFromRegNo RegNo
18
x19 :: Operand
x19 = RegNo -> Operand
operandFromRegNo RegNo
19
x20 :: Operand
x20 = RegNo -> Operand
operandFromRegNo RegNo
20
x21 :: Operand
x21 = RegNo -> Operand
operandFromRegNo RegNo
21
x22 :: Operand
x22 = RegNo -> Operand
operandFromRegNo RegNo
22
x23 :: Operand
x23 = RegNo -> Operand
operandFromRegNo RegNo
23
x24 :: Operand
x24 = RegNo -> Operand
operandFromRegNo RegNo
24
x25 :: Operand
x25 = RegNo -> Operand
operandFromRegNo RegNo
25
x26 :: Operand
x26 = RegNo -> Operand
operandFromRegNo RegNo
26
x27 :: Operand
x27 = RegNo -> Operand
operandFromRegNo RegNo
27
x28 :: Operand
x28 = RegNo -> Operand
operandFromRegNo RegNo
x28RegNo
x29 :: Operand
x29 = RegNo -> Operand
operandFromRegNo RegNo
29
x30 :: Operand
x30 = RegNo -> Operand
operandFromRegNo RegNo
30
x31 :: Operand
x31 = RegNo -> Operand
operandFromRegNo RegNo
x31RegNo
d0, d1, d2, d3, d4, d5, d6, d7 :: Operand
d8, d9, d10, d11, d12, d13, d14, d15 :: Operand
d16, d17, d18, d19, d20, d21, d22, d23 :: Operand
d24, d25, d26, d27, d28, d29, d30, d31 :: Operand
d0 :: Operand
d0 = RegNo -> Operand
operandFromRegNo RegNo
d0RegNo
d1 :: Operand
d1 = RegNo -> Operand
operandFromRegNo RegNo
33
d2 :: Operand
d2 = RegNo -> Operand
operandFromRegNo RegNo
34
d3 :: Operand
d3 = RegNo -> Operand
operandFromRegNo RegNo
35
d4 :: Operand
d4 = RegNo -> Operand
operandFromRegNo RegNo
36
d5 :: Operand
d5 = RegNo -> Operand
operandFromRegNo RegNo
37
d6 :: Operand
d6 = RegNo -> Operand
operandFromRegNo RegNo
38
d7 :: Operand
d7 = RegNo -> Operand
operandFromRegNo RegNo
d7RegNo
d8 :: Operand
d8 = RegNo -> Operand
operandFromRegNo RegNo
40
d9 :: Operand
d9 = RegNo -> Operand
operandFromRegNo RegNo
41
d10 :: Operand
d10 = RegNo -> Operand
operandFromRegNo RegNo
d10RegNo
d11 :: Operand
d11 = RegNo -> Operand
operandFromRegNo RegNo
43
d12 :: Operand
d12 = RegNo -> Operand
operandFromRegNo RegNo
44
d13 :: Operand
d13 = RegNo -> Operand
operandFromRegNo RegNo
45
d14 :: Operand
d14 = RegNo -> Operand
operandFromRegNo RegNo
46
d15 :: Operand
d15 = RegNo -> Operand
operandFromRegNo RegNo
47
d16 :: Operand
d16 = RegNo -> Operand
operandFromRegNo RegNo
48
d17 :: Operand
d17 = RegNo -> Operand
operandFromRegNo RegNo
d17RegNo
d18 :: Operand
d18 = RegNo -> Operand
operandFromRegNo RegNo
50
d19 :: Operand
d19 = RegNo -> Operand
operandFromRegNo RegNo
51
d20 :: Operand
d20 = RegNo -> Operand
operandFromRegNo RegNo
52
d21 :: Operand
d21 = RegNo -> Operand
operandFromRegNo RegNo
53
d22 :: Operand
d22 = RegNo -> Operand
operandFromRegNo RegNo
54
d23 :: Operand
d23 = RegNo -> Operand
operandFromRegNo RegNo
55
d24 :: Operand
d24 = RegNo -> Operand
operandFromRegNo RegNo
56
d25 :: Operand
d25 = RegNo -> Operand
operandFromRegNo RegNo
57
d26 :: Operand
d26 = RegNo -> Operand
operandFromRegNo RegNo
58
d27 :: Operand
d27 = RegNo -> Operand
operandFromRegNo RegNo
59
d28 :: Operand
d28 = RegNo -> Operand
operandFromRegNo RegNo
60
d29 :: Operand
d29 = RegNo -> Operand
operandFromRegNo RegNo
61
d30 :: Operand
d30 = RegNo -> Operand
operandFromRegNo RegNo
62
d31 :: Operand
d31 = RegNo -> Operand
operandFromRegNo RegNo
d31RegNo
fitsIn12bitImm :: (Num a, Ord a) => a -> Bool
fitsIn12bitImm :: forall a. (Num a, Ord a) => a -> Bool
fitsIn12bitImm a
off = a
off a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
forall a. Num a => a
intMin12bit Bool -> Bool -> Bool
&& a
off a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
forall a. Num a => a
intMax12bit
intMin12bit :: (Num a) => a
intMin12bit :: forall a. Num a => a
intMin12bit = -a
2048
intMax12bit :: (Num a) => a
intMax12bit :: forall a. Num a => a
intMax12bit = a
2047
fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool
fitsIn32bits :: forall a. (Num a, Ord a, Bits a) => a -> Bool
fitsIn32bits a
i = (-a
1 a -> RegNo -> a
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
31) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= (a
1 a -> RegNo -> a
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
31 a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
isNbitEncodeable :: Int -> Integer -> Bool
isNbitEncodeable :: RegNo -> Integer -> Bool
isNbitEncodeable RegNo
n Integer
i = let shift :: RegNo
shift = RegNo
n RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
- RegNo
1 in (-Integer
1 Integer -> RegNo -> Integer
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
shift) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
1 Integer -> RegNo -> Integer
forall a. Bits a => a -> RegNo -> a
`shiftL` RegNo
shift)
isEncodeableInWidth :: Width -> Integer -> Bool
isEncodeableInWidth :: Width -> Integer -> Bool
isEncodeableInWidth = RegNo -> Integer -> Bool
isNbitEncodeable (RegNo -> Integer -> Bool)
-> (Width -> RegNo) -> Width -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> RegNo
widthInBits
isIntOp :: Operand -> Bool
isIntOp :: Operand -> Bool
isIntOp = Bool -> Bool
not (Bool -> Bool) -> (Operand -> Bool) -> Operand -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operand -> Bool
isFloatOp
isFloatOp :: Operand -> Bool
isFloatOp :: Operand -> Bool
isFloatOp (OpReg Width
_ Reg
reg) | Reg -> Bool
isFloatReg Reg
reg = Bool
True
isFloatOp Operand
_ = Bool
False
isFloatReg :: Reg -> Bool
isFloatReg :: Reg -> Bool
isFloatReg (RegReal (RealRegSingle RegNo
i)) | RegNo
i RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
31 = Bool
True
isFloatReg (RegVirtual (VirtualRegD Unique
_)) = Bool
True
isFloatReg Reg
_ = Bool
False