{-# 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
   , movdOutFormat
   , 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 :: Bool -> Format
archWordFormat Bool
is32Bit
 | Bool
is32Bit   = Format
II32
 | Bool
otherwise = Format
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   Format Operand Operand -- ^ MOVD/MOVQ SSE2 instructions
                                        -- (bitcast between a general purpose
                                        -- register and a float register).
                                        -- Format is input format, output format is
                                        -- calculated in the 'movdOutFormat' function.
        | 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 Operand   -- 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
        | VEXTRACT    Format Imm Reg Operand
        | INSERTPS    Format Imm Operand Reg

        -- 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

        -- logic operations
        | PXOR        Format Operand Reg
        | VPXOR       Format Reg Reg Reg

        -- Arithmetic
        | VADD       Format Operand Reg Reg
        | VSUB       Format Operand Reg Reg
        | VMUL       Format Operand Reg Reg
        | VDIV       Format Operand Reg Reg

        -- Shuffle
        | SHUF       Format Imm Operand Reg
        | VSHUF      Format Imm Operand Reg Reg
        | PSHUFD     Format Imm Operand Reg
        | VPSHUFD    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.
        | MOVHLPS    Format Reg Reg
        | UNPCKL     Format Operand Reg
        | PUNPCKLQDQ Format Operand Reg

        -- Shift
        | PSLLDQ     Format Operand Reg
        | PSRLDQ     Format Operand Reg

        -- min/max
        | MINMAX  MinOrMax MinMaxType Format Operand Operand
        | VMINMAX MinOrMax MinMaxType Format Operand Reg Reg

data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2

-- | 'MIN' or 'MAX'
data MinOrMax = Min | Max
  deriving ( MinOrMax -> MinOrMax -> Bool
(MinOrMax -> MinOrMax -> Bool)
-> (MinOrMax -> MinOrMax -> Bool) -> Eq MinOrMax
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinOrMax -> MinOrMax -> Bool
== :: MinOrMax -> MinOrMax -> Bool
$c/= :: MinOrMax -> MinOrMax -> Bool
/= :: MinOrMax -> MinOrMax -> Bool
Eq, Int -> MinOrMax -> ShowS
[MinOrMax] -> ShowS
MinOrMax -> String
(Int -> MinOrMax -> ShowS)
-> (MinOrMax -> String) -> ([MinOrMax] -> ShowS) -> Show MinOrMax
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinOrMax -> ShowS
showsPrec :: Int -> MinOrMax -> ShowS
$cshow :: MinOrMax -> String
show :: MinOrMax -> String
$cshowList :: [MinOrMax] -> ShowS
showList :: [MinOrMax] -> ShowS
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 { MinMaxType -> Bool
minMaxSigned :: Bool } | FloatMinMax
  deriving ( MinMaxType -> MinMaxType -> Bool
(MinMaxType -> MinMaxType -> Bool)
-> (MinMaxType -> MinMaxType -> Bool) -> Eq MinMaxType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinMaxType -> MinMaxType -> Bool
== :: MinMaxType -> MinMaxType -> Bool
$c/= :: MinMaxType -> MinMaxType -> Bool
/= :: MinMaxType -> MinMaxType -> Bool
Eq, Int -> MinMaxType -> ShowS
[MinMaxType] -> ShowS
MinMaxType -> String
(Int -> MinMaxType -> ShowS)
-> (MinMaxType -> String)
-> ([MinMaxType] -> ShowS)
-> Show MinMaxType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinMaxType -> ShowS
showsPrec :: Int -> MinMaxType -> ShowS
$cshow :: MinMaxType -> String
show :: MinMaxType -> String
$cshowList :: [MinMaxType] -> ShowS
showList :: [MinMaxType] -> ShowS
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 -> RegUsage
regUsageOfInstr Platform
platform Instr
instr
 = case Instr
instr of
    MOV Format
fmt Operand
src Operand
dst
      -- MOVSS/MOVSD preserve the upper half of vector registers,
      -- but only for reg-2-reg moves
      | VecFormat Int
_ ScalarFormat
sFmt <- Format
fmt
      , ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
      , OpReg {} <- Operand
src
      , OpReg {} <- Operand
dst
      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
      -- other MOV instructions zero any remaining upper part of the destination
      -- (largely to avoid partial register stalls)
      | Bool
otherwise
      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    MOVD   Format
fmt Operand
src Operand
dst    ->
      -- NB: MOVD and MOVQ always zero any remaining upper part of destination,
      -- so the destination is "written" not "modified".
      HasDebugCallStack =>
Format -> Format -> Operand -> Operand -> RegUsage
Format -> Format -> Operand -> Operand -> RegUsage
usageRW' Format
fmt (Format -> Format
movdOutFormat Format
fmt) Operand
src Operand
dst
    CMOV Cond
_ Format
fmt Operand
src Reg
dst    -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    MOVZxL Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    MOVSxL Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    LEA    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    ADD    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    ADC    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    SUB    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    SBB    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    IMUL   Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst

    -- Result of IMULB will be in just in %ax
    IMUL2  Format
II8 Operand
src       -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
II8 Reg
eaxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
II8 Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
II8 Reg
eax]
    -- Result of IMUL for wider values, will be split between %dx/%edx/%rdx and
    -- %ax/%eax/%rax.
    IMUL2  Format
fmt Operand
src        -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eaxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eax,Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edx]

    MUL    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    MUL2   Format
fmt Operand
src        -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eaxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eax,Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edx]
    DIV    Format
fmt Operand
op -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eaxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eax, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edx]
    IDIV   Format
fmt Operand
op -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eaxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edxRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eax, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edx]
    ADD_CC Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    SUB_CC Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    AND    Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    OR     Format
fmt Operand
src Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst

    XOR    Format
fmt (OpReg Reg
src) (OpReg Reg
dst)
      | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    XOR    Format
fmt Operand
src Operand
dst
      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    VXOR Format
fmt (OpReg Reg
src1) Reg
src2 Reg
dst
      | Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
src2, Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VXOR Format
fmt Operand
src1 Reg
src2 Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src1 [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    NOT    Format
fmt Operand
op         -> HasDebugCallStack => Format -> Operand -> RegUsage
Format -> Operand -> RegUsage
usageM Format
fmt Operand
op
    BSWAP  Format
fmt Reg
reg        -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    NEGI   Format
fmt Operand
op         -> HasDebugCallStack => Format -> Operand -> RegUsage
Format -> Operand -> RegUsage
usageM Format
fmt Operand
op
    SHL    Format
fmt Operand
imm Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
imm Operand
dst
    SAR    Format
fmt Operand
imm Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
imm Operand
dst
    SHR    Format
fmt Operand
imm Operand
dst    -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
imm Operand
dst
    SHLD   Format
fmt Operand
imm Operand
dst1 Operand
dst2 -> HasDebugCallStack =>
Format -> Operand -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> Operand -> RegUsage
usageRMM Format
fmt Operand
imm Operand
dst1 Operand
dst2
    SHRD   Format
fmt Operand
imm Operand
dst1 Operand
dst2 -> HasDebugCallStack =>
Format -> Operand -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> Operand -> RegUsage
usageRMM Format
fmt Operand
imm Operand
dst1 Operand
dst2
    BT     Format
fmt Imm
_   Operand
src    -> [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src [])

    PUSH   Format
fmt Operand
op         -> [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op [])
    POP    Format
fmt Operand
op         -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] (Format -> Operand -> [RegWithFormat]
def_W Format
fmt Operand
op)
    TEST   Format
