-- All instructions will be rendered eventually. Thus, there's no benefit in
-- being lazy in data types.
{-# 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.Prelude
import GHC.Stack
import GHC.Types.Unique.Supply
import GHC.Utils.Outputable
import GHC.Utils.Panic

-- | Stack frame header size in bytes.
--
-- The stack frame header is made of the values that are always saved
-- (regardless of the context.) It consists of the saved return address and a
-- pointer to the previous frame. Thus, its size is two stack frame slots which
-- equals two addresses/words (2 * 8 byte).
stackFrameHeaderSize :: Int
stackFrameHeaderSize :: RegNo
stackFrameHeaderSize = RegNo
2 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
spillSlotSize

-- | All registers are 8 byte wide.
spillSlotSize :: Int
spillSlotSize :: RegNo
spillSlotSize = RegNo
8

-- | The number of bytes that the stack pointer should be aligned to.
stackAlign :: Int
stackAlign :: RegNo
stackAlign = RegNo
16

-- | The number of spill slots available without allocating more.
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

-- | Convert a spill slot number to a *byte* offset.
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 [Reg]
reads [Reg]
writes) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RegUsage(reads:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Reg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Reg]
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
<+> [Reg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Reg]
writes SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
')'

-- | Get the registers that are being used by this instruction.
-- regUsage doesn't need to do any trickery for jumps and such.
-- Just state precisely the regs read and written by that insn.
-- The consequences of control flow transfers, as far as register
-- allocation goes, are taken care of by the register allocator.
--
-- RegUsage = RU [<read regs>] [<write regs>]
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's third operand is always an immediate
  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)
  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
    -- filtering the usage is necessary, otherwise the register
    -- allocator will try to allocate pre-defined fixed stg
    -- registers as well, as they show up.
    usage :: ([Reg], [Reg]) -> RegUsage
    usage :: ([Reg], [Reg]) -> RegUsage
usage ([Reg]
srcRegs, [Reg]
dstRegs) =
      [Reg] -> [Reg] -> RegUsage
RU
        ((Reg -> Bool) -> [Reg] -> [Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
srcRegs)
        ((Reg -> Bool) -> [Reg] -> [Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
dstRegs)

    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]

    -- Is this register interesting for the register allocator?
    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

-- | Caller-saved registers (according to calling convention)
--
-- These registers may be clobbered after a jump.
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]

-- | Apply a given mapping to all the register references in this instruction.
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)
  -- o3 cannot be a register for ORI (always an immediate)
  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)
  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

-- | Checks whether this instruction is a jump/branch instruction.
--
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
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

-- | Get the `BlockId`s of the jump destinations (if any)
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
_ = []

-- | Change the destination of this (potential) jump instruction.
--
-- Used in the linear allocator when adding fixup blocks for join
-- points.
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

-- -----------------------------------------------------------------------------
-- Note [RISCV64 Spills and Reloads]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- We reserve @RESERVED_C_STACK_BYTES@ on the C stack for spilling and reloading
-- registers. The load and store instructions of RISCV64 address with a signed
-- 12-bit immediate + a register; machine stackpointer (sp/x2) in this case.
--
-- The @RESERVED_C_STACK_BYTES@ is 16k, so we can't always address into it in a
-- single load/store instruction. There are offsets to sp (not to be confused
-- with STG's SP!) which need a register to be calculated.
--
-- Using sp to compute the offset would violate assumptions about the stack pointer
-- pointing to the top of the stack during signal handling.  As we can't force
-- every signal to use its own stack, we have to ensure that the stack pointer
-- always points to the top of the stack, and we can't use it for computation.
--
-- So, we reserve one register (TMP) for this purpose (and other, unrelated
-- intermediate operations.) See Note [The made-up RISCV64 TMP (IP) register]

-- | Generate instructions to spill a register into a spill slot.
mkSpillInstr ::
  (HasCallStack) =>
  NCGConfig ->
  -- | register to spill
  Reg ->
  -- | current stack delta
  Int ->
  -- | spill slot to use
  Int ->
  [Instr]
mkSpillInstr :: HasCallStack => NCGConfig -> Reg -> RegNo -> RegNo -> [Instr]
mkSpillInstr NCGConfig
_config Reg
reg 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

-- | Generate instructions to load a register from a spill slot.
mkLoadInstr ::
  NCGConfig ->
  -- | register to load
  Reg ->
  -- | current stack delta
  Int ->
  -- | spill slot to use
  Int ->
  [Instr]
mkLoadInstr :: NCGConfig -> Reg -> RegNo -> RegNo -> [Instr]
mkLoadInstr NCGConfig
_config Reg
reg 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

-- | See if this instruction is telling us the current C stack delta
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

-- | Not real instructions.  Just meta data
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

-- | Copy the value in a register to another one.
--
-- Must work for all register classes.
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)

