Commit 3fc546fe authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Merge branch 'master' of darcs.haskell.org:/srv/darcs//ghc

parents d814d505 21a53a1c
......@@ -506,9 +506,10 @@ setupUpdate closure_info code
else do
tickyPushUpdateFrame
dflags <- getDynFlags
if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
then pushBHUpdateFrame (CmmReg nodeReg) code
else pushUpdateFrame (CmmReg nodeReg) code
if blackHoleOnEntry closure_info &&
not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
then pushBHUpdateFrame (CmmReg nodeReg) code
else pushUpdateFrame (CmmReg nodeReg) code
| otherwise -- A static closure
= do { tickyUpdateBhCaf closure_info
......
......@@ -731,7 +731,7 @@ blackHoleOnEntry cl_info
= case closureLFInfo cl_info of
LFReEntrant _ _ _ _ -> False
LFLetNoEscape _ -> False
LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
LFThunk _ _no_fvs _updatable _ _ -> True
_other -> panic "blackHoleOnEntry" -- Should never happen
isKnownFun :: LambdaFormInfo -> Bool
......
......@@ -565,12 +565,15 @@ setupUpdate closure_info node body
then do tickyUpdateFrameOmitted; body
else do
tickyPushUpdateFrame
--dflags <- getDynFlags
let es = [CmmReg (CmmLocal node), mkLblExpr mkUpdInfoLabel]
--if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
-- then pushUpdateFrame es body -- XXX black hole
-- else pushUpdateFrame es body
pushUpdateFrame es body
dflags <- getDynFlags
let
bh = blackHoleOnEntry closure_info &&
not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
lbl | bh = mkBHUpdInfoLabel
| otherwise = mkUpdInfoLabel
pushUpdateFrame [CmmReg (CmmLocal node), mkLblExpr lbl] body
| otherwise -- A static closure
= do { tickyUpdateBhCaf closure_info
......@@ -579,7 +582,7 @@ setupUpdate closure_info node body
then do -- Blackhole the (updatable) CAF:
{ upd_closure <- link_caf True
; pushUpdateFrame [CmmReg (CmmLocal upd_closure),
mkLblExpr mkUpdInfoLabel] body } -- XXX black hole
mkLblExpr mkBHUpdInfoLabel] body }
else do {tickyUpdateFrameOmitted; body}
}
......
......@@ -728,7 +728,7 @@ blackHoleOnEntry cl_info
= case closureLFInfo cl_info of
LFReEntrant _ _ _ _ -> False
LFLetNoEscape -> False
LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
LFThunk _ _no_fvs _updatable _ _ -> True
_other -> panic "blackHoleOnEntry" -- Should never happen
isStaticClosure :: ClosureInfo -> Bool
......
......@@ -156,8 +156,7 @@ throwTo (Capability *cap, // the Capability we hold
MessageThrowTo *msg;
msg = (MessageThrowTo *) allocate(cap, sizeofW(MessageThrowTo));
// message starts locked; the caller has to unlock it when it is
// ready.
// the message starts locked; see below
SET_HDR(msg, &stg_WHITEHOLE_info, CCS_SYSTEM);
msg->source = source;
msg->target = target;
......@@ -166,9 +165,16 @@ throwTo (Capability *cap, // the Capability we hold
switch (throwToMsg(cap, msg))
{
case THROWTO_SUCCESS:
// unlock the message now, otherwise we leave a WHITEHOLE in
// the heap (#6103)
SET_HDR(msg, &stg_MSG_THROWTO_info, CCS_SYSTEM);
return NULL;
case THROWTO_BLOCKED:
default:
// the caller will unlock the message when it is ready. We
// cannot unlock it yet, because the calling thread will need
// to tidy up its state first.
return msg;
}
}
......
Supports Markdown
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