fmt Operand
src Operand
dst    -> [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
dst [])
    CMP    Format
fmt Operand
src Operand
dst    -> [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
dst [])
    SETCC  Cond
_ Operand
op         -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] (Format -> Operand -> [RegWithFormat]
def_W Format
II8 Operand
op)
    JXX    Cond
_ BlockId
_          -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] []
    JXX_GBL Cond
_ Imm
_         -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] []
    JMP     Operand
op [RegWithFormat]
regs     -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
addrFmt Operand
op [RegWithFormat]
regs) []
    JMP_TBL Operand
op [Maybe JumpDest]
_ Section
_ CLabel
_    -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
addrFmt Operand
op []) []
    CALL (Left Imm
_)  [RegWithFormat]
params   -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [RegWithFormat]
params ((Reg -> RegWithFormat) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> RegWithFormat
mkFmt ([Reg] -> [RegWithFormat]) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ Platform -> [Reg]
callClobberedRegs Platform
platform)
    CALL (Right Reg
reg) [RegWithFormat]
params -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (Format -> Reg -> RegWithFormat
mk Format
addrFmt Reg
regRegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
:[RegWithFormat]
params) ((Reg -> RegWithFormat) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> RegWithFormat
mkFmt ([Reg] -> [RegWithFormat]) -> [Reg] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ Platform -> [Reg]
callClobberedRegs Platform
platform)
    CLTD   Format
fmt          -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
eax] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
edx]
    Instr
NOP                 -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] []

    X87Store Format
_fmt  AddrMode
dst -> [RegWithFormat] -> RegUsage
mkRUR (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
dst [])

    CVTSS2SD   Reg
src Reg
dst  -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
FF32 Reg
src] [Format -> Reg -> RegWithFormat
mk Format
FF64 Reg
dst]
    CVTSD2SS   Reg
src Reg
dst  -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
FF64 Reg
src] [Format -> Reg -> RegWithFormat
mk Format
FF32 Reg
dst]
    CVTTSS2SIQ Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
FF32 Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    CVTTSD2SIQ Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
FF64 Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    CVTSI2SS   Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
FF32 Reg
dst]
    CVTSI2SD   Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
FF64 Reg
dst]
    FDIV Format
fmt     Operand
src Operand
dst  -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    SQRT Format
fmt Operand
src Reg
dst      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    FETCHGOT Reg
reg        -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
addrFmt Reg
reg]
    FETCHPC  Reg
reg        -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
addrFmt Reg
reg]

    COMMENT FastString
_           -> RegUsage
noUsage
    LOCATION{}          -> RegUsage
noUsage
    UNWIND{}            -> RegUsage
noUsage
    DELTA   Int
_           -> RegUsage
noUsage

    POPCNT Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    LZCNT  Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    TZCNT  Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    BSF    Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    BSR    Format
fmt Operand
src Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    PDEP   Format
fmt Operand
src Operand
mask Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
mask []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    PEXT   Format
fmt Operand
src Operand
mask Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
mask []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    FMA3 Format
fmt FMASign
_ FMAPermutation
_ Operand
src3 Reg
src2 Reg
dst -> HasDebugCallStack => Format -> Operand -> Reg -> Reg -> RegUsage
Format -> Operand -> Reg -> Reg -> RegUsage
usageFMA Format
fmt Operand
src3 Reg
src2 Reg
dst

    -- note: might be a better way to do this
    PREFETCH PrefetchVariant
_  Format
fmt Operand
src -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) []
    LOCK Instr
i              -> Platform -> Instr -> RegUsage
regUsageOfInstr Platform
platform Instr
i
    XADD Format
fmt Operand
src Operand
dst      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageMM Format
fmt Operand
src Operand
dst
    CMPXCHG Format
fmt Operand
src Operand
dst   -> HasDebugCallStack =>
Format -> Operand -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> Operand -> RegUsage
usageRMM Format
fmt Operand
src Operand
dst (Reg -> Operand
OpReg Reg
eax)
    XCHG Format
fmt Operand
src Reg
dst      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageMM Format
fmt Operand
src (Reg -> Operand
OpReg Reg
dst)
    Instr
MFENCE -> RegUsage
noUsage

    -- vector instructions
    VBROADCAST Format
fmt Operand
src Reg
dst   -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VEXTRACT     Format
fmt Imm
_off Reg
src Operand
dst -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt (Reg -> Operand
OpReg Reg
src) Operand
dst
    INSERTPS     Format
fmt (ImmInt Int
off) Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst | Bool -> Bool
not Bool
doesNotReadDst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
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 :: Bool
doesNotReadDst = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
off Int
i | Int
i <- [Int
0, Int
1, Int
2, Int
3], Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
pos ]
            -- Check whether the positions in which we are not inserting
            -- are being zeroed.
            where pos :: Int
pos = ( Int
off Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4 ) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b11
    INSERTPS Format
fmt Imm
_off Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    VMOVU        Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    MOVU         Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    MOVL         Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    MOVH         Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    MOVDQU       Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst
    VMOVDQU      Format
fmt Operand
src Operand
dst   -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
src Operand
dst

    PXOR Format
fmt (OpReg Reg
src) Reg
dst
      | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
      | Bool
otherwise
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    VPXOR        Format
fmt Reg
s1 Reg
s2 Reg
dst
      | Reg
s1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
s2, Reg
s1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
      | Bool
otherwise
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s1, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s2] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    VADD         Format
fmt Operand
s1 Reg
s2 Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
s1 []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VSUB         Format
fmt Operand
s1 Reg
s2 Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
s1 []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VMUL         Format
fmt Operand
s1 Reg
s2 Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
s1 []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VDIV         Format
fmt Operand
s1 Reg
s2 Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU ((HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
s1 []) [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
s2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    SHUF Format
fmt Imm
_mask Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VSHUF Format
fmt Imm
_mask Operand
src1 Reg
src2 Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src1 [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    PSHUFD Format
fmt Imm
_mask Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    VPSHUFD Format
fmt Imm
_mask Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    PSLLDQ Format
fmt Operand
off Reg
dst -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
off []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    MOVHLPS    Format
fmt Reg
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    UNPCKL Format
fmt Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    PUNPCKLQDQ Format
fmt Operand
src Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]

    MINMAX MinOrMax
_ MinMaxType
_ Format
fmt Operand
src Operand
dst
      -> HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
src Operand
dst
    VMINMAX MinOrMax
_ MinMaxType
_ Format
fmt Operand
src1 Reg
src2 Reg
dst
      -> [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
src1 [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src2]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    Instr
_other              -> String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"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 :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageRW Format
fmt Operand
op (OpReg Reg
reg)      = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op []) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    usageRW Format
fmt Operand
op (OpAddr AddrMode
ea)      = [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [])
    usageRW Format
_ Operand
_ Operand
_                   = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageRW: no match"

    usageRW' :: HasDebugCallStack => Format -> Format -> Operand -> Operand -> RegUsage
    usageRW' :: HasDebugCallStack =>
Format -> Format -> Operand -> Operand -> RegUsage
usageRW' Format
fmt1 Format
fmt2 Operand
op (OpReg Reg
reg) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt1 Operand
op []) [Format -> Reg -> RegWithFormat
mk Format
fmt2 Reg
reg]
    usageRW' Format
fmt1 Format
_    Operand
op (OpAddr AddrMode
ea) = [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt1 Operand
op ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [])
    usageRW' Format
_  Format
_ Operand
_ Operand
_                 = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageRW: no match"

    -- 2 operand form; first operand Read; second Modified
    usageRM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
    usageRM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageRM Format
fmt Operand
op (OpReg Reg
reg)      = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    usageRM Format
fmt Operand
op (OpAddr AddrMode
ea)      = [RegWithFormat] -> RegUsage
mkRUR (HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt Operand
op ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [])
    usageRM Format
_ Operand
_ Operand
_                   = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageRM: no match"

    -- 2 operand form; first operand Modified; second Modified
    usageMM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
    usageMM :: HasDebugCallStack => Format -> Operand -> Operand -> RegUsage
usageMM Format
fmt (OpReg Reg
src) (OpReg Reg
dst) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    usageMM Format
fmt (OpReg Reg
src) (OpAddr AddrMode
ea) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src]
    usageMM Format
fmt (OpAddr AddrMode
ea) (OpReg Reg
dst) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    usageMM Format
_ Operand
_ Operand
_                       = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageMM: no match"

    -- 3 operand form; first operand Read; second Modified; third Modified
    usageRMM :: HasDebugCallStack => Format -> Operand -> Operand -> Operand -> RegUsage
    usageRMM :: HasDebugCallStack =>
Format -> Operand -> Operand -> Operand -> RegUsage
usageRMM Format
fmt (OpReg Reg
src) (OpReg Reg
dst) (OpReg Reg
reg) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    usageRMM Format
fmt (OpReg Reg
src) (OpAddr AddrMode
ea) (OpReg Reg
reg) = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    usageRMM Format
_ Operand
_ Operand
_ Operand
_                                 = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageRMM: no match"

    -- 3 operand form of FMA instructions.
    usageFMA :: HasDebugCallStack => Format -> Operand -> Reg -> Reg -> RegUsage
    usageFMA :: HasDebugCallStack => Format -> Operand -> Reg -> Reg -> RegUsage
usageFMA Format
fmt (OpReg Reg
src1) Reg
src2 Reg
dst =
      [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src1, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src2, Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst] [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    usageFMA Format
fmt (OpAddr AddrMode
ea1) Reg
src2 Reg
dst
      = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea1 [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
src2, Format -> Reg -> RegWithFormat
mk Format
fmt  Reg
dst]) [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
dst]
    usageFMA Format
_ Operand
_ Reg
_ Reg
_
      = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageFMA: no match"

    -- 1 operand form; operand Modified
    usageM :: HasDebugCallStack => Format -> Operand -> RegUsage
    usageM :: HasDebugCallStack => Format -> Operand -> RegUsage
usageM Format
fmt (OpReg Reg
reg) =
      let r' :: RegWithFormat
r' = Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg
      in [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [RegWithFormat
r'] [RegWithFormat
r']
    usageM Format
_ (OpAddr AddrMode
ea) = [RegWithFormat] -> RegUsage
mkRUR (AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [])
    usageM Format
_ Operand
_ = String -> RegUsage
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.usageM: no match"

    -- Registers defd when an operand is written.
    def_W :: Format -> Operand -> [RegWithFormat]
def_W Format
fmt (OpReg Reg
reg)         = [Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg]
    def_W Format
_   (OpAddr AddrMode
_ )         = []
    def_W Format
_   Operand
_                   = String -> [RegWithFormat]
forall a. HasCallStack => String -> a
panic String
"X86.RegInfo.def_W: no match"

    -- Registers used when an operand is read.
    use_R :: HasDebugCallStack => Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
    use_R :: HasDebugCallStack =>
Format -> Operand -> [RegWithFormat] -> [RegWithFormat]
use_R Format
fmt (OpReg Reg
reg)  [RegWithFormat]
tl = Format -> Reg -> RegWithFormat
mk Format
fmt Reg
reg RegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
: [RegWithFormat]
tl
    use_R Format
_   (OpImm Imm
_)    [RegWithFormat]
tl = [RegWithFormat]
tl
    use_R Format
_   (OpAddr AddrMode
ea)  [RegWithFormat]
tl = AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA AddrMode
ea [RegWithFormat]
tl

    -- Registers used to compute an effective address.
    use_EA :: AddrMode -> [RegWithFormat] -> [RegWithFormat]
use_EA (ImmAddr Imm
_ Int
_) [RegWithFormat]
tl = [RegWithFormat]
tl
    use_EA (AddrBaseIndex EABase
base EAIndex
index Imm
_) [RegWithFormat]
tl =
        EABase -> [RegWithFormat] -> [RegWithFormat]
use_base EABase
base ([RegWithFormat] -> [RegWithFormat])
-> [RegWithFormat] -> [RegWithFormat]
forall a b. (a -> b) -> a -> b
$! EAIndex -> [RegWithFormat] -> [RegWithFormat]
use_index EAIndex
index [RegWithFormat]
tl
        where use_base :: EABase -> [RegWithFormat] -> [RegWithFormat]
use_base (EABaseReg Reg
r)  [RegWithFormat]
tl = Format -> Reg -> RegWithFormat
mk Format
addrFmt Reg
r RegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
: [RegWithFormat]
tl
              use_base EABase
_              [RegWithFormat]
tl = [RegWithFormat]
tl
              use_index :: EAIndex -> [RegWithFormat] -> [RegWithFormat]
use_index EAIndex
EAIndexNone   [RegWithFormat]
tl = [RegWithFormat]
tl
              use_index (EAIndex Reg
i Int
_) [RegWithFormat]
tl = Format -> Reg -> RegWithFormat
mk Format
addrFmt Reg
i RegWithFormat -> [RegWithFormat] -> [RegWithFormat]
forall a. a -> [a] -> [a]
: [RegWithFormat]
tl

    mkRUR :: [RegWithFormat] -> RegUsage
    mkRUR :: [RegWithFormat] -> RegUsage
mkRUR [RegWithFormat]
src = [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [RegWithFormat]
src []

    mkRU :: [RegWithFormat] -> [RegWithFormat] -> RegUsage
    mkRU :: [RegWithFormat] -> [RegWithFormat] -> RegUsage
mkRU [RegWithFormat]
src [RegWithFormat]
dst = [RegWithFormat]
src' [RegWithFormat] -> RegUsage -> RegUsage
forall a b. a -> b -> b
`seq` [RegWithFormat]
dst' [RegWithFormat] -> RegUsage -> RegUsage
forall a b. a -> b -> b
`seq` [RegWithFormat] -> [RegWithFormat] -> RegUsage
RU [RegWithFormat]
src' [RegWithFormat]
dst'
        where src' :: [RegWithFormat]
src' = (RegWithFormat -> Bool) -> [RegWithFormat] -> [RegWithFormat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform (Reg -> Bool) -> (RegWithFormat -> Reg) -> RegWithFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg) [RegWithFormat]
src
              dst' :: [RegWithFormat]
dst' = (RegWithFormat -> Bool) -> [RegWithFormat] -> [RegWithFormat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Platform -> Reg -> Bool
interesting Platform
platform (Reg -> Bool) -> (RegWithFormat -> Reg) -> RegWithFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Reg
regWithFormat_reg) [RegWithFormat]
dst

    addrFmt :: Format
addrFmt = Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)
    mk :: Format -> Reg -> RegWithFormat
    mk :: Format -> Reg -> RegWithFormat
mk Format
fmt Reg
r = Reg -> Format -> RegWithFormat
RegWithFormat Reg
r Format
fmt

    mkFmt :: Reg -> RegWithFormat
    mkFmt :: Reg -> RegWithFormat
mkFmt Reg
r = Reg -> Format -> RegWithFormat
RegWithFormat Reg
r (Format -> RegWithFormat) -> Format -> RegWithFormat
forall a b. (a -> b) -> a -> b
$ case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
r of
      RegClass
RcInteger -> Format
addrFmt
      RegClass
RcFloatOrVector -> Format
FF64

-- | Is this register interesting for the register allocator?
interesting :: Platform -> Reg -> Bool
interesting :: Platform -> Reg -> Bool
interesting Platform
_        (RegVirtual VirtualReg
_)              = Bool
True
interesting Platform
platform (RegReal (RealRegSingle Int
i)) = Platform -> Int -> Bool
freeReg Platform
platform Int
i

movdOutFormat :: Format -> Format
movdOutFormat :: Format -> Format
movdOutFormat Format
format = case Format
format of
  Format
II32 -> Format
FF32
  Format
II64 -> Format
FF64
  Format
FF32 -> Format
II32
  Format
FF64 -> Format
II64
  Format
_    -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"X86: improper format for movd/movq" (Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
format)


-- | 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 :: HasDebugCallStack => Platform -> Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Platform
platform Instr
instr Reg -> Reg
env
  = case Instr
instr of
    MOV Format
fmt Operand
src Operand
dst      -> Format -> Operand -> Operand -> Instr
MOV Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    MOVD Format
fmt Operand
src Operand
dst     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
MOVD 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   -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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   -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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        -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
IMUL2 Format
fmt) Operand
src
    MUL Format
fmt Operand
src Operand
dst      -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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         -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
MUL2 Format
fmt) Operand
src
    IDIV Format
fmt Operand
op          -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
IDIV Format
fmt) Operand
op
    DIV Format
fmt Operand
op           -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
DIV Format
fmt) Operand
op
    ADD_CC Format
fmt Operand
src Operand
dst   -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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   -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Instr
XOR  Format
fmt) Operand
src Operand
dst
    VXOR Format
fmt Operand
src1 Reg
src2 Reg
dst -> Format -> Operand -> Reg -> Reg -> Instr
VXOR Format
fmt (Operand -> Operand
patchOp Operand
src1) (Reg -> Reg
env Reg
src2) (Reg -> Reg
env Reg
dst)
    NOT  Format
fmt Operand
op          -> (Operand -> Instr) -> Operand -> Instr
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          -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
NEGI Format
fmt) Operand
op
    SHL  Format
fmt Operand
imm Operand
dst     -> (Operand -> Instr) -> Operand -> Instr
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     -> (Operand -> Instr) -> Operand -> Instr
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     -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Operand -> Instr
SHR Format
fmt Operand
imm) Operand
dst
    SHLD Format
fmt Operand
imm Operand
dst1 Operand
dst2 -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Operand -> Instr
SHLD Format
fmt Operand
imm) Operand
dst1 Operand
dst2
    SHRD Format
fmt Operand
imm Operand
dst1 Operand
dst2 -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a. (Operand -> Operand -> a) -> Operand -> Operand -> a
patch2 (Format -> Operand -> Operand -> Operand -> Instr
SHRD Format
fmt Operand
imm) Operand
dst1 Operand
dst2
    BT   Format
fmt Imm
imm Operand
src     -> (Operand -> Instr) -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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          -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
PUSH Format
fmt) Operand
op
    POP  Format
fmt Operand
op          -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Format -> Operand -> Instr
POP  Format
fmt) Operand
op
    SETCC Cond
cond Operand
op        -> (Operand -> Instr) -> Operand -> Instr
forall a. (Operand -> a) -> Operand -> a
patch1 (Cond -> Operand -> Instr
SETCC Cond
cond) Operand
op
    JMP Operand
op [RegWithFormat]
regs          -> Operand -> [RegWithFormat] -> Instr
JMP (Operand -> Operand
patchOp Operand
op) [RegWithFormat]
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

    FMA3 Format
fmt FMASign
perm FMAPermutation
var Operand
x1 Reg
x2 Reg
x3 -> (Operand -> Reg -> Reg -> Instr) -> Operand -> Reg -> Reg -> Instr
forall a.
(Operand -> Reg -> Reg -> a) -> Operand -> Reg -> Reg -> a
patch3 (Format
-> FMASign -> FMAPermutation -> Operand -> Reg -> Reg -> Instr
FMA3 Format
fmt FMASign
perm FMAPermutation
var) Operand
x1 Reg
x2 Reg
x3

    -- literally only support storing the top x87 stack value st(0)
    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
