#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:
------------------------------------------+---------------------------------
Changes (by ezyang):
* owner: => ezyang
Comment:
It turns out the stupid implementation is actually pretty fast.
{{{diff --git a/compiler/codeGen/StgCmmHeap.hs
b/compiler/codeGen/StgCmmHeap.hs
index fb37391..a70d132 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -557,15 +557,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 =<< mkCmmIfThen yielding (alloc_n <*> mkBranch gc_id)
emitOutOfLine gc_id $
do_gc -- this is expected to jump back somewhere
}}}
A totally unscientific benchmark on
{{{
module Main where
import qualified Data.Vector as U
main = U.sum (U.enumFromTo 1 (1000000000 :: Int)) `seq` return ()
}}}
yields this C--
{{{
Main.main1_entry()
{ [(c1Zm,
Main.main1_info:
const 65539;
const 0;
const 15;),
(c1Zn,
block_c1Zn_info:
const 0;
const 32;)]
}
c1Zm:
if (Sp - 12 < SpLim) goto c1Zv;
if (HpLim == 0) goto c1Zu;
I32[Sp - 8] = 0;
I32[Sp - 12] = 1;
I32[Sp - 4] = c1Zn;
Sp = Sp - 12;
jump Main.main_$s$wfoldlM'_loop_info; // []
c1Zu:
HpAlloc = 0;
goto c1Zv;
c1Zv:
R1 = Main.main1_closure;
jump stg_gc_fun; // [R1]
c1Zn:
if (HpLim == 0) goto c1ZC;
R1 = GHC.Tuple.()_closure+1;
Sp = Sp + 4;
jump I32[Sp]; // [R1]
c1ZC:
HpAlloc = 0;
R1 = R1;
jump stg_gc_unbx_r1; // [R1]
}}}
which is only about 10% slower.
Unfortunately, if you want to guarantee things don't hang, it's not enough
to compile the untrusted code like this; all the other code needs to have
this transformation applied too. So we should probably have a -yielding
flag (like -threaded or -profiling) which allows us to compile "yielding"
versions of all relevant code. Unfortunately, the number of combinations
of such flags exponentially increases...
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/367#comment:17>
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
