X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmBind.hs;h=e7d54447617fbf7f68f49126c0b2ea014d25f574;hb=984a288119983912d40a80845c674ee4b83a19ce;hp=b4415eb1f0340132e87ad3d1f71e47be6dd9b57c;hpb=5892af0e08fdb890b5a0b9a64346d9f7773a6ed8;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index b4415eb..e7d5444 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -17,7 +17,6 @@ module StgCmmBind (
 
 import StgCmmExpr
 import StgCmmMonad
-import StgCmmExpr
 import StgCmmEnv
 import StgCmmCon
 import StgCmmHeap
@@ -37,7 +36,7 @@ import CLabel
 import StgSyn
 import CostCentre	
 import Id
-import Monad (foldM, liftM)
+import Control.Monad
 import Name
 import Module
 import ListSetOps
@@ -48,8 +47,6 @@ import Outputable
 import FastString
 import Maybes
 
-import Data.List
-
 ------------------------------------------------------------------------
 --		Top-level bindings
 ------------------------------------------------------------------------
@@ -394,21 +391,22 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
 
 	-- Emit the main entry code
         ; emitClosureProcAndInfoTable top_lvl bndr cl_info args $ \(node, arg_regs) -> do
-    	        -- Emit the slow-entry code (for entering a closure through a PAP)
-	        { mkSlowEntryCode cl_info arg_regs
-
-		; let lf_info = closureLFInfo cl_info
-		      node_points = nodeMustPointToIt lf_info
-		; tickyEnterFun cl_info
-		; whenC node_points (ldvEnterClosure cl_info)
-		; granYield arg_regs node_points
-
-			-- Main payload
-		; entryHeapCheck node arity arg_regs $ do
-		{ enterCostCentre cl_info cc body
+                    -- Emit the slow-entry code (for entering a closure through a PAP)
+                { mkSlowEntryCode cl_info arg_regs
+
+                ; let lf_info = closureLFInfo cl_info
+                      node_points = nodeMustPointToIt lf_info
+                ; tickyEnterFun cl_info
+                ; whenC node_points (ldvEnterClosure cl_info)
+                ; granYield arg_regs node_points
+
+                        -- Main payload
+                ; 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_fvs node lf_info fv_bindings -- Load free vars out of closure *after*
-		; cgExpr body }}	    -- heap check, to reduce live vars over check
+                -- Load free vars out of closure *after*
+                ; if node_points then load_fvs node lf_info fv_bindings else return ()
+                ; cgExpr body }}	    -- heap check, to reduce live vars over check
 
   }
 
@@ -459,10 +457,11 @@ 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
-	  whenC (blackHoleOnEntry cl_info && node_points)
+	  dflags <- getDynFlags
+	; whenC (blackHoleOnEntry dflags cl_info && node_points)
  	        (blackHoleIt cl_info)
 
 		-- Push update frame
@@ -495,8 +494,8 @@ emitBlackHoleCode is_single_entry
   | otherwise = 
 	nopC
   where
-    bh_lbl | is_single_entry = mkRtsDataLabel (sLit "stg_SE_BLACKHOLE_info")
-	   | otherwise	     = mkRtsDataLabel (sLit "stg_BLACKHOLE_info")
+    bh_lbl | is_single_entry = mkRtsDataLabel (fsLit "stg_SE_BLACKHOLE_info")
+	   | otherwise	     = mkRtsDataLabel (fsLit "stg_BLACKHOLE_info")
 
 	-- If we wanted to do eager blackholing with slop filling,
 	-- we'd need to do it at the *end* of a basic block, otherwise
@@ -606,7 +605,7 @@ link_caf cl_info _is_upd = do
 	-- so that the garbage collector can find them
 	-- This must be done *before* the info table pointer is overwritten, 
 	-- because the old info table ptr is needed for reversion
-  ; emitRtsCallWithVols (sLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
+  ; emitRtsCallWithVols (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
 	-- node is live, so save it.
 
 	-- Overwrite the closure with a (static) indirection