_)  [RegWithFormat]
_    -> Instr
instr
    CALL (Right Reg
reg) [RegWithFormat]
p  -> Either Imm Reg -> [RegWithFormat] -> Instr
CALL (Reg -> Either Imm Reg
forall a b. b -> Either a b
Right (Reg -> Reg
env Reg
reg)) [RegWithFormat]
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 FastString
_           -> Instr
instr
    LOCATION {}         -> Instr
instr
    UNWIND {}           -> Instr
instr
    DELTA Int
_             -> Instr
instr
    LDATA {}            -> Instr
instr
    NEWBLOCK {}         -> 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 (HasDebugCallStack => Platform -> Instr -> (Reg -> Reg) -> Instr
Platform -> Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Platform
platform Instr
i Reg -> Reg
env)
    XADD Format
fmt Operand
src Operand
dst     -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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  -> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
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

    -- vector instructions
    VBROADCAST   Format
fmt Operand
src Reg
dst   -> Format -> Operand -> Reg -> Instr
VBROADCAST Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
    VEXTRACT     Format
fmt Imm
off Reg
src Operand
dst
      -> Format -> Imm -> Reg -> Operand -> Instr
VEXTRACT Format
fmt Imm
off (Reg -> Reg
env Reg
src) (Operand -> Operand
patchOp Operand
dst)
    INSERTPS    Format
fmt Imm
off Operand
src Reg
dst
      -> Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt Imm
off (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)

    VMOVU      Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
VMOVU Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    MOVU       Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
MOVU  Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    MOVL       Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
MOVL  Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    MOVH       Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
MOVH  Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    MOVDQU     Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
MOVDQU  Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    VMOVDQU    Format
fmt Operand
src Operand
dst   -> Format -> Operand -> Operand -> Instr
VMOVDQU Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)

    PXOR       Format
fmt Operand
src Reg
dst   -> Format -> Operand -> Reg -> Instr
PXOR Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
    VPXOR      Format
fmt Reg
s1 Reg
s2 Reg
dst -> Format -> Reg -> Reg -> Reg -> Instr
VPXOR Format
fmt (Reg -> Reg
env Reg
s1) (Reg -> Reg
env Reg
s2) (Reg -> Reg
env Reg
dst)

    VADD       Format
fmt Operand
s1 Reg
s2 Reg
dst -> Format -> Operand -> Reg -> Reg -> Instr
VADD Format
fmt (Operand -> Operand
patchOp Operand
s1) (Reg -> Reg
env Reg
s2) (Reg -> Reg
env Reg
dst)
    VSUB       Format
fmt Operand
s1 Reg
s2 Reg
dst -> Format -> Operand -> Reg -> Reg -> Instr
VSUB Format
fmt (Operand -> Operand
patchOp Operand
s1) (Reg -> Reg
env Reg
s2) (Reg -> Reg
env Reg
dst)
    VMUL       Format
fmt Operand
s1 Reg
s2 Reg
dst -> Format -> Operand -> Reg -> Reg -> Instr
VMUL Format
fmt (Operand -> Operand
patchOp Operand
s1) (Reg -> Reg
env Reg
s2) (Reg -> Reg
env Reg
dst)
    VDIV       Format
fmt Operand
s1 Reg
s2 Reg
dst -> Format -> Operand -> Reg -> Reg -> Instr
VDIV Format
fmt (Operand -> Operand
patchOp Operand
s1) (Reg -> Reg
env Reg
s2) (Reg -> Reg
env Reg
dst)

    SHUF      Format
fmt Imm
off Operand
src Reg
dst
      -> Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt Imm
off (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
    VSHUF      Format
fmt Imm
off Operand
src1 Reg
src2 Reg
dst
      -> Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt Imm
off (Operand -> Operand
patchOp Operand
src1) (Reg -> Reg
env Reg
src2) (Reg -> Reg
env Reg
dst)
    PSHUFD       Format
fmt Imm
off Operand
src Reg
dst
      -> Format -> Imm -> Operand -> Reg -> Instr
PSHUFD  Format
fmt Imm
off (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
    VPSHUFD      Format
fmt Imm
off Operand
src Reg
dst
      -> Format -> Imm -> Operand -> Reg -> Instr
VPSHUFD Format
fmt Imm
off (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)

    PSLLDQ       Format
fmt Operand
off Reg
dst
      -> Format -> Operand -> Reg -> Instr
PSLLDQ  Format
fmt (Operand -> Operand
patchOp Operand
off) (Reg -> Reg
env Reg
dst)
    PSRLDQ       Format
fmt Operand
off Reg
dst
      -> Format -> Operand -> Reg -> Instr
PSRLDQ  Format
fmt (Operand -> Operand
patchOp Operand
off) (Reg -> Reg
env Reg
dst)

    MOVHLPS    Format
fmt Reg
src Reg
dst
      -> Format -> Reg -> Reg -> Instr
MOVHLPS Format
fmt (Reg -> Reg
env Reg
src) (Reg -> Reg
env Reg
dst)
    UNPCKL Format
fmt Operand
src Reg
dst
      -> Format -> Operand -> Reg -> Instr
UNPCKL Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)
    PUNPCKLQDQ Format
fmt Operand
src Reg
dst
      -> Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt (Operand -> Operand
patchOp Operand
src) (Reg -> Reg
env Reg
dst)

    MINMAX MinOrMax
minMax MinMaxType
ty Format
fmt Operand
src Operand
dst
      -> MinOrMax -> MinMaxType -> Format -> Operand -> Operand -> Instr
MINMAX MinOrMax
minMax MinMaxType
ty Format
fmt (Operand -> Operand
patchOp Operand
src) (Operand -> Operand
patchOp Operand
dst)
    VMINMAX MinOrMax
minMax MinMaxType
ty Format
fmt Operand
src1 Reg
src2 Reg
dst
      -> MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Reg -> Instr
VMINMAX MinOrMax
minMax MinMaxType
ty Format
fmt (Operand -> Operand
patchOp Operand
src1) (Reg -> Reg
env Reg
src2) (Reg -> Reg
env Reg
dst)

  where
    patch1 :: (Operand -> a) -> Operand -> a
    patch1 :: forall a. (Operand -> a) -> Operand -> a
patch1 Operand -> a
insn Operand
op      = Operand -> a
insn (Operand -> a) -> Operand -> a
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 (Operand -> Operand -> a) -> Operand -> Operand -> a
forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
src) (Operand -> a) -> Operand -> a
forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
dst
    patch3 :: (Operand -> Reg -> Reg -> a) -> Operand -> Reg -> Reg -> a
    patch3 :: forall a.