-- | Take the source and destination from this (potential) reg -> reg move instruction
--
-- We have to be a bit careful here: A `MOV` can also mean an implicit
-- conversion. This case is filtered out.
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

-- | Make an unconditional jump instruction.
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

-- | Decrement @sp@ to allocate stack space.
--
-- The stack grows downwards, so we decrement the stack pointer by @n@ (bytes).
-- This is dual to `mkStackDeallocInstr`. @sp@ is the RISCV stack pointer, not
-- to be confused with the STG stack pointer.
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

-- | Increment SP to deallocate stack space.
--
-- The stack grows downwards, so we increment the stack pointer by @n@ (bytes).
-- This is dual to `mkStackAllocInstr`. @sp@ is the RISCV stack pointer, not to
-- be confused with the STG stack pointer.
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 =
      -- This ends up in three effective instructions. We could get away with
      -- two for intMax12bit < n < 3 * intMax12bit by recursing once. However,
      -- this way is likely less surprising.
      [ 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

--
-- See Note [extra spill slots] in X86/Instr.hs
--
allocMoreStack ::
  Platform ->
  Int ->
  NatCmmDecl statics GHC.CmmToAsm.RV64.Instr.Instr ->
  UniqSM (NatCmmDecl statics GHC.CmmToAsm.RV64.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
_) = (NatCmmDecl statics Instr, [(BlockId, BlockId)])
-> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
forall a. a -> UniqSM 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 [GlobalReg]
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

  uniqs <- UniqSM [Unique]
forall (m :: * -> *). MonadUnique m => m [Unique]
getUniquesM

  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 -- round up
        where
          x :: RegNo
x = RegNo
slots RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
* RegNo
spillSlotSize -- sp delta
      alloc = Platform -> RegNo -> [Instr]
mkStackAllocInstr Platform
platform RegNo
delta
      dealloc = Platform -> RegNo -> [Instr]
mkStackDeallocInstr Platform
platform RegNo
delta

      retargetList = [BlockId] -> [BlockId] -> [(BlockId, BlockId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId]
entries ((Unique -> BlockId) -> [Unique] -> [BlockId]
forall a b. (a -> b) -> [a] -> [b]
map Unique -> BlockId
mkBlockId [Unique]
uniqs)

      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
  = -- | Comment pseudo-op
    COMMENT SDoc
  | -- | Multi-line comment pseudo-op
    MULTILINE_COMMENT SDoc
  | -- | Annotated instruction. Should print <instr> # <doc>
    ANN SDoc Instr
  | -- | Location pseudo-op @.loc@ (file, line, col, name)
    LOCATION Int Int Int LexicalFastString
  | -- | Static data spat out during code generation.
    LDATA Section RawCmmStatics
  | -- | Start a new basic block.
    --
    -- Useful during codegen, removed later. Preceding instruction should be a
    -- jump, as per the invariants for a BasicBlock (see Cmm).
    NEWBLOCK BlockId
  | -- | Specify current stack offset for benefit of subsequent passes
    DELTA Int
  | -- | Push a minimal stack frame consisting of the return address (RA) and the frame pointer (FP).
    PUSH_STACK_FRAME
  | -- | Pop the minimal stack frame of prior `PUSH_STACK_FRAME`.
    POP_STACK_FRAME
  | -- | Arithmetic addition (both integer and floating point)
    --
    -- @rd = rs1 + rs2@
    ADD Operand Operand Operand
  | -- | Arithmetic subtraction (both integer and floating point)
    --
    -- @rd = rs1 - rs2@
    SUB Operand Operand Operand
  | -- | Logical AND (integer only)
    --
    -- @rd = rs1 & rs2@
    AND Operand Operand Operand
  | -- | Logical OR (integer only)
    --
    -- @rd = rs1 | rs2@
    OR Operand Operand Operand
  | -- | Logical left shift (zero extened, integer only)
    --
    -- @rd = rs1 << rs2@
    SLL Operand Operand Operand
  | -- | Logical right shift (zero extened, integer only)
    --
    -- @rd = rs1 >> rs2@
    SRL Operand Operand Operand
  | -- | Arithmetic right shift (sign-extened, integer only)
    --
    -- @rd = rs1 >> rs2@
    SRA Operand Operand Operand
  | -- | Store to memory (both, integer and floating point)
    STR Format Operand Operand
  | -- | Load from memory (sign-extended, integer and floating point)
    LDR Format Operand Operand
  | -- | Load from memory (unsigned, integer and floating point)
    LDRU Format Operand Operand
  | -- | Arithmetic multiplication (both, integer and floating point)
    --
    -- @rd = rn × rm@
    MUL Operand Operand Operand
  | -- | Negation (both, integer and floating point)
    --
    -- @rd = -op2@
    NEG Operand Operand
  | -- | Division (both, integer and floating point)
    --
    -- @rd = rn ÷ rm@
    DIV Operand Operand Operand
  | -- | Remainder (integer only, signed)
    --
    -- @rd = rn % rm@
    REM Operand Operand Operand --
  | -- | Remainder (integer only, unsigned)
    --
    -- @rd = |rn % rm|@
    REMU Operand Operand Operand
  | -- | High part of a multiplication that doesn't fit into 64bits (integer only)
    --
    -- E.g. for a multiplication with 64bits width: @rd = (rs1 * rs2) >> 64@.
    MULH Operand Operand Operand
  | -- | Unsigned division (integer only)
    --
    -- @rd = |rn ÷ rm|@
    DIVU Operand Operand Operand
  | -- | XOR (integer only)
    --
    -- @rd = rn ⊕ op2@
    XOR Operand Operand Operand
  | -- | ORI with immediate (integer only)
    --
    -- @rd = rn | op2@
    ORI Operand Operand Operand
  | -- | OR with immediate (integer only)
    --
    -- @rd = rn ⊕ op2@
    XORI Operand Operand Operand
  | -- | Move to register (integer and floating point)
    --
    -- @rd = rn@  or  @rd = #imm@
    MOV Operand Operand
  | -- | Pseudo-op for conditional setting of a register.
    --
    -- @if(o2 cond o3) op <- 1 else op <- 0@
    CSET Operand Operand Operand Cond
  | -- | A jump instruction with data for switch/jump tables
    J_TBL [Maybe BlockId] (Maybe CLabel) Reg
  | -- | Unconditional jump (no linking)
    B Target
  | -- | Unconditional jump, links return address (sets @ra@/@x1@)
    BL Reg [Reg]
  | -- | branch with condition (integer only)
    BCOND Cond Operand Operand Target
  | -- | Fence instruction
    --
    -- Memory barrier.
    FENCE FenceType FenceType
  | -- | Floating point conversion
    FCVT FcvtVariant Operand Operand
  | -- | Floating point ABSolute value
    FABS Operand Operand
  | -- | Floating-point fused multiply-add instructions
    --
    -- - fmadd : d =   r1 * r2 + r3
    -- - fnmsub: d =   r1 * r2 - r3
    -- - fmsub : d = - r1 * r2 + r3
    -- - fnmadd: d = - r1 * r2 - r3
    FMA FMASign Operand Operand Operand Operand

-- | Operand of a FENCE instruction (@r@, @w@ or @rw@)
data FenceType = FenceRead | FenceWrite | FenceReadWrite

-- | Variant of a floating point conversion instruction
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"
    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
  = -- | register
    OpReg Width Reg
  | -- | immediate value
    OpImm Imm
  | -- | memory reference
    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 (VirtualRegF Unique
_)) = Bool
True
isFloatReg (RegVirtual (VirtualRegD Unique
_)) = Bool
True
isFloatReg Reg
_ = Bool
False