diff options
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 40 | ||||
| -rw-r--r-- | includes/rts/storage/GC.h | 4 | ||||
| -rw-r--r-- | rts/sm/Storage.c | 40 |
3 files changed, 39 insertions, 45 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 64772c66ce..05aae0aeeb 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -21,7 +21,7 @@ import StgCmmEnv import StgCmmCon import StgCmmHeap import StgCmmProf (curCCS, ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk, - initUpdFrameProf, costCentreFrom) + initUpdFrameProf) import StgCmmTicky import StgCmmLayout import StgCmmUtils @@ -718,13 +718,6 @@ emitUpdateFrame dflags frame lbl updatee = do -- (which Hugs needs to do in order that combined mode works right.) -- --- ToDo [Feb 04] This entire link_caf nonsense could all be moved --- into the "newCAF" RTS procedure, which we call anyway, including --- the allocation of the black-hole indirection closure. --- That way, code size would fall, the CAF-handling code would --- be closer together, and the compiler wouldn't need to know --- about off_indirectee etc. - link_caf :: LocalReg -- pointer to the closure -> Bool -- True <=> updatable, False <=> single-entry -> FCode CmmExpr -- Returns amode for closure to be updated @@ -736,40 +729,27 @@ link_caf :: LocalReg -- pointer to the closure -- so that generational GC is easier. link_caf node _is_upd = do { dflags <- getDynFlags - -- Alloc black hole specifying CC_HDR(Node) as the cost centre - ; let use_cc = costCentreFrom dflags (CmmReg nodeReg) - blame_cc = use_cc - tso = CmmReg (CmmGlobal CurrentTSO) - - ; hp_rel <- allocDynClosureCmm Nothing cafBlackHoleInfoTable mkLFBlackHole - use_cc blame_cc [(tso,fixedHdrSize dflags)] - -- small optimisation: we duplicate the hp_rel expression in - -- both the newCAF call and the value returned below. - -- If we instead used allocDynClosureReg which assigns it to a reg, - -- then the reg is live across the newCAF call and gets spilled, - -- which is stupid. Really we should have an optimisation pass to - -- fix this, but we don't yet. --SDM - -- Call the RTS function newCAF to add the CAF to the CafList -- so that the garbage collector can find them -- This must be done *before* the info table pointer is overwritten, -- because the old info table ptr is needed for reversion - ; ret <- newTemp (bWord dflags) - ; emitRtsCallGen [(ret,NoHint)] (mkForeignLabel (fsLit "newCAF") Nothing ForeignLabelInExternalPackage IsFunction) + ; let newCAF_lbl = mkForeignLabel (fsLit "newCAF") Nothing + ForeignLabelInExternalPackage IsFunction + ; bh <- newTemp (bWord dflags) + ; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl [ (CmmReg (CmmGlobal BaseReg), AddrHint), - (CmmReg (CmmLocal node), AddrHint), - (hp_rel, AddrHint) ] + (CmmReg (CmmLocal node), AddrHint) ] False -- see Note [atomic CAF entry] in rts/sm/Storage.c ; updfr <- getUpdFrameOff + ; let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node))) ; emit =<< mkCmmIfThen - (CmmMachOp (mo_wordEq dflags) [ CmmReg (CmmLocal ret), CmmLit (zeroCLit dflags)]) + (cmmEqWord dflags (CmmReg (CmmLocal bh)) (zeroExpr dflags)) -- re-enter the CAF - (let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node))) in - mkJump dflags NativeNodeCall target [] updfr) + (mkJump dflags NativeNodeCall target [] updfr) - ; return hp_rel } + ; return (CmmReg (CmmLocal bh)) } ------------------------------------------------------------------------ -- Profiling diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index f8b8afe328..63a9594da0 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -181,8 +181,8 @@ void performMajorGC(void); The CAF table - used to let us revert CAFs in GHCi -------------------------------------------------------------------------- */ -StgWord newCAF (StgRegTable *reg, StgIndStatic *caf, StgClosure *bh); -StgWord newDynCAF (StgRegTable *reg, StgIndStatic *caf, StgClosure *bh); +StgInd *newCAF (StgRegTable *reg, StgIndStatic *caf); +StgInd *newDynCAF (StgRegTable *reg, StgIndStatic *caf); void revertCAFs (void); // Request that all CAFs are retained indefinitely. diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index b5f3202887..755b3d9f00 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -333,9 +333,12 @@ freeStorage (rtsBool free_heap) -------------------------------------------------------------------------- */ -STATIC_INLINE StgWord lockCAF (StgIndStatic *caf, StgClosure *bh) +STATIC_INLINE StgInd * +lockCAF (StgRegTable *reg, StgIndStatic *caf) { const StgInfoTable *orig_info; + Capability *cap = regTableToCapability(reg); + StgInd *bh; orig_info = caf->header.info; @@ -345,7 +348,7 @@ STATIC_INLINE StgWord lockCAF (StgIndStatic *caf, StgClosure *bh) if (orig_info == &stg_IND_STATIC_info || orig_info == &stg_WHITEHOLE_info) { // already claimed by another thread; re-enter the CAF - return 0; + return NULL; } cur_info = (const StgInfoTable *) @@ -355,7 +358,7 @@ STATIC_INLINE StgWord lockCAF (StgIndStatic *caf, StgClosure *bh) if (cur_info != orig_info) { // already claimed by another thread; re-enter the CAF - return 0; + return NULL; } // successfully claimed by us; overwrite with IND_STATIC @@ -364,17 +367,25 @@ STATIC_INLINE StgWord lockCAF (StgIndStatic *caf, StgClosure *bh) // For the benefit of revertCAFs(), save the original info pointer caf->saved_info = orig_info; - caf->indirectee = bh; + // Allocate the blackhole indirection closure + bh = (StgInd *)allocate(cap, sizeofW(*bh)); + SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs); + bh->indirectee = (StgClosure *)cap->r.rCurrentTSO; + + caf->indirectee = (StgClosure *)bh; write_barrier(); SET_INFO((StgClosure*)caf,&stg_IND_STATIC_info); - return 1; + return bh; } -StgWord -newCAF(StgRegTable *reg, StgIndStatic *caf, StgClosure *bh) +StgInd * +newCAF(StgRegTable *reg, StgIndStatic *caf) { - if (lockCAF(caf,bh) == 0) return 0; + StgInd *bh; + + bh = lockCAF(reg, caf); + if (!bh) return NULL; if(keepCAFs) { @@ -418,7 +429,7 @@ newCAF(StgRegTable *reg, StgIndStatic *caf, StgClosure *bh) #endif } - return 1; + return bh; } // External API for setting the keepCAFs flag. see #3900. @@ -437,10 +448,13 @@ setKeepCAFs (void) // // The linker hackily arranges that references to newCaf from dynamic // code end up pointing to newDynCAF. -StgWord -newDynCAF (StgRegTable *reg STG_UNUSED, StgIndStatic *caf, StgClosure *bh) +StgInd * +newDynCAF (StgRegTable *reg, StgIndStatic *caf) { - if (lockCAF(caf,bh) == 0) return 0; + StgInd *bh; + + bh = lockCAF(reg, caf); + if (!bh) return NULL; ACQUIRE_SM_LOCK; @@ -449,7 +463,7 @@ newDynCAF (StgRegTable *reg STG_UNUSED, StgIndStatic *caf, StgClosure *bh) RELEASE_SM_LOCK; - return 1; + return bh; } /* ----------------------------------------------------------------------------- |