{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
module GHC.StgToCmm.Monad (
FCode,
initC, initFCodeState, runC, fixC,
newUnique,
emitLabel,
emit, emitDecl,
emitProcWithConvention, emitProcWithStackFrame,
emitOutOfLine, emitAssign, emitStore, emitStore',
emitComment, emitTick, emitUnwind,
newTemp,
getCmm, aGraphToGraph, getPlatform, getProfile,
getCodeR, getCode, getCodeScoped, getHeapUsage,
getContext,
mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,
mkCmmIfThenElse', mkCmmIfThen', mkCmmIfGoto',
mkCall, mkCmmCall,
forkClosureBody, forkLneBody, forkAlts, forkAltPair, codeOnly,
ConTagZ,
Sequel(..), ReturnKind(..),
withSequel, getSequel,
SelfLoopInfo(..),
setTickyCtrLabel, getTickyCtrLabel,
tickScope, getTickScope,
withUpdFrameOff, getUpdFrameOff,
HeapUsage(..), VirtualHpOffset, initHpUsage,
getHpUsage, setHpUsage, heapHWM,
setVirtHp, getVirtHp, setRealHp,
getModuleName,
getState, setState, getSelfLoop, withSelfLoop, getStgToCmmConfig,
CgIdInfo(..),
getBinds, setBinds,
StgToCmmConfig(..), CgState(..)
) where
import GHC.Prelude hiding( sequence, succ )
import GHC.Platform
import GHC.Platform.Profile
import GHC.Cmm
import GHC.StgToCmm.Config
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Sequel
import GHC.Cmm.Graph as CmmGraph
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
import GHC.Unit
import GHC.Types.Id
import GHC.Types.Var.Env
import GHC.Data.OrdList
import GHC.Types.Basic( ConTagZ )
import GHC.Types.Unique
import GHC.Types.Unique.Supply
import qualified GHC.Types.Unique.DSM as DSM ( MonadGetUnique, getUniqueM )
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
import GHC.Exts (oneShot)
import Control.Monad
import Data.List (mapAccumL)
newtype FCode a = FCode' { forall a.
FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
doFCode :: StgToCmmConfig -> FCodeState -> CgState -> (a, CgState) }
instance Functor FCode where
fmap :: forall a b. (a -> b) -> FCode a -> FCode b
fmap a -> b
f (FCode StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m) =
(StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b)
-> (StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
cfg FCodeState
fst CgState
state ->
case StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m StgToCmmConfig
cfg FCodeState
fst CgState
state of
(a
x, CgState
state') -> (a -> b
f a
x, CgState
state')
{-# COMPLETE FCode #-}
pattern FCode :: (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
pattern $mFCode :: forall {r} {a}.
FCode a
-> ((StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)) -> r)
-> ((# #) -> r)
-> r
$bFCode :: forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode m <- FCode' m
where
FCode StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m = (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode' ((StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a)
-> (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a b. (a -> b) -> a -> b
$ (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
forall a b. (a -> b) -> a -> b
oneShot (\StgToCmmConfig
cfg -> (FCodeState -> CgState -> (a, CgState))
-> FCodeState -> CgState -> (a, CgState)
forall a b. (a -> b) -> a -> b
oneShot
(\FCodeState
fstate -> (CgState -> (a, CgState)) -> CgState -> (a, CgState)
forall a b. (a -> b) -> a -> b
oneShot
(\CgState
state -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m StgToCmmConfig
cfg FCodeState
fstate CgState
state)))
instance Applicative FCode where
pure :: forall a. a -> FCode a
pure a
val = (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode (\StgToCmmConfig
_cfg FCodeState
_fstate CgState
state -> (a
val, CgState
state))
{-# INLINE pure #-}
<*> :: forall a b. FCode (a -> b) -> FCode a -> FCode b
(<*>) = FCode (a -> b) -> FCode a -> FCode b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad FCode where
FCode StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m >>= :: forall a b. FCode a -> (a -> FCode b) -> FCode b
>>= a -> FCode b
k = (StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b)
-> (StgToCmmConfig -> FCodeState -> CgState -> (b, CgState))
-> FCode b
forall a b. (a -> b) -> a -> b
$
\StgToCmmConfig
cfg FCodeState
fstate CgState
state ->
case StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
m StgToCmmConfig
cfg FCodeState
fstate CgState
state of
(a
m_result, CgState
new_state) ->
case a -> FCode b
k a
m_result of
FCode StgToCmmConfig -> FCodeState -> CgState -> (b, CgState)
kcode -> StgToCmmConfig -> FCodeState -> CgState -> (b, CgState)
kcode StgToCmmConfig
cfg FCodeState
fstate CgState
new_state
{-# INLINE (>>=) #-}
instance MonadUnique FCode where
getUniqueSupplyM :: FCode UniqSupply
getUniqueSupplyM = CgState -> UniqSupply
cgs_uniqs (CgState -> UniqSupply) -> FCode CgState -> FCode UniqSupply
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode CgState
getState
getUniqueM :: FCode Unique
getUniqueM = (StgToCmmConfig -> FCodeState -> CgState -> (Unique, CgState))
-> FCode Unique
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (Unique, CgState))
-> FCode Unique)
-> (StgToCmmConfig -> FCodeState -> CgState -> (Unique, CgState))
-> FCode Unique
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
_ FCodeState
_ CgState
st ->
let (Unique
u, UniqSupply
us') = UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply (CgState -> UniqSupply
cgs_uniqs CgState
st)
in (Unique
u, CgState
st { cgs_uniqs = us' })
instance DSM.MonadGetUnique FCode where
getUniqueM :: FCode Unique
getUniqueM = FCode Unique
forall (m :: * -> *). MonadUnique m => m Unique
GHC.Types.Unique.Supply.getUniqueM
initC :: IO CgState
initC :: IO CgState
initC = do { uniqs <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'c'
; return (initCgState uniqs) }
runC :: StgToCmmConfig -> FCodeState -> CgState -> FCode a -> (a, CgState)
runC :: forall a.
StgToCmmConfig -> FCodeState -> CgState -> FCode a -> (a, CgState)
runC StgToCmmConfig
cfg FCodeState
fst CgState
st FCode a
fcode = FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
forall a.
FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
doFCode FCode a
fcode StgToCmmConfig
cfg FCodeState
fst CgState
st
fixC :: (a -> FCode a) -> FCode a
fixC :: forall a. (a -> FCode a) -> FCode a
fixC a -> FCode a
fcode = (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a)
-> (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a b. (a -> b) -> a -> b
$
\StgToCmmConfig
cfg FCodeState
fstate CgState
state ->
let (a
v, CgState
s) = FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
forall a.
FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
doFCode (a -> FCode a
fcode a
v) StgToCmmConfig
cfg FCodeState
fstate CgState
state
in (a
v, CgState
s)
type CgBindings = IdEnv CgIdInfo
data CgIdInfo
= CgIdInfo
{ CgIdInfo -> Id
cg_id :: Id
, CgIdInfo -> LambdaFormInfo
cg_lf :: LambdaFormInfo
, CgIdInfo -> CgLoc
cg_loc :: CgLoc
}
instance OutputableP Platform CgIdInfo where
pdoc :: Platform -> CgIdInfo -> SDoc
pdoc Platform
env (CgIdInfo { cg_id :: CgIdInfo -> Id
cg_id = Id
id, cg_loc :: CgIdInfo -> CgLoc
cg_loc = CgLoc
loc })
= Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CgLoc -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
env CgLoc
loc
data ReturnKind
= AssignedDirectly
| ReturnedTo BlockId ByteOff
data CgState
= MkCgState {
CgState -> CmmAGraph
cgs_stmts :: CmmAGraph,
CgState -> OrdList DCmmDecl
cgs_tops :: OrdList DCmmDecl,
CgState -> CgBindings
cgs_binds :: CgBindings,
CgState -> HeapUsage
cgs_hp_usg :: HeapUsage,
CgState -> UniqSupply
cgs_uniqs :: UniqSupply }
data FCodeState =
MkFCodeState { FCodeState -> VirtualHpOffset
fcs_upframeoffset :: UpdFrameOffset
, FCodeState -> Sequel
fcs_sequel :: !Sequel
, FCodeState -> Maybe SelfLoopInfo
fcs_selfloop :: !(Maybe SelfLoopInfo)
, FCodeState -> CLabel
fcs_ticky :: !CLabel
, FCodeState -> CmmTickScope
fcs_tickscope :: !CmmTickScope
}
data HeapUsage
= HeapUsage {
HeapUsage -> VirtualHpOffset
virtHp :: VirtualHpOffset,
HeapUsage -> VirtualHpOffset
realHp :: VirtualHpOffset
}
type VirtualHpOffset = WordOff
initCgState :: UniqSupply -> CgState
initCgState :: UniqSupply -> CgState
initCgState UniqSupply
uniqs
= MkCgState { cgs_stmts :: CmmAGraph
cgs_stmts = CmmAGraph
mkNop
, cgs_tops :: OrdList DCmmDecl
cgs_tops = OrdList DCmmDecl
forall a. OrdList a
nilOL
, cgs_binds :: CgBindings
cgs_binds = CgBindings
forall a. VarEnv a
emptyVarEnv
, cgs_hp_usg :: HeapUsage
cgs_hp_usg = HeapUsage
initHpUsage
, cgs_uniqs :: UniqSupply
cgs_uniqs = UniqSupply
uniqs }
stateIncUsage :: CgState -> CgState -> CgState
stateIncUsage :: CgState -> CgState -> CgState
stateIncUsage CgState
s1 s2 :: CgState
s2@(MkCgState { cgs_hp_usg :: CgState -> HeapUsage
cgs_hp_usg = HeapUsage
hp_usg })
= CgState
s1 { cgs_hp_usg = cgs_hp_usg s1 `maxHpHw` virtHp hp_usg }
CgState -> CgState -> CgState
`addCodeBlocksFrom` CgState
s2
addCodeBlocksFrom :: CgState -> CgState -> CgState
CgState
s1 addCodeBlocksFrom :: CgState -> CgState -> CgState
`addCodeBlocksFrom` CgState
s2
= CgState
s1 { cgs_stmts = cgs_stmts s1 CmmGraph.<*> cgs_stmts s2,
cgs_tops = cgs_tops s1 `appOL` cgs_tops s2 }
heapHWM :: HeapUsage -> VirtualHpOffset
heapHWM :: HeapUsage -> VirtualHpOffset
heapHWM = HeapUsage -> VirtualHpOffset
virtHp
initHpUsage :: HeapUsage
initHpUsage :: HeapUsage
initHpUsage = HeapUsage { virtHp :: VirtualHpOffset
virtHp = VirtualHpOffset
0, realHp :: VirtualHpOffset
realHp = VirtualHpOffset
0 }
maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
HeapUsage
hp_usg maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
`maxHpHw` VirtualHpOffset
hw = HeapUsage
hp_usg { virtHp = virtHp hp_usg `max` hw }
getState :: FCode CgState
getState :: FCode CgState
getState = (StgToCmmConfig -> FCodeState -> CgState -> (CgState, CgState))
-> FCode CgState
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (CgState, CgState))
-> FCode CgState)
-> (StgToCmmConfig -> FCodeState -> CgState -> (CgState, CgState))
-> FCode CgState
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
_cfg FCodeState
_fstate CgState
state -> (CgState
state, CgState
state)
setState :: CgState -> FCode ()
setState :: CgState -> FCode ()
setState CgState
state = (StgToCmmConfig -> FCodeState -> CgState -> ((), CgState))
-> FCode ()
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> ((), CgState))
-> FCode ())
-> (StgToCmmConfig -> FCodeState -> CgState -> ((), CgState))
-> FCode ()
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
_cfg FCodeState
_fstate CgState
_ -> ((), CgState
state)
getHpUsage :: FCode HeapUsage
getHpUsage :: FCode HeapUsage
getHpUsage = do
state <- FCode CgState
getState
return $ cgs_hp_usg state
setHpUsage :: HeapUsage -> FCode ()
setHpUsage :: HeapUsage -> FCode ()
setHpUsage HeapUsage
new_hp_usg = do
state <- FCode CgState
getState
setState $ state {cgs_hp_usg = new_hp_usg}
setVirtHp :: VirtualHpOffset -> FCode ()
setVirtHp :: VirtualHpOffset -> FCode ()
setVirtHp VirtualHpOffset
new_virtHp
= do { hp_usage <- FCode HeapUsage
getHpUsage
; setHpUsage (hp_usage {virtHp = new_virtHp}) }
getVirtHp :: FCode VirtualHpOffset
getVirtHp :: FCode VirtualHpOffset
getVirtHp
= do { hp_usage <- FCode HeapUsage
getHpUsage
; return (virtHp hp_usage) }
setRealHp :: VirtualHpOffset -> FCode ()
setRealHp :: VirtualHpOffset -> FCode ()
setRealHp VirtualHpOffset
new_realHp
= do { hp_usage <- FCode HeapUsage
getHpUsage
; setHpUsage (hp_usage {realHp = new_realHp}) }
getBinds :: FCode CgBindings
getBinds :: FCode CgBindings
getBinds = do
state <- FCode CgState
getState
return $ cgs_binds state
setBinds :: CgBindings -> FCode ()
setBinds :: CgBindings -> FCode ()
setBinds CgBindings
new_binds = do
state <- FCode CgState
getState
setState $ state {cgs_binds = new_binds}
withCgState :: FCode a -> CgState -> FCode (a,CgState)
withCgState :: forall a. FCode a -> CgState -> FCode (a, CgState)
withCgState (FCode StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
fcode) CgState
newstate = (StgToCmmConfig
-> FCodeState -> CgState -> ((a, CgState), CgState))
-> FCode (a, CgState)
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig
-> FCodeState -> CgState -> ((a, CgState), CgState))
-> FCode (a, CgState))
-> (StgToCmmConfig
-> FCodeState -> CgState -> ((a, CgState), CgState))
-> FCode (a, CgState)
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
cfg FCodeState
fstate CgState
state ->
case StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
fcode StgToCmmConfig
cfg FCodeState
fstate CgState
newstate of
(a
retval, CgState
state2) -> ((a
retval,CgState
state2), CgState
state)
newUniqSupply :: FCode UniqSupply
newUniqSupply :: FCode UniqSupply
newUniqSupply = do
state <- FCode CgState
getState
let (us1, us2) = splitUniqSupply (cgs_uniqs state)
setState $ state { cgs_uniqs = us1 }
return us2
newUnique :: FCode Unique
newUnique :: FCode Unique
newUnique = do
state <- FCode CgState
getState
let (u,us') = takeUniqFromSupply (cgs_uniqs state)
setState $ state { cgs_uniqs = us' }
return u
newTemp :: DSM.MonadGetUnique m => CmmType -> m LocalReg
newTemp :: forall (m :: * -> *). MonadGetUnique m => CmmType -> m LocalReg
newTemp CmmType
rep = do { uniq <- m Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
DSM.getUniqueM
; return (LocalReg uniq rep) }
initFCodeState :: Platform -> FCodeState
initFCodeState :: Platform -> FCodeState
initFCodeState Platform
p =
MkFCodeState { fcs_upframeoffset :: VirtualHpOffset
fcs_upframeoffset = Platform -> VirtualHpOffset
platformWordSizeInBytes Platform
p
, fcs_sequel :: Sequel
fcs_sequel = Sequel
Return
, fcs_selfloop :: Maybe SelfLoopInfo
fcs_selfloop = Maybe SelfLoopInfo
forall a. Maybe a
Nothing
, fcs_ticky :: CLabel
fcs_ticky = CLabel
mkTopTickyCtrLabel
, fcs_tickscope :: CmmTickScope
fcs_tickscope = CmmTickScope
GlobalScope
}
getFCodeState :: FCode FCodeState
getFCodeState :: FCode FCodeState
getFCodeState = (StgToCmmConfig -> FCodeState -> CgState -> (FCodeState, CgState))
-> FCode FCodeState
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (FCodeState, CgState))
-> FCode FCodeState)
-> (StgToCmmConfig
-> FCodeState -> CgState -> (FCodeState, CgState))
-> FCode FCodeState
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
_ FCodeState
fstate CgState
state -> (FCodeState
fstate,CgState
state)
withFCodeState :: FCode a -> FCodeState -> FCode a
withFCodeState :: forall a. FCode a -> FCodeState -> FCode a
withFCodeState (FCode StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
fcode) FCodeState
fst = (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a)
-> (StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
cfg FCodeState
_ CgState
state -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
fcode StgToCmmConfig
cfg FCodeState
fst CgState
state
getSelfLoop :: FCode (Maybe SelfLoopInfo)
getSelfLoop :: FCode (Maybe SelfLoopInfo)
getSelfLoop = FCodeState -> Maybe SelfLoopInfo
fcs_selfloop (FCodeState -> Maybe SelfLoopInfo)
-> FCode FCodeState -> FCode (Maybe SelfLoopInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode FCodeState
getFCodeState
withSelfLoop :: SelfLoopInfo -> FCode a -> FCode a
withSelfLoop :: forall a. SelfLoopInfo -> FCode a -> FCode a
withSelfLoop SelfLoopInfo
self_loop FCode a
code = do
fstate <- FCode FCodeState
getFCodeState
withFCodeState code (fstate {fcs_selfloop = Just self_loop})
withSequel :: Sequel -> FCode a -> FCode a
withSequel :: forall a. Sequel -> FCode a -> FCode a
withSequel Sequel
sequel FCode a
code
= do { fstate <- FCode FCodeState
getFCodeState
; withFCodeState code (fstate { fcs_sequel = sequel
, fcs_selfloop = Nothing }) }
getSequel :: FCode Sequel
getSequel :: FCode Sequel
getSequel = FCodeState -> Sequel
fcs_sequel (FCodeState -> Sequel) -> FCode FCodeState -> FCode Sequel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode FCodeState
getFCodeState
withUpdFrameOff :: UpdFrameOffset -> FCode a -> FCode a
withUpdFrameOff :: forall a. VirtualHpOffset -> FCode a -> FCode a
withUpdFrameOff VirtualHpOffset
size FCode a
code
= do { fstate <- FCode FCodeState
getFCodeState
; withFCodeState code (fstate {fcs_upframeoffset = size }) }
getUpdFrameOff :: FCode UpdFrameOffset
getUpdFrameOff :: FCode VirtualHpOffset
getUpdFrameOff = FCodeState -> VirtualHpOffset
fcs_upframeoffset (FCodeState -> VirtualHpOffset)
-> FCode FCodeState -> FCode VirtualHpOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode FCodeState
getFCodeState
getTickyCtrLabel :: FCode CLabel
getTickyCtrLabel :: FCode CLabel
getTickyCtrLabel = FCodeState -> CLabel
fcs_ticky (FCodeState -> CLabel) -> FCode FCodeState -> FCode CLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode FCodeState
getFCodeState
setTickyCtrLabel :: CLabel -> FCode a -> FCode a
setTickyCtrLabel :: forall a. CLabel -> FCode a -> FCode a
setTickyCtrLabel CLabel
ticky FCode a
code = do
fstate <- FCode FCodeState
getFCodeState
withFCodeState code (fstate {fcs_ticky = ticky})
getTickScope :: FCode CmmTickScope
getTickScope :: FCode CmmTickScope
getTickScope = FCodeState -> CmmTickScope
fcs_tickscope (FCodeState -> CmmTickScope)
-> FCode FCodeState -> FCode CmmTickScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode FCodeState
getFCodeState
tickScope :: FCode a -> FCode a
tickScope :: forall a. FCode a -> FCode a
tickScope FCode a
code = do
cfg <- FCode StgToCmmConfig
getStgToCmmConfig
fstate <- getFCodeState
if not $ stgToCmmEmitDebugInfo cfg then code else do
u <- newUnique
let scope' = Unique -> CmmTickScope -> CmmTickScope
SubScope Unique
u (FCodeState -> CmmTickScope
fcs_tickscope FCodeState
fstate)
withFCodeState code fstate{ fcs_tickscope = scope' }
getStgToCmmConfig :: FCode StgToCmmConfig
getStgToCmmConfig :: FCode StgToCmmConfig
getStgToCmmConfig = (StgToCmmConfig
-> FCodeState -> CgState -> (StgToCmmConfig, CgState))
-> FCode StgToCmmConfig
forall a.
(StgToCmmConfig -> FCodeState -> CgState -> (a, CgState))
-> FCode a
FCode ((StgToCmmConfig
-> FCodeState -> CgState -> (StgToCmmConfig, CgState))
-> FCode StgToCmmConfig)
-> (StgToCmmConfig
-> FCodeState -> CgState -> (StgToCmmConfig, CgState))
-> FCode StgToCmmConfig
forall a b. (a -> b) -> a -> b
$ \StgToCmmConfig
cfg FCodeState
_ CgState
state -> (StgToCmmConfig
cfg,CgState
state)
getProfile :: FCode Profile
getProfile :: FCode Profile
getProfile = StgToCmmConfig -> Profile
stgToCmmProfile (StgToCmmConfig -> Profile)
-> FCode StgToCmmConfig -> FCode Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
getPlatform :: FCode Platform
getPlatform :: FCode Platform
getPlatform = Profile -> Platform
profilePlatform (Profile -> Platform) -> FCode Profile -> FCode Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode Profile
getProfile
getContext :: FCode SDocContext
getContext :: FCode SDocContext
getContext = StgToCmmConfig -> SDocContext
stgToCmmContext (StgToCmmConfig -> SDocContext)
-> FCode StgToCmmConfig -> FCode SDocContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
getModuleName :: FCode Module
getModuleName :: FCode Module
getModuleName = StgToCmmConfig -> Module
stgToCmmThisModule (StgToCmmConfig -> Module) -> FCode StgToCmmConfig -> FCode Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
forkClosureBody :: FCode () -> FCode ()
forkClosureBody :: FCode () -> FCode ()
forkClosureBody FCode ()
body_code
= do { platform <- FCode Platform
getPlatform
; cfg <- getStgToCmmConfig
; fstate <- getFCodeState
; us <- newUniqSupply
; state <- getState
; let fcs = FCodeState
fstate { fcs_sequel = Return
, fcs_upframeoffset = platformWordSizeInBytes platform
, fcs_selfloop = Nothing
}
fork_state_in = (UniqSupply -> CgState
initCgState UniqSupply
us) { cgs_binds = cgs_binds state }
((),fork_state_out) = doFCode body_code cfg fcs fork_state_in
; setState $ state `addCodeBlocksFrom` fork_state_out }
forkLneBody :: FCode a -> FCode a
forkLneBody :: forall a. FCode a -> FCode a
forkLneBody FCode a
body_code
= do { cfg <- FCode StgToCmmConfig
getStgToCmmConfig
; us <- newUniqSupply
; state <- getState
; fstate <- getFCodeState
; let fork_state_in = (UniqSupply -> CgState
initCgState UniqSupply
us) { cgs_binds = cgs_binds state }
(result, fork_state_out) = doFCode body_code cfg fstate fork_state_in
; setState $ state `addCodeBlocksFrom` fork_state_out
; return result }
codeOnly :: FCode () -> FCode ()
codeOnly :: FCode () -> FCode ()
codeOnly FCode ()
body_code
= do { cfg <- FCode StgToCmmConfig
getStgToCmmConfig
; us <- newUniqSupply
; state <- getState
; fstate <- getFCodeState
; let fork_state_in = (UniqSupply -> CgState
initCgState UniqSupply
us) { cgs_binds = cgs_binds state
, cgs_hp_usg = cgs_hp_usg state }
((), fork_state_out) = doFCode body_code cfg fstate fork_state_in
; setState $ state `addCodeBlocksFrom` fork_state_out }
forkAlts :: [FCode a] -> FCode [a]
forkAlts :: forall a. [FCode a] -> FCode [a]
forkAlts [FCode a]
branch_fcodes
= do { cfg <- FCode StgToCmmConfig
getStgToCmmConfig
; us <- newUniqSupply
; state <- getState
; fstate <- getFCodeState
; let compile UniqSupply
us FCode a
branch
= (UniqSupply
us2, FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
forall a.
FCode a -> StgToCmmConfig -> FCodeState -> CgState -> (a, CgState)
doFCode FCode a
branch StgToCmmConfig
cfg FCodeState
fstate CgState
branch_state)
where
(UniqSupply
us1,UniqSupply
us2) = UniqSupply -> (UniqSupply, UniqSupply)
splitUniqSupply UniqSupply
us
branch_state :: CgState
branch_state = (UniqSupply -> CgState
initCgState UniqSupply
us1) {
cgs_binds = cgs_binds state
, cgs_hp_usg = cgs_hp_usg state }
(_us, results) = mapAccumL compile us branch_fcodes
(branch_results, branch_out_states) = unzip results
; setState $ foldl' stateIncUsage state branch_out_states
; return branch_results }
forkAltPair :: FCode a -> FCode a -> FCode (a,a)
forkAltPair :: forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair FCode a
x FCode a
y = do
xy' <- [FCode a] -> FCode [a]
forall a. [FCode a] -> FCode [a]
forkAlts [FCode a
x,FCode a
y]
case xy' of
[a
x',a
y'] -> (a, a) -> FCode (a, a)
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x',a
y')
[a]
_ -> String -> FCode (a, a)
forall a. HasCallStack => String -> a
panic String
"forkAltPair"
getCodeR :: FCode a -> FCode (a, CmmAGraph)
getCodeR :: forall a. FCode a -> FCode (a, CmmAGraph)
getCodeR FCode a
fcode
= do { state1 <- FCode CgState
getState
; (a, state2) <- withCgState fcode (state1 { cgs_stmts = mkNop })
; setState $ state2 { cgs_stmts = cgs_stmts state1 }
; return (a, cgs_stmts state2) }
getCode :: FCode a -> FCode CmmAGraph
getCode :: forall a. FCode a -> FCode CmmAGraph
getCode FCode a
fcode = do { (_,stmts) <- FCode a -> FCode (a, CmmAGraph)
forall a. FCode a -> FCode (a, CmmAGraph)
getCodeR FCode a
fcode; return stmts }
getCodeScoped :: FCode a -> FCode (a, CmmAGraphScoped)
getCodeScoped :: forall a. FCode a -> FCode (a, CmmAGraphScoped)
getCodeScoped FCode a
fcode
= do { state1 <- FCode CgState
getState
; ((a, tscope), state2) <-
tickScope $
flip withCgState state1 { cgs_stmts = mkNop } $
do { a <- fcode
; scp <- getTickScope
; return (a, scp) }
; setState $ state2 { cgs_stmts = cgs_stmts state1 }
; return (a, (cgs_stmts state2, tscope)) }
getHeapUsage :: (VirtualHpOffset -> FCode a) -> FCode a
getHeapUsage :: forall a. (VirtualHpOffset -> FCode a) -> FCode a
getHeapUsage VirtualHpOffset -> FCode a
fcode
= do { cfg <- FCode StgToCmmConfig
getStgToCmmConfig
; state <- getState
; fcstate <- getFCodeState
; let fstate_in = CgState
state { cgs_hp_usg = initHpUsage }
(r, fstate_out) = doFCode (fcode hp_hw) cfg fcstate fstate_in
hp_hw = HeapUsage -> VirtualHpOffset
heapHWM (CgState -> HeapUsage
cgs_hp_usg CgState
fstate_out)
; setState $ fstate_out { cgs_hp_usg = cgs_hp_usg state }
; return r }
emitCgStmt :: CgStmt -> FCode ()
emitCgStmt :: CgStmt -> FCode ()
emitCgStmt CgStmt
stmt
= do { state <- FCode CgState
getState
; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
}
emitLabel :: BlockId -> FCode ()
emitLabel :: BlockId -> FCode ()
emitLabel BlockId
id = do tscope <- FCode CmmTickScope
getTickScope
emitCgStmt (CgLabel id tscope)
emitComment :: FastString -> FCode ()
FastString
s
| Bool
debugIsOn = CgStmt -> FCode ()
emitCgStmt (CmmNode O O -> CgStmt
CgStmt (FastString -> CmmNode O O
CmmComment FastString
s))
| Bool
otherwise = () -> FCode ()
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
emitTick :: CmmTickish -> FCode ()
emitTick :: CmmTickish -> FCode ()
emitTick = CgStmt -> FCode ()
emitCgStmt (CgStmt -> FCode ())
-> (CmmTickish -> CgStmt) -> CmmTickish -> FCode ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmNode O O -> CgStmt
CgStmt (CmmNode O O -> CgStmt)
-> (CmmTickish -> CmmNode O O) -> CmmTickish -> CgStmt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmTickish -> CmmNode O O
CmmTick
emitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()
emitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()
emitUnwind [(GlobalReg, Maybe CmmExpr)]
regs = do
debug <- StgToCmmConfig -> Bool
stgToCmmEmitDebugInfo (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
when debug $
emitCgStmt $ CgStmt $ CmmUnwind regs
emitAssign :: CmmReg -> CmmExpr -> FCode ()
emitAssign :: CmmReg -> CmmExpr -> FCode ()
emitAssign CmmReg
l CmmExpr
r = CgStmt -> FCode ()
emitCgStmt (CmmNode O O -> CgStmt
CgStmt (CmmReg -> CmmExpr -> CmmNode O O
CmmAssign CmmReg
l CmmExpr
r))
emitStore :: CmmExpr -> CmmExpr -> FCode ()
emitStore :: CmmExpr -> CmmExpr -> FCode ()
emitStore = AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
emitStore' AlignmentSpec
NaturallyAligned
emitStore' :: AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
emitStore' :: AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
emitStore' AlignmentSpec
alignment CmmExpr
l CmmExpr
r = CgStmt -> FCode ()
emitCgStmt (CmmNode O O -> CgStmt
CgStmt (CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode O O
CmmStore CmmExpr
l CmmExpr
r AlignmentSpec
alignment))
emit :: CmmAGraph -> FCode ()
emit :: CmmAGraph -> FCode ()
emit CmmAGraph
ag
= do { state <- FCode CgState
getState
; setState $ state { cgs_stmts = cgs_stmts state CmmGraph.<*> ag } }
emitDecl :: DCmmDecl -> FCode ()
emitDecl :: DCmmDecl -> FCode ()
emitDecl DCmmDecl
decl
= do { state <- FCode CgState
getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
emitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()
emitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()
emitOutOfLine BlockId
l (CmmAGraph
stmts, CmmTickScope
tscope) = CgStmt -> FCode ()
emitCgStmt (BlockId -> CmmAGraph -> CmmTickScope -> CgStmt
CgFork BlockId
l CmmAGraph
stmts CmmTickScope
tscope)
emitProcWithStackFrame
:: Convention
-> Maybe CmmInfoTable
-> CLabel
-> [CmmFormal]
-> [CmmFormal]
-> CmmAGraphScoped
-> Bool
-> FCode ()
emitProcWithStackFrame :: Convention
-> Maybe CmmInfoTable
-> CLabel
-> [LocalReg]
-> [LocalReg]
-> CmmAGraphScoped
-> Bool
-> FCode ()
emitProcWithStackFrame Convention
_conv Maybe CmmInfoTable
mb_info CLabel
lbl [LocalReg]
_stk_args [] CmmAGraphScoped
blocks Bool
False
= do { platform <- FCode Platform
getPlatform
; emitProc mb_info lbl [] blocks (widthInBytes (wordWidth platform)) False
}
emitProcWithStackFrame Convention
conv Maybe CmmInfoTable
mb_info CLabel
lbl [LocalReg]
stk_args [LocalReg]
args (CmmAGraph
graph, CmmTickScope
tscope) Bool
True
= do { profile <- FCode Profile
getProfile
; let (offset, live, entry) = mkCallEntry profile conv args stk_args
graph' = CmmAGraph
entry CmmAGraph -> CmmAGraph -> CmmAGraph
CmmGraph.<*> CmmAGraph
graph
; emitProc mb_info lbl live (graph', tscope) offset True
}
emitProcWithStackFrame Convention
_ Maybe CmmInfoTable
_ CLabel
_ [LocalReg]
_ [LocalReg]
_ CmmAGraphScoped
_ Bool
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"emitProcWithStackFrame"
emitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel
-> [CmmFormal]
-> CmmAGraphScoped
-> FCode ()
emitProcWithConvention :: Convention
-> Maybe CmmInfoTable
-> CLabel
-> [LocalReg]
-> CmmAGraphScoped
-> FCode ()
emitProcWithConvention Convention
conv Maybe CmmInfoTable
mb_info CLabel
lbl [LocalReg]
args CmmAGraphScoped
blocks
= Convention
-> Maybe CmmInfoTable
-> CLabel
-> [LocalReg]
-> [LocalReg]
-> CmmAGraphScoped
-> Bool
-> FCode ()
emitProcWithStackFrame Convention
conv Maybe CmmInfoTable
mb_info CLabel
lbl [] [LocalReg]
args CmmAGraphScoped
blocks Bool
True
emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalRegUse] -> CmmAGraphScoped
-> Int -> Bool -> FCode ()
emitProc :: Maybe CmmInfoTable
-> CLabel
-> [GlobalRegUse]
-> CmmAGraphScoped
-> VirtualHpOffset
-> Bool
-> FCode ()
emitProc Maybe CmmInfoTable
mb_info CLabel
lbl [GlobalRegUse]
live CmmAGraphScoped
blocks VirtualHpOffset
offset Bool
do_layout
= do { l <- FCode BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId
; let
blks :: DCmmGraph
blks = BlockId -> CmmAGraphScoped -> DCmmGraph
labelAGraph BlockId
l CmmAGraphScoped
blocks
infos | Just CmmInfoTable
info <- Maybe CmmInfoTable
mb_info = [((DCmmGraph -> BlockId
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry DCmmGraph
blks), CmmInfoTable
info)]
| Bool
otherwise = []
sinfo = StackInfo { arg_space :: VirtualHpOffset
arg_space = VirtualHpOffset
offset
, do_layout :: Bool
do_layout = Bool
do_layout }
tinfo = TopInfo { info_tbls :: DWrap CmmInfoTable
info_tbls = [(BlockId, CmmInfoTable)] -> DWrap CmmInfoTable
forall a. [(BlockId, a)] -> DWrap a
DWrap [(BlockId, CmmInfoTable)]
infos
, stack_info :: CmmStackInfo
stack_info=CmmStackInfo
sinfo}
proc_block = GenCmmTopInfo DWrap
-> CLabel -> [GlobalRegUse] -> DCmmGraph -> DCmmDecl
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc GenCmmTopInfo DWrap
tinfo CLabel
lbl [GlobalRegUse]
live DCmmGraph
blks
; state <- getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
getCmm :: FCode a -> FCode (a, DCmmGroup)
getCmm :: forall a. FCode a -> FCode (a, DCmmGroup)
getCmm FCode a
code
= do { state1 <- FCode CgState
getState
; (a, state2) <- withCgState code (state1 { cgs_tops = nilOL })
; setState $ state2 { cgs_tops = cgs_tops state1 }
; return (a, fromOL (cgs_tops state2)) }
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse CmmExpr
e CmmAGraph
tbranch CmmAGraph
fbranch = CmmExpr -> CmmAGraph -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThenElse' CmmExpr
e CmmAGraph
tbranch CmmAGraph
fbranch Maybe Bool
forall a. Maybe a
Nothing
mkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph
-> Maybe Bool -> FCode CmmAGraph
mkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThenElse' CmmExpr
e CmmAGraph
tbranch CmmAGraph
fbranch Maybe Bool
likely = do
tscp <- FCode CmmTickScope
getTickScope
endif <- newBlockId
tid <- newBlockId
fid <- newBlockId
let
(test, then_, else_, likely') = case likely of
Just Bool
False | Just CmmExpr
e' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
e
-> (CmmExpr
e', CmmAGraph
fbranch, CmmAGraph
tbranch, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
Maybe Bool
_ -> (CmmExpr
e, CmmAGraph
tbranch, CmmAGraph
fbranch, Maybe Bool
likely)
return $ catAGraphs [ mkCbranch test tid fid likely'
, mkLabel tid tscp, then_, mkBranch endif
, mkLabel fid tscp, else_, mkLabel endif tscp ]
mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
mkCmmIfGoto CmmExpr
e BlockId
tid = CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
mkCmmIfGoto' CmmExpr
e BlockId
tid Maybe Bool
forall a. Maybe a
Nothing
mkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
mkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
mkCmmIfGoto' CmmExpr
e BlockId
tid Maybe Bool
l = do
endif <- FCode BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId
tscp <- getTickScope
return $ catAGraphs [ mkCbranch e tid endif l, mkLabel endif tscp ]
mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThen CmmExpr
e CmmAGraph
tbranch = CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThen' CmmExpr
e CmmAGraph
tbranch Maybe Bool
forall a. Maybe a
Nothing
mkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThen' CmmExpr
e CmmAGraph
tbranch Maybe Bool
l = do
endif <- FCode BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId
tid <- newBlockId
tscp <- getTickScope
return $ catAGraphs [ mkCbranch e tid endif l
, mkLabel tid tscp, tbranch, mkLabel endif tscp ]
mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmExpr]
-> UpdFrameOffset -> [CmmExpr] -> FCode CmmAGraph
mkCall :: CmmExpr
-> (Convention, Convention)
-> [LocalReg]
-> [CmmExpr]
-> VirtualHpOffset
-> [CmmExpr]
-> FCode CmmAGraph
mkCall CmmExpr
f (Convention
callConv, Convention
retConv) [LocalReg]
results [CmmExpr]
actuals VirtualHpOffset
updfr_off [CmmExpr]
extra_stack = do
profile <- FCode Profile
getProfile
k <- newBlockId
tscp <- getTickScope
let area = BlockId -> Area
Young BlockId
k
(off, _, copyin) = copyInOflow profile retConv area results []
copyout = Profile
-> CmmExpr
-> Convention
-> [CmmExpr]
-> BlockId
-> VirtualHpOffset
-> VirtualHpOffset
-> [CmmExpr]
-> CmmAGraph
mkCallReturnsTo Profile
profile CmmExpr
f Convention
callConv [CmmExpr]
actuals BlockId
k VirtualHpOffset
off VirtualHpOffset
updfr_off [CmmExpr]
extra_stack
return $ catAGraphs [copyout, mkLabel k tscp, copyin]
mkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmExpr] -> UpdFrameOffset
-> FCode CmmAGraph
mkCmmCall :: CmmExpr
-> [LocalReg] -> [CmmExpr] -> VirtualHpOffset -> FCode CmmAGraph
mkCmmCall CmmExpr
f [LocalReg]
results [CmmExpr]
actuals VirtualHpOffset
updfr_off
= CmmExpr
-> (Convention, Convention)
-> [LocalReg]
-> [CmmExpr]
-> VirtualHpOffset
-> [CmmExpr]
-> FCode CmmAGraph
mkCall CmmExpr
f (Convention
NativeDirectCall, Convention
NativeReturn) [LocalReg]
results [CmmExpr]
actuals VirtualHpOffset
updfr_off []
aGraphToGraph :: CmmAGraphScoped -> FCode DCmmGraph
aGraphToGraph :: CmmAGraphScoped -> FCode DCmmGraph
aGraphToGraph CmmAGraphScoped
stmts
= do { l <- FCode BlockId
forall (m :: * -> *). MonadGetUnique m => m BlockId
newBlockId
; return (labelAGraph l stmts) }