{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.AArch64.Instr
where
import GHC.Prelude
import GHC.CmmToAsm.AArch64.Cond
import GHC.CmmToAsm.AArch64.Regs
import GHC.CmmToAsm.Instr (RegUsage(..))
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Platform.Regs
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm
import GHC.Cmm.CLabel
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Types.Unique.Supply
import GHC.Utils.Panic
import Control.Monad (replicateM)
import Data.Maybe (fromMaybe)
import GHC.Stack
stackFrameHeaderSize :: Platform -> Int
Platform
_ = RegNo
64
spillSlotSize :: Int
spillSlotSize :: RegNo
spillSlotSize = RegNo
8
stackAlign :: Int
stackAlign :: RegNo
stackAlign = RegNo
16
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots :: NCGConfig -> RegNo
maxSpillSlots NCGConfig
config
= let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
in ((NCGConfig -> RegNo
ncgSpillPreallocSize NCGConfig
config forall a. Num a => a -> a -> a
- Platform -> RegNo
stackFrameHeaderSize Platform
platform)
forall a. Integral a => a -> a -> a
`div` RegNo
spillSlotSize) forall a. Num a => a -> a -> a
- RegNo
1
spillSlotToOffset :: NCGConfig -> Int -> Int
spillSlotToOffset :: NCGConfig -> RegNo -> RegNo
spillSlotToOffset NCGConfig
config RegNo
slot
= Platform -> RegNo
stackFrameHeaderSize (NCGConfig -> Platform
ncgPlatform NCGConfig
config) forall a. Num a => a -> a -> a
+ RegNo
spillSlotSize forall a. Num a => a -> a -> a
* RegNo
slot
instance Outputable RegUsage where
ppr :: RegUsage -> SDoc
ppr (RU [Reg]
reads [Reg]
writes) = String -> SDoc
text String
"RegUsage(reads:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Reg]
reads SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"writes:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Reg]
writes SDoc -> SDoc -> SDoc
<> Char -> SDoc
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
ADD Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
CMN Operand
l Operand
r -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
l forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
r, [])
CMP Operand
l Operand
r -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
l forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
r, [])
MSUB Operand
dst Operand
src1 Operand
src2 Operand
src3 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src3, Operand -> [Reg]
regOp Operand
dst)
MUL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 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)
SMULH Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SMULL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SDIV Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 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 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
UDIV Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
SBFM Operand
dst Operand
src Operand
_ Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
UBFM Operand
dst Operand
src Operand
_ Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
SBFX Operand
dst Operand
src Operand
_ Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
UBFX Operand
dst Operand
src Operand
_ Operand
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
SXTB Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
UXTB Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
SXTH Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
UXTH Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
AND Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
ASR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
BIC Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
BICS Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
EON Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
EOR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
LSL Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
LSR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 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)
MOVK Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
MVN Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
ORR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
ROR Operand
dst Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, Operand -> [Reg]
regOp Operand
dst)
TST Operand
src1 Operand
src2 -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2, [])
J Target
t -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t, [])
B Target
t -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t, [])
BCOND Cond
_ Target
t -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t, [])
BL Target
t [Reg]
ps [Reg]
_rs -> ([Reg], [Reg]) -> RegUsage
usage (Target -> [Reg]
regTarget Target
t forall a. [a] -> [a] -> [a]
++ [Reg]
ps, [Reg]
callerSavedRegisters)
CSET Operand
dst Cond
_ -> ([Reg], [Reg]) -> RegUsage
usage ([], Operand -> [Reg]
regOp Operand
dst)
CBZ Operand
src Target
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, [])
CBNZ Operand
src Target
_ -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, [])
STR Format
_ Operand
src Operand
dst -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src 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)
STP Format
_ Operand
src1 Operand
src2 Operand
dst -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
src2 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
dst, [])
LDP Format
_ Operand
dst1 Operand
dst2 Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst1 forall a. [a] -> [a] -> [a]
++ Operand -> [Reg]
regOp Operand
dst2)
Instr
DMBSY -> ([Reg], [Reg]) -> RegUsage
usage ([], [])
FCVT Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
SCVTF Operand
dst Operand
src -> ([Reg], [Reg]) -> RegUsage
usage (Operand -> [Reg]
regOp Operand
src, Operand -> [Reg]
regOp Operand
dst)
FCVTZS 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)
Instr
_ -> forall a. String -> a
panic String
"regUsageOfInstr"
where
usage :: ([Reg], [Reg]) -> RegUsage
usage ([Reg]
src, [Reg]
dst) = [Reg] -> [Reg] -> RegUsage
RU (forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
src)
(forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
dst)
regAddr :: AddrMode -> [Reg]
regAddr :: AddrMode -> [Reg]
regAddr (AddrRegReg Reg
r1 Reg
r2) = [Reg
r1, Reg
r2]
regAddr (AddrRegImm Reg
r1 Imm
_) = [Reg
r1]
regAddr (AddrReg Reg
r1) = [Reg
r1]
regOp :: Operand -> [Reg]
regOp :: Operand -> [Reg]
regOp (OpReg Width
_ Reg
r1) = [Reg
r1]
regOp (OpRegExt Width
_ Reg
r1 ExtMode
_ RegNo
_) = [Reg
r1]
regOp (OpRegShift Width
_ Reg
r1 ShiftMode
_ RegNo
_) = [Reg
r1]
regOp (OpAddr AddrMode
a) = AddrMode -> [Reg]
regAddr AddrMode
a
regOp (OpImm Imm
_) = []
regOp (OpImmShift Imm
_ ShiftMode
_ RegNo
_) = []
regTarget :: Target -> [Reg]
regTarget :: Target -> [Reg]
regTarget (TBlock BlockId
_) = []
regTarget (TLabel CLabel
_) = []
regTarget (TReg Reg
r1) = [Reg
r1]
interesting :: Platform -> Reg -> Bool
interesting :: Platform -> Reg -> Bool
interesting Platform
_ (RegVirtual VirtualReg
_) = Bool
True
interesting Platform
_ (RegReal (RealRegSingle (-1))) = Bool
False
interesting Platform
platform (RegReal (RealRegSingle RegNo
i)) = Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
i
interesting Platform
_ (RegReal (RealRegPair{}))
= forall a. String -> a
panic String
"AArch64.Instr.interesting: no reg pairs on this arch"
callerSavedRegisters :: [Reg]
callerSavedRegisters :: [Reg]
callerSavedRegisters
= forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
0..RegNo
18]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
32..RegNo
39]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
48..RegNo
63]
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)
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)
CMN Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
CMN (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
CMP Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
CMP (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
MSUB Operand
o1 Operand
o2 Operand
o3 Operand
o4 -> Operand -> Operand -> Operand -> Operand -> Instr
MSUB (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
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)
SMULH Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SMULH (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SMULL Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SMULL (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SDIV Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
SDIV (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)
UDIV Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
UDIV (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
SBFM Operand
o1 Operand
o2 Operand
o3 Operand
o4 -> Operand -> Operand -> Operand -> Operand -> Instr
SBFM (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
UBFM Operand
o1 Operand
o2 Operand
o3 Operand
o4 -> Operand -> Operand -> Operand -> Operand -> Instr
UBFM (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
SBFX Operand
o1 Operand
o2 Operand
o3 Operand
o4 -> Operand -> Operand -> Operand -> Operand -> Instr
SBFX (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
UBFX Operand
o1 Operand
o2 Operand
o3 Operand
o4 -> Operand -> Operand -> Operand -> Operand -> Instr
UBFX (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3) (Operand -> Operand
patchOp Operand
o4)
SXTB Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
SXTB (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
UXTB Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
UXTB (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
SXTH Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
SXTH (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
UXTH Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
UXTH (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
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)
ANDS Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ANDS (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
ASR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ASR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
BIC Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
BIC (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
BICS Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
BICS (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
EON Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
EON (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
EOR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
EOR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
LSL Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
LSL (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
LSR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
LSR (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)
MOVK Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
MOVK (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
MVN Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
MVN (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
ORR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ORR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
ROR Operand
o1 Operand
o2 Operand
o3 -> Operand -> Operand -> Operand -> Instr
ROR (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
TST Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
TST (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
J Target
t -> Target -> Instr
J (Target -> Target
patchTarget Target
t)
B Target
t -> Target -> Instr
B (Target -> Target
patchTarget Target
t)
BL Target
t [Reg]
rs [Reg]
ts -> Target -> [Reg] -> [Reg] -> Instr
BL (Target -> Target
patchTarget Target
t) [Reg]
rs [Reg]
ts
BCOND Cond
c Target
t -> Cond -> Target -> Instr
BCOND Cond
c (Target -> Target
patchTarget Target
t)
CSET Operand
o Cond
c -> Operand -> Cond -> Instr
CSET (Operand -> Operand
patchOp Operand
o) Cond
c
CBZ Operand
o Target
l -> Operand -> Target -> Instr
CBZ (Operand -> Operand
patchOp Operand
o) Target
l
CBNZ Operand
o Target
l -> Operand -> Target -> Instr
CBNZ (Operand -> Operand
patchOp Operand
o) Target
l
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)
STP Format
f Operand
o1 Operand
o2 Operand
o3 -> Format -> Operand -> Operand -> Operand -> Instr
STP Format
f (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
LDP Format
f Operand
o1 Operand
o2 Operand
o3 -> Format -> Operand -> Operand -> Operand -> Instr
LDP Format
f (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2) (Operand -> Operand
patchOp Operand
o3)
Instr
DMBSY -> Instr
DMBSY
FCVT Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
FCVT (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
SCVTF Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
SCVTF (Operand -> Operand
patchOp Operand
o1) (Operand -> Operand
patchOp Operand
o2)
FCVTZS Operand
o1 Operand
o2 -> Operand -> Operand -> Instr
FCVTZS (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)
Instr
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"patchRegsOfInstr" (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show 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 (OpRegExt Width
w Reg
r ExtMode
x RegNo
s) = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
w (Reg -> Reg
env Reg
r) ExtMode
x RegNo
s
patchOp (OpRegShift Width
w Reg
r ShiftMode
m RegNo
s) = Width -> Reg -> ShiftMode -> RegNo -> Operand
OpRegShift Width
w (Reg -> Reg
env Reg
r) ShiftMode
m RegNo
s
patchOp (OpAddr AddrMode
a) = AddrMode -> Operand
OpAddr (AddrMode -> AddrMode
patchAddr AddrMode
a)
patchOp Operand
op = Operand
op
patchTarget :: Target -> Target
patchTarget :: Target -> Target
patchTarget (TReg Reg
r) = Reg -> Target
TReg (Reg -> Reg
env Reg
r)
patchTarget Target
t = Target
t
patchAddr :: AddrMode -> AddrMode
patchAddr :: AddrMode -> AddrMode
patchAddr (AddrRegReg Reg
r1 Reg
r2) = Reg -> Reg -> AddrMode
AddrRegReg (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
patchAddr (AddrRegImm Reg
r1 Imm
i) = Reg -> Imm -> AddrMode
AddrRegImm (Reg -> Reg
env Reg
r1) Imm
i
patchAddr (AddrReg Reg
r) = Reg -> AddrMode
AddrReg (Reg -> Reg
env Reg
r)
isJumpishInstr :: Instr -> Bool
isJumpishInstr :: Instr -> Bool
isJumpishInstr Instr
instr = case Instr
instr of
ANN SDoc
_ Instr
i -> Instr -> Bool
isJumpishInstr Instr
i
CBZ{} -> Bool
True
CBNZ{} -> Bool
True
J{} -> Bool
True
B{} -> Bool
True
BL{} -> Bool
True
BCOND{} -> Bool
True
Instr
_ -> Bool
False
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN SDoc
_ Instr
i) = Instr -> [BlockId]
jumpDestsOfInstr Instr
i
jumpDestsOfInstr (CBZ Operand
_ Target
t) = [ BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (CBNZ Operand
_ Target
t) = [ BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (J Target
t) = [BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (B Target
t) = [BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (BL Target
t [Reg]
_ [Reg]
_) = [ BlockId
id | TBlock BlockId
id <- [Target
t]]
jumpDestsOfInstr (BCOND Cond
_ 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)
CBZ Operand
r (TBlock BlockId
bid) -> Operand -> Target -> Instr
CBZ Operand
r (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
CBNZ Operand
r (TBlock BlockId
bid) -> Operand -> Target -> Instr
CBNZ Operand
r (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
J (TBlock BlockId
bid) -> Target -> Instr
J (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
B (TBlock BlockId
bid) -> Target -> Instr
B (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
BL (TBlock BlockId
bid) [Reg]
ps [Reg]
rs -> Target -> [Reg] -> [Reg] -> Instr
BL (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid)) [Reg]
ps [Reg]
rs
BCOND Cond
c (TBlock BlockId
bid) -> Cond -> Target -> Instr
BCOND Cond
c (BlockId -> Target
TBlock (BlockId -> BlockId
patchF BlockId
bid))
Instr
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"patchJumpInstr" (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Instr
instr)
mkSpillInstr
:: HasCallStack
=> NCGConfig
-> Reg
-> Int
-> Int
-> [Instr]
mkSpillInstr :: HasCallStack => NCGConfig -> Reg -> RegNo -> RegNo -> [Instr]
mkSpillInstr NCGConfig
config Reg
reg RegNo
delta RegNo
slot =
case (NCGConfig -> RegNo -> RegNo
spillSlotToOffset NCGConfig
config RegNo
slot) forall a. Num a => a -> a -> a
- RegNo
delta of
RegNo
imm | -RegNo
256 forall a. Ord a => a -> a -> Bool
<= RegNo
imm Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
255 -> [ RegNo -> Instr
mkStrSp RegNo
imm ]
RegNo
imm | RegNo
imm forall a. Ord a => a -> a -> Bool
> RegNo
0 Bool -> Bool -> Bool
&& RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0x7 forall a. Eq a => a -> a -> Bool
== RegNo
0x0 Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
0xfff -> [ RegNo -> Instr
mkStrSp RegNo
imm ]
RegNo
imm | RegNo
imm forall a. Ord a => a -> a -> Bool
> RegNo
0xfff Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
0xffffff Bool -> Bool -> Bool
&& RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0x7 forall a. Eq a => a -> a -> Bool
== RegNo
0x0 -> [ RegNo -> Instr
mkIp0SpillAddr (RegNo
imm forall a. Bits a => a -> a -> a
.&~. RegNo
0xfff)
, RegNo -> Instr
mkStrIp0 (RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0xfff)
]
RegNo
imm -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkSpillInstr" (String -> SDoc
text String
"Unable to spill into" SDoc -> SDoc -> SDoc
<+> RegNo -> SDoc
int RegNo
imm)
where
a
a .&~. :: a -> a -> a
.&~. a
b = a
a forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> a
complement a
b)
fmt :: Format
fmt = case Reg
reg of
RegReal (RealRegSingle RegNo
n) | RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
32 -> Format
II64
Reg
_ -> Format
FF64
mkIp0SpillAddr :: RegNo -> Instr
mkIp0SpillAddr RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Spill: IP0 <- SP + " SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int RegNo
imm) forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
ip0 Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
imm))
mkStrSp :: RegNo -> Instr
mkStrSp RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Spill@" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int (RegNo
off forall a. Num a => a -> a -> a
- RegNo
delta)) 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 (RegNo -> Reg
regSingle RegNo
31) (RegNo -> Imm
ImmInt RegNo
imm)))
mkStrIp0 :: RegNo -> Instr
mkStrIp0 RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Spill@" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int (RegNo
off forall a. Num a => a -> a -> a
- RegNo
delta)) 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 (RegNo -> Reg
regSingle RegNo
16) (RegNo -> Imm
ImmInt RegNo
imm)))
off :: RegNo
off = NCGConfig -> RegNo -> RegNo
spillSlotToOffset NCGConfig
config RegNo
slot
mkLoadInstr
:: NCGConfig
-> Reg
-> Int
-> Int
-> [Instr]
mkLoadInstr :: NCGConfig -> Reg -> RegNo -> RegNo -> [Instr]
mkLoadInstr NCGConfig
config Reg
reg RegNo
delta RegNo
slot =
case (NCGConfig -> RegNo -> RegNo
spillSlotToOffset NCGConfig
config RegNo
slot) forall a. Num a => a -> a -> a
- RegNo
delta of
RegNo
imm | -RegNo
256 forall a. Ord a => a -> a -> Bool
<= RegNo
imm Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
255 -> [ RegNo -> Instr
mkLdrSp RegNo
imm ]
RegNo
imm | RegNo
imm forall a. Ord a => a -> a -> Bool
> RegNo
0 Bool -> Bool -> Bool
&& RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0x7 forall a. Eq a => a -> a -> Bool
== RegNo
0x0 Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
0xfff -> [ RegNo -> Instr
mkLdrSp RegNo
imm ]
RegNo
imm | RegNo
imm forall a. Ord a => a -> a -> Bool
> RegNo
0xfff Bool -> Bool -> Bool
&& RegNo
imm forall a. Ord a => a -> a -> Bool
<= RegNo
0xffffff Bool -> Bool -> Bool
&& RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0x7 forall a. Eq a => a -> a -> Bool
== RegNo
0x0 -> [ RegNo -> Instr
mkIp0SpillAddr (RegNo
imm forall a. Bits a => a -> a -> a
.&~. RegNo
0xfff)
, RegNo -> Instr
mkLdrIp0 (RegNo
imm forall a. Bits a => a -> a -> a
.&. RegNo
0xfff)
]
RegNo
imm -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkSpillInstr" (String -> SDoc
text String
"Unable to spill into" SDoc -> SDoc -> SDoc
<+> RegNo -> SDoc
int RegNo
imm)
where
a
a .&~. :: a -> a -> a
.&~. a
b = a
a forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => a -> a
complement a
b)
fmt :: Format
fmt = case Reg
reg of
RegReal (RealRegSingle RegNo
n) | RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
32 -> Format
II64
Reg
_ -> Format
FF64
mkIp0SpillAddr :: RegNo -> Instr
mkIp0SpillAddr RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Reload: IP0 <- SP + " SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int RegNo
imm) forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
ip0 Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
imm))
mkLdrSp :: RegNo -> Instr
mkLdrSp RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Reload@" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int (RegNo
off forall a. Num a => a -> a -> a
- RegNo
delta)) 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 (RegNo -> Reg
regSingle RegNo
31) (RegNo -> Imm
ImmInt RegNo
imm)))
mkLdrIp0 :: RegNo -> Instr
mkLdrIp0 RegNo
imm = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Reload@" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int (RegNo
off forall a. Num a => a -> a -> a
- RegNo
delta)) 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 (RegNo -> Reg
regSingle RegNo
16) (RegNo -> Imm
ImmInt RegNo
imm)))
off :: RegNo
off = NCGConfig -> RegNo -> RegNo
spillSlotToOffset NCGConfig
config 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) = forall a. a -> Maybe a
Just RegNo
i
takeDeltaInstr Instr
_ = 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 (String -> SDoc
text String
"Reg->Reg Move: " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Reg
src SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" -> " SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Reg
dst) forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Instr
MOV (Width -> Reg -> Operand
OpReg Width
W64 Reg
dst) (Width -> Reg -> Operand
OpReg Width
W64 Reg
src)
takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr Instr
_ = forall a. Maybe a
Nothing
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr BlockId
id = [Target -> Instr
B (BlockId -> Target
TBlock BlockId
id)]
mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr :: Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
platform RegNo
n
| RegNo
n forall a. Eq a => a -> a -> Bool
== RegNo
0 = []
| RegNo
n forall a. Ord a => a -> a -> Bool
> RegNo
0 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
4096 = [ SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Alloc More Stack") forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
SUB Operand
sp Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
n)) ]
| RegNo
n forall a. Ord a => a -> a -> Bool
> RegNo
0 = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Alloc More Stack") (Operand -> Operand -> Operand -> Instr
SUB Operand
sp Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
4095))) forall a. a -> [a] -> [a]
: Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
platform (RegNo
n forall a. Num a => a -> a -> a
- RegNo
4095)
mkStackAllocInstr Platform
_platform RegNo
n = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkStackAllocInstr" (RegNo -> SDoc
int RegNo
n)
mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr :: Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
platform RegNo
n
| RegNo
n forall a. Eq a => a -> a -> Bool
== RegNo
0 = []
| RegNo
n forall a. Ord a => a -> a -> Bool
> RegNo
0 Bool -> Bool -> Bool
&& RegNo
n forall a. Ord a => a -> a -> Bool
< RegNo
4096 = [ SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Dealloc More Stack") forall a b. (a -> b) -> a -> b
$ Operand -> Operand -> Operand -> Instr
ADD Operand
sp Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
n)) ]
| RegNo
n forall a. Ord a => a -> a -> Bool
> RegNo
0 = SDoc -> Instr -> Instr
ANN (String -> SDoc
text String
"Dealloc More Stack") (Operand -> Operand -> Operand -> Instr
ADD Operand
sp Operand
sp (Imm -> Operand
OpImm (RegNo -> Imm
ImmInt RegNo
4095))) forall a. a -> [a] -> [a]
: Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
platform (RegNo
n forall a. Num a => a -> a -> a
- RegNo
4095)
mkStackDeallocInstr Platform
_platform RegNo
n = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkStackDeallocInstr" (RegNo -> SDoc
int RegNo
n)
allocMoreStack
:: Platform
-> Int
-> NatCmmDecl statics GHC.CmmToAsm.AArch64.Instr.Instr
-> UniqSM (NatCmmDecl statics GHC.CmmToAsm.AArch64.Instr.Instr, [(BlockId,BlockId)])
allocMoreStack :: forall statics.
Platform
-> RegNo
-> NatCmmDecl statics Instr
-> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
allocMoreStack Platform
_ RegNo
_ top :: NatCmmDecl statics Instr
top@(CmmData Section
_ statics
_) = 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 [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
code)) = do
let entries :: [BlockId]
entries = forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks NatCmmDecl statics Instr
proc
[Unique]
uniqs <- forall (m :: * -> *) a. Applicative m => RegNo -> m a -> m [a]
replicateM (forall (t :: * -> *) a. Foldable t => t a -> RegNo
length [BlockId]
entries) forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
let
delta :: RegNo
delta = ((RegNo
x forall a. Num a => a -> a -> a
+ RegNo
stackAlign forall a. Num a => a -> a -> a
- RegNo
1) forall a. Integral a => a -> a -> a
`quot` RegNo
stackAlign) forall a. Num a => a -> a -> a
* RegNo
stackAlign
where x :: RegNo
x = RegNo
slots forall a. Num a => a -> a -> a
* RegNo
spillSlotSize
alloc :: [Instr]
alloc = Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
platform RegNo
delta
dealloc :: [Instr]
dealloc = Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
platform RegNo
delta
retargetList :: [(BlockId, BlockId)]
retargetList = (forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId]
entries (forall a b. (a -> b) -> [a] -> [b]
map Unique -> BlockId
mkBlockId [Unique]
uniqs))
new_blockmap :: LabelMap BlockId
new_blockmap :: LabelMap BlockId
new_blockmap = forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList [(BlockId, BlockId)]
retargetList
insert_stack_insn :: GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insn (BasicBlock BlockId
id [Instr]
insns)
| Just BlockId
new_blockid <- forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
id LabelMap BlockId
new_blockmap
= [ forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id forall a b. (a -> b) -> a -> b
$ [Instr]
alloc forall a. [a] -> [a] -> [a]
++ [ Target -> Instr
B (BlockId -> Target
TBlock BlockId
new_blockid) ]
, forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
new_blockid [Instr]
block' ]
| Bool
otherwise
= [ forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
block' ]
where
block' :: [Instr]
block' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Instr -> [Instr] -> [Instr]
insert_dealloc [] [Instr]
insns
insert_dealloc :: Instr -> [Instr] -> [Instr]
insert_dealloc Instr
insn [Instr]
r = case Instr
insn of
J Target
_ -> [Instr]
dealloc forall a. [a] -> [a] -> [a]
++ (Instr
insn forall a. a -> [a] -> [a]
: [Instr]
r)
ANN SDoc
_ (J Target
_) -> [Instr]
dealloc forall a. [a] -> [a] -> [a]
++ (Instr
insn forall a. a -> [a] -> [a]
: [Instr]
r)
Instr
_other | Instr -> [BlockId]
jumpDestsOfInstr Instr
insn forall a. Eq a => a -> a -> Bool
/= []
-> Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
insn BlockId -> BlockId
retarget forall a. a -> [a] -> [a]
: [Instr]
r
Instr
_other -> Instr
insn forall a. a -> [a] -> [a]
: [Instr]
r
where retarget :: BlockId -> BlockId
retarget BlockId
b = forall a. a -> Maybe a -> a
fromMaybe BlockId
b (forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
b LabelMap BlockId
new_blockmap)
new_code :: [GenBasicBlock Instr]
new_code = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insn [GenBasicBlock Instr]
code
forall (m :: * -> *) a. Monad m => a -> m a
return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
new_code), [(BlockId, BlockId)]
retargetList)
data Instr
= SDoc
| SDoc
| ANN SDoc Instr
| LOCATION Int Int Int String
| LDATA Section RawCmmStatics
| NEWBLOCK BlockId
| DELTA Int
| SXTB Operand Operand
| UXTB Operand Operand
| SXTH Operand Operand
| UXTH Operand Operand
| PUSH_STACK_FRAME
| POP_STACK_FRAME
| ADD Operand Operand Operand
| CMN Operand Operand
| CMP Operand Operand
| MSUB Operand Operand Operand Operand
| MUL Operand Operand Operand
| NEG Operand Operand
| SDIV Operand Operand Operand
| SMULH Operand Operand Operand
| SMULL Operand Operand Operand
| SUB Operand Operand Operand
| UDIV Operand Operand Operand
| SBFM Operand Operand Operand Operand
| UBFM Operand Operand Operand Operand
| SBFX Operand Operand Operand Operand
| UBFX Operand Operand Operand Operand
| AND Operand Operand Operand
| ANDS Operand Operand Operand
| ASR Operand Operand Operand
| BIC Operand Operand Operand
| BICS Operand Operand Operand
| EON Operand Operand Operand
| EOR Operand Operand Operand
| LSL Operand Operand Operand
| LSR Operand Operand Operand
| MOV Operand Operand
| MOVK Operand Operand
| MVN Operand Operand
| ORN Operand Operand Operand
| ORR Operand Operand Operand
| ROR Operand Operand Operand
| TST Operand Operand
| STR Format Operand Operand
| LDR Format Operand Operand
| STP Format Operand Operand Operand
| LDP Format Operand Operand Operand
| CSET Operand Cond
| CBZ Operand Target
| CBNZ Operand Target
| J Target
| B Target
| BL Target [Reg] [Reg]
| BCOND Cond Target
| DMBSY
| FCVT Operand Operand
| SCVTF Operand Operand
| FCVTZS Operand Operand
| FABS Operand Operand
instance Show Instr where
show :: Instr -> String
show (LDR Format
_f Operand
o1 Operand
o2) = String
"LDR " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Operand
o1 forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Operand
o2
show (MOV Operand
o1 Operand
o2) = String
"MOV " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Operand
o1 forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Operand
o2
show Instr
_ = String
"missing"
data Target
= TBlock BlockId
| TLabel CLabel
| TReg Reg
data ExtMode
= EUXTB | EUXTH | EUXTW | EUXTX
| ESXTB | ESXTH | ESXTW | ESXTX
deriving (ExtMode -> ExtMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtMode -> ExtMode -> Bool
$c/= :: ExtMode -> ExtMode -> Bool
== :: ExtMode -> ExtMode -> Bool
$c== :: ExtMode -> ExtMode -> Bool
Eq, RegNo -> ExtMode -> ShowS
[ExtMode] -> ShowS
ExtMode -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtMode] -> ShowS
$cshowList :: [ExtMode] -> ShowS
show :: ExtMode -> String
$cshow :: ExtMode -> String
showsPrec :: RegNo -> ExtMode -> ShowS
$cshowsPrec :: RegNo -> ExtMode -> ShowS
Show)
data ShiftMode
= SLSL | SLSR | SASR | SROR
deriving (ShiftMode -> ShiftMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShiftMode -> ShiftMode -> Bool
$c/= :: ShiftMode -> ShiftMode -> Bool
== :: ShiftMode -> ShiftMode -> Bool
$c== :: ShiftMode -> ShiftMode -> Bool
Eq, RegNo -> ShiftMode -> ShowS
[ShiftMode] -> ShowS
ShiftMode -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShiftMode] -> ShowS
$cshowList :: [ShiftMode] -> ShowS
show :: ShiftMode -> String
$cshow :: ShiftMode -> String
showsPrec :: RegNo -> ShiftMode -> ShowS
$cshowsPrec :: RegNo -> ShiftMode -> ShowS
Show)
type ExtShift = Int
type RegShift = Int
data Operand
= OpReg Width Reg
| OpRegExt Width Reg ExtMode ExtShift
| OpRegShift Width Reg ShiftMode RegShift
| OpImm Imm
| OpImmShift Imm ShiftMode RegShift
| OpAddr AddrMode
deriving (Operand -> Operand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c== :: Operand -> Operand -> Bool
Eq, RegNo -> Operand -> ShowS
[Operand] -> ShowS
Operand -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operand] -> ShowS
$cshowList :: [Operand] -> ShowS
show :: Operand -> String
$cshow :: Operand -> String
showsPrec :: RegNo -> Operand -> ShowS
$cshowsPrec :: RegNo -> Operand -> ShowS
Show)
opReg :: Width -> Reg -> Operand
opReg :: Width -> Reg -> Operand
opReg = Width -> Reg -> Operand
OpReg
xzr, wzr, sp, ip0 :: Operand
xzr :: Operand
xzr = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (-RegNo
1)))
wzr :: Operand
wzr = Width -> Reg -> Operand
OpReg Width
W32 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle (-RegNo
1)))
sp :: Operand
sp = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
31))
ip0 :: Operand
ip0 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
16))
_x :: Int -> Operand
_x :: RegNo -> Operand
_x RegNo
i = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
i))
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 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
0))
x1 :: Operand
x1 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
1))
x2 :: Operand
x2 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
2))
x3 :: Operand
x3 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
3))
x4 :: Operand
x4 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
4))
x5 :: Operand
x5 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
5))
x6 :: Operand
x6 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
6))
x7 :: Operand
x7 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
7))
x8 :: Operand
x8 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
8))
x9 :: Operand
x9 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
9))
x10 :: Operand
x10 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
10))
x11 :: Operand
x11 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
11))
x12 :: Operand
x12 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
12))
x13 :: Operand
x13 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
13))
x14 :: Operand
x14 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
14))
x15 :: Operand
x15 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
15))
x16 :: Operand
x16 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
16))
x17 :: Operand
x17 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
17))
x18 :: Operand
x18 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
18))
x19 :: Operand
x19 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
19))
x20 :: Operand
x20 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
20))
x21 :: Operand
x21 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
21))
x22 :: Operand
x22 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
22))
x23 :: Operand
x23 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
23))
x24 :: Operand
x24 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
24))
x25 :: Operand
x25 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
25))
x26 :: Operand
x26 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
26))
x27 :: Operand
x27 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
27))
x28 :: Operand
x28 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
28))
x29 :: Operand
x29 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
29))
x30 :: Operand
x30 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
30))
x31 :: Operand
x31 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
31))
_d :: Int -> Operand
_d :: RegNo -> Operand
_d = Width -> Reg -> Operand
OpReg Width
W64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealReg -> Reg
RegReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegNo -> RealReg
RealRegSingle
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 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
32))
d1 :: Operand
d1 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
33))
d2 :: Operand
d2 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
34))
d3 :: Operand
d3 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
35))
d4 :: Operand
d4 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
36))
d5 :: Operand
d5 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
37))
d6 :: Operand
d6 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
38))
d7 :: Operand
d7 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
39))
d8 :: Operand
d8 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
40))
d9 :: Operand
d9 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
41))
d10 :: Operand
d10 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
42))
d11 :: Operand
d11 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
43))
d12 :: Operand
d12 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
44))
d13 :: Operand
d13 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
45))
d14 :: Operand
d14 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
46))
d15 :: Operand
d15 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
47))
d16 :: Operand
d16 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
48))
d17 :: Operand
d17 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
49))
d18 :: Operand
d18 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
50))
d19 :: Operand
d19 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
51))
d20 :: Operand
d20 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
52))
d21 :: Operand
d21 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
53))
d22 :: Operand
d22 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
54))
d23 :: Operand
d23 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
55))
d24 :: Operand
d24 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
56))
d25 :: Operand
d25 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
57))
d26 :: Operand
d26 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
58))
d27 :: Operand
d27 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
59))
d28 :: Operand
d28 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
60))
d29 :: Operand
d29 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
61))
d30 :: Operand
d30 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
62))
d31 :: Operand
d31 = Width -> Reg -> Operand
OpReg Width
W64 (RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
63))
opRegUExt :: Width -> Reg -> Operand
opRegUExt :: Width -> Reg -> Operand
opRegUExt Width
W64 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W64 Reg
r ExtMode
EUXTX RegNo
0
opRegUExt Width
W32 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W32 Reg
r ExtMode
EUXTW RegNo
0
opRegUExt Width
W16 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W16 Reg
r ExtMode
EUXTH RegNo
0
opRegUExt Width
W8 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W8 Reg
r ExtMode
EUXTB RegNo
0
opRegUExt Width
w Reg
_r = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"opRegUExt" (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Width
w)
opRegSExt :: Width -> Reg -> Operand
opRegSExt :: Width -> Reg -> Operand
opRegSExt Width
W64 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W64 Reg
r ExtMode
ESXTX RegNo
0
opRegSExt Width
W32 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W32 Reg
r ExtMode
ESXTW RegNo
0
opRegSExt Width
W16 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W16 Reg
r ExtMode
ESXTH RegNo
0
opRegSExt Width
W8 Reg
r = Width -> Reg -> ExtMode -> RegNo -> Operand
OpRegExt Width
W8 Reg
r ExtMode
ESXTB RegNo
0
opRegSExt Width
w Reg
_r = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"opRegSExt" (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Width
w)