(Operand -> Reg -> Reg -> a) -> Operand -> Reg -> Reg -> a
patch3 Operand -> Reg -> Reg -> a
insn Operand
src1 Reg
src2 Reg
dst = ((Operand -> Reg -> Reg -> a
insn (Operand -> Reg -> Reg -> a) -> Operand -> Reg -> Reg -> a
forall a b. (a -> b) -> a -> b
$! Operand -> Operand
patchOp Operand
src1) (Reg -> Reg -> a) -> Reg -> Reg -> a
forall a b. (a -> b) -> a -> b
$! Reg -> Reg
env Reg
src2) (Reg -> a) -> Reg -> a
forall a b. (a -> b) -> a -> b
$! Reg -> Reg
env Reg
dst

    patchOp :: Operand -> Operand
patchOp (OpReg  Reg
reg) = Reg -> Operand
OpReg (Reg -> Operand) -> Reg -> Operand
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 (AddrMode -> Operand) -> AddrMode -> Operand
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 (EABase -> EAIndex -> Imm -> AddrMode)
-> EABase -> EAIndex -> Imm -> AddrMode
forall a b. (a -> b) -> a -> b
$! EABase -> EABase
lookupBase EABase
base) (EAIndex -> Imm -> AddrMode) -> EAIndex -> Imm -> AddrMode
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 (Reg -> EABase) -> Reg -> EABase
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 (Reg -> Int -> EAIndex) -> Reg -> Int -> 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

canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo Instr
insn BlockId
bid
  = case Instr
insn of
    JXX Cond
_ BlockId
target          -> BlockId
bid BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
target
    JMP_TBL Operand
_ [Maybe JumpDest]
targets Section
_ CLabel
_ -> (Maybe JumpDest -> Bool) -> [Maybe JumpDest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe JumpDest -> Bool
isTargetBid [Maybe JumpDest]
targets
    Instr
_                     -> Bool
False
  where
    isTargetBid :: Maybe JumpDest -> Bool
isTargetBid Maybe JumpDest
target = case Maybe JumpDest
target of
      Maybe JumpDest
Nothing                      -> Bool
True
      Just (DestBlockId BlockId
target) -> BlockId
target BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
bid
      Maybe JumpDest
_                  -> 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 ((Maybe JumpDest -> Maybe JumpDest)
-> [Maybe JumpDest] -> [Maybe JumpDest]
forall a b. (a -> b) -> [a] -> [b]
map ((JumpDest -> JumpDest) -> Maybe JumpDest -> Maybe JumpDest
forall a b. (a -> b) -> Maybe a -> Maybe b
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





-- -----------------------------------------------------------------------------
-- | Make a spill instruction.
mkSpillInstr
    :: HasDebugCallStack
    => NCGConfig
    -> RegWithFormat -- register to spill
    -> Int       -- current stack delta
    -> Int       -- spill slot to use
    -> [Instr]

mkSpillInstr :: HasDebugCallStack =>
NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
mkSpillInstr NCGConfig
config (RegWithFormat Reg
reg Format
fmt) Int
delta Int
slot =
  [ HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
fmt' (Reg -> Operand
OpReg Reg
reg) (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) ]
  where
    fmt' :: Format
fmt'
      | Format -> Bool
isVecFormat Format
fmt
      = Format
fmt
      | Bool
otherwise
      = Platform -> Format -> Format
scalarMoveFormat Platform
platform Format
fmt
      -- Spill the platform word size, at a minimum
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    off :: Int
off = Platform -> Int -> Int
spillSlotToOffset Platform
platform Int
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta

-- | Make a spill reload instruction.
mkLoadInstr
    :: HasDebugCallStack
    => NCGConfig
    -> RegWithFormat      -- register to load
    -> Int      -- current stack delta
    -> Int      -- spill slot to use
    -> [Instr]

mkLoadInstr :: HasDebugCallStack =>
NCGConfig -> RegWithFormat -> Int -> Int -> [Instr]
mkLoadInstr NCGConfig
config (RegWithFormat Reg
reg Format
fmt) Int
delta Int
slot =
  [ HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
fmt' (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) (Reg -> Operand
OpReg Reg
reg) ]
  where
    fmt' :: Format
fmt'
      | Format -> Bool
isVecFormat Format
fmt
      = Format
fmt
      | Bool
otherwise
      = Platform -> Format -> Format
scalarMoveFormat Platform
platform Format
fmt
        -- Load the platform word size, at a minimum
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    off :: Int
off = Platform -> Int -> Int
spillSlotToOffset Platform
platform Int
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta

-- | A move instruction for moving the entire contents of an operand
-- at the given 'Format'.
movInstr :: HasDebugCallStack => NCGConfig -> Format -> (Operand -> Operand -> Instr)
movInstr :: HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
fmt =
  case Format
fmt of
    VecFormat Int
_ ScalarFormat
sFmt ->
      case Format -> Width
formatToWidth Format
fmt of
        Width
W512 ->
          if Bool
avx512f
          then ScalarFormat -> Operand -> Operand -> Instr
avx_move ScalarFormat
sFmt
          else String -> Operand -> Operand -> Instr
forall a. HasCallStack => String -> a
sorry String
"512-bit wide vectors require -mavx512f"
        Width
W256 ->
          if Bool
avx2
          then ScalarFormat -> Operand -> Operand -> Instr
avx_move ScalarFormat
sFmt
          else String -> Operand -> Operand -> Instr
forall a. HasCallStack => String -> a
sorry String
"256-bit wide vectors require -mavx2"
        Width
W128 ->
          if Bool
avx
            -- Prefer AVX instructions over SSE when available
            -- (usually results in better performance).
          then ScalarFormat -> Operand -> Operand -> Instr
avx_move ScalarFormat
sFmt
          else ScalarFormat -> Operand -> Operand -> Instr
sse_move ScalarFormat
sFmt
        Width
w -> String -> Operand -> Operand -> Instr
forall a. HasCallStack => String -> a
sorry (String -> Operand -> Operand -> Instr)
-> String -> Operand -> Operand -> Instr
forall a b. (a -> b) -> a -> b
$ String
"Unhandled SIMD vector width: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bits"
    Format
_ -> Format -> Operand -> Operand -> Instr
MOV Format
fmt
  where

    assertCompatibleRegs :: ( Operand -> Operand -> Instr ) -> Operand -> Operand -> Instr
    assertCompatibleRegs :: (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
assertCompatibleRegs Operand -> Operand -> Instr
f
      | Bool
debugIsOn
      = \ Operand
op1 Operand
op2 ->
          if | OpReg Reg
r1 <- Operand
op1
             , OpReg Reg
r2 <- Operand
op2
             , Platform -> Reg -> RegClass
targetClassOfReg Platform
plat Reg
r1 RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
/= Platform -> Reg -> RegClass
targetClassOfReg Platform
plat Reg
r2
             -> Bool
-> SDoc
-> (Operand -> Operand -> Instr)
-> Operand
-> Operand
-> Instr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False
                  ( [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"movInstr: move between incompatible registers"
                         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fmt:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt
                         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"r1:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r1
                         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"r2:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
r2 ]
                  ) Operand -> Operand -> Instr
f Operand
op1 Operand
op2
             | Bool
otherwise
             -> Operand -> Operand -> Instr
f Operand
op1 Operand
op2
      | Bool
otherwise
      = Operand -> Operand -> Instr
f

    plat :: Platform
plat    = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    avx :: Bool
avx     = NCGConfig -> Bool
ncgAvxEnabled NCGConfig
config
    avx2 :: Bool
avx2    = NCGConfig -> Bool
ncgAvx2Enabled NCGConfig
config
    avx512f :: Bool
avx512f = NCGConfig -> Bool
ncgAvx512fEnabled NCGConfig
config
    avx_move :: ScalarFormat -> Operand -> Operand -> Instr
avx_move ScalarFormat
sFmt =
      if ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
      then (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
assertCompatibleRegs ((Operand -> Operand -> Instr) -> Operand -> Operand -> Instr)
-> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a b. (a -> b) -> a -> b
$
           Format -> Operand -> Operand -> Instr
VMOVU   Format
fmt
      else Format -> Operand -> Operand -> Instr
VMOVDQU Format
fmt
    sse_move :: ScalarFormat -> Operand -> Operand -> Instr
sse_move ScalarFormat
sFmt =
      if ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
      then (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
assertCompatibleRegs ((Operand -> Operand -> Instr) -> Operand -> Operand -> Instr)
-> (Operand -> Operand -> Instr) -> Operand -> Operand -> Instr
forall a b. (a -> b) -> a -> b
$
           Format -> Operand -> Operand -> Instr
MOVU   Format
fmt
      else Format -> Operand -> Operand -> Instr
MOVDQU Format
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 -> 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
64) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Platform -> Int
spillSlotSize (NCGConfig -> Platform
ncgPlatform NCGConfig
config)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
--  = 0 -- useful for testing allocMoreStack

-- number of bytes that the stack pointer should be aligned to
stackAlign :: Int
stackAlign :: Int
stackAlign = Int
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 -> Int -> Int
spillSlotToOffset Platform
platform Int
slot
   = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Platform -> Int
spillSlotSize Platform
platform Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
slot

--------------------------------------------------------------------------------

-- | See if this instruction is telling us the current C stack delta
takeDeltaInstr
        :: Instr
        -> Maybe Int

takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr Instr
instr
 = case Instr
instr of
        DELTA Int
i         -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Instr
_               -> Maybe Int
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

-- | Make a reg-reg move instruction.
mkRegRegMoveInstr
    :: HasDebugCallStack
    => NCGConfig
    -> Format
    -> Reg
    -> Reg
    -> Instr
mkRegRegMoveInstr :: HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
config Format
fmt Reg
src Reg
dst =
  HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
fmt' (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
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 :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    fmt' :: Format
fmt'
      | Format -> Bool
isVecFormat Format
fmt
      = Format
fmt
      | Bool
otherwise
      = Platform -> Format -> Format
scalarMoveFormat Platform
platform Format
fmt

scalarMoveFormat :: Platform -> Format -> Format
scalarMoveFormat :: Platform -> Format -> Format
scalarMoveFormat Platform
platform Format
fmt
  | Format -> Bool
isFloatFormat Format
fmt
  = Format
FF64
  | Format
II64 <- Format
fmt
  = Format
II64
  | Bool
otherwise
  = Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
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 -> Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr Platform
platform = \case
  MOV Format
fmt (OpReg Reg
r1) (OpReg Reg
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.
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Format -> Bool
isVecFormat Format
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.
    , Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
r1 RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
r2
    -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
r1, Reg
r2)
  MOVD {}
    -- MOVD moves between xmm registers and general-purpose registers,
    -- and we don't want to eliminate those moves (as noted for MOV).
    -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing

  -- SSE2/AVX move instructions always move the full register.
  MOVU Format
_ (OpReg Reg
r1) (OpReg Reg
r2)
    -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
r1, Reg
r2)
  VMOVU Format
_ (OpReg Reg
r1) (OpReg Reg
r2)
    -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
r1, Reg
r2)
  MOVDQU Format
_ (OpReg Reg
r1) (OpReg Reg
r2)
    -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
r1, Reg
r2)
  VMOVDQU Format
