From ccda4862102104e080a200e4d9c2ca8f42eb5b70 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Sun, 18 Feb 2018 11:08:52 -0500 Subject: 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 --- compiler/codeGen/CgUtils.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 11 +++++---- compiler/codeGen/StgCmmCon.hs | 4 ++-- compiler/codeGen/StgCmmForeign.hs | 47 +++++++++++++-------------------------- compiler/codeGen/StgCmmHeap.hs | 9 ++++---- compiler/codeGen/StgCmmLayout.hs | 3 +-- compiler/codeGen/StgCmmPrim.hs | 18 +++++++-------- compiler/codeGen/StgCmmProf.hs | 15 +++++-------- compiler/codeGen/StgCmmUtils.hs | 2 +- 9 files changed, 45 insertions(+), 66 deletions(-) (limited to 'compiler/codeGen') diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index a9f13c6ffa..c20f1fd1d0 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -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 diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 13f908e846..cf602ef0b8 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -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 diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index a38f7bce37..197291006b 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -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) diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index fc3d42aa8b..d0ad17f59b 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -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 diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 2a1165395c..07633ed4ae 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -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) diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 5111b93bc5..95828ad4c6 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -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") ------------------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 8ec132b1d3..7661e9f8fb 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -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) ] diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index e5e1379877..a0bca5d661 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -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))) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index b6092e8358..94013f5c6d 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -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 -- cgit v1.2.1