[commit: ghc] master: Move the allocation of CAF blackholes into 'newCAF' (#8590) (55c703b)
git at git.haskell.org
git at git.haskell.org
Wed Dec 4 18:49:30 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/55c703b8fdb040c51bf8784beb3dc02332db417a/ghc
>---------------------------------------------------------------
commit 55c703b8fdb040c51bf8784beb3dc02332db417a
Author: Patrick Palka <patrick at parcs.ath.cx>
Date: Sun Dec 1 21:17:43 2013 -0500
Move the allocation of CAF blackholes into 'newCAF' (#8590)
We now do the allocation of the blackhole indirection closure inside the
RTS procedure 'newCAF' instead of generating the allocation code inline
in the closure body of each CAF. This slightly decreases code size in
modules with a lot of CAFs.
As a result of this change, for example, the size of DynFlags.o drops by
~60KB and HsExpr.o by ~100KB.
>---------------------------------------------------------------
55c703b8fdb040c51bf8784beb3dc02332db417a
compiler/codeGen/StgCmmBind.hs | 40 ++++++++++------------------------------
includes/rts/storage/GC.h | 4 ++--
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 64772c6..05aae0a 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 f8b8afe..63a9594 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 b5f3202..755b3d9 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;
}
/* -----------------------------------------------------------------------------
More information about the ghc-commits
mailing list