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