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