Commit ccda4862 authored by Simon Marlow's avatar Simon Marlow Committed by Ben Gamari

Tidy up and consolidate canned CmmReg and CmmGlobals

Test Plan: validate

Reviewers: bgamari, erikd

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4380
parent bfb90bca
......@@ -10,7 +10,10 @@ module CmmExpr
, CmmReg(..), cmmRegType
, CmmLit(..), cmmLitType
, LocalReg(..), localRegType
, GlobalReg(..), isArgReg, globalRegType, spReg, hpReg, spLimReg, nodeReg, node, baseReg
, GlobalReg(..), isArgReg, globalRegType
, spReg, hpReg, spLimReg, hpLimReg, nodeReg
, currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
, node, baseReg
, VGcPtr(..)
, DefinerOfRegs, UserOfRegs
......@@ -551,12 +554,18 @@ instance Ord GlobalReg where
compare _ EagerBlackholeInfo = GT
-- convenient aliases
baseReg, spReg, hpReg, spLimReg, nodeReg :: CmmReg
baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: CmmReg
baseReg = CmmGlobal BaseReg
spReg = CmmGlobal Sp
hpReg = CmmGlobal Hp
hpLimReg = CmmGlobal HpLim
spLimReg = CmmGlobal SpLim
nodeReg = CmmGlobal node
currentTSOReg = CmmGlobal CurrentTSO
currentNurseryReg = CmmGlobal CurrentNursery
hpAllocReg = CmmGlobal HpAlloc
cccsReg = CmmGlobal CCCS
node :: GlobalReg
node = VanillaReg 1 VGcPtr
......
......@@ -582,7 +582,7 @@ makeFixupBlock dflags sp0 l stack tscope assigs
= block `blockSnoc` CmmUnwind [(Sp, Just unwind_val)]
| otherwise
= block
where unwind_val = cmmOffset dflags (CmmReg spReg) (sm_sp stack)
where unwind_val = cmmOffset dflags spExpr (sm_sp stack)
block = blockJoin (CmmEntry tmp_lbl tscope)
( maybeAddSpAdj dflags sp_off
$ maybeAddUnwind
......@@ -895,7 +895,7 @@ maybeAddSpAdj :: DynFlags -> ByteOff -> Block CmmNode O O -> Block CmmNode O O
maybeAddSpAdj _ 0 block = block
maybeAddSpAdj dflags sp_off block = block `blockSnoc` adj
where
adj = CmmAssign spReg (cmmOffset dflags (CmmReg spReg) sp_off)
adj = CmmAssign spReg (cmmOffset dflags spExpr sp_off)
{- Note [SP old/young offsets]
......@@ -918,7 +918,7 @@ arguments.
areaToSp :: DynFlags -> ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr
areaToSp dflags sp_old _sp_hwm area_off (CmmStackSlot area n)
= cmmOffset dflags (CmmReg spReg) (sp_old - area_off area - n)
= cmmOffset dflags spExpr (sp_old - area_off area - n)
-- Replace (CmmStackSlot area n) with an offset from Sp
areaToSp dflags _ sp_hwm _ (CmmLit CmmHighStackMark)
......@@ -1088,7 +1088,7 @@ insertReloads dflags stackmap live =
[ CmmAssign (CmmLocal reg)
-- This cmmOffset basically corresponds to manifesting
-- @CmmStackSlot Old sp_off@, see Note [SP old/young offsets]
(CmmLoad (cmmOffset dflags (CmmReg spReg) (sp_off - reg_off))
(CmmLoad (cmmOffset dflags spExpr (sp_off - reg_off))
(localRegType reg))
| (reg, reg_off) <- stackSlotRegs stackmap
, reg `elemRegSet` live
......@@ -1141,7 +1141,7 @@ lowerSafeForeignCall dflags block
-- Both 'id' and 'new_base' are KindNonPtr because they're
-- RTS-only objects and are not subject to garbage collection
id <- newTemp (bWord dflags)
new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg))
new_base <- newTemp (cmmRegType dflags baseReg)
let (caller_save, caller_load) = callerSaveVolatileRegs dflags
save_state_code <- saveThreadState dflags
load_state_code <- loadThreadState dflags
......@@ -1152,7 +1152,7 @@ lowerSafeForeignCall dflags block
resume = mkMiddle (callResumeThread new_base id) <*>
-- Assign the result to BaseReg: we
-- might now have a different Capability!
mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*>
mkAssign baseReg (CmmReg (CmmLocal new_base)) <*>
caller_load <*>
load_state_code
......@@ -1167,7 +1167,7 @@ lowerSafeForeignCall dflags block
-- different. Hence we continue by jumping to the top stack frame,
-- not by jumping to succ.
jump = CmmCall { cml_target = entryCode dflags $
CmmLoad (CmmReg spReg) (bWord dflags)
CmmLoad spExpr (bWord dflags)
, cml_cont = Just succ
, cml_args_regs = regs
, cml_args = widthInBytes (wordWidth dflags)
......@@ -1197,7 +1197,7 @@ callSuspendThread dflags id intrbl =
CmmUnsafeForeignCall
(ForeignTarget (foreignLbl (fsLit "suspendThread"))
(ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint] CmmMayReturn))
[id] [CmmReg (CmmGlobal BaseReg), mkIntExpr dflags (fromEnum intrbl)]
[id] [baseExpr, mkIntExpr dflags (fromEnum intrbl)]
callResumeThread :: LocalReg -> LocalReg -> CmmNode O O
callResumeThread new_base id =
......
......@@ -745,7 +745,7 @@ loadAddr dflags e w =
case e of
CmmReg r -> regAddr dflags r 0 w
CmmRegOff r i -> regAddr dflags r i w
_other | regUsedIn dflags (CmmGlobal Sp) e -> StackMem
_other | regUsedIn dflags spReg e -> StackMem
| otherwise -> AnyMem
regAddr :: DynFlags -> CmmReg -> Int -> Width -> AbsMem
......
......@@ -37,6 +37,9 @@ module CmmUtils(
isTrivialCmmExpr, hasNoGlobalRegs,
baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,
currentTSOExpr, currentNurseryExpr, cccsExpr,
-- Statics
blankWord,
......@@ -567,3 +570,18 @@ blockTicks b = reverse $ foldBlockNodesF goStmt b []
where goStmt :: CmmNode e x -> [CmmTickish] -> [CmmTickish]
goStmt (CmmTick t) ts = t:ts
goStmt _other ts = ts
-- -----------------------------------------------------------------------------
-- Access to common global registers
baseExpr, spExpr, hpExpr, currentTSOExpr, currentNurseryExpr,
spLimExpr, hpLimExpr, cccsExpr :: CmmExpr
baseExpr = CmmReg baseReg
spExpr = CmmReg spReg
spLimExpr = CmmReg spLimReg
hpExpr = CmmReg hpReg
hpLimExpr = CmmReg hpLimReg
currentTSOExpr = CmmReg currentTSOReg
currentNurseryExpr = CmmReg currentNurseryReg
cccsExpr = CmmReg cccsReg
......@@ -118,7 +118,7 @@ regTableOffset dflags n =
get_Regtable_addr_from_offset :: DynFlags -> CmmType -> Int -> CmmExpr
get_Regtable_addr_from_offset dflags _ offset =
if haveRegBase (targetPlatform dflags)
then CmmRegOff (CmmGlobal BaseReg) offset
then CmmRegOff baseReg offset
else regTableOffset dflags offset
-- | Fixup global registers so that they assign to locations within the
......
......@@ -24,7 +24,7 @@ import StgCmmMonad
import StgCmmEnv
import StgCmmCon
import StgCmmHeap
import StgCmmProf (curCCS, ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk,
import StgCmmProf (ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk,
initUpdFrameProf)
import StgCmmTicky
import StgCmmLayout
......@@ -367,7 +367,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body
-- BUILD THE OBJECT
-- ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
; let use_cc = curCCS; blame_cc = curCCS
; let use_cc = cccsExpr; blame_cc = cccsExpr
; emit (mkComment $ mkFastString "calling allocDynClosure")
; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
; let info_tbl = mkCmmInfo closure_info
......@@ -405,7 +405,7 @@ cgRhsStdThunk bndr lf_info payload
descr
-- ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
; let use_cc = curCCS; blame_cc = curCCS
; let use_cc = cccsExpr; blame_cc = cccsExpr
-- BUILD THE OBJECT
......@@ -632,8 +632,7 @@ emitBlackHoleCode node = do
-- work with profiling.
when eager_blackholing $ do
emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags))
(CmmReg (CmmGlobal CurrentTSO))
emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags)) currentTSOExpr
emitPrimCall [] MO_WriteBarrier []
emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo))
......@@ -718,7 +717,7 @@ link_caf node _is_upd = do
ForeignLabelInExternalPackage IsFunction
; bh <- newTemp (bWord dflags)
; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl
[ (CmmReg (CmmGlobal BaseReg), AddrHint),
[ (baseExpr, AddrHint),
(CmmReg (CmmLocal node), AddrHint) ]
False
......
......@@ -28,9 +28,9 @@ import StgCmmHeap
import StgCmmLayout
import StgCmmUtils
import StgCmmClosure
import StgCmmProf ( curCCS )
import CmmExpr
import CmmUtils
import CLabel
import MkGraph
import SMRep
......@@ -246,7 +246,7 @@ buildDynCon' dflags _ binder actually_bound ccs con args
; return (mkRhsInit dflags reg lf_info hp_plus_n) }
where
use_cc -- cost-centre to stick in the object
| isCurrentCCS ccs = curCCS
| isCurrentCCS ccs = cccsExpr
| otherwise = panic "buildDynCon: non-current CCS not implemented"
blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
......
......@@ -25,7 +25,7 @@ module StgCmmForeign (
import GhcPrelude hiding( succ, (<*>) )
import StgSyn
import StgCmmProf (storeCurCCS, ccsType, curCCS)
import StgCmmProf (storeCurCCS, ccsType)
import StgCmmEnv
import StgCmmMonad
import StgCmmUtils
......@@ -287,7 +287,7 @@ saveThreadState dflags = do
close_nursery <- closeNursery dflags tso
pure $ catAGraphs [
-- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
mkAssign (CmmLocal tso) currentTSOExpr,
-- tso->stackobj->sp = Sp;
mkStore (cmmOffset dflags
(CmmLoad (cmmOffset dflags
......@@ -295,11 +295,11 @@ saveThreadState dflags = do
(tso_stackobj dflags))
(bWord dflags))
(stack_SP dflags))
stgSp,
spExpr,
close_nursery,
-- and save the current cost centre stack in the TSO when profiling:
if gopt Opt_SccProfilingOn dflags then
mkStore (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) curCCS
mkStore (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) cccsExpr
else mkNop
]
......@@ -308,7 +308,7 @@ emitCloseNursery = do
dflags <- getDynFlags
tso <- newTemp (bWord dflags)
code <- closeNursery dflags tso
emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*> code
emit $ mkAssign (CmmLocal tso) currentTSOExpr <*> code
{- |
@closeNursery dflags tso@ produces code to close the nursery.
......@@ -336,14 +336,14 @@ closeNursery df tso = do
let tsoreg = CmmLocal tso
cnreg <- CmmLocal <$> newTemp (bWord df)
pure $ catAGraphs [
mkAssign cnreg stgCurrentNursery,
mkAssign cnreg currentNurseryExpr,
-- CurrentNursery->free = Hp+1;
mkStore (nursery_bdescr_free df cnreg) (cmmOffsetW df stgHp 1),
mkStore (nursery_bdescr_free df cnreg) (cmmOffsetW df hpExpr 1),
let alloc =
CmmMachOp (mo_wordSub df)
[ cmmOffsetW df stgHp 1
[ cmmOffsetW df hpExpr 1
, CmmLoad (nursery_bdescr_start df cnreg) (bWord df)
]
......@@ -370,18 +370,18 @@ loadThreadState dflags = do
open_nursery <- openNursery dflags tso
pure $ catAGraphs [
-- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
mkAssign (CmmLocal tso) currentTSOExpr,
-- stack = tso->stackobj;
mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),
-- Sp = stack->sp;
mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
mkAssign spReg (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
-- SpLim = stack->stack + RESERVED_STACK_WORDS;
mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
mkAssign spLimReg (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
(rESERVED_STACK_WORDS dflags)),
-- HpAlloc = 0;
-- HpAlloc is assumed to be set to non-zero only by a failed
-- a heap check, see HeapStackCheck.cmm:GC_GENERIC
mkAssign hpAlloc (zeroExpr dflags),
mkAssign hpAllocReg (zeroExpr dflags),
open_nursery,
-- and load the current cost centre stack from the TSO when profiling:
if gopt Opt_SccProfilingOn dflags
......@@ -397,7 +397,7 @@ emitOpenNursery = do
dflags <- getDynFlags
tso <- newTemp (bWord dflags)
code <- openNursery dflags tso
emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*> code
emit $ mkAssign (CmmLocal tso) currentTSOExpr <*> code
{- |
@openNursery dflags tso@ produces code to open the nursery. A local register
......@@ -439,17 +439,17 @@ openNursery df tso = do
-- what code we generate, look at the assembly for
-- stg_returnToStackTop in rts/StgStartup.cmm.
pure $ catAGraphs [
mkAssign cnreg stgCurrentNursery,
mkAssign cnreg currentNurseryExpr,
mkAssign bdfreereg (CmmLoad (nursery_bdescr_free df cnreg) (bWord df)),
-- Hp = CurrentNursery->free - 1;
mkAssign hp (cmmOffsetW df (CmmReg bdfreereg) (-1)),
mkAssign hpReg (cmmOffsetW df (CmmReg bdfreereg) (-1)),
mkAssign bdstartreg (CmmLoad (nursery_bdescr_start df cnreg) (bWord df)),
-- HpLim = CurrentNursery->start +
-- CurrentNursery->blocks*BLOCK_SIZE_W - 1;
mkAssign hpLim
mkAssign hpLimReg
(cmmOffsetExpr df
(CmmReg bdstartreg)
(cmmOffset df
......@@ -496,21 +496,6 @@ stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags)
closureField :: DynFlags -> ByteOff -> ByteOff
closureField dflags off = off + fixedHdrSize dflags
stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
stgSp = CmmReg sp
stgHp = CmmReg hp
stgCurrentTSO = CmmReg currentTSO
stgCurrentNursery = CmmReg currentNursery
sp, spLim, hp, hpLim, currentTSO, currentNursery, hpAlloc :: CmmReg
sp = CmmGlobal Sp
spLim = CmmGlobal SpLim
hp = CmmGlobal Hp
hpLim = CmmGlobal HpLim
currentTSO = CmmGlobal CurrentTSO
currentNursery = CmmGlobal CurrentNursery
hpAlloc = CmmGlobal HpAlloc
-- -----------------------------------------------------------------------------
-- For certain types passed to foreign calls, we adjust the actual
-- value passed to the call. For ByteArray#/Array# we pass the
......
......@@ -603,7 +603,7 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
let
Just alloc_lit = mb_alloc_lit
bump_hp = cmmOffsetExprB dflags (CmmReg hpReg) alloc_lit
bump_hp = cmmOffsetExprB dflags hpExpr alloc_lit
-- Sp overflow if ((old + 0) - CmmHighStack < SpLim)
-- At the beginning of a function old + 0 = Sp
......@@ -617,10 +617,9 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
-- Hp overflow if (Hp > HpLim)
-- (Hp has been incremented by now)
-- HpLim points to the LAST WORD of valid allocation space.
hp_oflo = CmmMachOp (mo_wordUGt dflags)
[CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
hp_oflo = CmmMachOp (mo_wordUGt dflags) [hpExpr, hpLimExpr]
alloc_n = mkAssign (CmmGlobal HpAlloc) alloc_lit
alloc_n = mkAssign hpAllocReg alloc_lit
case mb_stk_hwm of
Nothing -> return ()
......@@ -645,7 +644,7 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
when (checkYield && not (gopt Opt_OmitYields dflags)) $ do
-- Yielding if HpLim == 0
let yielding = CmmMachOp (mo_wordEq dflags)
[CmmReg (CmmGlobal HpLim),
[CmmReg hpLimReg,
CmmLit (zeroCLit dflags)]
emit =<< mkCmmIfGoto' yielding gc_id (Just False)
......
......@@ -39,7 +39,6 @@ import StgCmmArgRep -- notably: ( slowCallPattern )
import StgCmmTicky
import StgCmmMonad
import StgCmmUtils
import StgCmmProf (curCCS)
import MkGraph
import SMRep
......@@ -373,7 +372,7 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not
stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat
this_pat = (N, Just (mkLblExpr stg_ap_pat)) : call_args
save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just curCCS)]
save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just cccsExpr)]
save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit "stg_restore_cccs")
-------------------------------------------------------------------------
......
......@@ -26,7 +26,7 @@ import StgCmmMonad
import StgCmmUtils
import StgCmmTicky
import StgCmmHeap
import StgCmmProf ( costCentreFrom, curCCS )
import StgCmmProf ( costCentreFrom )
import DynFlags
import Platform
......@@ -281,7 +281,7 @@ emitPrimOp _ [res] ParOp [arg]
emitCCall
[(res,NoHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)]
[(baseExpr, AddrHint), (arg,AddrHint)]
emitPrimOp dflags [res] SparkOp [arg]
= do
......@@ -293,7 +293,7 @@ emitPrimOp dflags [res] SparkOp [arg]
emitCCall
[(tmp2,NoHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
[(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))
emitPrimOp dflags [res] GetCCSOfOp [arg]
......@@ -304,7 +304,7 @@ emitPrimOp dflags [res] GetCCSOfOp [arg]
| otherwise = CmmLit (zeroCLit dflags)
emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
= emitAssign (CmmLocal res) curCCS
= emitAssign (CmmLocal res) cccsExpr
emitPrimOp dflags [res] ReadMutVarOp [mutv]
= emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
......@@ -317,7 +317,7 @@ emitPrimOp dflags res@[] WriteMutVarOp [mutv,var]
emitCCall
[{-no results-}]
(CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
[(CmmReg (CmmGlobal BaseReg), AddrHint), (mutv,AddrHint)]
[(baseExpr, AddrHint), (mutv,AddrHint)]
-- #define sizzeofByteArrayzh(r,a) \
-- r = ((StgArrBytes *)(a))->bytes
......@@ -1730,7 +1730,7 @@ doNewByteArrayOp res_r n = do
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr curCCS
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgArrBytes_bytes dflags)
]
......@@ -1898,7 +1898,7 @@ doNewArrayOp res_r rep info payload n init = do
(mkIntExpr dflags (nonHdrSize dflags rep))
(zeroExpr dflags)
base <- allocHeapClosure rep info_ptr curCCS payload
base <- allocHeapClosure rep info_ptr cccsExpr payload
arr <- CmmLocal `fmap` newTemp (bWord dflags)
emit $ mkAssign arr base
......@@ -2080,7 +2080,7 @@ emitCloneArray info_p res_r src src_off n = do
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr curCCS
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags)
, (mkIntExpr dflags (nonHdrSizeW rep),
......@@ -2119,7 +2119,7 @@ emitCloneSmallArray info_p res_r src src_off n = do
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr curCCS
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
]
......
......@@ -16,7 +16,7 @@ module StgCmmProf (
dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
enterCostCentreThunk, enterCostCentreFun,
costCentreFrom,
curCCS, storeCurCCS,
storeCurCCS,
emitSetCCC,
saveCurrentCostCentre, restoreCurrentCostCentre,
......@@ -62,11 +62,8 @@ ccsType = bWord
ccType :: DynFlags -> CmmType -- Type of a cost centre
ccType = bWord
curCCS :: CmmExpr
curCCS = CmmReg (CmmGlobal CCCS)
storeCurCCS :: CmmExpr -> CmmAGraph
storeCurCCS e = mkAssign (CmmGlobal CCCS) e
storeCurCCS e = mkAssign cccsReg e
mkCCostCentre :: CostCentre -> CmmLit
mkCCostCentre cc = CmmLabel (mkCCLabel cc)
......@@ -93,7 +90,7 @@ initUpdFrameProf :: CmmExpr -> FCode ()
initUpdFrameProf frame
= ifProfiling $ -- frame->header.prof.ccs = CCCS
do dflags <- getDynFlags
emitStore (cmmOffset dflags frame (oFFSET_StgHeader_ccs dflags)) curCCS
emitStore (cmmOffset dflags frame (oFFSET_StgHeader_ccs dflags)) cccsExpr
-- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0)
-- is unnecessary because it is not used anyhow.
......@@ -133,7 +130,7 @@ saveCurrentCostCentre
if not (gopt Opt_SccProfilingOn dflags)
then return Nothing
else do local_cc <- newTemp (ccType dflags)
emitAssign (CmmLocal local_cc) curCCS
emitAssign (CmmLocal local_cc) cccsExpr
return (Just local_cc)
restoreCurrentCostCentre :: Maybe LocalReg -> FCode ()
......@@ -186,7 +183,7 @@ enterCostCentreFun ccs closure =
if isCurrentCCS ccs
then do dflags <- getDynFlags
emitRtsCall rtsUnitId (fsLit "enterFunCCS")
[(CmmReg (CmmGlobal BaseReg), AddrHint),
[(baseExpr, AddrHint),
(costCentreFrom dflags closure, AddrHint)] False
else return () -- top-level function, nothing to do
......@@ -280,7 +277,7 @@ emitSetCCC cc tick push
if not (gopt Opt_SccProfilingOn dflags)
then return ()
else do tmp <- newTemp (ccsType dflags)
pushCostCentre tmp curCCS cc
pushCostCentre tmp cccsExpr cc
when tick $ emit (bumpSccCount dflags (CmmReg (CmmLocal tmp)))
when push $ emit (storeCurCCS (CmmReg (CmmLocal tmp)))
......
......@@ -280,7 +280,7 @@ regTableOffset dflags n =
get_Regtable_addr_from_offset :: DynFlags -> CmmType -> Int -> CmmExpr
get_Regtable_addr_from_offset dflags _rep offset =
if haveRegBase (targetPlatform dflags)
then CmmRegOff (CmmGlobal BaseReg) offset
then CmmRegOff baseReg offset
else regTableOffset dflags offset
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment