-do_checks :: WordOff -- Heap headroom
- -> CmmAGraph -- What to do on failure
- -> CmmAGraph
-do_checks 0 _
- = mkNop
-do_checks alloc do_gc
- = withFreshLabel "gc" $ \ blk_id ->
- mkLabel blk_id Nothing
- <*> mkAssign hpReg bump_hp
- <*> mkCmmIfThen hp_oflo
- (save_alloc
- <*> do_gc
- <*> mkBranch blk_id)
- -- Bump heap pointer, and test for heap exhaustion
+do_checks :: Bool -- Should we check the stack?
+ -> WordOff -- Heap headroom
+ -> CmmAGraph -- What to do on failure
+ -> CmmAGraph
+do_checks checkStack alloc do_gc
+ = withFreshLabel "gc" $ \ loop_id ->
+ withFreshLabel "gc" $ \ gc_id ->
+ mkLabel loop_id
+ <*> (let hpCheck = if alloc == 0 then mkNop
+ else mkAssign hpReg bump_hp <*>
+ mkCmmIfThen hp_oflo (save_alloc <*> mkBranch gc_id)
+ in if checkStack then
+ mkCmmIfThenElse sp_oflo (mkBranch gc_id) hpCheck
+ else hpCheck)
+ <*> mkComment (mkFastString "outOfLine should follow:")
+ <*> outOfLine (mkLabel gc_id
+ <*> mkComment (mkFastString "outOfLine here")
+ <*> do_gc
+ <*> mkBranch loop_id)
+ -- Test for stack pointer exhaustion, then
+ -- bump heap pointer, and test for heap exhaustion