_ (OpReg Reg
r1) (OpReg Reg
r2)
    -> (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
r1, Reg
r2)

  -- TODO: perhaps we can eliminate MOVZxL in certain situations?
  MOVZxL {} -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing
  MOVSxL {} -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing

  -- MOVL, MOVH and MOVHLPS preserve some part of the destination register,
  -- so are not simple moves.
  MOVL {} -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing
  MOVH {} -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing
  MOVHLPS {} -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing

  -- Other instructions are not moves.
  Instr
_ -> Maybe (Reg, Reg)
forall a. Maybe a
Nothing

-- | Make an unconditional branch instruction.
mkJumpInstr
        :: BlockId
        -> [Instr]

mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr BlockId
id
        = [Cond -> BlockId -> Instr
JXX Cond
ALWAYS BlockId
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 -> 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_64 -> Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
4 Int -> Int -> Int
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 ->
        -- 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 Platform -> Arch
platformArch Platform
platform of
            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 -> [RegWithFormat] -> Instr
CALL (Imm -> Either Imm Reg
forall a b. a -> Either a b
Left (Imm -> Either Imm Reg) -> Imm -> Either Imm Reg
forall a b. (a -> b) -> a -> b
$ FastString -> Imm
strImmLit (String -> FastString
fsLit String
"___chkstk_ms")) [Reg -> Format -> RegWithFormat
RegWithFormat Reg
rax Format
II64]
                           , 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
_ -> String -> [Instr]
forall a. HasCallStack => 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
_ -> String -> [Instr]
forall a. HasCallStack => 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
_ -> String -> [Instr]
forall a. HasCallStack => String -> a
panic String
"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 :: forall statics.
Platform
-> Int
-> NatCmmDecl statics Instr
-> UniqDSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
allocMoreStack Platform
_ Int
_ top :: NatCmmDecl statics Instr
top@(CmmData Section
_ statics
_) = (NatCmmDecl statics Instr, [(BlockId, BlockId)])
-> UniqDSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (NatCmmDecl statics Instr
top,[])
allocMoreStack Platform
platform Int
slots proc :: NatCmmDecl statics Instr
proc@(CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalRegUse]
live (ListGraph [GenBasicBlock Instr]
code)) = do
    let entries :: [BlockId]
entries = NatCmmDecl statics Instr -> [BlockId]
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> [BlockId]
entryBlocks NatCmmDecl statics Instr
proc

    retargetList <- (BlockId -> UniqDSM (BlockId, BlockId))
