Tidy up and consolidate canned CmmReg and CmmGlobals
authorSimon Marlow <marlowsd@gmail.com>
Sun, 18 Feb 2018 16:08:52 +0000 (11:08 -0500)
committerBen Gamari <ben@smart-cactus.org>
Sun, 18 Feb 2018 16:57:45 +0000 (11:57 -0500)
Test Plan: validate

Reviewers: bgamari, erikd

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4380

13 files changed:
compiler/cmm/CmmExpr.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmSink.hs
compiler/cmm/CmmUtils.hs
compiler/codeGen/CgUtils.hs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmCon.hs
compiler/codeGen/StgCmmForeign.hs
compiler/codeGen/StgCmmHeap.hs
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmPrim.hs
compiler/codeGen/StgCmmProf.hs
compiler/codeGen/StgCmmUtils.hs

index 6a0220e..bae5a73 100644 (file)
@@ -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
index 6cf8f8e..2602dc8 100644 (file)
@@ -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 =
index 76ce18b..464a041 100644 (file)
@@ -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
index 8e8c1ed..4a1d874 100644 (file)
@@ -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
index a9f13c6..c20f1fd 100644 (file)
@@ -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
index 13f908e..cf602ef 100644 (file)
@@ -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
 
index a38f7bc..1972910 100644 (file)
@@ -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)
index fc3d42a..d0ad17f 100644 (file)
@@ -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
index 2a11653..07633ed 100644 (file)
@@ -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)
 
index 5111b93..95828ad 100644 (file)
@@ -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")
 
 -------------------------------------------------------------------------
index 8ec132b..7661e9f 100644 (file)
@@ -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)
                      ]
index e5e1379..a0bca5d 100644 (file)
@@ -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)))
 
index b6092e8..94013f5 100644 (file)
@@ -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