Commit 96c80d34 authored by Simon Marlow's avatar Simon Marlow

make CAFs atomic, to fix #5558

See Note [atomic CAFs] in rts/sm/Storage.c
parent e91ed183
......@@ -572,27 +572,26 @@ link_caf cl_info _is_upd = do
-- 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
; emitRtsCallWithVols rtsPackageId (fsLit "newCAF")
; ret <- newTemp bWord
; emitRtsCallGen [CmmHinted ret NoHint] rtsPackageId (fsLit "newCAF")
[ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint,
CmmHinted (CmmReg nodeReg) AddrHint ]
[node] False
CmmHinted (CmmReg nodeReg) AddrHint,
CmmHinted hp_rel AddrHint ]
(Just [node]) False
-- node is live, so save it.
-- Overwrite the closure with a (static) indirection
-- to the newly-allocated black hole
; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
, CmmStore (CmmReg nodeReg) ind_static_info ]
-- see Note [atomic CAF entry] in rts/sm/Storage.c
; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), CmmLit zeroCLit]) $
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
stmtC (CmmJump target [])
; returnFC hp_rel }
where
bh_cl_info :: ClosureInfo
bh_cl_info = cafBlackHoleClosureInfo cl_info
ind_static_info :: CmmExpr
ind_static_info = mkLblExpr mkIndStaticInfoLabel
off_indirectee :: WordOff
off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
\end{code}
......
......@@ -13,6 +13,7 @@ module CgUtils (
emitRODataLits, mkRODataLits,
emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
emitRtsCallGen,
assignTemp, assignTemp_, newTemp,
emitSimultaneously,
emitSwitch, emitLitSwitch,
......@@ -235,22 +236,23 @@ emitRtsCall
-> Bool -- ^ whether this is a safe call
-> Code -- ^ cmm code
emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
emitRtsCall pkg fun args safe = emitRtsCallGen [] pkg fun args Nothing safe
-- The 'Nothing' says "save all global registers"
emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
emitRtsCallWithVols pkg fun args vols safe
= emitRtsCall' [] pkg fun args (Just vols) safe
= emitRtsCallGen [] pkg fun args (Just vols) safe
emitRtsCallWithResult
:: LocalReg -> ForeignHint
-> PackageId -> FastString
-> [CmmHinted CmmExpr] -> Bool -> Code
emitRtsCallWithResult res hint pkg fun args safe
= emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe
= emitRtsCallGen [CmmHinted res hint] pkg fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
emitRtsCallGen
:: [CmmHinted LocalReg]
-> PackageId
-> FastString
......@@ -258,7 +260,7 @@ emitRtsCall'
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
-> Code
emitRtsCall' res pkg fun args vols safe = do
emitRtsCallGen res pkg fun args vols safe = do
safety <- if safe
then getSRTInfo >>= (return . CmmSafe)
else return CmmUnsafe
......
......@@ -644,25 +644,24 @@ link_caf _is_upd = do
-- 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
; emitRtsCallWithVols rtsPackageId (fsLit "newCAF")
; ret <- newTemp bWord
; emitRtsCallGen [(ret,NoHint)] rtsPackageId (fsLit "newCAF")
[ (CmmReg (CmmGlobal BaseReg), AddrHint),
(CmmReg nodeReg, AddrHint) ]
[node] False
-- node is live, so save it.
-- Overwrite the closure with a (static) indirection
-- to the newly-allocated black hole
; emit (mkStore (cmmRegOffW nodeReg off_indirectee) (CmmReg (CmmLocal hp_rel)) <*>
mkStore (CmmReg nodeReg) ind_static_info)
(CmmReg nodeReg, AddrHint),
(CmmReg (CmmLocal hp_rel), AddrHint) ]
(Just [node]) False
-- node is live, so save it.
-- see Note [atomic CAF entry] in rts/sm/Storage.c
; emit $ mkCmmIfThen
(CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), CmmLit zeroCLit]) $
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
mkJump target [] 0
; return hp_rel }
where
ind_static_info :: CmmExpr
ind_static_info = mkLblExpr mkIndStaticInfoLabel
off_indirectee :: WordOff
off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
------------------------------------------------------------------------
-- Profiling
......
......@@ -10,8 +10,8 @@ module StgCmmUtils (
cgLit, mkSimpleLit,
emitDataLits, mkDataLits,
emitRODataLits, mkRODataLits,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
assignTemp, newTemp, withTemp,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult, emitRtsCallGen,
assignTemp, newTemp, withTemp,
newUnboxedTupleRegs,
......@@ -171,20 +171,20 @@ tagToClosure tycon tag
-------------------------------------------------------------------------
emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
emitRtsCall pkg fun args safe = emitRtsCallGen [] pkg fun args Nothing safe
-- The 'Nothing' says "save all global registers"
emitRtsCallWithVols :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
emitRtsCallWithVols pkg fun args vols safe
= emitRtsCall' [] pkg fun args (Just vols) safe
= emitRtsCallGen [] pkg fun args (Just vols) safe
emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString
-> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCallWithResult res hint pkg fun args safe
= emitRtsCall' [(res,hint)] pkg fun args Nothing safe
= emitRtsCallGen [(res,hint)] pkg fun args Nothing safe
-- Make a call to an RTS C procedure
emitRtsCall'
emitRtsCallGen
:: [(LocalReg,ForeignHint)]
-> PackageId
-> FastString
......@@ -192,9 +192,8 @@ emitRtsCall'
-> Maybe [GlobalReg]
-> Bool -- True <=> CmmSafe call
-> FCode ()
emitRtsCall' res pkg fun args _vols safe
= --error "emitRtsCall'"
do { updfr_off <- getUpdFrameOff
emitRtsCallGen res pkg fun args _vols safe
= do { updfr_off <- getUpdFrameOff
; emit caller_save
; emit $ call updfr_off
; emit caller_load }
......
......@@ -170,8 +170,8 @@ void performMajorGC(void);
The CAF table - used to let us revert CAFs in GHCi
-------------------------------------------------------------------------- */
void newCAF (StgRegTable *reg, StgClosure *);
void newDynCAF (StgRegTable *reg, StgClosure *);
StgWord newCAF (StgRegTable *reg, StgClosure *caf, StgClosure *bh);
StgWord newDynCAF (StgRegTable *reg, StgClosure *caf, StgClosure *bh);
void revertCAFs (void);
// Request that all CAFs are retained indefinitely.
......
......@@ -229,21 +229,47 @@ freeStorage (rtsBool free_heap)
The entry code for every CAF does the following:
- builds a BLACKHOLE in the heap
- pushes an update frame pointing to the BLACKHOLE
- calls newCaf, below
- updates the CAF with a static indirection to the BLACKHOLE
- builds a CAF_BLACKHOLE in the heap
- calls newCaf, which atomically updates the CAF with
IND_STATIC pointing to the CAF_BLACKHOLE
- if newCaf returns zero, it re-enters the CAF (see Note [atomic
CAF entry])
- pushes an update frame pointing to the CAF_BLACKHOLE
Why do we build an BLACKHOLE in the heap rather than just updating
the thunk directly? It's so that we only need one kind of update
frame - otherwise we'd need a static version of the update frame too.
frame - otherwise we'd need a static version of the update frame
too, and various other parts of the RTS that deal with update
frames would also need special cases for static update frames.
newCaf() does the following:
- it updates the CAF with an IND_STATIC pointing to the
CAF_BLACKHOLE, atomically.
- it puts the CAF on the oldest generation's mutable list.
This is so that we treat the CAF as a root when collecting
younger generations.
------------------
Note [atomic CAF entry]
With THREADED_RTS, newCaf() is required to be atomic (see
#5558). This is because if two threads happened to enter the same
CAF simultaneously, they would create two distinct CAF_BLACKHOLEs,
and so the normal threadPaused() machinery for detecting duplicate
evaluation will not detect this. Hence in lockCAF() below, we
atomically lock the CAF with WHITEHOLE before updating it with
IND_STATIC, and return zero if another thread locked the CAF first.
In the event that we lost the race, CAF entry code will re-enter
the CAF and block on the other thread's CAF_BLACKHOLE.
------------------
Note [GHCi CAFs]
For GHCI, we have additional requirements when dealing with CAFs:
- we must *retain* all dynamically-loaded CAFs ever entered,
......@@ -264,36 +290,76 @@ freeStorage (rtsBool free_heap)
-------------------------------------------------------------------------- */
void
newCAF(StgRegTable *reg, StgClosure* caf)
STATIC_INLINE StgWord lockCAF (StgClosure *caf, StgClosure *bh)
{
if(keepCAFs)
{
// HACK:
// If we are in GHCi _and_ we are using dynamic libraries,
// then we can't redirect newCAF calls to newDynCAF (see below),
// so we make newCAF behave almost like newDynCAF.
// The dynamic libraries might be used by both the interpreted
// program and GHCi itself, so they must not be reverted.
// This also means that in GHCi with dynamic libraries, CAFs are not
// garbage collected. If this turns out to be a problem, we could
// do another hack here and do an address range test on caf to figure
// out whether it is from a dynamic library.
((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
ACQUIRE_SM_LOCK; // caf_list is global, locked by sm_mutex
((StgIndStatic *)caf)->static_link = caf_list;
caf_list = caf;
RELEASE_SM_LOCK;
}
else
{
// Put this CAF on the mutable list for the old generation.
((StgIndStatic *)caf)->saved_info = NULL;
if (oldest_gen->no != 0) {
recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
const StgInfoTable *orig_info;
orig_info = caf->header.info;
#ifdef THREADED_RTS
const StgInfoTable *cur_info;
if (orig_info == &stg_IND_STATIC_info ||
orig_info == &stg_WHITEHOLE_info) {
// already claimed by another thread; re-enter the CAF
return 0;
}
}
cur_info = (const StgInfoTable *)
cas((StgVolatilePtr)&caf->header.info,
(StgWord)orig_info,
(StgWord)&stg_WHITEHOLE_info);
if (cur_info != orig_info) {
// already claimed by another thread; re-enter the CAF
return 0;
}
// successfully claimed by us; overwrite with IND_STATIC
#endif
// For the benefit of revertCAFs(), save the original info pointer
((StgIndStatic *)caf)->saved_info = orig_info;
((StgIndStatic*)caf)->indirectee = bh;
write_barrier();
SET_INFO(caf,&stg_IND_STATIC_info);
return 1;
}
StgWord
newCAF(StgRegTable *reg, StgClosure *caf, StgClosure *bh)
{
if (lockCAF(caf,bh) == 0) return 0;
if(keepCAFs)
{
// HACK:
// If we are in GHCi _and_ we are using dynamic libraries,
// then we can't redirect newCAF calls to newDynCAF (see below),
// so we make newCAF behave almost like newDynCAF.
// The dynamic libraries might be used by both the interpreted
// program and GHCi itself, so they must not be reverted.
// This also means that in GHCi with dynamic libraries, CAFs are not
// garbage collected. If this turns out to be a problem, we could
// do another hack here and do an address range test on caf to figure
// out whether it is from a dynamic library.
ACQUIRE_SM_LOCK; // caf_list is global, locked by sm_mutex
((StgIndStatic *)caf)->static_link = caf_list;
caf_list = caf;
RELEASE_SM_LOCK;
}
else
{
// Put this CAF on the mutable list for the old generation.
((StgIndStatic *)caf)->saved_info = NULL;
if (oldest_gen->no != 0) {
recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
}
}
return 1;
}
// External API for setting the keepCAFs flag. see #3900.
......@@ -312,16 +378,19 @@ setKeepCAFs (void)
//
// The linker hackily arranges that references to newCaf from dynamic
// code end up pointing to newDynCAF.
void
newDynCAF (StgRegTable *reg STG_UNUSED, StgClosure *caf)
StgWord
newDynCAF (StgRegTable *reg STG_UNUSED, StgClosure *caf, StgClosure *bh)
{
if (lockCAF(caf,bh) == 0) return 0;
ACQUIRE_SM_LOCK;
((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
((StgIndStatic *)caf)->static_link = revertible_caf_list;
revertible_caf_list = caf;
RELEASE_SM_LOCK;
return 1;
}
/* -----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment