Safe Haskell | None |
---|---|
Language | GHC2021 |
Synopsis
- data NcgImpl statics instr jumpDest = NcgImpl {
- ncgConfig :: !NCGConfig
- cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr]
- generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr)
- getJumpDestBlockId :: jumpDest -> Maybe BlockId
- canShortcut :: instr -> Maybe jumpDest
- shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics
- shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr
- pprNatCmmDeclS :: NatCmmDecl statics instr -> SDoc
- pprNatCmmDeclH :: NatCmmDecl statics instr -> HDoc
- maxSpillSlots :: Int
- allocatableRegs :: [RealReg]
- ncgAllocMoreStack :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])
- ncgMakeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> UniqSM [NatBasicBlock instr]
- extractUnwindPoints :: [instr] -> [UnwindPoint]
- invertCondBranches :: Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
- data NatM_State = NatM_State {}
- mkNatM_State :: UniqSupply -> Int -> NCGConfig -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
- data NatM a
- initNat :: NatM_State -> NatM a -> (a, NatM_State)
- addImportNat :: CLabel -> NatM ()
- addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM ()
- addImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()
- updateCfgNat :: (CFG -> CFG) -> NatM ()
- getUniqueNat :: NatM Unique
- setDeltaNat :: Int -> NatM ()
- getConfig :: NatM NCGConfig
- getPlatform :: NatM Platform
- getDeltaNat :: NatM Int
- getThisModuleNat :: NatM Module
- getBlockIdNat :: NatM BlockId
- getNewLabelNat :: NatM CLabel
- getNewRegNat :: Format -> NatM Reg
- getPicBaseMaybeNat :: NatM (Maybe Reg)
- getPicBaseNat :: Format -> NatM Reg
- getCfgWeights :: NatM Weights
- getFileId :: FastString -> NatM Int
- getDebugBlock :: Label -> NatM (Maybe DebugBlock)
- type DwarfFiles = UniqFM FastString (FastString, Int)
- data Reg64 = Reg64 !Reg !Reg
- data RegCode64 code = RegCode64 code !Reg !Reg
- getNewReg64 :: NatM Reg64
- localReg64 :: HasDebugCallStack => LocalReg -> Reg64
Documentation
data NcgImpl statics instr jumpDest Source #
NcgImpl | |
|
data NatM_State Source #
NatM_State | |
|
mkNatM_State :: UniqSupply -> Int -> NCGConfig -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State Source #
Instances
initNat :: NatM_State -> NatM a -> (a, NatM_State) Source #
addImportNat :: CLabel -> NatM () Source #
addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM () Source #
Record that we added a block between from
and old
.
setDeltaNat :: Int -> NatM () Source #
getPlatform :: NatM Platform Source #
Get target platform from native code generator configuration
getDeltaNat :: NatM Int Source #
getCfgWeights :: NatM Weights Source #
Get CFG edge weights
getDebugBlock :: Label -> NatM (Maybe DebugBlock) Source #
type DwarfFiles = UniqFM FastString (FastString, Int) Source #
64-bit registers on 32-bit architectures
Two 32-bit regs used as a single virtual 64-bit register
Two 32-bit regs used as a single virtual 64-bit register and the code to set them appropriately
getNewReg64 :: NatM Reg64 Source #
Return a virtual 64-bit register
localReg64 :: HasDebugCallStack => LocalReg -> Reg64 Source #
Convert a 64-bit LocalReg into two virtual 32-bit regs.
Used to handle 64-bit "registers" on 32-bit architectures