Commit 01f842b9 authored by dias@eecs.tufts.edu's avatar dias@eecs.tufts.edu
Browse files

When calling gc, avoid saving node in static closures

parent 5dd61c66
......@@ -403,7 +403,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
; granYield arg_regs node_points
-- Main payload
; entryHeapCheck node arity arg_regs $ do
; entryHeapCheck (if node_points then Just node else Nothing) arity arg_regs $ do
{ enterCostCentre cl_info cc body
; fv_bindings <- mapM bind_fv fv_details
-- Load free vars out of closure *after*
......@@ -459,7 +459,7 @@ thunkCode cl_info fv_details cc node arity body
; granThunk node_points
-- Heap overflow check
; entryHeapCheck node arity [] $ do
; entryHeapCheck (if node_points then Just node else Nothing) arity [] $ do
{ -- Overwrite with black hole if necessary
-- but *after* the heap-overflow check
dflags <- getDynFlags
......
......@@ -334,7 +334,7 @@ These are used in the following circumstances
--------------------------------------------------------------
-- 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 ()
......@@ -344,7 +344,8 @@ entryHeapCheck fun arity args code
= do updfr_sz <- getUpdFrameOff
heapCheck True (gc_call updfr_sz) code -- The 'fun' keeps relevant CAFs alive
where
args' = fun : 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)) arg_exprs updfr_sz
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment