module GHC.StgToCmm.Prof (
initCostCentres, ccType, ccsType,
mkCCostCentre, mkCCostCentreStack,
initInfoTableProv, emitInfoTableProv,
dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
enterCostCentreThunk, enterCostCentreFun,
costCentreFrom,
storeCurCCS,
emitSetCCC,
saveCurrentCostCentre, restoreCurrentCostCentre,
ldvEnter, ldvEnterClosure, ldvRecordCreate
) where
import GHC.Prelude
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Platform
import GHC.Platform.Profile
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Monad
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Graph
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Types.CostCentre
import GHC.Types.IPE
import GHC.Types.ForeignStubs
import GHC.Data.FastString
import GHC.Unit.Module as Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Driver.CodeOutput ( ipInitCode )
import GHC.Utils.Encoding
import Control.Monad
import Data.Char (ord)
ccsType :: Platform -> CmmType
ccsType :: Platform -> CmmType
ccsType = Platform -> CmmType
bWord
ccType :: Platform -> CmmType
ccType :: Platform -> CmmType
ccType = Platform -> CmmType
bWord
storeCurCCS :: CmmExpr -> CmmAGraph
storeCurCCS :: CmmExpr -> CmmAGraph
storeCurCCS CmmExpr
e = CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
cccsReg CmmExpr
e
mkCCostCentre :: CostCentre -> CmmLit
mkCCostCentre :: CostCentre -> CmmLit
mkCCostCentre CostCentre
cc = CLabel -> CmmLit
CmmLabel (CostCentre -> CLabel
mkCCLabel CostCentre
cc)
mkCCostCentreStack :: CostCentreStack -> CmmLit
mkCCostCentreStack :: CostCentreStack -> CmmLit
mkCCostCentreStack CostCentreStack
ccs = CLabel -> CmmLit
CmmLabel (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
ccs)
costCentreFrom :: Platform
-> CmmExpr
-> CmmExpr
costCentreFrom :: Platform -> CmmExpr -> CmmExpr
costCentreFrom Platform
platform CmmExpr
cl = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
cl (PlatformConstants -> Int
pc_OFFSET_StgHeader_ccs (Platform -> PlatformConstants
platformConstants Platform
platform))) (Platform -> CmmType
ccsType Platform
platform) AlignmentSpec
NaturallyAligned
staticProfHdr :: Profile -> CostCentreStack -> [CmmLit]
staticProfHdr :: Profile -> CostCentreStack -> [CmmLit]
staticProfHdr Profile
profile CostCentreStack
ccs
| Profile -> Bool
profileIsProfiling Profile
profile = [CostCentreStack -> CmmLit
mkCCostCentreStack CostCentreStack
ccs, Platform -> CmmLit
staticLdvInit Platform
platform]
| Bool
otherwise = []
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
dynProfHdr :: Profile -> CmmExpr -> [CmmExpr]
dynProfHdr :: Profile -> CmmExpr -> [CmmExpr]
dynProfHdr Profile
profile CmmExpr
ccs
| Profile -> Bool
profileIsProfiling Profile
profile = [CmmExpr
ccs, Platform -> CmmExpr
dynLdvInit (Profile -> Platform
profilePlatform Profile
profile)]
| Bool
otherwise = []
initUpdFrameProf :: CmmExpr -> FCode ()
initUpdFrameProf :: CmmExpr -> FCode ()
initUpdFrameProf CmmExpr
frame
= FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$
do Platform
platform <- FCode Platform
getPlatform
CmmExpr -> CmmExpr -> FCode ()
emitStore (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
frame (PlatformConstants -> Int
pc_OFFSET_StgHeader_ccs (Platform -> PlatformConstants
platformConstants Platform
platform))) CmmExpr
cccsExpr
saveCurrentCostCentre :: FCode (Maybe LocalReg)
saveCurrentCostCentre :: FCode (Maybe LocalReg)
saveCurrentCostCentre
= do DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Platform
platform <- FCode Platform
getPlatform
if Bool -> Bool
not (DynFlags -> Bool
sccProfilingEnabled DynFlags
dflags)
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do LocalReg
local_cc <- forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmType
ccType Platform
platform)
CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
local_cc) CmmExpr
cccsExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just LocalReg
local_cc)
restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
restoreCurrentCostCentre Maybe LocalReg
Nothing
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
restoreCurrentCostCentre (Just LocalReg
local_cc)
= CmmAGraph -> FCode ()
emit (CmmExpr -> CmmAGraph
storeCurCCS (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
local_cc)))
profDynAlloc :: SMRep -> CmmExpr -> FCode ()
profDynAlloc :: SMRep -> CmmExpr -> FCode ()
profDynAlloc SMRep
rep CmmExpr
ccs
= FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$
do Profile
profile <- DynFlags -> Profile
targetProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
CmmExpr -> CmmExpr -> FCode ()
profAlloc (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> SMRep -> Int
heapClosureSizeW Profile
profile SMRep
rep)) CmmExpr
ccs
profAlloc :: CmmExpr -> CmmExpr -> FCode ()
profAlloc :: CmmExpr -> CmmExpr -> FCode ()
profAlloc CmmExpr
words CmmExpr
ccs
= FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$
do Profile
profile <- DynFlags -> Profile
targetProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
let alloc_rep :: CmmType
alloc_rep = Platform -> CmmType
rEP_CostCentreStack_mem_alloc Platform
platform
CmmAGraph -> FCode ()
emit forall a b. (a -> b) -> a -> b
$ CmmType -> CmmExpr -> CmmExpr -> CmmAGraph
addToMemE CmmType
alloc_rep
(Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
ccs (PlatformConstants -> Int
pc_OFFSET_CostCentreStack_mem_alloc (Platform -> PlatformConstants
platformConstants Platform
platform)))
(MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
wordWidth Platform
platform) (CmmType -> Width
typeWidth CmmType
alloc_rep)) forall a b. (a -> b) -> a -> b
$
[MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordSub Platform
platform) [ CmmExpr
words, Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
profHdrSize Profile
profile)]]
)
enterCostCentreThunk :: CmmExpr -> FCode ()
enterCostCentreThunk :: CmmExpr -> FCode ()
enterCostCentreThunk CmmExpr
closure =
FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$ do
Platform
platform <- FCode Platform
getPlatform
CmmAGraph -> FCode ()
emit forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmAGraph
storeCurCCS (Platform -> CmmExpr -> CmmExpr
costCentreFrom Platform
platform CmmExpr
closure)
enterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()
enterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()
enterCostCentreFun CostCentreStack
ccs CmmExpr
closure =
FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$
if CostCentreStack -> Bool
isCurrentCCS CostCentreStack
ccs
then do Platform
platform <- FCode Platform
getPlatform
UnitId
-> FastString -> [(CmmExpr, ForeignHint)] -> Bool -> FCode ()
emitRtsCall UnitId
rtsUnitId (String -> FastString
fsLit String
"enterFunCCS")
[(CmmExpr
baseExpr, ForeignHint
AddrHint),
(Platform -> CmmExpr -> CmmExpr
costCentreFrom Platform
platform CmmExpr
closure, ForeignHint
AddrHint)] Bool
False
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
ifProfiling :: FCode () -> FCode ()
ifProfiling :: FCode () -> FCode ()
ifProfiling FCode ()
code
= do Profile
profile <- DynFlags -> Profile
targetProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
if Profile -> Bool
profileIsProfiling Profile
profile
then FCode ()
code
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
initCostCentres :: CollectedCCs -> FCode ()
initCostCentres :: CollectedCCs -> FCode ()
initCostCentres ([CostCentre]
local_CCs, [CostCentreStack]
singleton_CCSs)
= FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CostCentre -> FCode ()
emitCostCentreDecl [CostCentre]
local_CCs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CostCentreStack -> FCode ()
emitCostCentreStackDecl [CostCentreStack]
singleton_CCSs
emitCostCentreDecl :: CostCentre -> FCode ()
emitCostCentreDecl :: CostCentre -> FCode ()
emitCostCentreDecl CostCentre
cc = do
{ DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Platform
platform <- FCode Platform
getPlatform
; let is_caf :: CmmLit
is_caf | CostCentre -> Bool
isCafCC CostCentre
cc = Platform -> Int -> CmmLit
mkIntCLit Platform
platform (Char -> Int
ord Char
'c')
| Bool
otherwise = Platform -> CmmLit
zero Platform
platform
; CmmLit
label <- ByteString -> FCode CmmLit
newByteStringCLit (FastString -> ByteString
bytesFS forall a b. (a -> b) -> a -> b
$ CostCentre -> FastString
costCentreUserNameFS CostCentre
cc)
; CmmLit
modl <- ByteString -> FCode CmmLit
newByteStringCLit (FastString -> ByteString
bytesFS forall a b. (a -> b) -> a -> b
$ ModuleName -> FastString
moduleNameFS
forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName
forall a b. (a -> b) -> a -> b
$ CostCentre -> Module
cc_mod CostCentre
cc)
; CmmLit
loc <- ByteString -> FCode CmmLit
newByteStringCLit forall a b. (a -> b) -> a -> b
$ String -> ByteString
utf8EncodeString forall a b. (a -> b) -> a -> b
$
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags (CostCentre -> SrcSpan
costCentreSrcSpan CostCentre
cc)
; let
lits :: [CmmLit]
lits = [ Platform -> CmmLit
zero Platform
platform,
CmmLit
label,
CmmLit
modl,
CmmLit
loc,
CmmLit
zero64,
Platform -> CmmLit
zero Platform
platform,
CmmLit
is_caf,
Platform -> CmmLit
zero Platform
platform
]
; CLabel -> [CmmLit] -> FCode ()
emitDataLits (CostCentre -> CLabel
mkCCLabel CostCentre
cc) [CmmLit]
lits
}
emitCostCentreStackDecl :: CostCentreStack -> FCode ()
emitCostCentreStackDecl :: CostCentreStack -> FCode ()
emitCostCentreStackDecl CostCentreStack
ccs
= case CostCentreStack -> Maybe CostCentre
maybeSingletonCCS CostCentreStack
ccs of
Just CostCentre
cc ->
do Platform
platform <- FCode Platform
getPlatform
let mk_lits :: CostCentre -> [CmmLit]
mk_lits CostCentre
cc = Platform -> CmmLit
zero Platform
platform forall a. a -> [a] -> [a]
:
CostCentre -> CmmLit
mkCCostCentre CostCentre
cc forall a. a -> [a] -> [a]
:
forall a. Int -> a -> [a]
replicate (Platform -> Int
sizeof_ccs_words Platform
platform forall a. Num a => a -> a -> a
- Int
2) (Platform -> CmmLit
zero Platform
platform)
CLabel -> [CmmLit] -> FCode ()
emitDataLits (CostCentreStack -> CLabel
mkCCSLabel CostCentreStack
ccs) (CostCentre -> [CmmLit]
mk_lits CostCentre
cc)
Maybe CostCentre
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"emitCostCentreStackDecl" (forall a. Outputable a => a -> SDoc
ppr CostCentreStack
ccs)
zero :: Platform -> CmmLit
zero :: Platform -> CmmLit
zero Platform
platform = Platform -> Int -> CmmLit
mkIntCLit Platform
platform Int
0
zero64 :: CmmLit
zero64 :: CmmLit
zero64 = Integer -> Width -> CmmLit
CmmInt Integer
0 Width
W64
sizeof_ccs_words :: Platform -> Int
sizeof_ccs_words :: Platform -> Int
sizeof_ccs_words Platform
platform
| Int
ms forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ws
| Bool
otherwise = Int
ws forall a. Num a => a -> a -> a
+ Int
1
where
(Int
ws,Int
ms) = PlatformConstants -> Int
pc_SIZEOF_CostCentreStack (Platform -> PlatformConstants
platformConstants Platform
platform) forall a. Integral a => a -> a -> (a, a)
`divMod` Platform -> Int
platformWordSizeInBytes Platform
platform
initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> Module -> FCode CStub
initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> Module -> FCode CStub
initInfoTableProv [CmmInfoTable]
infos InfoTableProvMap
itmap Module
this_mod
= do
DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let ents :: [InfoProvEnt]
ents = DynFlags
-> [CmmInfoTable] -> Module -> InfoTableProvMap -> [InfoProvEnt]
convertInfoProvMap DynFlags
dflags [CmmInfoTable]
infos Module
this_mod InfoTableProvMap
itmap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ InfoProvEnt -> FCode ()
emitInfoTableProv [InfoProvEnt]
ents
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> Module -> [InfoProvEnt] -> CStub
ipInitCode DynFlags
dflags Module
this_mod [InfoProvEnt]
ents)
emitInfoTableProv :: InfoProvEnt -> FCode ()
emitInfoTableProv :: InfoProvEnt -> FCode ()
emitInfoTableProv InfoProvEnt
ip = do
{ DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let mod :: Module
mod = InfoProvEnt -> Module
infoProvModule InfoProvEnt
ip
; let (String
src, String
label) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
"", String
"") (\(RealSrcSpan
s, String
l) -> (forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags RealSrcSpan
s, String
l)) (InfoProvEnt -> Maybe (RealSrcSpan, String)
infoTableProv InfoProvEnt
ip)
; Platform
platform <- FCode Platform
getPlatform
; let mk_string :: String -> FCode CmmLit
mk_string = ByteString -> FCode CmmLit
newByteStringCLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
utf8EncodeString
; CmmLit
label <- String -> FCode CmmLit
mk_string String
label
; CmmLit
modl <- ByteString -> FCode CmmLit
newByteStringCLit (FastString -> ByteString
bytesFS forall a b. (a -> b) -> a -> b
$ ModuleName -> FastString
moduleNameFS
forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName
forall a b. (a -> b) -> a -> b
$ Module
mod)
; CmmLit
ty_string <- String -> FCode CmmLit
mk_string (InfoProvEnt -> String
infoTableType InfoProvEnt
ip)
; CmmLit
loc <- String -> FCode CmmLit
mk_string String
src
; CmmLit
table_name <- String -> FCode CmmLit
mk_string (forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags (Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
CStyle (InfoProvEnt -> CLabel
infoTablePtr InfoProvEnt
ip)))
; CmmLit
closure_type <- String -> FCode CmmLit
mk_string
(forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags (String -> SDoc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ InfoProvEnt -> Int
infoProvEntClosureType InfoProvEnt
ip))
; let
lits :: [CmmLit]
lits = [ CLabel -> CmmLit
CmmLabel (InfoProvEnt -> CLabel
infoTablePtr InfoProvEnt
ip),
CmmLit
table_name,
CmmLit
closure_type,
CmmLit
ty_string,
CmmLit
label,
CmmLit
modl,
CmmLit
loc,
Platform -> CmmLit
zero Platform
platform
]
; CLabel -> [CmmLit] -> FCode ()
emitDataLits (InfoProvEnt -> CLabel
mkIPELabel InfoProvEnt
ip) [CmmLit]
lits
}
emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
emitSetCCC CostCentre
cc Bool
tick Bool
push
= do Profile
profile <- DynFlags -> Profile
targetProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
if Bool -> Bool
not (Profile -> Bool
profileIsProfiling Profile
profile)
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do LocalReg
tmp <- forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmType
ccsType Platform
platform)
LocalReg -> CmmExpr -> CostCentre -> FCode ()
pushCostCentre LocalReg
tmp CmmExpr
cccsExpr CostCentre
cc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tick forall a b. (a -> b) -> a -> b
$ CmmAGraph -> FCode ()
emit (Platform -> CmmExpr -> CmmAGraph
bumpSccCount Platform
platform (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp)))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
push forall a b. (a -> b) -> a -> b
$ CmmAGraph -> FCode ()
emit (CmmExpr -> CmmAGraph
storeCurCCS (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp)))
pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
pushCostCentre LocalReg
result CmmExpr
ccs CostCentre
cc
= LocalReg
-> ForeignHint
-> UnitId
-> FastString
-> [(CmmExpr, ForeignHint)]
-> Bool
-> FCode ()
emitRtsCallWithResult LocalReg
result ForeignHint
AddrHint
UnitId
rtsUnitId
(String -> FastString
fsLit String
"pushCostCentre") [(CmmExpr
ccs,ForeignHint
AddrHint),
(CmmLit -> CmmExpr
CmmLit (CostCentre -> CmmLit
mkCCostCentre CostCentre
cc), ForeignHint
AddrHint)]
Bool
False
bumpSccCount :: Platform -> CmmExpr -> CmmAGraph
bumpSccCount :: Platform -> CmmExpr -> CmmAGraph
bumpSccCount Platform
platform CmmExpr
ccs
= CmmType -> CmmExpr -> Int -> CmmAGraph
addToMem (Platform -> CmmType
rEP_CostCentreStack_scc_count Platform
platform)
(Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
ccs (PlatformConstants -> Int
pc_OFFSET_CostCentreStack_scc_count (Platform -> PlatformConstants
platformConstants Platform
platform))) Int
1
staticLdvInit :: Platform -> CmmLit
staticLdvInit :: Platform -> CmmLit
staticLdvInit = Platform -> CmmLit
zeroCLit
dynLdvInit :: Platform -> CmmExpr
dynLdvInit :: Platform -> CmmExpr
dynLdvInit Platform
platform =
MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordOr Platform
platform) [
MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordShl Platform
platform) [Platform -> CmmExpr
loadEra Platform
platform, Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (PlatformConstants -> Int
pc_LDV_SHIFT (Platform -> PlatformConstants
platformConstants Platform
platform))],
CmmLit -> CmmExpr
CmmLit (Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (PlatformConstants -> Integer
pc_ILDV_STATE_CREATE (Platform -> PlatformConstants
platformConstants Platform
platform)))
]
ldvRecordCreate :: CmmExpr -> FCode ()
ldvRecordCreate :: CmmExpr -> FCode ()
ldvRecordCreate CmmExpr
closure = do
Platform
platform <- FCode Platform
getPlatform
CmmAGraph -> FCode ()
emit forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmAGraph
mkStore (Platform -> CmmExpr -> CmmExpr
ldvWord Platform
platform CmmExpr
closure) (Platform -> CmmExpr
dynLdvInit Platform
platform)
ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
ldvEnterClosure ClosureInfo
closure_info CmmReg
node_reg = do
Platform
platform <- FCode Platform
getPlatform
let tag :: Int
tag = Platform -> ClosureInfo -> Int
funTag Platform
platform ClosureInfo
closure_info
CmmExpr -> FCode ()
ldvEnter (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (CmmReg -> CmmExpr
CmmReg CmmReg
node_reg) (-Int
tag))
ldvEnter :: CmmExpr -> FCode ()
ldvEnter :: CmmExpr -> FCode ()
ldvEnter CmmExpr
cl_ptr = do
Platform
platform <- FCode Platform
getPlatform
let constants :: PlatformConstants
constants = Platform -> PlatformConstants
platformConstants Platform
platform
ldv_wd :: CmmExpr
ldv_wd = Platform -> CmmExpr -> CmmExpr
ldvWord Platform
platform CmmExpr
cl_ptr
new_ldv_wd :: CmmExpr
new_ldv_wd = Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOrWord Platform
platform
(Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAndWord Platform
platform (Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform CmmExpr
ldv_wd)
(CmmLit -> CmmExpr
CmmLit (Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (PlatformConstants -> Integer
pc_ILDV_CREATE_MASK PlatformConstants
constants))))
(Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOrWord Platform
platform (Platform -> CmmExpr
loadEra Platform
platform) (CmmLit -> CmmExpr
CmmLit (Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (PlatformConstants -> Integer
pc_ILDV_STATE_USE PlatformConstants
constants))))
FCode () -> FCode ()
ifProfiling forall a b. (a -> b) -> a -> b
$
CmmAGraph -> FCode ()
emit forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordUGt Platform
platform) [Platform -> CmmExpr
loadEra Platform
platform, CmmLit -> CmmExpr
CmmLit (Platform -> CmmLit
zeroCLit Platform
platform)])
(CmmExpr -> CmmExpr -> CmmAGraph
mkStore CmmExpr
ldv_wd CmmExpr
new_ldv_wd)
CmmAGraph
mkNop
loadEra :: Platform -> CmmExpr
loadEra :: Platform -> CmmExpr
loadEra Platform
platform = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
cIntWidth Platform
platform) (Platform -> Width
wordWidth Platform
platform))
[CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (CLabel -> CmmExpr
mkLblExpr (FastString -> CLabel
mkRtsCmmDataLabel (String -> FastString
fsLit String
"era")))
(Platform -> CmmType
cInt Platform
platform)
AlignmentSpec
NaturallyAligned]
ldvWord :: Platform -> CmmExpr -> CmmExpr
ldvWord :: Platform -> CmmExpr -> CmmExpr
ldvWord Platform
platform CmmExpr
closure_ptr
= Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
closure_ptr (PlatformConstants -> Int
pc_OFFSET_StgHeader_ldvw (Platform -> PlatformConstants
platformConstants Platform
platform))