#367: Infinite loops can hang Concurrent Haskell
------------------------------------------+---------------------------------
Reporter: simonpj | Owner: ezyang
Type: bug | Status: new
Priority: lowest | Milestone: _|_
Component: Compiler | Version: 6.4.1
Resolution: None | Keywords: scheduler
allocation
Os: Unknown/Multiple | Architecture: Unknown/Multiple
Failure: Incorrect result at runtime | Difficulty: Unknown
Testcase: | Blockedby:
Blocking: | Related:
------------------------------------------+---------------------------------
Comment(by ezyang):
Here is a variant of the patch that only does heap checks when not
returning (since it's not possible to "infinitely return".) We do much
better on runtime and binary size; maybe good enough to ship by default!
{{{
diff --git a/compiler/codeGen/StgCmmHeap.hs
b/compiler/codeGen/StgCmmHeap.hs
index fb37391..4c53bc2 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -371,7 +371,7 @@ entryHeapCheck cl_info nodeSet arity args code
loop_id <- newLabelC
emitLabel loop_id
- heapCheck True (gc_call updfr_sz <*> mkBranch loop_id) code
+ heapCheck True True (gc_call updfr_sz <*> mkBranch loop_id) code
{-
-- This code is slightly outdated now and we could easily keep the
above
@@ -461,7 +461,7 @@ cannedGCReturnsTo :: Bool -> CmmExpr -> [LocalReg] ->
Label -> ByteOff
cannedGCReturnsTo cont_on_stack gc regs lret off code
= do dflags <- getDynFlags
updfr_sz <- getUpdFrameOff
- heapCheck False (gc_call dflags gc updfr_sz) code
+ heapCheck False False (gc_call dflags gc updfr_sz) code
where
reg_exprs = map (CmmReg . CmmLocal) regs
-- Note [stg_gc arguments]
@@ -476,7 +476,7 @@ genericGC code
lretry <- newLabelC
emitLabel lretry
call <- mkCall generic_gc (GC, GC) [] [] updfr_sz (0,[])
- heapCheck False (call <*> mkBranch lretry) code
+ heapCheck False True (call <*> mkBranch lretry) code
cannedGCEntryPoint :: DynFlags -> [LocalReg] -> Maybe CmmExpr
cannedGCEntryPoint dflags regs
@@ -524,22 +524,23 @@ mkGcLabel :: String -> CmmExpr
mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit s)))
-------------------------------
-heapCheck :: Bool -> CmmAGraph -> FCode a -> FCode a
-heapCheck checkStack do_gc code
+heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a
+heapCheck checkStack checkYield do_gc code
= getHeapUsage $ \ hpHw ->
-- Emit heap checks, but be sure to do it lazily so
-- that the conditionals on hpHw don't cause a black hole
- do { codeOnly $ do_checks checkStack hpHw do_gc
+ do { codeOnly $ do_checks checkStack checkYield hpHw do_gc
; tickyAllocHeap hpHw
; doGranAllocate hpHw
; setRealHp hpHw
; code }
do_checks :: Bool -- Should we check the stack?
+ -> Bool -- Should we check for preemption?
-> WordOff -- Heap headroom
-> CmmAGraph -- What to do on failure
-> FCode ()
-do_checks checkStack alloc do_gc = do
+do_checks checkStack checkYield alloc do_gc = do
dflags <- getDynFlags
let
alloc_lit = mkIntExpr dflags (alloc * wORD_SIZE dflags) -- Bytes
@@ -557,15 +558,22 @@ do_checks checkStack alloc do_gc = do
hp_oflo = CmmMachOp (mo_wordUGt dflags)
[CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
+ -- Yielding if HpLim == 0
+ yielding = CmmMachOp (mo_wordEq dflags)
+ [CmmReg (CmmGlobal HpLim), CmmLit (zeroCLit
dflags)]
+
alloc_n = mkAssign (CmmGlobal HpAlloc) alloc_lit
gc_id <- newLabelC
when checkStack $ do
emit =<< mkCmmIfGoto sp_oflo gc_id
- when (alloc /= 0) $ do
- emitAssign hpReg bump_hp
- emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id)
+ if (alloc /= 0)
+ then do
+ emitAssign hpReg bump_hp
+ emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id)
+ else do
+ emit =<< mkCmmIfGoto yielding gc_id
emitOutOfLine gc_id $
do_gc -- this is expected to jump back somewhere
}}}
{{{
--------------------------------------------------------------------------------
Program Size Allocs Runtime Elapsed TotalMem
--------------------------------------------------------------------------------
anna +5.5% +0.0% 0.13 0.13 +0.0%
ansi +6.0% +0.0% 0.00 0.00 +0.0%
atom +6.0% +0.0% +0.0% +0.3% +0.0%
awards +6.0% +0.0% 0.00 0.00 +0.0%
banner +5.9% +0.0% 0.00 0.00 +0.0%
bernouilli +6.0% +0.0% +0.3% +0.3% +0.0%
boyer +5.9% +0.0% 0.06 0.06 +0.0%
boyer2 +5.9% +0.0% 0.01 0.01 +0.0%
bspt +5.8% +0.0% 0.02 0.02 +0.0%
cacheprof +5.7% -0.1% -0.3% -0.3% +0.0%
calendar +6.0% +0.0% 0.00 0.00 +0.0%
cichelli +6.0% +0.0% 0.10 0.10 +0.0%
circsim +6.0% +0.0% +1.0% +1.0% +0.0%
clausify +6.0% +0.0% 0.05 0.05 +0.0%
comp_lab_zift +6.0% +0.0% +2.1% +1.6% +0.0%
compress +6.0% +0.0% +0.0% +0.0% +0.0%
compress2 +6.0% +0.0% +0.0% +0.0% +0.0%
constraints +6.0% +0.0% +0.9% +0.9% +0.0%
cryptarithm1 +6.0% +0.0% -2.7% -2.8% +0.0%
cryptarithm2 +6.0% +0.0% 0.02 0.02 +0.0%
cse +6.0% +0.0% 0.00 0.00 +0.0%
eliza +5.9% +0.0% 0.00 0.00 +0.0%
event +6.0% +0.0% 0.17 0.17 +0.0%
exp3_8 +6.0% +0.0% +0.0% -0.3% +0.0%
expert +5.9% +0.0% 0.00 0.00 +0.0%
fem +5.9% +0.0% 0.03 0.03 +0.0%
fft +6.0% +0.0% 0.05 0.05 +0.0%
fft2 +6.0% +0.0% 0.08 0.08 +0.0%
fibheaps +6.0% +0.0% 0.04 0.04 +0.0%
fish +6.0% +0.0% 0.03 0.03 +0.0%
fluid +5.8% +0.0% 0.01 0.01 +0.0%
fulsom +5.9% +0.0% +1.7% +1.0% +0.9%
gamteb +6.0% +0.0% 0.06 0.06 +0.0%
gcd +6.0% +0.0% 0.04 0.04 +0.0%
gen_regexps +6.0% +0.0% 0.00 0.00 +0.0%
genfft +6.0% +0.0% 0.04 0.04 +0.0%
gg +5.9% +0.0% 0.02 0.02 +0.0%
grep +5.9% +0.0% 0.00 0.00 +0.0%
hidden +5.9% +0.0% +8.9% +9.3% +0.0%
hpg +5.9% +0.0% 0.16 0.16 +0.0%
ida +6.0% +0.0% 0.13 0.13 +0.0%
infer +5.9% +0.0% 0.08 0.08 +0.0%
integer +6.0% +0.0% +1.1% +1.0% +0.0%
integrate +6.0% +0.0% -4.9% -4.7% +0.0%
knights +6.0% +0.0% 0.01 0.01 +0.0%
lcss +6.0% +0.0% +0.0% +0.0% +0.0%
life +6.0% +0.0% +5.3% +4.6% +0.0%
lift +6.0% +0.0% 0.00 0.00 +0.0%
listcompr +6.0% +0.0% 0.11 0.11 +0.0%
listcopy +6.0% +0.0% 0.12 0.12 +0.0%
maillist +6.0% +0.0% 0.10 0.10 +1.7%
mandel +6.0% +0.0% 0.09 0.09 +0.0%
mandel2 +6.0% +0.0% 0.01 0.01 +0.0%
minimax +6.0% +0.0% 0.01 0.01 +0.0%
mkhprog +6.0% +0.0% 0.01 0.01 +0.0%
multiplier +6.0% +0.0% 0.15 0.15 +0.0%
nucleic2 +6.0% +0.0% 0.08 0.08 +0.0%
para +6.0% +0.0% -0.2% -0.0% +0.0%
paraffins +6.0% +0.0% 0.11 0.11 +0.0%
parser +5.8% +0.0% 0.04 0.04 +0.0%
parstof +5.7% +0.0% 0.01 0.01 +0.0%
pic +5.9% +0.0% 0.02 0.02 +0.0%
power +6.0% +0.0% +3.1% +2.8% +0.0%
pretty +6.0% +0.0% 0.00 0.00 +0.0%
primes +6.0% +0.0% 0.08 0.08 +0.0%
primetest +6.0% +0.0% 0.14 0.14 +0.0%
prolog +6.0% +0.0% 0.01 0.01 +0.0%
puzzle +6.0% +0.0% 0.18 0.18 +0.0%
queens +6.0% +0.0% 0.03 0.03 +0.0%
reptile +5.8% +0.0% 0.02 0.02 +0.0%
rewrite +6.0% +0.0% 0.02 0.02 +0.0%
rfib +6.0% +0.0% 0.02 0.02 +0.0%
rsa +6.0% +0.0% 0.04 0.04 +0.0%
scc +6.0% +0.0% 0.00 0.00 +0.0%
sched +6.0% +0.0% 0.03 0.03 +0.0%
scs +5.9% +0.0% +1.5% +1.6% +0.0%
simple +5.7% +0.0% +1.0% +1.8% +0.0%
solid +5.9% +0.0% 0.17 0.17 +0.0%
sorting +6.0% +0.0% 0.00 0.00 +0.0%
sphere +6.0% +0.0% 0.08 0.08 +0.0%
symalg +6.0% +0.0% 0.02 0.02 +0.0%
tak +6.0% +0.0% 0.02 0.02 +0.0%
transform +5.9% +0.0% -6.7% -6.7% +0.0%
treejoin +6.0% +0.0% -0.3% -0.3% +0.0%
typecheck +5.9% +0.0% +0.5% +1.1% +0.0%
veritas +5.4% +0.0% 0.01 0.01 +0.0%
wang +6.0% +0.0% 0.14 0.14 +0.0%
wave4main +6.0% +0.0% +1.1% +0.9% +0.0%
wheel-sieve1 +6.0% +0.0% +4.3% +4.6% +0.0%
wheel-sieve2 +6.0% +0.0% +1.0% +1.0% +0.0%
x2n1 +6.0% +0.0% 0.01 0.01 +0.0%
--------------------------------------------------------------------------------
Min +5.4% -0.1% -6.7% -6.7% +0.0%
Max +6.0% +0.0% +8.9% +9.3% +1.7%
Geometric Mean +5.9% -0.0% +0.7% +0.7% +0.0%
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/367#comment:24>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
