X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmBind.hs;h=ee033b19c9193e6ea2d31f7ac22272ea0b6094bc;hb=0aa5f6851c493805be58da3798f6ad55b6538cf2;hp=ad1b3e2bb56ec68f5a0b5cc89482a0fddde93c92;hpb=ea9fe633d8eb7e986832519e3d4923a6e694ebbb;p=ghc-hetmet.git diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index ad1b3e2..ee033b1 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -87,8 +87,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 +153,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 +419,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 +462,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 +596,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