Safe Haskell | None |
---|
- type Code = FCode ()
- data FCode a
- initC :: IO CgState
- runC :: DynFlags -> Module -> CgState -> FCode a -> (a, CgState)
- thenC :: Code -> FCode a -> FCode a
- thenFC :: FCode a -> (a -> FCode c) -> FCode c
- listCs :: [Code] -> Code
- listFCs :: [FCode a] -> FCode [a]
- mapCs :: (a -> Code) -> [a] -> Code
- mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
- returnFC :: a -> FCode a
- fixC :: (a -> FCode a) -> FCode a
- fixC_ :: (a -> FCode a) -> FCode ()
- checkedAbsC :: CmmStmt -> Code
- stmtC :: CmmStmt -> Code
- stmtsC :: [CmmStmt] -> Code
- labelC :: BlockId -> Code
- emitStmts :: CmmStmts -> Code
- nopC :: Code
- whenC :: Bool -> Code -> Code
- newLabelC :: FCode BlockId
- newUnique :: FCode Unique
- newUniqSupply :: FCode UniqSupply
- type CgStmts = OrdList CgStmt
- emitCgStmts :: CgStmts -> Code
- forkCgStmts :: CgStmts -> FCode BlockId
- cgStmtsToBlocks :: CgStmts -> FCode [CmmBasicBlock]
- getCgStmts' :: FCode a -> FCode (a, CgStmts)
- getCgStmts :: FCode a -> FCode CgStmts
- noCgStmts :: CgStmts
- oneCgStmt :: CmmStmt -> CgStmts
- consCgStmt :: CmmStmt -> CgStmts -> CgStmts
- getCmm :: Code -> FCode CmmGroup
- emitDecl :: CmmDecl -> Code
- emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
- emitSimpleProc :: CLabel -> Code -> Code
- forkLabelledCode :: Code -> FCode BlockId
- forkClosureBody :: Code -> Code
- forkStatics :: FCode a -> FCode a
- forkAlts :: [FCode a] -> FCode [a]
- forkEval :: EndOfBlockInfo -> Code -> FCode Sequel -> FCode EndOfBlockInfo
- forkEvalHelp :: EndOfBlockInfo -> Code -> FCode a -> FCode (VirtualSpOffset, a)
- forkProc :: Code -> FCode CgStmts
- codeOnly :: Code -> Code
- type SemiTaggingStuff = Maybe ([(ConTagZ, CmmLit)], CmmLit)
- type ConTagZ = Int
- data EndOfBlockInfo = EndOfBlockInfo VirtualSpOffset Sequel
- setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
- getEndOfBlockInfo :: FCode EndOfBlockInfo
- setSRT :: SRT -> FCode a -> FCode a
- getSRT :: FCode SRT
- setSRTLabel :: CLabel -> FCode a -> FCode a
- getSRTLabel :: FCode CLabel
- setTickyCtrLabel :: CLabel -> Code -> Code
- getTickyCtrLabel :: FCode CLabel
- data StackUsage = StackUsage {}
- data HeapUsage = HeapUsage {}
- type VirtualSpOffset = WordOff
- type VirtualHpOffset = WordOff
- initStkUsage :: StackUsage
- initHpUsage :: HeapUsage
- getHpUsage :: FCode HeapUsage
- setHpUsage :: HeapUsage -> Code
- heapHWM :: HeapUsage -> VirtualHpOffset
- getModuleName :: FCode Module
- data Sequel
- getState :: FCode CgState
- setState :: CgState -> FCode ()
- getInfoDown :: FCode CgInfoDownwards
- getDynFlags :: HasDynFlags m => m DynFlags
- getThisPackage :: FCode PackageId
- getStkUsage :: FCode StackUsage
- setStkUsage :: StackUsage -> Code
- getBinds :: FCode CgBindings
- setBinds :: CgBindings -> FCode ()
- getStaticBinds :: FCode CgBindings
- data CgInfoDownwards = MkCgInfoDown {}
- data CgState = MkCgState {
- cgs_stmts :: OrdList CgStmt
- cgs_tops :: OrdList CmmDecl
- cgs_binds :: CgBindings
- cgs_stk_usg :: StackUsage
- cgs_hp_usg :: HeapUsage
- cgs_uniqs :: UniqSupply
Documentation
checkedAbsC :: CmmStmt -> CodeSource
emitCgStmts :: CgStmts -> CodeSource
forkCgStmts :: CgStmts -> FCode BlockIdSource
getCgStmts' :: FCode a -> FCode (a, CgStmts)Source
getCgStmts :: FCode a -> FCode CgStmtsSource
consCgStmt :: CmmStmt -> CgStmts -> CgStmtsSource
emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> CodeSource
emitSimpleProc :: CLabel -> Code -> CodeSource
forkClosureBody :: Code -> CodeSource
Takes code and compiles it in a completely fresh environment, except that compilation info and statics are passed in unchanged. The current environment is passed on completely unaltered, except that the Cmm code from the fork is incorporated.
forkStatics :: FCode a -> FCode aSource
forkStatics
$fc$ compiles $fc$ in an environment whose statics come
from the current bindings, but which is otherwise freshly initialised.
The Cmm returned is attached to the current state, but the bindings and
usage information is otherwise unchanged.
forkAlts :: [FCode a] -> FCode [a]Source
forkAlts
$bs~d$ takes fcodes $bs$ for the branches of a case
, and an
an fcode for the default case $d$, and compiles each in the current
environment. The current environment is passed on unmodified, except that:
* the worst stack high-water mark is incorporated
* the virtual Hp is moved on to the worst virtual Hp for the branches
forkEval :: EndOfBlockInfo -> Code -> FCode Sequel -> FCode EndOfBlockInfoSource
forkEval
takes two blocks of code.
- The first meddles with the environment to set it up as expected by
the alternatives of a
case
which does an eval (or gc-possible primop). * The second block is the code for the alternatives. (plus info for semi-tagging purposes)
forkEval
picks up the virtual stack pointer and returns a suitable
EndOfBlockInfo
for the caller to use, together with whatever value
is returned by the second block.
It uses initEnvForAlternatives
to initialise the environment, and
stateIncUsageAlt
to incorporate usage; the latter ignores the heap usage.
forkEvalHelp :: EndOfBlockInfo -> Code -> FCode a -> FCode (VirtualSpOffset, a)Source
forkProc :: Code -> FCode CgStmtsSource
forkProc
takes a code and compiles it in the current environment,
returning the basic blocks thus constructed. The current environment is
passed on completely unchanged. It is pretty similar to getBlocks
, except
that the latter does affect the environment.
data EndOfBlockInfo Source
EndOfBlockInfo
tells what to do at the end of this block of code or, if
the expression is a case
, what to do at the end of each alternative.
setEndOfBlockInfo :: EndOfBlockInfo -> Code -> CodeSource
setSRTLabel :: CLabel -> FCode a -> FCode aSource
setTickyCtrLabel :: CLabel -> Code -> CodeSource
data StackUsage Source
Stack usage information during code generation.
INVARIANT: The environment contains no Stable references to stack slots below (lower offset) frameSp It can contain volatile references to this area though.
Heap usage information during code generation.
virtHp keeps track of the next location to allocate an object at. realHp keeps track of what the Hp STG register actually points to. The reason these aren't always the same is that we want to be able to move the realHp in one go when allocating numerous objects to save having to bump it each time. virtHp we do bump each time but it doesn't create corresponding inefficient machine code.
type VirtualSpOffset = WordOffSource
type VirtualHpOffset = WordOffSource
initStkUsage :: StackUsageSource
Initial stack usage
initHpUsage :: HeapUsageSource
Initial heap usage
setHpUsage :: HeapUsage -> CodeSource
heapHWM :: HeapUsage -> VirtualHpOffsetSource
Return the heap usage high water mark
Sequel
is a representation of the next continuation to jump to
after the current function.
Any addressing modes inside Sequel
must be ``robust,'' in the sense
that it must survive stack pointer adjustments at the end of the block.
getDynFlags :: HasDynFlags m => m DynFlagsSource
setStkUsage :: StackUsage -> CodeSource
setBinds :: CgBindings -> FCode ()Source
data CgInfoDownwards Source
State only passed *downwards* by the monad
MkCgInfoDown | |
|
State passed around and modified during code generation
MkCgState | |
|