entryHeapCheck :: LocalReg -- Function (closure environment)
-> Int -- Arity -- not same as length args b/c of voids
-> [LocalReg] -- Non-void args (empty for thunk)
entryHeapCheck :: LocalReg -- Function (closure environment)
-> Int -- Arity -- not same as length args b/c of voids
-> [LocalReg] -- Non-void args (empty for thunk)
= do updfr_sz <- getUpdFrameOff
heapCheck True (gc_call updfr_sz) code -- The 'fun' keeps relevant CAFs alive
where
= do updfr_sz <- getUpdFrameOff
heapCheck True (gc_call updfr_sz) code -- The 'fun' keeps relevant CAFs alive
where
do_checks checkStack alloc do_gc
= withFreshLabel "gc" $ \ loop_id ->
withFreshLabel "gc" $ \ gc_id ->
do_checks checkStack alloc do_gc
= withFreshLabel "gc" $ \ loop_id ->
withFreshLabel "gc" $ \ gc_id ->
<*> (let hpCheck = if alloc == 0 then mkNop
else mkAssign hpReg bump_hp <*>
mkCmmIfThen hp_oflo (save_alloc <*> mkBranch gc_id)
<*> (let hpCheck = if alloc == 0 then mkNop
else mkAssign hpReg bump_hp <*>
mkCmmIfThen hp_oflo (save_alloc <*> mkBranch gc_id)
mkCmmIfThenElse sp_oflo (mkBranch gc_id) hpCheck
else hpCheck)
<*> mkComment (mkFastString "outOfLine should follow:")
mkCmmIfThenElse sp_oflo (mkBranch gc_id) hpCheck
else hpCheck)
<*> mkComment (mkFastString "outOfLine should follow:")