--------------------------------------------------------------
-- A heap/stack check at a function or thunk entry point.
-entryHeapCheck :: LocalReg -- Function (closure environment)
+entryHeapCheck :: Maybe LocalReg -- Function (closure environment)
-> Int -- Arity -- not same as length args b/c of voids
-> [LocalReg] -- Non-void args (empty for thunk)
-> FCode ()
= do updfr_sz <- getUpdFrameOff
heapCheck True (gc_call updfr_sz) code -- The 'fun' keeps relevant CAFs alive
where
- fun_expr = CmmReg (CmmLocal fun)
- -- JD: ugh... we should only do the following for dynamic closures
- args' = fun_expr : map (CmmReg . CmmLocal) args
+ args' = case fun of Just f -> f : args
+ Nothing -> args
+ arg_exprs = map (CmmReg . CmmLocal) args'
gc_call updfr_sz
- | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) args' updfr_sz
- | otherwise = case gc_lbl (fun : args) of
- Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
- args' updfr_sz
- Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz
+ | arity == 0 = mkJumpGC (CmmReg (CmmGlobal GCEnter1)) arg_exprs updfr_sz
+ | otherwise = case gc_lbl args' of
+ Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
+ arg_exprs updfr_sz
+ Nothing -> mkCall generic_gc (GC, GC) [] [] updfr_sz
gc_lbl :: [LocalReg] -> Maybe LitString
{-