{-# LANGUAGE TypeFamilies #-}
module GHC.CmmToAsm.X86.Instr
( Instr(..)
, Operand(..)
, PrefetchVariant(..)
, JumpDest(..)
, getJumpDestBlockId
, canShortcut
, shortcutStatics
, shortcutJump
, allocMoreStack
, maxSpillSlots
, archWordFormat
, takeRegRegMoveInstr
, regUsageOfInstr
, takeDeltaInstr
, mkLoadInstr
, mkJumpInstr
, mkStackAllocInstr
, mkStackDeallocInstr
, mkSpillInstr
, mkRegRegMoveInstr
, jumpDestsOfInstr
, patchRegsOfInstr
, patchJumpInstr
, isMetaInstr
, isJumpishInstr
)
where
import GHC.Prelude
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Platform.Regs
import GHC.Cmm
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
import GHC.Cmm.CLabel
import GHC.Types.Unique.Set
import GHC.Types.Unique
import GHC.Types.Unique.Supply
import GHC.Types.Basic (Alignment)
import GHC.Cmm.DebugBlock (UnwindTable)
import Data.Maybe (fromMaybe)
archWordFormat :: Bool -> Format
archWordFormat :: Bool -> Format
archWordFormat Bool
is32Bit
| Bool
is32Bit = Format
II32
| Bool
otherwise = Format
II64
data Instr
= SDoc
| LOCATION Int Int Int String
| LDATA Section (Alignment, RawCmmStatics)
| NEWBLOCK BlockId
| UNWIND CLabel UnwindTable
| DELTA Int
| MOV Format Operand Operand
| CMOV Cond Format Operand Reg
| MOVZxL Format Operand Operand
| MOVSxL Format Operand Operand
| LEA Format Operand Operand
| ADD Format Operand Operand
| ADC Format Operand Operand
| SUB Format Operand Operand
| SBB Format Operand Operand
| MUL Format Operand Operand
| MUL2 Format Operand
| IMUL Format Operand Operand
| IMUL2 Format Operand
| DIV Format Operand
| IDIV Format Operand
| ADD_CC Format Operand Operand
| SUB_CC Format Operand Operand
| AND Format Operand Operand
| OR Format Operand Operand
| XOR Format Operand Operand
| NOT Format Operand
| NEGI Format Operand
| BSWAP Format Reg
| SHL Format Operand Operand
| SAR Format Operand Operand
| SHR Format Operand Operand
| BT Format Imm Operand
| NOP
| X87Store Format AddrMode
| CVTSS2SD Reg Reg
| CVTSD2SS Reg Reg
| CVTTSS2SIQ Format Operand Reg
| CVTTSD2SIQ Format Operand Reg
| CVTSI2SS Format Operand Reg
| CVTSI2SD Format Operand Reg
| FDIV Format Operand Operand
| SQRT Format Operand Reg
| TEST Format Operand Operand
| CMP Format Operand Operand
| SETCC Cond Operand
| PUSH Format Operand
| POP Format Operand
| JMP Operand [Reg]
| JXX Cond BlockId
| JXX_GBL Cond Imm
| JMP_TBL Operand
[Maybe JumpDest]
Section
CLabel
| CALL (Either Imm Reg)
[Reg]
| CLTD Format
| FETCHGOT Reg
| FETCHPC Reg
| POPCNT Format Operand Reg
| LZCNT Format Operand Reg
| TZCNT Format Operand Reg
| BSF Format Operand Reg
| BSR Format Operand Reg
| PDEP Format Operand Operand Reg
| PEXT Format Operand Operand Reg
| PREFETCH PrefetchVariant Format Operand
| LOCK Instr
| XADD Format Operand Operand
| CMPXCHG Format Operand Operand
| XCHG Format Operand Reg
| MFENCE
data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
data Operand
= OpReg Reg
| OpImm Imm
| OpAddr AddrMode
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr Platform
platform Instr
instr
= case Instr
instr of
MOV Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRW Operand
src Operand
dst
CMOV Cond
_ Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src [Reg
dst]) [Reg
dst]
MOVZxL Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRW Operand
src Operand
dst
MOVSxL Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRW Operand
src Operand
dst
LEA Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRW Operand
src Operand
dst
ADD Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
ADC Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
SUB Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
SBB Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
IMUL Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
IMUL2 Format
II8 Operand
src -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
eaxforall a. a -> [a] -> [a]
:Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
eax]
IMUL2 Format
_ Operand
src -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
eaxforall a. a -> [a] -> [a]
:Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
eax,Reg
edx]
MUL Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
MUL2 Format
_ Operand
src -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
eaxforall a. a -> [a] -> [a]
:Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
eax,Reg
edx]
DIV Format
_ Operand
op -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
eaxforall a. a -> [a] -> [a]
:Reg
edxforall a. a -> [a] -> [a]
:Operand -> [Reg] -> [Reg]
use_R Operand
op []) [Reg
eax,Reg
edx]
IDIV Format
_ Operand
op -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
eaxforall a. a -> [a] -> [a]
:Reg
edxforall a. a -> [a] -> [a]
:Operand -> [Reg] -> [Reg]
use_R Operand
op []) [Reg
eax,Reg
edx]
ADD_CC Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
SUB_CC Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
AND Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
OR Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
XOR Format
_ (OpReg Reg
src) (OpReg Reg
dst)
| Reg
src forall a. Eq a => a -> a -> Bool
== Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU [] [Reg
dst]
XOR Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
NOT Format
_ Operand
op -> Operand -> RegUsage
usageM Operand
op
BSWAP Format
_ Reg
reg -> [Reg] -> [Reg] -> RegUsage
mkRU [Reg
reg] [Reg
reg]
NEGI Format
_ Operand
op -> Operand -> RegUsage
usageM Operand
op
SHL Format
_ Operand
imm Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
imm Operand
dst
SAR Format
_ Operand
imm Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
imm Operand
dst
SHR Format
_ Operand
imm Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
imm Operand
dst
BT Format
_ Imm
_ Operand
src -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
src [])
PUSH Format
_ Operand
op -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
op [])
POP Format
_ Operand
op -> [Reg] -> [Reg] -> RegUsage
mkRU [] (Operand -> [Reg]
def_W Operand
op)
TEST Format
_ Operand
src Operand
dst -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
src forall a b. (a -> b) -> a -> b
$! Operand -> [Reg] -> [Reg]
use_R Operand
dst [])
CMP Format
_ Operand
src Operand
dst -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
src forall a b. (a -> b) -> a -> b
$! Operand -> [Reg] -> [Reg]
use_R Operand
dst [])
SETCC Cond
_ Operand
op -> [Reg] -> [Reg] -> RegUsage
mkRU [] (Operand -> [Reg]
def_W Operand
op)
JXX Cond
_ BlockId
_ -> [Reg] -> [Reg] -> RegUsage
mkRU [] []
JXX_GBL Cond
_ Imm
_ -> [Reg] -> [Reg] -> RegUsage
mkRU [] []
JMP Operand
op [Reg]
regs -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
op [Reg]
regs)
JMP_TBL Operand
op [Maybe JumpDest]
_ Section
_ CLabel
_ -> [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
op [])
CALL (Left Imm
_) [Reg]
params -> [Reg] -> [Reg] -> RegUsage
mkRU [Reg]
params (Platform -> [Reg]
callClobberedRegs Platform
platform)
CALL (Right Reg
reg) [Reg]
params -> [Reg] -> [Reg] -> RegUsage
mkRU (Reg
regforall a. a -> [a] -> [a]
:[Reg]
params) (Platform -> [Reg]
callClobberedRegs Platform
platform)
CLTD Format
_ -> [Reg] -> [Reg] -> RegUsage
mkRU [Reg
eax] [Reg
edx]
Instr
NOP -> [Reg] -> [Reg] -> RegUsage
mkRU [] []
X87Store Format
_ AddrMode
dst -> [Reg] -> RegUsage
mkRUR ( AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
dst [])
CVTSS2SD Reg
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU [Reg
src] [Reg
dst]
CVTSD2SS Reg
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU [Reg
src] [Reg
dst]
CVTTSS2SIQ Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
CVTTSD2SIQ Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
CVTSI2SS Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
CVTSI2SD Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
FDIV Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageRM Operand
src Operand
dst
SQRT Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
FETCHGOT Reg
reg -> [Reg] -> [Reg] -> RegUsage
mkRU [] [Reg
reg]
FETCHPC Reg
reg -> [Reg] -> [Reg] -> RegUsage
mkRU [] [Reg
reg]
COMMENT SDoc
_ -> RegUsage
noUsage
LOCATION{} -> RegUsage
noUsage
UNWIND{} -> RegUsage
noUsage
DELTA Int
_ -> RegUsage
noUsage
POPCNT Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
LZCNT Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
TZCNT Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
BSF Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
BSR Format
_ Operand
src Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) [Reg
dst]
PDEP Format
_ Operand
src Operand
mask Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src forall a b. (a -> b) -> a -> b
$ Operand -> [Reg] -> [Reg]
use_R Operand
mask []) [Reg
dst]
PEXT Format
_ Operand
src Operand
mask Reg
dst -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src forall a b. (a -> b) -> a -> b
$ Operand -> [Reg] -> [Reg]
use_R Operand
mask []) [Reg
dst]
PREFETCH PrefetchVariant
_ Format
_ Operand
src -> [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
src []) []
LOCK Instr
i -> Platform -> Instr -> RegUsage
regUsageOfInstr Platform
platform Instr
i
XADD Format
_ Operand
src Operand
dst -> Operand -> Operand -> RegUsage
usageMM Operand
src Operand
dst
CMPXCHG Format
_ Operand
src Operand
dst -> Operand -> Operand -> Operand -> RegUsage
usageRMM Operand
src Operand
dst (Reg -> Operand
OpReg Reg
eax)
XCHG Format
_ Operand
src Reg
dst -> Operand -> Operand -> RegUsage
usageMM Operand
src (Reg -> Operand
OpReg Reg
dst)
Instr
MFENCE -> RegUsage
noUsage
Instr
_other -> forall a. String -> a
panic String
"regUsage: unrecognised instr"
where
usageRW :: Operand -> Operand -> RegUsage
usageRW :: Operand -> Operand -> RegUsage
usageRW Operand
op (OpReg Reg
reg) = [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
op []) [Reg
reg]
usageRW Operand
op (OpAddr AddrMode
ea) = [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
op forall a b. (a -> b) -> a -> b
$! AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [])
usageRW Operand
_ Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.usageRW: no match"
usageRM :: Operand -> Operand -> RegUsage
usageRM :: Operand -> Operand -> RegUsage
usageRM Operand
op (OpReg Reg
reg) = [Reg] -> [Reg] -> RegUsage
mkRU (Operand -> [Reg] -> [Reg]
use_R Operand
op [Reg
reg]) [Reg
reg]
usageRM Operand
op (OpAddr AddrMode
ea) = [Reg] -> RegUsage
mkRUR (Operand -> [Reg] -> [Reg]
use_R Operand
op forall a b. (a -> b) -> a -> b
$! AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [])
usageRM Operand
_ Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.usageRM: no match"
usageMM :: Operand -> Operand -> RegUsage
usageMM :: Operand -> Operand -> RegUsage
usageMM (OpReg Reg
src) (OpReg Reg
dst) = [Reg] -> [Reg] -> RegUsage
mkRU [Reg
src, Reg
dst] [Reg
src, Reg
dst]
usageMM (OpReg Reg
src) (OpAddr AddrMode
ea) = [Reg] -> [Reg] -> RegUsage
mkRU (AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [Reg
src]) [Reg
src]
usageMM (OpAddr AddrMode
ea) (OpReg Reg
dst) = [Reg] -> [Reg] -> RegUsage
mkRU (AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [Reg
dst]) [Reg
dst]
usageMM Operand
_ Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.usageMM: no match"
usageRMM :: Operand -> Operand -> Operand -> RegUsage
usageRMM :: Operand -> Operand -> Operand -> RegUsage
usageRMM (OpReg Reg
src) (OpReg Reg
dst) (OpReg Reg
reg) = [Reg] -> [Reg] -> RegUsage
mkRU [Reg
src, Reg
dst, Reg
reg] [Reg
dst, Reg
reg]
usageRMM (OpReg Reg
src) (OpAddr AddrMode
ea) (OpReg Reg
reg) = [Reg] -> [Reg] -> RegUsage
mkRU (AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [Reg
src, Reg
reg]) [Reg
reg]
usageRMM Operand
_ Operand
_ Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.usageRMM: no match"
usageM :: Operand -> RegUsage
usageM :: Operand -> RegUsage
usageM (OpReg Reg
reg) = [Reg] -> [Reg] -> RegUsage
mkRU [Reg
reg] [Reg
reg]
usageM (OpAddr AddrMode
ea) = [Reg] -> RegUsage
mkRUR (AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [])
usageM Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.usageM: no match"
def_W :: Operand -> [Reg]
def_W (OpReg Reg
reg) = [Reg
reg]
def_W (OpAddr AddrMode
_ ) = []
def_W Operand
_ = forall a. String -> a
panic String
"X86.RegInfo.def_W: no match"
use_R :: Operand -> [Reg] -> [Reg]
use_R (OpReg Reg
reg) [Reg]
tl = Reg
reg forall a. a -> [a] -> [a]
: [Reg]
tl
use_R (OpImm Imm
_) [Reg]
tl = [Reg]
tl
use_R (OpAddr AddrMode
ea) [Reg]
tl = AddrMode -> [Reg] -> [Reg]
use_EA AddrMode
ea [Reg]
tl
use_EA :: AddrMode -> [Reg] -> [Reg]
use_EA (ImmAddr Imm
_ Int
_) [Reg]
tl = [Reg]
tl
use_EA (AddrBaseIndex EABase
base EAIndex
index Imm
_) [Reg]
tl =
EABase -> [Reg] -> [Reg]
use_base EABase
base forall a b. (a -> b) -> a -> b
$! EAIndex -> [Reg] -> [Reg]
use_index EAIndex
index [Reg]
tl
where use_base :: EABase -> [Reg] -> [Reg]
use_base (EABaseReg Reg
r) [Reg]
tl = Reg
r forall a. a -> [a] -> [a]
: [Reg]
tl
use_base EABase
_ [Reg]
tl = [Reg]
tl
use_index :: EAIndex -> [Reg] -> [Reg]
use_index EAIndex
EAIndexNone [Reg]
tl = [Reg]
tl
use_index (EAIndex Reg
i Int
_) [Reg]
tl = Reg
i forall a. a -> [a] -> [a]
: [Reg]
tl
mkRUR :: [Reg] -> RegUsage
mkRUR [Reg]
src = [Reg]
src' seq :: forall a b. a -> b -> b
`seq` [Reg] -> [Reg] -> RegUsage
RU [Reg]
src' []
where src' :: [Reg]
src' = forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
src
mkRU :: [Reg] -> [Reg] -> RegUsage
mkRU [Reg]
src [Reg]
dst = [Reg]
src' seq :: forall a b. a -> b -> b
`seq` [Reg]
dst' seq :: forall a b. a -> b -> b
`seq` [Reg] -> [Reg] -> RegUsage
RU [Reg]
src' [Reg]
dst'
where src' :: [Reg]
src' = forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
src
dst' :: [Reg]
dst' = forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform) [Reg]
dst
interesting :: Platform -> Reg -> Bool
interesting :: Platform -> Reg -> Bool
interesting Platform
_ (RegVirtual VirtualReg
_) = Bool
True
interesting Platform
platform (RegReal (RealRegSingle Int
i)) = Platform -> Int -> Bool
freeReg Platform
platform Int
i
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
instr Reg -> Reg
env
= case Instr
instr of
MOV Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
MOV Format
fmt) Operand
src Operand
dst
CMOV Cond
cc Format
fmt Operand
src Reg
dst -> Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
cc Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
MOVZxL Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
MOVZxL Format
fmt) Operand
src Operand
dst
MOVSxL Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
MOVSxL Format
fmt) Operand
src Operand
dst
LEA Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
LEA Format
fmt) Operand
src Operand
dst
ADD Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
ADD Format
fmt) Operand
src Operand
dst
ADC Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
ADC Format
fmt) Operand
src Operand
dst
SUB Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
SUB Format
fmt) Operand
src Operand
dst
SBB Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
SBB Format
fmt) Operand
src Operand
dst
IMUL Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
IMUL Format
fmt) Operand
src Operand
dst
IMUL2 Format
fmt Operand
src -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
IMUL2 Format
fmt) Operand
src
MUL Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
MUL Format
fmt) Operand
src Operand
dst
MUL2 Format
fmt Operand
src -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
MUL2 Format
fmt) Operand
src
IDIV Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
IDIV Format
fmt) Operand
op
DIV Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
DIV Format
fmt) Operand
op
ADD_CC Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
ADD_CC Format
fmt) Operand
src Operand
dst
SUB_CC Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
SUB_CC Format
fmt) Operand
src Operand
dst
AND Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
AND Format
fmt) Operand
src Operand
dst
OR Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
OR Format
fmt) Operand
src Operand
dst
XOR Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
XOR Format
fmt) Operand
src Operand
dst
NOT Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
NOT Format
fmt) Operand
op
BSWAP Format
fmt Reg
reg -> Format -> Reg -> Instr
BSWAP Format
fmt (Reg -> Reg
env Reg
reg)
NEGI Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
NEGI Format
fmt) Operand
op
SHL Format
fmt Operand
imm Operand
dst -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Operand -> Instr
SHL Format
fmt Operand
imm) Operand
dst
SAR Format
fmt Operand
imm Operand
dst -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Operand -> Instr
SAR Format
fmt Operand
imm) Operand
dst
SHR Format
fmt Operand
imm Operand
dst -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Operand -> Instr
SHR Format
fmt Operand
imm) Operand
dst
BT Format
fmt Imm
imm Operand
src -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Imm -> Operand -> Instr
BT Format
fmt Imm
imm) Operand
src
TEST Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
TEST Format
fmt) Operand
src Operand
dst
CMP Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
CMP Format
fmt) Operand
src Operand
dst
PUSH Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
PUSH Format
fmt) Operand
op
POP Format
fmt Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
POP Format
fmt) Operand
op
SETCC Cond
cond Operand
op -> forall a. (Operand -> a) -> Operand -> a
patch1 (Cond -> Operand -> Instr
SETCC Cond
cond) Operand
op
JMP Operand
op [Reg]
regs -> Operand -> [Reg] -> Instr
JMP (Operand -> Operand
patchOp Operand
op) [Reg]
regs
JMP_TBL Operand
op [Maybe JumpDest]
ids Section
s CLabel
lbl -> Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL (Operand -> Operand
patchOp Operand
op) [Maybe JumpDest]
ids Section
s CLabel
lbl
X87Store Format
fmt AddrMode
dst -> Format -> AddrMode -> Instr
X87Store Format
fmt (AddrMode -> AddrMode
lookupAddr AddrMode
dst)
CVTSS2SD Reg
src Reg
dst -> Reg -> Reg -> Instr
CVTSS2SD (Reg -> Reg
env Reg
src) (Reg -> Reg
env Reg
dst)
CVTSD2SS Reg
src Reg
dst -> Reg -> Reg -> Instr
CVTSD2SS (Reg -> Reg
env Reg
src) (Reg -> Reg
env Reg
dst)
CVTTSS2SIQ Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
CVTTSS2SIQ Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
CVTTSD2SIQ Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
CVTTSD2SIQ Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
CVTSI2SS Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
CVTSI2SS Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
CVTSI2SD Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
CVTSI2SD Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
FDIV Format
fmt Operand
src Operand
dst -> Format -> Operand -> Operand -> Instr
FDIV Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
SQRT Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
SQRT Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
CALL (Left Imm
_) [Reg]
_ -> Instr
instr
CALL (Right Reg
reg) [Reg]
p -> Either Imm Reg -> [Reg] -> Instr
CALL (forall a b. b -> Either a b
Right (Reg -> Reg
env Reg
reg)) [Reg]
p
FETCHGOT Reg
reg -> Reg -> Instr
FETCHGOT (Reg -> Reg
env Reg
reg)
FETCHPC Reg
reg -> Reg -> Instr
FETCHPC (Reg -> Reg
env Reg
reg)
Instr
NOP -> Instr
instr
COMMENT SDoc
_ -> Instr
instr
LOCATION {} -> Instr
instr
UNWIND {} -> Instr
instr
DELTA Int
_ -> Instr
instr
JXX Cond
_ BlockId
_ -> Instr
instr
JXX_GBL Cond
_ Imm
_ -> Instr
instr
CLTD Format
_ -> Instr
instr
POPCNT Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
POPCNT Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
LZCNT Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
LZCNT Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
TZCNT Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
TZCNT Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
PDEP Format
fmt Operand
src Operand
mask Reg
dst -> Format -> Operand -> Operand -> Reg -> Instr
PDEP Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
mask) (Reg -> Reg
env Reg
dst)
PEXT Format
fmt Operand
src Operand
mask Reg
dst -> Format -> Operand -> Operand -> Reg -> Instr
PEXT Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
mask) (Reg -> Reg
env Reg
dst)
BSF Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
BSF Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
BSR Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
BSR Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
PREFETCH PrefetchVariant
lvl Format
format Operand
src -> PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
lvl Format
format (Operand -> Operand
patchOp Operand
src)
LOCK Instr
i -> Instr -> Instr
LOCK (Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
i Reg -> Reg
env)
XADD Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
XADD Format
fmt) Operand
src Operand
dst
CMPXCHG Format
fmt Operand
src Operand
dst -> forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
CMPXCHG Format
fmt) Operand
src Operand
dst
XCHG Format
fmt Operand
src Reg
dst -> Format -> Operand -> Reg -> Instr
XCHG Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
Instr
MFENCE -> Instr
instr
Instr
_other -> forall a. String -> a
panic String
"patchRegs: unrecognised instr"
where
patch1 :: (Operand -> a) -> Operand -> a
patch1 :: forall a. (Operand -> a) -> Operand -> a
patch1 Operand -> a
insn Operand
op = Operand -> a
insn forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
op
patch2 :: (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 :: forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 Operand -> Operand -> a
insn Operand
src Operand
dst = (Operand -> Operand -> a
insn forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
src) forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
dst
patchOp :: Operand -> Operand
patchOp (OpReg Reg
reg) = Reg -> Operand
OpReg forall a b. (a -> b) -> a -> b
$! Reg -> Reg
env Reg
reg
patchOp (OpImm Imm
imm) = Imm -> Operand
OpImm Imm
imm
patchOp (OpAddr AddrMode
ea) = AddrMode -> Operand
OpAddr forall a b. (a -> b) -> a -> b
$! AddrMode -> AddrMode
lookupAddr AddrMode
ea
lookupAddr :: AddrMode -> AddrMode
lookupAddr (ImmAddr Imm
imm Int
off) = Imm -> Int -> AddrMode
ImmAddr Imm
imm Int
off
lookupAddr (AddrBaseIndex EABase
base EAIndex
index Imm
disp)
= ((EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex forall a b. (a -> b) -> a -> b
$! EABase -> EABase
lookupBase EABase
base) forall a b. (a -> b) -> a -> b
$! EAIndex -> EAIndex
lookupIndex EAIndex
index) Imm
disp
where
lookupBase :: EABase -> EABase
lookupBase EABase
EABaseNone = EABase
EABaseNone
lookupBase EABase
EABaseRip = EABase
EABaseRip
lookupBase (EABaseReg Reg
r) = Reg -> EABase
EABaseReg forall a b. (a -> b) -> a -> b
$! Reg -> Reg
env Reg
r
lookupIndex :: EAIndex -> EAIndex
lookupIndex EAIndex
EAIndexNone = EAIndex
EAIndexNone
lookupIndex (EAIndex Reg
r Int
i) = (Reg -> Int -> EAIndex
EAIndex forall a b. (a -> b) -> a -> b
$! Reg -> Reg
env Reg
r) Int
i
isJumpishInstr
:: Instr -> Bool
isJumpishInstr :: Instr -> Bool
isJumpishInstr Instr
instr
= case Instr
instr of
JMP{} -> Bool
True
JXX{} -> Bool
True
JXX_GBL{} -> Bool
True
JMP_TBL{} -> Bool
True
CALL{} -> Bool
True
Instr
_ -> Bool
False
jumpDestsOfInstr
:: Instr
-> [BlockId]
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr Instr
insn
= case Instr
insn of
JXX Cond
_ BlockId
id -> [BlockId
id]
JMP_TBL Operand
_ [Maybe JumpDest]
ids Section
_ CLabel
_ -> [BlockId
id | Just (DestBlockId BlockId
id) <- [Maybe JumpDest]
ids]
Instr
_ -> []
patchJumpInstr
:: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
insn BlockId -> BlockId
patchF
= case Instr
insn of
JXX Cond
cc BlockId
id -> Cond -> BlockId -> Instr
JXX Cond
cc (BlockId -> BlockId
patchF BlockId
id)
JMP_TBL Operand
op [Maybe JumpDest]
ids Section
section CLabel
lbl
-> Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL Operand
op (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BlockId -> BlockId) -> JumpDest -> JumpDest
patchJumpDest BlockId -> BlockId
patchF)) [Maybe JumpDest]
ids) Section
section CLabel
lbl
Instr
_ -> Instr
insn
where
patchJumpDest :: (BlockId -> BlockId) -> JumpDest -> JumpDest
patchJumpDest BlockId -> BlockId
f (DestBlockId BlockId
id) = BlockId -> JumpDest
DestBlockId (BlockId -> BlockId
f BlockId
id)
patchJumpDest BlockId -> BlockId
_ JumpDest
dest = JumpDest
dest
mkSpillInstr
:: NCGConfig
-> Reg
-> Int
-> Int
-> [Instr]
mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkSpillInstr NCGConfig
config Reg
reg Int
delta Int
slot
= let off :: Int
off = Platform -> Int -> Int
spillSlotToOffset Platform
platform Int
slot forall a. Num a => a -> a -> a
- Int
delta
in
case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
reg of
RegClass
RcInteger -> [Format -> Operand -> Operand -> Instr
MOV (Bool -> Format
archWordFormat Bool
is32Bit)
(Reg -> Operand
OpReg Reg
reg) (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off))]
RegClass
RcDouble -> [Format -> Operand -> Operand -> Instr
MOV Format
FF64 (Reg -> Operand
OpReg Reg
reg) (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off))]
RegClass
_ -> forall a. String -> a
panic String
"X86.mkSpillInstr: no match"
where platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
is32Bit :: Bool
is32Bit = Platform -> Bool
target32Bit Platform
platform
mkLoadInstr
:: NCGConfig
-> Reg
-> Int
-> Int
-> [Instr]
mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
mkLoadInstr NCGConfig
config Reg
reg Int
delta Int
slot
= let off :: Int
off = Platform -> Int -> Int
spillSlotToOffset Platform
platform Int
slot forall a. Num a => a -> a -> a
- Int
delta
in
case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
reg of
RegClass
RcInteger -> ([Format -> Operand -> Operand -> Instr
MOV (Bool -> Format
archWordFormat Bool
is32Bit)
(AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) (Reg -> Operand
OpReg Reg
reg)])
RegClass
RcDouble -> ([Format -> Operand -> Operand -> Instr
MOV Format
FF64 (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) (Reg -> Operand
OpReg Reg
reg)])
RegClass
_ -> forall a. String -> a
panic String
"X86.mkLoadInstr"
where platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
is32Bit :: Bool
is32Bit = Platform -> Bool
target32Bit Platform
platform
spillSlotSize :: Platform -> Int
spillSlotSize :: Platform -> Int
spillSlotSize Platform
platform
| Platform -> Bool
target32Bit Platform
platform = Int
12
| Bool
otherwise = Int
8
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots NCGConfig
config
= ((NCGConfig -> Int
ncgSpillPreallocSize NCGConfig
config forall a. Num a => a -> a -> a
- Int
64) forall a. Integral a => a -> a -> a
`div` Platform -> Int
spillSlotSize (NCGConfig -> Platform
ncgPlatform NCGConfig
config)) forall a. Num a => a -> a -> a
- Int
1
stackAlign :: Int
stackAlign :: Int
stackAlign = Int
16
spillSlotToOffset :: Platform -> Int -> Int
spillSlotToOffset :: Platform -> Int -> Int
spillSlotToOffset Platform
platform Int
slot
= Int
64 forall a. Num a => a -> a -> a
+ Platform -> Int
spillSlotSize Platform
platform forall a. Num a => a -> a -> a
* Int
slot
takeDeltaInstr
:: Instr
-> Maybe Int
takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr Instr
instr
= case Instr
instr of
DELTA Int
i -> forall a. a -> Maybe a
Just Int
i
Instr
_ -> forall a. Maybe a
Nothing
isMetaInstr
:: Instr
-> Bool
isMetaInstr :: Instr -> Bool
isMetaInstr Instr
instr
= case Instr
instr of
COMMENT{} -> Bool
True
LOCATION{} -> Bool
True
LDATA{} -> Bool
True
NEWBLOCK{} -> Bool
True
UNWIND{} -> Bool
True
DELTA{} -> Bool
True
Instr
_ -> Bool
False
mkRegRegMoveInstr
:: Platform
-> Reg
-> Reg
-> Instr
mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform Reg
src Reg
dst
= case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
src of
RegClass
RcInteger -> case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst)
Arch
ArchX86_64 -> Format -> Operand -> Operand -> Instr
MOV Format
II64 (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst)
Arch
_ -> forall a. String -> a
panic String
"X86.mkRegRegMoveInstr: Bad arch"
RegClass
RcDouble -> Format -> Operand -> Operand -> Instr
MOV Format
FF64 (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst)
RegClass
_ -> forall a. String -> a
panic String
"X86.RegInfo.mkRegRegMoveInstr: no match"
takeRegRegMoveInstr
:: Instr
-> Maybe (Reg,Reg)
takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr (MOV Format
_ (OpReg Reg
r1) (OpReg Reg
r2))
= forall a. a -> Maybe a
Just (Reg
r1,Reg
r2)
takeRegRegMoveInstr Instr
_ = forall a. Maybe a
Nothing
mkJumpInstr
:: BlockId
-> [Instr]
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr BlockId
id
= [Cond -> BlockId -> Instr
JXX Cond
ALWAYS BlockId
id]
needs_probe_call :: Platform -> Int -> Bool
needs_probe_call :: Platform -> Int -> Bool
needs_probe_call Platform
platform Int
amount
= case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Int
amount forall a. Ord a => a -> a -> Bool
> (Int
4 forall a. Num a => a -> a -> a
* Int
1024)
Arch
ArchX86_64 -> Int
amount forall a. Ord a => a -> a -> Bool
> (Int
4 forall a. Num a => a -> a -> a
* Int
1024)
Arch
_ -> Bool
False
OS
_ -> Bool
False
mkStackAllocInstr
:: Platform
-> Int
-> [Instr]
mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr Platform
platform Int
amount
= case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 ->
case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 | Platform -> Int -> Bool
needs_probe_call Platform
platform Int
amount ->
[ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
eax)
, Either Imm Reg -> [Reg] -> Instr
CALL (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Imm
strImmLit String
"___chkstk_ms") [Reg
eax]
, Format -> Operand -> Operand -> Instr
SUB Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
esp)
]
| Bool
otherwise ->
[ Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
esp)
, Format -> Operand -> Operand -> Instr
TEST Format
II32 (Reg -> Operand
OpReg Reg
esp) (Reg -> Operand
OpReg Reg
esp)
]
Arch
ArchX86_64 | Platform -> Int -> Bool
needs_probe_call Platform
platform Int
amount ->
[ Format -> Operand -> Operand -> Instr
MOV Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
rax)
, Either Imm Reg -> [Reg] -> Instr
CALL (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Imm
strImmLit String
"___chkstk_ms") [Reg
rax]
, Format -> Operand -> Operand -> Instr
SUB Format
II64 (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
rsp)
]
| Bool
otherwise ->
[ Format -> Operand -> Operand -> Instr
SUB Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
rsp)
, Format -> Operand -> Operand -> Instr
TEST Format
II64 (Reg -> Operand
OpReg Reg
rsp) (Reg -> Operand
OpReg Reg
rsp)
]
Arch
_ -> forall a. String -> a
panic String
"X86.mkStackAllocInstr"
OS
_ ->
case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> [ Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
esp) ]
Arch
ArchX86_64 -> [ Format -> Operand -> Operand -> Instr
SUB Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
rsp) ]
Arch
_ -> forall a. String -> a
panic String
"X86.mkStackAllocInstr"
mkStackDeallocInstr
:: Platform
-> Int
-> [Instr]
mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr Platform
platform Int
amount
= case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> [Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
esp)]
Arch
ArchX86_64 -> [Format -> Operand -> Operand -> Instr
ADD Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
amount)) (Reg -> Operand
OpReg Reg
rsp)]
Arch
_ -> forall a. String -> a
panic String
"X86.mkStackDeallocInstr"
allocMoreStack
:: Platform
-> Int
-> NatCmmDecl statics GHC.CmmToAsm.X86.Instr.Instr
-> UniqSM (NatCmmDecl statics GHC.CmmToAsm.X86.Instr.Instr, [(BlockId,BlockId)])
allocMoreStack :: forall statics.
Platform
-> Int
-> NatCmmDecl statics Instr
-> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
allocMoreStack Platform
_ Int
_ top :: NatCmmDecl statics Instr
top@(CmmData Section
_ statics
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (NatCmmDecl statics Instr
top,[])
allocMoreStack Platform
platform Int
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 :: * -> *). MonadUnique m => m [Unique]
getUniquesM
let
delta :: Int
delta = ((Int
x forall a. Num a => a -> a -> a
+ Int
stackAlign forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`quot` Int
stackAlign) forall a. Num a => a -> a -> a
* Int
stackAlign
where x :: Int
x = Int
slots forall a. Num a => a -> a -> a
* Platform -> Int
spillSlotSize Platform
platform
alloc :: [Instr]
alloc = Platform -> Int -> [Instr]
mkStackAllocInstr Platform
platform Int
delta
dealloc :: [Instr]
dealloc = Platform -> Int -> [Instr]
mkStackDeallocInstr Platform
platform Int
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_insns :: GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insns (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]
++ [Cond -> BlockId -> Instr
JXX Cond
ALWAYS 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
JMP Operand
_ [Reg]
_ -> [Instr]
dealloc forall a. [a] -> [a] -> [a]
++ (Instr
insn forall a. a -> [a] -> [a]
: [Instr]
r)
JXX_GBL Cond
_ Imm
_ -> forall a. String -> a
panic String
"insert_dealloc: cannot handle JXX_GBL"
Instr
_other -> Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
insn BlockId -> BlockId
retarget 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_insns [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 JumpDest = DestBlockId BlockId | DestImm Imm
instance Outputable JumpDest where
ppr :: JumpDest -> SDoc
ppr (DestBlockId BlockId
bid) = String -> SDoc
text String
"jd<blk>:" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr BlockId
bid
ppr (DestImm Imm
_imm) = String -> SDoc
text String
"jd<imm>:noShow"
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId (DestBlockId BlockId
bid) = forall a. a -> Maybe a
Just BlockId
bid
getJumpDestBlockId JumpDest
_ = forall a. Maybe a
Nothing
canShortcut :: Instr -> Maybe JumpDest
canShortcut :: Instr -> Maybe JumpDest
canShortcut (JXX Cond
ALWAYS BlockId
id) = forall a. a -> Maybe a
Just (BlockId -> JumpDest
DestBlockId BlockId
id)
canShortcut (JMP (OpImm Imm
imm) [Reg]
_) = forall a. a -> Maybe a
Just (Imm -> JumpDest
DestImm Imm
imm)
canShortcut Instr
_ = forall a. Maybe a
Nothing
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump BlockId -> Maybe JumpDest
fn Instr
insn = (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' BlockId -> Maybe JumpDest
fn (forall set. IsSet set => set
setEmpty :: LabelSet) Instr
insn
where
shortcutJump' :: (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' :: (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' BlockId -> Maybe JumpDest
fn LabelSet
seen insn :: Instr
insn@(JXX Cond
cc BlockId
id) =
if forall set. IsSet set => ElemOf set -> set -> Bool
setMember BlockId
id LabelSet
seen then Instr
insn
else case BlockId -> Maybe JumpDest
fn BlockId
id of
Maybe JumpDest
Nothing -> Instr
insn
Just (DestBlockId BlockId
id') -> (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' BlockId -> Maybe JumpDest
fn LabelSet
seen' (Cond -> BlockId -> Instr
JXX Cond
cc BlockId
id')
Just (DestImm Imm
imm) -> (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' BlockId -> Maybe JumpDest
fn LabelSet
seen' (Cond -> Imm -> Instr
JXX_GBL Cond
cc Imm
imm)
where seen' :: LabelSet
seen' = forall set. IsSet set => ElemOf set -> set -> set
setInsert BlockId
id LabelSet
seen
shortcutJump' BlockId -> Maybe JumpDest
fn LabelSet
_ (JMP_TBL Operand
addr [Maybe JumpDest]
blocks Section
section CLabel
tblId) =
let updateBlock :: Maybe JumpDest -> Maybe JumpDest
updateBlock (Just (DestBlockId BlockId
bid)) =
case BlockId -> Maybe JumpDest
fn BlockId
bid of
Maybe JumpDest
Nothing -> forall a. a -> Maybe a
Just (BlockId -> JumpDest
DestBlockId BlockId
bid )
Just JumpDest
dest -> forall a. a -> Maybe a
Just JumpDest
dest
updateBlock Maybe JumpDest
dest = Maybe JumpDest
dest
blocks' :: [Maybe JumpDest]
blocks' = forall a b. (a -> b) -> [a] -> [b]
map Maybe JumpDest -> Maybe JumpDest
updateBlock [Maybe JumpDest]
blocks
in Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL Operand
addr [Maybe JumpDest]
blocks' Section
section CLabel
tblId
shortcutJump' BlockId -> Maybe JumpDest
_ LabelSet
_ Instr
other = Instr
other
shortcutStatics :: (BlockId -> Maybe JumpDest) -> (Alignment, RawCmmStatics) -> (Alignment, RawCmmStatics)
shortcutStatics :: (BlockId -> Maybe JumpDest)
-> (Alignment, RawCmmStatics) -> (Alignment, RawCmmStatics)
shortcutStatics BlockId -> Maybe JumpDest
fn (Alignment
align, CmmStaticsRaw CLabel
lbl [CmmStatic]
statics)
= (Alignment
align, forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic BlockId -> Maybe JumpDest
fn) [CmmStatic]
statics)
shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel BlockId -> Maybe JumpDest
fn CLabel
lab
| Just BlockId
blkId <- CLabel -> Maybe BlockId
maybeLocalBlockLabel CLabel
lab = (BlockId -> Maybe JumpDest) -> UniqSet Unique -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn forall a. UniqSet a
emptyUniqSet BlockId
blkId
| Bool
otherwise = CLabel
lab
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic BlockId -> Maybe JumpDest
fn (CmmStaticLit (CmmLabel CLabel
lab))
= CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CmmLit
CmmLabel ((BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel BlockId -> Maybe JumpDest
fn CLabel
lab))
shortcutStatic BlockId -> Maybe JumpDest
fn (CmmStaticLit (CmmLabelDiffOff CLabel
lbl1 CLabel
lbl2 Int
off Width
w))
= CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff ((BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel BlockId -> Maybe JumpDest
fn CLabel
lbl1) CLabel
lbl2 Int
off Width
w)
shortcutStatic BlockId -> Maybe JumpDest
_ CmmStatic
other_static
= CmmStatic
other_static
shortBlockId
:: (BlockId -> Maybe JumpDest)
-> UniqSet Unique
-> BlockId
-> CLabel
shortBlockId :: (BlockId -> Maybe JumpDest) -> UniqSet Unique -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn UniqSet Unique
seen BlockId
blockid =
case (forall a. Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet Unique
uq UniqSet Unique
seen, BlockId -> Maybe JumpDest
fn BlockId
blockid) of
(Bool
True, Maybe JumpDest
_) -> BlockId -> CLabel
blockLbl BlockId
blockid
(Bool
_, Maybe JumpDest
Nothing) -> BlockId -> CLabel
blockLbl BlockId
blockid
(Bool
_, Just (DestBlockId BlockId
blockid')) -> (BlockId -> Maybe JumpDest) -> UniqSet Unique -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn (forall a. Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet UniqSet Unique
seen Unique
uq) BlockId
blockid'
(Bool
_, Just (DestImm (ImmCLbl CLabel
lbl))) -> CLabel
lbl
(Bool
_, Maybe JumpDest
_other) -> forall a. String -> a
panic String
"shortBlockId"
where uq :: Unique
uq = forall a. Uniquable a => a -> Unique
getUnique BlockId
blockid