When calling gc, avoid saving node in static closures

2 files changed, 5 insertions, 4 deletions

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 5decdebd7e..dbeab2b337 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -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
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index ec6095313e..817a896591 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -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