-> [BlockId] -> UniqDSM [(BlockId, BlockId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\BlockId
e -> (BlockId
e,) (BlockId -> (BlockId, BlockId))
-> UniqDSM BlockId -> UniqDSM (BlockId, BlockId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqDSM BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId) [BlockId]
entries

    let
      delta = ((Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stackAlign Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
stackAlign) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
stackAlign -- round up
        where x :: Int
x = Int
slots Int -> Int -> Int
forall a. Num a => a -> a -> a
* Platform -> Int
spillSlotSize Platform
platform -- sp delta

      alloc   = Platform -> Int -> [Instr]
mkStackAllocInstr   Platform
platform Int
delta
      dealloc = Platform -> Int -> [Instr]
mkStackDeallocInstr Platform
platform Int
delta

      new_blockmap :: LabelMap BlockId
      new_blockmap = [(BlockId, BlockId)] -> LabelMap BlockId
forall v. [(BlockId, v)] -> LabelMap v
mapFromList [(BlockId, BlockId)]
retargetList

      insert_stack_insns (BasicBlock BlockId
id [Instr]
insns)
         | Just BlockId
new_blockid <- BlockId -> LabelMap BlockId -> Maybe BlockId
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
id LabelMap BlockId
new_blockmap
         = [ BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id ([Instr] -> GenBasicBlock Instr) -> [Instr] -> GenBasicBlock Instr
forall a b. (a -> b) -> a -> b
$ [Instr]
alloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ [Cond -> BlockId -> Instr
JXX Cond
ALWAYS BlockId
new_blockid]
           , BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
new_blockid [Instr]
block' ]
         | Bool
otherwise
         = [ BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
block' ]
         where
           block' :: [Instr]
block' = (Instr -> [Instr] -> [Instr]) -> [Instr] -> [Instr] -> [Instr]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Instr -> [Instr] -> [Instr]
insert_dealloc [] [Instr]
insns

      insert_dealloc Instr
insn [Instr]
r = case Instr
insn of
         JMP Operand
_ [RegWithFormat]
_     -> [Instr]
dealloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ (Instr
insn Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r)
         JXX_GBL Cond
_ Imm
_ -> String -> [Instr]
forall a. HasCallStack => String -> a
panic String
"insert_dealloc: cannot handle JXX_GBL"
         Instr
_other      -> Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr Instr
insn BlockId -> BlockId
retarget Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
           where retarget :: BlockId -> BlockId
retarget BlockId
b = BlockId -> Maybe BlockId -> BlockId
forall a. a -> Maybe a -> a
fromMaybe BlockId
b (BlockId -> LabelMap BlockId -> Maybe BlockId
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
b LabelMap BlockId
new_blockmap)

      new_code = (GenBasicBlock Instr -> [GenBasicBlock Instr])
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insns [GenBasicBlock Instr]
code
    -- in
    return (CmmProc info lbl live (ListGraph new_code), retargetList)

data JumpDest = DestBlockId BlockId | DestImm Imm

-- Debug Instance
instance Outputable JumpDest where
  ppr :: JumpDest -> SDoc
ppr (DestBlockId BlockId
bid) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"jd<blk>:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
bid
  ppr (DestImm Imm
_imm)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"jd<imm>:noShow"

-- Implementations of the methods of 'NgcImpl'

getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId (DestBlockId BlockId
bid) = BlockId -> Maybe BlockId
forall a. a -> Maybe a
Just BlockId
bid
getJumpDestBlockId JumpDest
_                 = Maybe BlockId
forall a. Maybe a
Nothing

canShortcut :: Instr -> Maybe JumpDest
canShortcut :: Instr -> Maybe JumpDest
canShortcut (JXX Cond
ALWAYS BlockId
id)      = JumpDest -> Maybe JumpDest
forall a. a -> Maybe a
Just (BlockId -> JumpDest
DestBlockId BlockId
id)
canShortcut (JMP (OpImm Imm
imm) [RegWithFormat]
_)  = JumpDest -> Maybe JumpDest
forall a. a -> Maybe a
Just (Imm -> JumpDest
DestImm Imm
imm)
canShortcut Instr
_                    = Maybe JumpDest
forall a. Maybe a
Nothing

-- This helper shortcuts a sequence of branches.
-- The blockset helps avoid following cycles.
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 (LabelSet
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 BlockId -> LabelSet -> 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' = BlockId -> LabelSet -> LabelSet
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   -> JumpDest -> Maybe JumpDest
forall a. a -> Maybe a
Just (BlockId -> JumpDest
DestBlockId BlockId
bid )
                    Just JumpDest
dest -> JumpDest -> Maybe JumpDest
forall a. a -> Maybe a
Just JumpDest
dest
            updateBlock Maybe JumpDest
dest = Maybe JumpDest
dest
            blocks' :: [Maybe JumpDest]
blocks' = (Maybe JumpDest -> Maybe JumpDest)
-> [Maybe JumpDest] -> [Maybe JumpDest]
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

-- Here because it knows about JumpDest
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, CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl ([CmmStatic] -> RawCmmStatics) -> [CmmStatic] -> RawCmmStatics
forall a b. (a -> b) -> a -> b
$ (CmmStatic -> CmmStatic) -> [CmmStatic] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map ((BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic BlockId -> Maybe JumpDest
fn) [CmmStatic]
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 :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel BlockId -> Maybe JumpDest
fn CLabel
lab
  | Just BlockId
blkId <- CLabel -> Maybe BlockId
maybeLocalBlockLabel CLabel
lab = (BlockId -> Maybe JumpDest) -> UniqueSet -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn UniqueSet
emptyUniqueSet 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)
        -- slightly dodgy, we're ignoring the second label, but this
        -- works with the way we use CmmLabelDiffOff for jump tables now.
shortcutStatic BlockId -> Maybe JumpDest
_ CmmStatic
other_static
        = CmmStatic
other_static

shortBlockId
        :: (BlockId -> Maybe JumpDest)
        -> UniqueSet
        -> BlockId
        -> CLabel

shortBlockId :: (BlockId -> Maybe JumpDest) -> UniqueSet -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn UniqueSet
seen BlockId
blockid =
  case (Unique -> UniqueSet -> Bool
memberUniqueSet Unique
uq UniqueSet
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) -> UniqueSet -> BlockId -> CLabel
shortBlockId BlockId -> Maybe JumpDest
fn (Unique -> UniqueSet -> UniqueSet
insertUniqueSet Unique
uq UniqueSet
seen) BlockId
blockid'
    (Bool
_, Just (DestImm (ImmCLbl CLabel
lbl))) -> CLabel
lbl
    (Bool
_, Maybe JumpDest
_other) -> String -> CLabel
forall a. HasCallStack => String -> a
panic String
"shortBlockId"
  where uq :: Unique
uq = BlockId -> Unique
forall a. Uniquable a => a -> Unique
getUnique BlockId
blockid