X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmBind.hs;h=f098f3f73360cd2a5803e2ba1854e90f72dfbc87;hb=f8f4cb3f3a46e0495917a927cefe906531b7b38e;hp=ad1b3e2bb56ec68f5a0b5cc89482a0fddde93c92;hpb=ea9fe633d8eb7e986832519e3d4923a6e694ebbb;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index ad1b3e2..f098f3f 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
@@ -87,8 +86,7 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
   ; forkClosureBody (closureCodeBody True id closure_info ccs
                                      (nonVoidIds args) (length args) body fv_details)
 
-  ; pprTrace "arity for" (ppr id <+> ppr (length args) <+> ppr args) $
-    returnFC cg_id_info }
+  ; returnFC cg_id_info }
 
 ------------------------------------------------------------------------
 --		Non-top-level bindings
@@ -154,8 +152,7 @@ cgRhs name (StgRhsCon maybe_cc con args)
   = buildDynCon name maybe_cc con args
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = pprTrace "cgRhs closure" (ppr name <+> ppr args) $
-    mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag srt args body
+  = mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag srt args body
 
 ------------------------------------------------------------------------
 --		Non-constructor right hand sides
@@ -421,7 +418,7 @@ bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }
 
 load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, WordOff)] -> FCode ()
 load_fvs node lf_info = mapCs (\ (reg, off) ->
-      pprTrace "get tag for" (ppr reg <+> ppr tag) $ emit $ mkTaggedObjectLoad reg node off tag)
+      emit $ mkTaggedObjectLoad reg node off tag)
   where tag = lfDynTag lf_info
 
 -----------------------------------------
@@ -464,7 +461,8 @@ thunkCode cl_info fv_details cc node arity body
 	; entryHeapCheck node 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
@@ -597,7 +595,7 @@ link_caf :: ClosureInfo
 -- updated with the new value when available.  The reason for all of this
 -- is that we only want to update dynamic heap objects, not static ones,
 -- so that generational GC is easier.
-link_caf cl_info is_upd = do
+link_caf cl_info _is_upd = do
   { 	-- Alloc black hole specifying CC_HDR(Node) as the cost centre
   ; let	use_cc   = costCentreFrom (CmmReg nodeReg)
         blame_cc = use_cc