ghc-9.14.1: GHC/CmmToAsm/X86/Instr.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
--
-- Machine-dependent assembly language
--
-- (c) The University of Glasgow 1993-2004
--
-----------------------------------------------------------------------------
module GHC.CmmToAsm.X86.Instr
( Instr(..)
, Operand(..)
, PrefetchVariant(..)
, FMAPermutation(..)
, JumpDest(..)
, getJumpDestBlockId
, canShortcut
, shortcutStatics
, shortcutJump
, allocMoreStack
, maxSpillSlots
, archWordFormat
, takeRegRegMoveInstr
, regUsageOfInstr
, takeDeltaInstr
, mkLoadInstr
, mkJumpInstr
, mkStackAllocInstr
, mkStackDeallocInstr
, mkSpillInstr
, mkRegRegMoveInstr
, movInstr
, jumpDestsOfInstr
, canFallthroughTo
, patchRegsOfInstr
, patchJumpInstr
, isMetaInstr
, isJumpishInstr
, MinOrMax(..), MinMaxType(..)
)
where
import GHC.Prelude
import GHC.Data.FastString
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
import GHC.Platform.Reg
import GHC.Platform.Reg.Class.Unified
import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Label
import GHC.Platform.Regs
import GHC.Cmm
import GHC.Utils.Constants ( debugIsOn )
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.DSM
import GHC.Types.Basic (Alignment)
import GHC.Cmm.DebugBlock (UnwindTable)
import GHC.Utils.Misc ( HasDebugCallStack )
import GHC.Data.Maybe
-- Format of an x86/x86_64 memory address, in bytes.
--
archWordFormat :: Bool -> Format
archWordFormat is32Bit
| is32Bit = II32
| otherwise = II64
-- -----------------------------------------------------------------------------
-- Intel x86 instructions
data Instr
-- comment pseudo-op
= COMMENT FastString
-- location pseudo-op (file, line, col, name)
| LOCATION Int Int Int String
-- some static data spat out during code
-- generation. Will be extracted before
-- pretty-printing.
| LDATA Section (Alignment, 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
-- unwinding information
-- See Note [Unwinding information in the NCG].
| UNWIND CLabel UnwindTable
-- specify current stack offset for benefit of subsequent passes.
-- This carries a BlockId so it can be used in unwinding information.
| DELTA Int
-- | X86 scalar move instruction.
--
-- When used at a vector format, only moves the lower 64 bits of data;
-- the rest of the data in the destination may either be zeroed or
-- preserved, depending on the specific format and operands.
| MOV Format Operand Operand
-- N.B. Due to AT&T assembler quirks, when used with 'II64'
-- 'Format' immediate source and memory target operand, the source
-- operand is interpreted to be a 32-bit sign-extended value.
-- True 64-bit operands need to be either first moved to a register or moved
-- with @MOVABS@; we currently do not use this instruction in GHC.
-- See https://stackoverflow.com/questions/52434073/whats-the-difference-between-the-x86-64-att-instructions-movq-and-movabsq.
-- | MOVD/MOVQ SSE2 instructions
-- (bitcast between a general purpose register and a float register).
| MOVD
Format -- ^ input format
Format -- ^ output format
Operand Operand
-- NB: MOVD stores both the input and output formats. This is because
-- neither format fully determines the other, as either might be
-- a vector format, and we need to know the exact format in order to
-- correctly spill/unspill. See #25659.
| CMOV Cond Format Operand Reg
| MOVZxL Format Operand Operand
-- ^ The format argument is the size of operand 1 (the number of bits we keep)
-- We always zero *all* high bits, even though this isn't how the actual instruction
-- works. The code generator also seems to rely on this behaviour and it's faster
-- to execute on many cpus as well so for now I'm just documenting the fact.
| MOVSxL Format Operand Operand -- format is the size of operand 1
-- x86_64 note: plain mov into a 32-bit register always zero-extends
-- into the 64-bit reg, in contrast to the 8 and 16-bit movs which
-- don't affect the high bits of the register.
-- Load effective address (also a very useful three-operand add instruction :-)
| LEA Format Operand Operand
-- Int Arithmetic.
| ADD Format Operand Operand
| ADC Format Operand Operand
| SUB Format Operand Operand
| SBB Format Operand Operand
| MUL Format Operand Operand
| MUL2 Format Operand -- %edx:%eax = operand * %rax
| IMUL Format Operand Operand -- signed int mul
| IMUL2 Format Operand -- %edx:%eax = operand * %eax
| DIV Format Operand -- eax := eax:edx/op, edx := eax:edx%op
| IDIV Format Operand -- ditto, but signed
-- Int Arithmetic, where the effects on the condition register
-- are important. Used in specialized sequences such as MO_Add2.
-- Do not rewrite these instructions to "equivalent" ones that
-- have different effect on the condition register! (See #9013.)
| ADD_CC Format Operand Operand
| SUB_CC Format Operand Operand
-- Simple bit-twiddling.
| AND Format Operand Operand
| OR Format Operand Operand
| XOR Format Operand Operand
-- | AVX bitwise logical XOR operation
| VXOR Format Operand Reg Reg
| NOT Format Operand
| NEGI Format Operand -- NEG instruction (name clash with Cond)
| BSWAP Format Reg
-- Shifts (amount may be immediate or %cl only)
| SHL Format Operand{-amount-} Operand
| SAR Format Operand{-amount-} Operand
| SHR Format Operand{-amount-} Operand
| SHRD Format Operand{-amount-} Operand Operand
| SHLD Format Operand{-amount-} Operand Operand
| BT Format Imm Operand
| NOP
-- We need to support the FSTP (x87 store and pop) instruction
-- so that we can correctly read off the return value of an
-- x86 CDECL C function call when its floating point.
-- so we don't include a register argument, and just use st(0)
-- this instruction is used ONLY for return values of C ffi calls
-- in x86_32 abi
| X87Store Format AddrMode -- st(0), dst
-- SSE2 floating point: we use a restricted set of the available SSE2
-- instructions for floating-point.
-- use MOV for moving (either movss or movsd (movlpd better?))
| CVTSS2SD Reg Reg -- F32 to F64
| CVTSD2SS Reg Reg -- F64 to F32
| CVTTSS2SIQ Format Operand Reg -- F32 to I32/I64 (with truncation)
| CVTTSD2SIQ Format Operand Reg -- F64 to I32/I64 (with truncation)
| CVTSI2SS Format Operand Reg -- I32/I64 to F32
| CVTSI2SD Format Operand Reg -- I32/I64 to F64
-- | FMA3 fused multiply-add operations.
| FMA3 Format FMASign FMAPermutation Operand Reg Reg
-- For the FMA213 permutation (the only one we use currently),
-- this is: src3 (r/m), src2 (r), dst/src1 (r)
-- (NB: this isexactly reversed from how Intel lists the arguments.)
-- use ADD, SUB, and SQRT for arithmetic. In both cases, operands
-- are Operand Reg.
-- SSE2 floating-point division:
| FDIV Format Operand Reg -- divisor, dividend(dst)
-- use CMP for comparisons. ucomiss and ucomisd instructions
-- compare single/double prec floating point respectively.
| SQRT Format Operand Reg -- src, dst
-- Comparison
| TEST Format Operand Operand
| CMP Format Operand Operand
| SETCC Cond Operand
-- Stack Operations.
| PUSH Format Operand
| POP Format Operand
-- both unused (SDM):
-- | PUSHA
-- | POPA
-- Jumping around.
| JMP Operand [RegWithFormat] -- including live Regs at the call
| JXX Cond BlockId -- includes unconditional branches
| JXX_GBL Cond Imm -- non-local version of JXX
-- Table jump
| JMP_TBL Operand -- Address to jump to
[Maybe JumpDest] -- Targets of the jump table
Section -- Data section jump table should be put in
CLabel -- Label of jump table
-- | X86 call instruction
| CALL (Either Imm Reg) -- ^ Jump target
[RegWithFormat] -- ^ Arguments (required for register allocation)
-- Other things.
| CLTD Format -- sign extend %eax into %edx:%eax
| FETCHGOT Reg -- pseudo-insn for ELF position-independent code
-- pretty-prints as
-- call 1f
-- 1: popl %reg
-- addl __GLOBAL_OFFSET_TABLE__+.-1b, %reg
| FETCHPC Reg -- pseudo-insn for Darwin position-independent code
-- pretty-prints as
-- call 1f
-- 1: popl %reg
-- bit counting instructions
| POPCNT Format Operand Reg -- [SSE4.2] count number of bits set to 1
| LZCNT Format Operand Reg -- [BMI2] count number of leading zeros
| TZCNT Format Operand Reg -- [BMI2] count number of trailing zeros
| BSF Format Operand Reg -- bit scan forward
| BSR Format Operand Reg -- bit scan reverse
-- bit manipulation instructions
| PDEP Format Operand Operand Reg -- [BMI2] deposit bits to the specified mask
| PEXT Format Operand Operand Reg -- [BMI2] extract bits from the specified mask
-- prefetch
| PREFETCH PrefetchVariant Format Operand -- prefetch Variant, addr size, address to prefetch
-- variant can be NTA, Lvl0, Lvl1, or Lvl2
| LOCK Instr -- lock prefix
| XADD Format Operand Operand -- src (r), dst (r/m)
| CMPXCHG Format Operand Operand -- src (r), dst (r/m), eax implicit
| XCHG Format Operand Reg -- src (r/m), dst (r/m)
| MFENCE
-- Vector Instructions --
-- NOTE: Instructions follow the AT&T syntax
-- Constructors and deconstructors
| VBROADCAST Format Operand Reg
| VPBROADCAST Format Format Operand Reg -- scalar format, vector format, source, destination
| VEXTRACT Format Imm Reg Operand
| INSERTPS Format Imm Operand Reg
| VINSERTPS Format Imm Operand Reg Reg
| PINSR Format Format Imm Operand Reg -- scalar format, vector format, offset, scalar src, vector
| PEXTR Format Format Imm Reg Operand -- scalar format, vector format, offset, vector src, scalar dst
-- move operations
-- | SSE2 unaligned move of floating-point vectors
| MOVU Format Operand Operand
-- | AVX unaligned move of floating-point vectors
| VMOVU Format Operand Operand
-- | SSE2 move between memory and low-part of an xmm register
| MOVL Format Operand Operand
-- | SSE move between memory and high-part of an xmm register
| MOVH Format Operand Operand
-- | SSE2 unaligned move of integer vectors
| MOVDQU Format Operand Operand
-- | AVX unaligned move of integer vectors
| VMOVDQU Format Operand Operand
-- | Alias for VMOVSS/VMOVSD, used to merge two vectors
| VMOV_MERGE Format Reg Reg Reg
-- logic operations
| PXOR Format Operand Reg
| VPXOR Format Reg Reg Reg
| PAND Format Operand Reg
| PANDN Format Operand Reg
| POR Format Operand Reg
-- Arithmetic
| VADD Format Operand Reg Reg
| VSUB Format Operand Reg Reg
| VMUL Format Operand Reg Reg
| VDIV Format Operand Reg Reg
| PADD Format Operand Reg
| PSUB Format Operand Reg
| PMULL Format Operand Reg
| PMULUDQ Format Operand Reg
-- SIMD compare
| PCMPGT Format Operand Reg
-- Shuffle
| SHUF Format Imm Operand Reg
| VSHUF Format Imm Operand Reg Reg
| PSHUFB Format Operand Reg
| PSHUFLW Format Imm Operand Reg
| PSHUFHW Format Imm Operand Reg
| PSHUFD Format Imm Operand Reg
| VPSHUFD Format Imm Operand Reg
| BLEND Format Imm Operand Reg
| VBLEND Format Imm Operand Reg Reg
| PBLENDW Format Imm Operand Reg
-- | Move two 32-bit floats from the high part of an xmm register
-- to the low part of another xmm register.
--
-- If the format is a vector format, the destination register is treated as the second source.
-- If the format is FF32 or FF64, the destination register is not treated as a source.
| MOVHLPS Format Reg Reg
| VMOVHLPS Format Reg Reg Reg
| MOVLHPS Format Reg Reg
| VMOVLHPS Format Reg Reg Reg
| UNPCKL Format Operand Reg
| VUNPCKL Format Operand Reg Reg
| UNPCKH Format Operand Reg
| VUNPCKH Format Operand Reg Reg
| PUNPCKLQDQ Format Operand Reg
| PUNPCKLDQ Format Operand Reg
| PUNPCKLWD Format Operand Reg
| PUNPCKLBW Format Operand Reg
| PUNPCKHQDQ Format Operand Reg
| PUNPCKHDQ Format Operand Reg
| PUNPCKHWD Format Operand Reg
| PUNPCKHBW Format Operand Reg
| PACKUSWB Format Operand Reg
-- Shift
| PSLL Format Operand Reg
| PSLLDQ Format Imm Reg
| PSRL Format Operand Reg
| PSRLDQ Format Imm Reg
| PALIGNR Format Imm Operand Reg
-- min/max
| MINMAX MinOrMax MinMaxType Format Operand Reg
| VMINMAX MinOrMax MinMaxType Format Operand Reg Reg
data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
-- | 'MIN' or 'MAX'
data MinOrMax = Min | Max
deriving ( Eq, Show )
-- | What kind of min/max operation: signed or unsigned vector integer min/max,
-- or (scalar or vector) floating point min/max?
data MinMaxType =
IntVecMinMax { minMaxSigned :: Bool } | FloatMinMax
deriving ( Eq, Show )
data Operand
= OpReg Reg -- register
| OpImm Imm -- immediate value
| OpAddr AddrMode -- memory reference
-- NB: As of 2023 we only use the FMA213 permutation.
data FMAPermutation = FMA132 | FMA213 | FMA231
-- | Returns which registers are read and written as a (read, written)
-- pair.
regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr platform instr
= case instr of
MOV fmt src dst
-- MOVSS/MOVSD preserve the upper half of vector registers,
-- but only for reg-2-reg moves
| VecFormat _ sFmt <- fmt
, isFloatScalarFormat sFmt
, OpReg {} <- src
, OpReg {} <- dst
-> usageRM fmt src dst
-- other MOV instructions zero any remaining upper part of the destination
-- (largely to avoid partial register stalls)
| otherwise
-> usageRW fmt src dst
MOVD fmt1 fmt2 src dst ->
-- NB: MOVD and MOVQ always zero any remaining upper part of destination,
-- so the destination is "written" not "modified".
usageRW' fmt1 fmt2 src dst
CMOV _ fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
MOVZxL fmt src dst -> usageRW fmt src dst
MOVSxL fmt src dst -> usageRW fmt src dst
LEA fmt src dst -> usageRW fmt src dst
ADD fmt src dst -> usageRM fmt src dst
ADC fmt src dst -> usageRM fmt src dst
SUB fmt src dst -> usageRM fmt src dst
SBB fmt src dst -> usageRM fmt src dst
IMUL fmt src dst -> usageRM fmt src dst
-- Result of IMULB will be in just in %ax
IMUL2 II8 src -> mkRU (mk II8 eax:use_R II8 src []) [mk II8 eax]
-- Result of IMUL for wider values, will be split between %dx/%edx/%rdx and
-- %ax/%eax/%rax.
IMUL2 fmt src -> mkRU (mk fmt eax:use_R fmt src []) [mk fmt eax,mk fmt edx]
MUL fmt src dst -> usageRM fmt src dst
MUL2 fmt src -> mkRU (mk fmt eax:use_R fmt src []) [mk fmt eax,mk fmt edx]
DIV fmt op -> mkRU (mk fmt eax:mk fmt edx:use_R fmt op []) [mk fmt eax, mk fmt edx]
IDIV fmt op -> mkRU (mk fmt eax:mk fmt edx:use_R fmt op []) [mk fmt eax, mk fmt edx]
ADD_CC fmt src dst -> usageRM fmt src dst
SUB_CC fmt src dst -> usageRM fmt src dst
AND fmt src dst -> usageRM fmt src dst
OR fmt src dst -> usageRM fmt src dst
XOR fmt (OpReg src) (OpReg dst)
| src == dst
-> mkRU [] [mk fmt dst]
XOR fmt src dst
-> usageRM fmt src dst
VXOR fmt (OpReg src1) src2 dst
| src1 == src2, src1 == dst
-> mkRU [] [mk fmt dst]
VXOR fmt src1 src2 dst
-> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst]
NOT fmt op -> usageM fmt op
BSWAP fmt reg -> mkRU [mk fmt reg] [mk fmt reg]
NEGI fmt op -> usageM fmt op
SHL fmt imm dst -> usageRM fmt imm dst
SAR fmt imm dst -> usageRM fmt imm dst
SHR fmt imm dst -> usageRM fmt imm dst
SHLD fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
SHRD fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
BT fmt _ src -> mkRUR (use_R fmt src [])
PUSH fmt op -> mkRUR (use_R fmt op [])
POP fmt op -> mkRU [] (def_W fmt op)
TEST fmt src dst -> mkRUR (use_R fmt src $! use_R fmt dst [])
CMP fmt src dst -> mkRUR (use_R fmt src $! use_R fmt dst [])
SETCC _ op -> mkRU [] (def_W II8 op)
JXX _ _ -> mkRU [] []
JXX_GBL _ _ -> mkRU [] []
JMP op regs -> mkRU (use_R addrFmt op regs) []
JMP_TBL op _ _ _ -> mkRU (use_R addrFmt op []) []
CALL (Left _) params -> mkRU params (map mkFmt $ callClobberedRegs platform)
CALL (Right reg) params -> mkRU (mk addrFmt reg:params) (map mkFmt $ callClobberedRegs platform)
CLTD fmt -> mkRU [mk fmt eax] [mk fmt edx]
NOP -> mkRU [] []
X87Store _fmt dst -> mkRUR (use_EA dst [])
CVTSS2SD src dst -> mkRU [mk FF32 src] [mk FF64 dst]
CVTSD2SS src dst -> mkRU [mk FF64 src] [mk FF32 dst]
CVTTSS2SIQ fmt src dst -> mkRU (use_R FF32 src []) [mk fmt dst]
CVTTSD2SIQ fmt src dst -> mkRU (use_R FF64 src []) [mk fmt dst]
CVTSI2SS fmt src dst -> mkRU (use_R fmt src []) [mk FF32 dst]
CVTSI2SD fmt src dst -> mkRU (use_R fmt src []) [mk FF64 dst]
FDIV fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
SQRT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
FETCHGOT reg -> mkRU [] [mk addrFmt reg]
FETCHPC reg -> mkRU [] [mk addrFmt reg]
COMMENT _ -> noUsage
LOCATION{} -> noUsage
UNWIND{} -> noUsage
DELTA _ -> noUsage
POPCNT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
LZCNT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
TZCNT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
BSF fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
BSR fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
PDEP fmt src mask dst -> mkRU (use_R fmt src $ use_R fmt mask []) [mk fmt dst]
PEXT fmt src mask dst -> mkRU (use_R fmt src $ use_R fmt mask []) [mk fmt dst]
FMA3 fmt _ _ src3 src2 dst -> usageFMA fmt src3 src2 dst
-- note: might be a better way to do this
PREFETCH _ fmt src -> mkRU (use_R fmt src []) []
LOCK i -> regUsageOfInstr platform i
XADD fmt src dst -> usageMM fmt src dst
CMPXCHG fmt src dst -> usageRMM fmt src dst (OpReg eax)
XCHG fmt src dst -> usageMM fmt src (OpReg dst)
MFENCE -> noUsage
-- vector instructions
VBROADCAST fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst]
VPBROADCAST sFmt vFmt src dst -> mkRU (use_R sFmt src []) [mk vFmt dst]
VEXTRACT fmt _off src dst -> usageRW fmt (OpReg src) dst
INSERTPS fmt (ImmInt off) src dst
-> mkRU ((use_R fmt src []) ++ [mk fmt dst | not doesNotReadDst]) [mk fmt dst]
where
-- Compute whether the instruction reads the destination register or not.
-- Immediate bits: ss_dd_zzzz s = src pos, d = dst pos, z = zeroed components.
doesNotReadDst = and [ testBit off i | i <- [0, 1, 2, 3], i /= pos ]
-- Check whether the positions in which we are not inserting
-- are being zeroed.
where pos = ( off `shiftR` 4 ) .&. 0b11
INSERTPS fmt _off src dst
-> mkRU ((use_R fmt src []) ++ [mk fmt dst]) [mk fmt dst]
VINSERTPS fmt _imm src2 src1 dst
-> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst]
PINSR sFmt vFmt _off src dst
-> mkRU (use_R sFmt src [mk vFmt dst]) [mk vFmt dst]
PEXTR sFmt vFmt _off src dst
-> usageRW' vFmt sFmt (OpReg src) dst
VMOVU fmt src dst -> usageRW fmt src dst
MOVU fmt src dst -> usageRW fmt src dst
MOVL fmt src dst -> usageRM fmt src dst
MOVH fmt src dst -> usageRM fmt src dst
MOVDQU fmt src dst -> usageRW fmt src dst
VMOVDQU fmt src dst -> usageRW fmt src dst
VMOV_MERGE fmt src2 src1 dst -> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst]
PXOR fmt (OpReg src) dst
| src == dst
-> mkRU [] [mk fmt dst]
| otherwise
-> mkRU [mk fmt src, mk fmt dst] [mk fmt dst]
VPXOR fmt s1 s2 dst
| s1 == s2, s1 == dst
-> mkRU [] [mk fmt dst]
| otherwise
-> mkRU [mk fmt s1, mk fmt s2] [mk fmt dst]
PAND fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PANDN fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
POR fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VADD fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst]
VSUB fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst]
VMUL fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst]
VDIV fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst]
PADD fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PSUB fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PMULL fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PMULUDQ fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PCMPGT fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
SHUF fmt _mask src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VSHUF fmt _mask src1 src2 dst
-> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst]
PSHUFB fmt mask dst
-> mkRU (use_R fmt mask [mk fmt dst]) [mk fmt dst]
PSHUFLW fmt _mask src dst
-> mkRU (use_R fmt src []) [mk fmt dst]
PSHUFHW fmt _mask src dst
-> mkRU (use_R fmt src []) [mk fmt dst]
PSHUFD fmt _mask src dst
-> mkRU (use_R fmt src []) [mk fmt dst]
VPSHUFD fmt _mask src dst
-> mkRU (use_R fmt src []) [mk fmt dst]
BLEND fmt _mask src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VBLEND fmt _mask src2 src1 dst
-> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst]
PBLENDW fmt _mask src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PSLL fmt off dst -> mkRU (use_R fmt off [mk fmt dst]) [mk fmt dst]
PSLLDQ fmt _off dst -> mkRU [mk fmt dst] [mk fmt dst]
PSRL fmt off dst -> mkRU (use_R fmt off [mk fmt dst]) [mk fmt dst]
PSRLDQ fmt _off dst -> mkRU [mk fmt dst] [mk fmt dst]
PALIGNR fmt _off src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
MOVHLPS fmt src dst
-> case fmt of
VecFormat {} -> mkRU [mk fmt src, mk fmt dst] [mk fmt dst]
-- MOVHLPS moves the high 64 bits of src to the low 64 bits of dst,
-- keeping the high 64 bits of dst intact.
-- If we only care about the lower 64 bits of the result,
-- dst is only written to, not read.
FF64 -> mkRU [mk (VecFormat 2 FmtDouble) src] [mk fmt dst]
FF32 -> mkRU [mk (VecFormat 4 FmtFloat) src] [mk fmt dst]
_ -> pprPanic "regUsage: invalid format for MOVHLPS" (ppr fmt)
VMOVHLPS fmt src2 src1 dst
-> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst]
MOVLHPS fmt src dst
-> mkRU [mk fmt src, mk fmt dst] [mk fmt dst]
VMOVLHPS fmt src2 src1 dst
-> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst]
UNPCKL fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VUNPCKL fmt src2 src1 dst
-> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst]
UNPCKH fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VUNPCKH fmt src2 src1 dst
-> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst]
PUNPCKLQDQ fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKLDQ fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKLWD fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKLBW fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKHQDQ fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKHDQ fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKHWD fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PUNPCKHBW fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
PACKUSWB fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
MINMAX _ _ fmt src dst
-> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
VMINMAX _ _ fmt src1 src2 dst
-> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst]
_other -> panic "regUsage: unrecognised instr"
where
-- # Definitions
--
-- Written: If the operand is a register, it's written. If it's an
-- address, registers mentioned in the address are read.
--
-- Modified: If the operand is a register, it's both read and
-- written. If it's an address, registers mentioned in the address
-- are read.
-- 2 operand form; first operand Read; second Written
usageRW :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageRW fmt op (OpReg reg) = mkRU (use_R fmt op []) [mk fmt reg]
usageRW fmt op (OpAddr ea) = mkRUR (use_R fmt op $! use_EA ea [])
usageRW _ _ _ = panic "X86.RegInfo.usageRW: no match"
usageRW' :: HasDebugCallStack => Format -> Format -> Operand -> Operand -> RegUsage
usageRW' fmt1 fmt2 op (OpReg reg) = mkRU (use_R fmt1 op []) [mk fmt2 reg]
usageRW' fmt1 _ op (OpAddr ea) = mkRUR (use_R fmt1 op $! use_EA ea [])
usageRW' _ _ _ _ = panic "X86.RegInfo.usageRW: no match"
-- 2 operand form; first operand Read; second Modified
usageRM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageRM fmt op (OpReg reg) = mkRU (use_R fmt op [mk fmt reg]) [mk fmt reg]
usageRM fmt op (OpAddr ea) = mkRUR (use_R fmt op $! use_EA ea [])
usageRM _ _ _ = panic "X86.RegInfo.usageRM: no match"
-- 2 operand form; first operand Modified; second Modified
usageMM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageMM fmt (OpReg src) (OpReg dst) = mkRU [mk fmt src, mk fmt dst] [mk fmt src, mk fmt dst]
usageMM fmt (OpReg src) (OpAddr ea) = mkRU (use_EA ea [mk fmt src]) [mk fmt src]
usageMM fmt (OpAddr ea) (OpReg dst) = mkRU (use_EA ea [mk fmt dst]) [mk fmt dst]
usageMM _ _ _ = panic "X86.RegInfo.usageMM: no match"
-- 3 operand form; first operand Read; second Modified; third Modified
usageRMM :: HasDebugCallStack => Format -> Operand -> Operand -> Operand -> RegUsage
usageRMM fmt (OpReg src) (OpReg dst) (OpReg reg) = mkRU [mk fmt src, mk fmt dst, mk fmt reg] [mk fmt dst, mk fmt reg]
usageRMM fmt (OpReg src) (OpAddr ea) (OpReg reg) = mkRU (use_EA ea [mk fmt src, mk fmt reg]) [mk fmt reg]
usageRMM _ _ _ _ = panic "X86.RegInfo.usageRMM: no match"
-- 3 operand form of FMA instructions.
usageFMA :: HasDebugCallStack => Format -> Operand -> Reg -> Reg -> RegUsage
usageFMA fmt (OpReg src1) src2 dst =
mkRU [mk fmt src1, mk fmt src2, mk fmt dst] [mk fmt dst]
usageFMA fmt (OpAddr ea1) src2 dst
= mkRU (use_EA ea1 [mk fmt src2, mk fmt dst]) [mk fmt dst]
usageFMA _ _ _ _
= panic "X86.RegInfo.usageFMA: no match"
-- 1 operand form; operand Modified
usageM :: HasDebugCallStack => Format -> Operand -> RegUsage
usageM fmt (OpReg reg) =
let r' = mk fmt reg
in mkRU [r'] [r']
usageM _ (OpAddr ea) = mkRUR (use_EA ea [])
usageM _ _ = panic "X86.RegInfo.usageM: no match"
-- Registers defd when an operand is written.
def_W fmt (OpReg reg) = [mk fmt reg]
def_W _ (OpAddr _ ) = []
def_W _ _ = panic "X86.RegInfo.def_W: no match"
-- Registers used when an operand is read.
use_R :: HasDebugCallStack => Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R fmt (OpReg reg) tl = mk fmt reg : tl
use_R _ (OpImm _) tl = tl
use_R _ (OpAddr ea) tl = use_EA ea tl
-- Registers used to compute an effective address.
use_EA (ImmAddr _ _) tl = tl
use_EA (AddrBaseIndex base index _) tl =
use_base base $! use_index index tl
where use_base (EABaseReg r) tl = mk addrFmt r : tl
use_base _ tl = tl
use_index EAIndexNone tl = tl
use_index (EAIndex i _) tl = mk addrFmt i : tl
mkRUR :: [RegWithFormat] -> RegUsage
mkRUR src = mkRU src []
mkRU :: [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU src dst = src' `seq` dst' `seq` RU src' dst'
where src' = filter (interesting platform . regWithFormat_reg) src
dst' = filter (interesting platform . regWithFormat_reg) dst
addrFmt = archWordFormat (target32Bit platform)
mk :: Format -> Reg -> RegWithFormat
mk fmt r = RegWithFormat r fmt
mkFmt :: Reg -> RegWithFormat
mkFmt r = RegWithFormat r $ case targetClassOfReg platform r of
RcInteger -> addrFmt
RcFloatOrVector -> FF64
-- | Is this register interesting for the register allocator?
interesting :: Platform -> Reg -> Bool
interesting _ (RegVirtual _) = True
interesting platform (RegReal (RealRegSingle i)) = freeReg platform i
-- | Applies the supplied function to all registers in instructions.
-- Typically used to change virtual registers to real registers.
patchRegsOfInstr :: HasDebugCallStack => Platform -> Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr platform instr env
= case instr of
MOV fmt src dst -> MOV fmt (patchOp src) (patchOp dst)
MOVD fmt1 fmt2 src dst -> patch2 (MOVD fmt1 fmt2) src dst
CMOV cc fmt src dst -> CMOV cc fmt (patchOp src) (env dst)
MOVZxL fmt src dst -> patch2 (MOVZxL fmt) src dst
MOVSxL fmt src dst -> patch2 (MOVSxL fmt) src dst
LEA fmt src dst -> patch2 (LEA fmt) src dst
ADD fmt src dst -> patch2 (ADD fmt) src dst
ADC fmt src dst -> patch2 (ADC fmt) src dst
SUB fmt src dst -> patch2 (SUB fmt) src dst
SBB fmt src dst -> patch2 (SBB fmt) src dst
IMUL fmt src dst -> patch2 (IMUL fmt) src dst
IMUL2 fmt src -> patch1 (IMUL2 fmt) src
MUL fmt src dst -> patch2 (MUL fmt) src dst
MUL2 fmt src -> patch1 (MUL2 fmt) src
IDIV fmt op -> patch1 (IDIV fmt) op
DIV fmt op -> patch1 (DIV fmt) op
ADD_CC fmt src dst -> patch2 (ADD_CC fmt) src dst
SUB_CC fmt src dst -> patch2 (SUB_CC fmt) src dst
AND fmt src dst -> patch2 (AND fmt) src dst
OR fmt src dst -> patch2 (OR fmt) src dst
XOR fmt src dst -> patch2 (XOR fmt) src dst
VXOR fmt src1 src2 dst -> VXOR fmt (patchOp src1) (env src2) (env dst)
NOT fmt op -> patch1 (NOT fmt) op
BSWAP fmt reg -> BSWAP fmt (env reg)
NEGI fmt op -> patch1 (NEGI fmt) op
SHL fmt imm dst -> patch1 (SHL fmt imm) dst
SAR fmt imm dst -> patch1 (SAR fmt imm) dst
SHR fmt imm dst -> patch1 (SHR fmt imm) dst
SHLD fmt imm dst1 dst2 -> patch2 (SHLD fmt imm) dst1 dst2
SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2
BT fmt imm src -> patch1 (BT fmt imm) src
TEST fmt src dst -> patch2 (TEST fmt) src dst
CMP fmt src dst -> patch2 (CMP fmt) src dst
PUSH fmt op -> patch1 (PUSH fmt) op
POP fmt op -> patch1 (POP fmt) op
SETCC cond op -> patch1 (SETCC cond) op
JMP op regs -> JMP (patchOp op) regs
JMP_TBL op ids s lbl -> JMP_TBL (patchOp op) ids s lbl
FMA3 fmt perm var x1 x2 x3 -> patch3 (FMA3 fmt perm var) x1 x2 x3
-- literally only support storing the top x87 stack value st(0)
X87Store fmt dst -> X87Store fmt (lookupAddr dst)
CVTSS2SD src dst -> CVTSS2SD (env src) (env dst)
CVTSD2SS src dst -> CVTSD2SS (env src) (env dst)
CVTTSS2SIQ fmt src dst -> CVTTSS2SIQ fmt (patchOp src) (env dst)
CVTTSD2SIQ fmt src dst -> CVTTSD2SIQ fmt (patchOp src) (env dst)
CVTSI2SS fmt src dst -> CVTSI2SS fmt (patchOp src) (env dst)
CVTSI2SD fmt src dst -> CVTSI2SD fmt (patchOp src) (env dst)
FDIV fmt src dst -> FDIV fmt (patchOp src) (env dst)
SQRT fmt src dst -> SQRT fmt (patchOp src) (env dst)
CALL (Left _) _ -> instr
CALL (Right reg) p -> CALL (Right (env reg)) p
FETCHGOT reg -> FETCHGOT (env reg)
FETCHPC reg -> FETCHPC (env reg)
NOP -> instr
COMMENT _ -> instr
LOCATION {} -> instr
UNWIND {} -> instr
DELTA _ -> instr
LDATA {} -> instr
NEWBLOCK {} -> instr
JXX _ _ -> instr
JXX_GBL _ _ -> instr
CLTD _ -> instr
POPCNT fmt src dst -> POPCNT fmt (patchOp src) (env dst)
LZCNT fmt src dst -> LZCNT fmt (patchOp src) (env dst)
TZCNT fmt src dst -> TZCNT fmt (patchOp src) (env dst)
PDEP fmt src mask dst -> PDEP fmt (patchOp src) (patchOp mask) (env dst)
PEXT fmt src mask dst -> PEXT fmt (patchOp src) (patchOp mask) (env dst)
BSF fmt src dst -> BSF fmt (patchOp src) (env dst)
BSR fmt src dst -> BSR fmt (patchOp src) (env dst)
PREFETCH lvl format src -> PREFETCH lvl format (patchOp src)
LOCK i -> LOCK (patchRegsOfInstr platform i env)
XADD fmt src dst -> patch2 (XADD fmt) src dst
CMPXCHG fmt src dst -> patch2 (CMPXCHG fmt) src dst
XCHG fmt src dst -> XCHG fmt (patchOp src) (env dst)
MFENCE -> instr
-- vector instructions
VBROADCAST fmt src dst -> VBROADCAST fmt (patchOp src) (env dst)
VPBROADCAST fmt1 fmt2 src dst
-> VPBROADCAST fmt1 fmt2 (patchOp src) (env dst)
VEXTRACT fmt off src dst
-> VEXTRACT fmt off (env src) (patchOp dst)
INSERTPS fmt off src dst
-> INSERTPS fmt off (patchOp src) (env dst)
VINSERTPS fmt off src2 src1 dst
-> VINSERTPS fmt off (patchOp src2) (env src1) (env dst)
PINSR fmt1 fmt2 off src dst
-> PINSR fmt1 fmt2 off (patchOp src) (env dst)
PEXTR fmt1 fmt2 off src dst
-> PEXTR fmt1 fmt2 off (env src) (patchOp dst)
VMOVU fmt src dst -> VMOVU fmt (patchOp src) (patchOp dst)
MOVU fmt src dst -> MOVU fmt (patchOp src) (patchOp dst)
MOVL fmt src dst -> MOVL fmt (patchOp src) (patchOp dst)
MOVH fmt src dst -> MOVH fmt (patchOp src) (patchOp dst)
MOVDQU fmt src dst -> MOVDQU fmt (patchOp src) (patchOp dst)
VMOVDQU fmt src dst -> VMOVDQU fmt (patchOp src) (patchOp dst)
VMOV_MERGE fmt src2 src1 dst -> VMOV_MERGE fmt (env src2) (env src1) (env dst)
PXOR fmt src dst -> PXOR fmt (patchOp src) (env dst)
VPXOR fmt s1 s2 dst -> VPXOR fmt (env s1) (env s2) (env dst)
PAND fmt src dst -> PAND fmt (patchOp src) (env dst)
PANDN fmt src dst -> PANDN fmt (patchOp src) (env dst)
POR fmt src dst -> POR fmt (patchOp src) (env dst)
VADD fmt s1 s2 dst -> VADD fmt (patchOp s1) (env s2) (env dst)
VSUB fmt s1 s2 dst -> VSUB fmt (patchOp s1) (env s2) (env dst)
VMUL fmt s1 s2 dst -> VMUL fmt (patchOp s1) (env s2) (env dst)
VDIV fmt s1 s2 dst -> VDIV fmt (patchOp s1) (env s2) (env dst)
PADD fmt src dst -> PADD fmt (patchOp src) (env dst)
PSUB fmt src dst -> PSUB fmt (patchOp src) (env dst)
PMULL fmt src dst -> PMULL fmt (patchOp src) (env dst)
PMULUDQ fmt src dst -> PMULUDQ fmt (patchOp src) (env dst)
PCMPGT fmt src dst -> PCMPGT fmt (patchOp src) (env dst)
SHUF fmt off src dst
-> SHUF fmt off (patchOp src) (env dst)
VSHUF fmt off src1 src2 dst
-> VSHUF fmt off (patchOp src1) (env src2) (env dst)
PSHUFB fmt mask dst
-> PSHUFB fmt (patchOp mask) (env dst)
PSHUFLW fmt off src dst
-> PSHUFLW fmt off (patchOp src) (env dst)
PSHUFHW fmt off src dst
-> PSHUFHW fmt off (patchOp src) (env dst)
PSHUFD fmt off src dst
-> PSHUFD fmt off (patchOp src) (env dst)
VPSHUFD fmt off src dst
-> VPSHUFD fmt off (patchOp src) (env dst)
BLEND fmt mask src dst
-> BLEND fmt mask (patchOp src) (env dst)
VBLEND fmt mask src2 src1 dst
-> VBLEND fmt mask (patchOp src2) (env src1) (env dst)
PBLENDW fmt mask src dst
-> PBLENDW fmt mask (patchOp src) (env dst)
PSLL fmt off dst
-> PSLL fmt (patchOp off) (env dst)
PSLLDQ fmt off dst
-> PSLLDQ fmt off (env dst)
PSRL fmt off dst
-> PSRL fmt (patchOp off) (env dst)
PSRLDQ fmt off dst
-> PSRLDQ fmt off (env dst)
PALIGNR fmt off src dst
-> PALIGNR fmt off (patchOp src) (env dst)
MOVHLPS fmt src dst
-> MOVHLPS fmt (env src) (env dst)
VMOVHLPS fmt src2 src1 dst
-> VMOVHLPS fmt (env src2) (env src1) (env dst)
MOVLHPS fmt src dst
-> MOVLHPS fmt (env src) (env dst)
VMOVLHPS fmt src2 src1 dst
-> VMOVLHPS fmt (env src2) (env src1) (env dst)
UNPCKL fmt src dst
-> UNPCKL fmt (patchOp src) (env dst)
VUNPCKL fmt src2 src1 dst
-> VUNPCKL fmt (patchOp src2) (env src1) (env dst)
UNPCKH fmt src dst
-> UNPCKH fmt (patchOp src) (env dst)
VUNPCKH fmt src2 src1 dst
-> VUNPCKH fmt (patchOp src2) (env src1) (env dst)
PUNPCKLQDQ fmt src dst
-> PUNPCKLQDQ fmt (patchOp src) (env dst)
PUNPCKLDQ fmt src dst
-> PUNPCKLDQ fmt (patchOp src) (env dst)
PUNPCKLWD fmt src dst
-> PUNPCKLWD fmt (patchOp src) (env dst)
PUNPCKLBW fmt src dst
-> PUNPCKLBW fmt (patchOp src) (env dst)
PUNPCKHQDQ fmt src dst
-> PUNPCKHQDQ fmt (patchOp src) (env dst)
PUNPCKHDQ fmt src dst
-> PUNPCKHDQ fmt (patchOp src) (env dst)
PUNPCKHWD fmt src dst
-> PUNPCKHWD fmt (patchOp src) (env dst)
PUNPCKHBW fmt src dst
-> PUNPCKHBW fmt (patchOp src) (env dst)
PACKUSWB fmt src dst
-> PACKUSWB fmt (patchOp src) (env dst)
MINMAX minMax ty fmt src dst
-> MINMAX minMax ty fmt (patchOp src) (env dst)
VMINMAX minMax ty fmt src1 src2 dst
-> VMINMAX minMax ty fmt (patchOp src1) (env src2) (env dst)
where
patch1 :: (Operand -> a) -> Operand -> a
patch1 insn op = insn $! patchOp op
patch2 :: (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
patch3 :: (Operand -> Reg -> Reg -> a) -> Operand -> Reg -> Reg -> a
patch3 insn src1 src2 dst = ((insn $! patchOp src1) $! env src2) $! env dst
patchOp (OpReg reg) = OpReg $! env reg
patchOp (OpImm imm) = OpImm imm
patchOp (OpAddr ea) = OpAddr $! lookupAddr ea
lookupAddr (ImmAddr imm off) = ImmAddr imm off
lookupAddr (AddrBaseIndex base index disp)
= ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
where
lookupBase EABaseNone = EABaseNone
lookupBase EABaseRip = EABaseRip
lookupBase (EABaseReg r) = EABaseReg $! env r
lookupIndex EAIndexNone = EAIndexNone
lookupIndex (EAIndex r i) = (EAIndex $! env r) i
--------------------------------------------------------------------------------
isJumpishInstr
:: Instr -> Bool
isJumpishInstr instr
= case instr of
JMP{} -> True
JXX{} -> True
JXX_GBL{} -> True
JMP_TBL{} -> True
CALL{} -> True
_ -> False
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo insn bid
= case insn of
JXX _ target -> bid == target
JMP_TBL _ targets _ _ -> all isTargetBid targets
_ -> False
where
isTargetBid target = case target of
Nothing -> True
Just (DestBlockId target) -> target == bid
_ -> False
jumpDestsOfInstr
:: Instr
-> [BlockId]
jumpDestsOfInstr insn
= case insn of
JXX _ id -> [id]
JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
_ -> []
patchJumpInstr
:: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr insn patchF
= case insn of
JXX cc id -> JXX cc (patchF id)
JMP_TBL op ids section lbl
-> JMP_TBL op (map (fmap (patchJumpDest patchF)) ids) section lbl
_ -> insn
where
patchJumpDest f (DestBlockId id) = DestBlockId (f id)
patchJumpDest _ dest = dest
-- -----------------------------------------------------------------------------
-- | Make a spill instruction.
mkSpillInstr
:: HasDebugCallStack
=> NCGConfig
-> RegWithFormat -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
mkSpillInstr config (RegWithFormat reg fmt) delta slot =
[ movInstr config fmt' (OpReg reg) (OpAddr (spRel platform off)) ]
where
fmt'
| isVecFormat fmt
= fmt
| otherwise
= scalarMoveFormat platform fmt
-- Spill the platform word size, at a minimum
platform = ncgPlatform config
off = spillSlotToOffset platform slot - delta
-- | Make a spill reload instruction.
mkLoadInstr
:: HasDebugCallStack
=> NCGConfig
-> RegWithFormat -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> [Instr]
mkLoadInstr config (RegWithFormat reg fmt) delta slot =
[ movInstr config fmt' (OpAddr (spRel platform off)) (OpReg reg) ]
where
fmt'
| isVecFormat fmt
= fmt
| otherwise
= scalarMoveFormat platform fmt
-- Load the platform word size, at a minimum
platform = ncgPlatform config
off = spillSlotToOffset platform slot - delta
-- | A move instruction for moving the entire contents of an operand
-- at the given 'Format'.
movInstr :: HasDebugCallStack => NCGConfig -> Format -> (Operand -> Operand -> Instr)
movInstr config fmt =
case fmt of
VecFormat _ sFmt ->
case formatToWidth fmt of
W512 ->
if avx512f
then avx_move sFmt
else sorry "512-bit wide vectors require -mavx512f"
W256 ->
if avx2
then avx_move sFmt
else sorry "256-bit wide vectors require -mavx2"
W128 ->
if avx
-- Prefer AVX instructions over SSE when available
-- (usually results in better performance).
then avx_move sFmt
else sse_move sFmt
w -> sorry $ "Unhandled SIMD vector width: " ++ show w ++ " bits"
_ -> MOV fmt
where
assertCompatibleRegs :: ( Operand -> Operand -> Instr ) -> Operand -> Operand -> Instr
assertCompatibleRegs f
| debugIsOn
= \ op1 op2 ->
if | OpReg r1 <- op1
, OpReg r2 <- op2
, targetClassOfReg plat r1 /= targetClassOfReg plat r2
-> assertPpr False
( vcat [ text "movInstr: move between incompatible registers"
, text "fmt:" <+> ppr fmt
, text "r1:" <+> ppr r1
, text "r2:" <+> ppr r2 ]
) f op1 op2
| otherwise
-> f op1 op2
| otherwise
= f
plat = ncgPlatform config
avx = ncgAvxEnabled config
avx2 = ncgAvx2Enabled config
avx512f = ncgAvx512fEnabled config
avx_move sFmt =
if isFloatScalarFormat sFmt
then assertCompatibleRegs $
VMOVU fmt
else VMOVDQU fmt
sse_move sFmt =
if isFloatScalarFormat sFmt
then assertCompatibleRegs $
MOVU fmt
else MOVDQU fmt
-- NB: we are using {V}MOVU and not {V}MOVA, because we have no guarantees
-- about the stack being sufficiently aligned (even for even numbered stack slots).
--
-- (Ben Gamari told me that using MOVA instead of MOVU does not make a
-- difference in practice when moving between registers.)
spillSlotSize :: Platform -> Int
spillSlotSize platform
| target32Bit platform = 12
| otherwise = 8
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots config
= ((ncgSpillPreallocSize config - 64) `div` spillSlotSize (ncgPlatform config)) - 1
-- = 0 -- useful for testing allocMoreStack
-- number of bytes that the stack pointer should be aligned to
stackAlign :: Int
stackAlign = 16
-- convert a spill slot number to a *byte* offset, with no sign:
-- decide on a per arch basis whether you are spilling above or below
-- the C stack pointer.
spillSlotToOffset :: Platform -> Int -> Int
spillSlotToOffset platform slot
= 64 + spillSlotSize platform * slot
--------------------------------------------------------------------------------
-- | See if this instruction is telling us the current C stack delta
takeDeltaInstr
:: Instr
-> Maybe Int
takeDeltaInstr instr
= case instr of
DELTA i -> Just i
_ -> Nothing
isMetaInstr
:: Instr
-> Bool
isMetaInstr instr
= case instr of
COMMENT{} -> True
LOCATION{} -> True
LDATA{} -> True
NEWBLOCK{} -> True
UNWIND{} -> True
DELTA{} -> True
_ -> False
-- | Make a reg-reg move instruction.
mkRegRegMoveInstr
:: HasDebugCallStack
=> NCGConfig
-> Format
-> Reg
-> Reg
-> Instr
mkRegRegMoveInstr config fmt src dst =
movInstr config fmt' (OpReg src) (OpReg dst)
-- Move the platform word size, at a minimum.
--
-- This ensures the upper part of the register is properly cleared
-- and avoids partial register stalls.
--
-- See also the 'ArithInt8' and 'ArithWord8' tests,
-- which fail without this logic.
where
platform = ncgPlatform config
fmt'
| isVecFormat fmt
= fmt
| otherwise
= scalarMoveFormat platform fmt
scalarMoveFormat :: Platform -> Format -> Format
scalarMoveFormat platform fmt
| isFloatFormat fmt
= FF64
| II64 <- fmt
= II64
| otherwise
= archWordFormat (target32Bit platform)
-- | Check whether an instruction represents a reg-reg move.
-- The register allocator attempts to eliminate reg->reg moves whenever it can,
-- by assigning the src and dest temporaries to the same real register.
--
takeRegRegMoveInstr
:: Platform
-> Instr
-> Maybe (Reg,Reg)
takeRegRegMoveInstr platform = \case
MOV fmt (OpReg r1) (OpReg r2)
-- When used with vector registers, MOV only moves the lower part,
-- so it is not a real move. For example, MOVSS/MOVSD between xmm registers
-- preserves the upper half, and MOVQ between xmm registers zeroes the upper half.
| not $ isVecFormat fmt
-- Don't eliminate a move between e.g. RAX and XMM:
-- even though we might be using XMM to store a scalar integer value,
-- some instructions only support XMM registers.
, targetClassOfReg platform r1 == targetClassOfReg platform r2
-> Just (r1, r2)
MOVD {}
-- MOVD moves between xmm registers and general-purpose registers,
-- and we don't want to eliminate those moves (as noted for MOV).
-> Nothing
-- SSE2/AVX move instructions always move the full register.
MOVU _ (OpReg r1) (OpReg r2)
-> Just (r1, r2)
VMOVU _ (OpReg r1) (OpReg r2)
-> Just (r1, r2)
MOVDQU _ (OpReg r1) (OpReg r2)
-> Just (r1, r2)
VMOVDQU _ (OpReg r1) (OpReg r2)
-> Just (r1, r2)
-- TODO: perhaps we can eliminate MOVZxL in certain situations?
MOVZxL {} -> Nothing
MOVSxL {} -> Nothing
-- MOVL, MOVH and MOVHLPS preserve some part of the destination register,
-- so are not simple moves.
MOVL {} -> Nothing
MOVH {} -> Nothing
MOVHLPS {} -> Nothing
-- Other instructions are not moves.
_ -> Nothing
-- | Make an unconditional branch instruction.
mkJumpInstr
:: BlockId
-> [Instr]
mkJumpInstr id
= [JXX ALWAYS id]
-- Note [Windows stack layout]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- | On most OSes the kernel will place a guard page after the current stack
-- page. If you allocate larger than a page worth you may jump over this
-- guard page. Not only is this a security issue, but on certain OSes such
-- as Windows a new page won't be allocated if you don't hit the guard. This
-- will cause a segfault or access fault.
--
-- This function defines if the current allocation amount requires a probe.
-- On Windows (for now) we emit a call to _chkstk for this. For other OSes
-- this is not yet implemented.
-- See https://docs.microsoft.com/en-us/windows/desktop/DevNotes/-win32-chkstk
-- The Windows stack looks like this:
--
-- +-------------------+
-- | SP |
-- +-------------------+
-- | |
-- | GUARD PAGE |
-- | |
-- +-------------------+
-- | |
-- | |
-- | UNMAPPED |
-- | |
-- | |
-- +-------------------+
--
-- In essence each allocation larger than a page size needs to be chunked and
-- a probe emitted after each page allocation. You have to hit the guard
-- page so the kernel can map in the next page, otherwise you'll segfault.
-- See Note [Windows stack allocations].
--
needs_probe_call :: Platform -> Int -> Bool
needs_probe_call platform amount
= case platformOS platform of
OSMinGW32 -> case platformArch platform of
ArchX86_64 -> amount > (4 * 1024)
_ -> False
_ -> False
mkStackAllocInstr
:: Platform
-> Int
-> [Instr]
mkStackAllocInstr platform amount
= case platformOS platform of
OSMinGW32 ->
-- These will clobber AX but this should be ok because
--
-- 1. It is the first thing we do when entering the closure and AX is
-- a caller saved registers on Windows both on x86_64 and x86.
--
-- 2. The closures are only entered via a call or longjmp in which case
-- there are no expectations for volatile registers.
--
-- 3. When the target is a local branch point it is re-targeted
-- after the dealloc, preserving #2. See Note [extra spill slots].
--
-- We emit a call because the stack probes are quite involved and
-- would bloat code size a lot. GHC doesn't really have an -Os.
-- ___chkstk is guaranteed to leave all nonvolatile registers and AX
-- untouched. It's part of the standard prologue code for any Windows
-- function dropping the stack more than a page.
-- See Note [Windows stack layout]
case platformArch platform of
ArchX86_64 | needs_probe_call platform amount ->
[ MOV II64 (OpImm (ImmInt amount)) (OpReg rax)
, CALL (Left $ strImmLit (fsLit "___chkstk_ms")) [RegWithFormat rax II64]
, SUB II64 (OpReg rax) (OpReg rsp)
]
| otherwise ->
[ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp)
, TEST II64 (OpReg rsp) (OpReg rsp)
]
_ -> panic "X86.mkStackAllocInstr"
_ ->
case platformArch platform of
ArchX86 -> [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp) ]
ArchX86_64 -> [ SUB II64 (OpImm (ImmInt amount)) (OpReg rsp) ]
_ -> panic "X86.mkStackAllocInstr"
mkStackDeallocInstr
:: Platform
-> Int
-> [Instr]
mkStackDeallocInstr platform amount
= case platformArch platform of
ArchX86 -> [ADD II32 (OpImm (ImmInt amount)) (OpReg esp)]
ArchX86_64 -> [ADD II64 (OpImm (ImmInt amount)) (OpReg rsp)]
_ -> panic "X86.mkStackDeallocInstr"
-- Note [extra spill slots]
-- ~~~~~~~~~~~~~~~~~~~~~~~~
-- If the register allocator used more spill slots than we have
-- pre-allocated (rESERVED_C_STACK_BYTES), then we must allocate more
-- C stack space on entry and exit from this proc. Therefore we
-- insert a "sub $N, %rsp" at every entry point, and an "add $N, %rsp"
-- before every non-local jump.
--
-- This became necessary when the new codegen started bundling entire
-- functions together into one proc, because the register allocator
-- assigns a different stack slot to each virtual reg within a proc.
-- To avoid using so many slots we could also:
--
-- - split up the proc into connected components before code generator
--
-- - rename the virtual regs, so that we re-use vreg names and hence
-- stack slots for non-overlapping vregs.
--
-- Note that when a block is both a non-local entry point (with an
-- info table) and a local branch target, we have to split it into
-- two, like so:
--
-- <info table>
-- L:
-- <code>
--
-- becomes
--
-- <info table>
-- L:
-- subl $rsp, N
-- jmp Lnew
-- Lnew:
-- <code>
--
-- and all branches pointing to L are retargetted to point to Lnew.
-- Otherwise, we would repeat the $rsp adjustment for each branch to
-- L.
--
-- Returns a list of (L,Lnew) pairs.
--
allocMoreStack
:: Platform
-> Int
-> NatCmmDecl statics GHC.CmmToAsm.X86.Instr.Instr
-> UniqDSM (NatCmmDecl statics GHC.CmmToAsm.X86.Instr.Instr, [(BlockId,BlockId)])
allocMoreStack _ _ top@(CmmData _ _) = return (top,[])
allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
let entries = entryBlocks proc
retargetList <- mapM (\e -> (e,) <$> newBlockId) entries
let
delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up
where x = slots * spillSlotSize platform -- sp delta
alloc = mkStackAllocInstr platform delta
dealloc = mkStackDeallocInstr platform delta
new_blockmap :: LabelMap BlockId
new_blockmap = mapFromList retargetList
insert_stack_insns (BasicBlock id insns)
| Just new_blockid <- mapLookup id new_blockmap
= [ BasicBlock id $ alloc ++ [JXX ALWAYS new_blockid]
, BasicBlock new_blockid block' ]
| otherwise
= [ BasicBlock id block' ]
where
block' = foldr insert_dealloc [] insns
insert_dealloc insn r = case insn of
JMP _ _ -> dealloc ++ (insn : r)
JXX_GBL _ _ -> panic "insert_dealloc: cannot handle JXX_GBL"
_other -> patchJumpInstr insn retarget : r
where retarget b = fromMaybe b (mapLookup b new_blockmap)
new_code = concatMap insert_stack_insns code
-- in
return (CmmProc info lbl live (ListGraph new_code), retargetList)
data JumpDest = DestBlockId BlockId | DestImm Imm
-- Debug Instance
instance Outputable JumpDest where
ppr (DestBlockId bid) = text "jd<blk>:" <> ppr bid
ppr (DestImm _imm) = text "jd<imm>:noShow"
-- Implementations of the methods of 'NgcImpl'
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId (DestBlockId bid) = Just bid
getJumpDestBlockId _ = Nothing
canShortcut :: Instr -> Maybe JumpDest
canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
canShortcut (JMP (OpImm imm) _) = Just (DestImm imm)
canShortcut _ = Nothing
-- This helper shortcuts a sequence of branches.
-- The blockset helps avoid following cycles.
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump fn insn = shortcutJump' fn (setEmpty :: LabelSet) insn
where
shortcutJump' :: (BlockId -> Maybe JumpDest) -> LabelSet -> Instr -> Instr
shortcutJump' fn seen insn@(JXX cc id) =
if setMember id seen then insn
else case fn id of
Nothing -> insn
Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm)
where seen' = setInsert id seen
shortcutJump' fn _ (JMP_TBL addr blocks section tblId) =
let updateBlock (Just (DestBlockId bid)) =
case fn bid of
Nothing -> Just (DestBlockId bid )
Just dest -> Just dest
updateBlock dest = dest
blocks' = map updateBlock blocks
in JMP_TBL addr blocks' section tblId
shortcutJump' _ _ other = other
-- Here because it knows about JumpDest
shortcutStatics :: (BlockId -> Maybe JumpDest) -> (Alignment, RawCmmStatics) -> (Alignment, RawCmmStatics)
shortcutStatics fn (align, CmmStaticsRaw lbl statics)
= (align, CmmStaticsRaw lbl $ map (shortcutStatic fn) statics)
-- we need to get the jump tables, so apply the mapping to the entries
-- of a CmmData too.
shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel fn lab
| Just blkId <- maybeLocalBlockLabel lab = shortBlockId fn emptyUniqueSet blkId
| otherwise = lab
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic fn (CmmStaticLit (CmmLabel lab))
= CmmStaticLit (CmmLabel (shortcutLabel fn lab))
shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off w))
= CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off w)
-- slightly dodgy, we're ignoring the second label, but this
-- works with the way we use CmmLabelDiffOff for jump tables now.
shortcutStatic _ other_static
= other_static
shortBlockId
:: (BlockId -> Maybe JumpDest)
-> UniqueSet
-> BlockId
-> CLabel
shortBlockId fn seen blockid =
case (memberUniqueSet uq seen, fn blockid) of
(True, _) -> blockLbl blockid
(_, Nothing) -> blockLbl blockid
(_, Just (DestBlockId blockid')) -> shortBlockId fn (insertUniqueSet uq seen) blockid'
(_, Just (DestImm (ImmCLbl lbl))) -> lbl
(_, _other) -> panic "shortBlockId"
where uq = getUnique blockid