From 5892af0e08fdb890b5a0b9a64346d9f7773a6ed8 Mon Sep 17 00:00:00 2001 From: "dias@eecs.harvard.edu" Date: Wed, 26 Nov 2008 18:08:08 +0000 Subject: [PATCH] drop some debugging traces and use only one flag for new codegen --- compiler/cmm/CmmCPSZ.hs | 4 ++-- compiler/codeGen/CgCallConv.hs | 2 +- compiler/codeGen/StgCmmBind.hs | 8 +++----- compiler/codeGen/StgCmmClosure.hs | 7 +++---- compiler/codeGen/StgCmmCon.hs | 3 +-- compiler/codeGen/StgCmmExpr.hs | 2 +- compiler/codeGen/StgCmmLayout.hs | 4 +--- compiler/codeGen/StgCmmPrim.hs | 2 +- compiler/main/HscMain.lhs | 2 +- 9 files changed, 14 insertions(+), 20 deletions(-) diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs index 008fa5d..aac9372 100644 --- a/compiler/cmm/CmmCPSZ.hs +++ b/compiler/cmm/CmmCPSZ.hs @@ -47,8 +47,8 @@ protoCmmCPSZ :: HscEnv -- Compilation env including -> CmmZ -- Input C-- with Procedures -> IO (TopSRT, [CmmZ]) -- Output CPS transformed C-- protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops) - | not (dopt Opt_RunCPSZ (hsc_dflags hsc_env)) - = return (topSRT, Cmm tops : rst) -- Only if -frun-cps + | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env)) + = return (topSRT, Cmm tops : rst) -- Only if -fnew-codegen | otherwise = do let dflags = hsc_dflags hsc_env showPass dflags "CPSZ" diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 87c69b6..a9c591b 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -369,7 +369,7 @@ assign_regs args supply assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs) assign_reg FloatArg (vs, f:fs, ds, ls) = Just (FloatReg f, (vs, fs, ds, ls)) assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d, (vs, fs, ds, ls)) -assign_reg LongArg (vs, fs, ds, l:ls) = pprTrace "longArg" (ppr l) $ Just (LongReg l, (vs, fs, ds, ls)) +assign_reg LongArg (vs, fs, ds, l:ls) = Just (LongReg l, (vs, fs, ds, ls)) assign_reg PtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VGcPtr, (vs, fs, ds, ls)) assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VNonGcPtr, (vs, fs, ds, ls)) -- PtrArg and NonPtrArg both go in a vanilla register diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index e4960fc..b4415eb 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 ----------------------------------------- diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 81656fc..7e8f02c 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -337,8 +337,8 @@ tagForArity arity | isSmallFamily arity = arity lfDynTag :: LambdaFormInfo -> DynTag -- Return the tag in the low order bits of a variable bound -- to this LambdaForm -lfDynTag (LFCon con) = pprTrace "tagForCon" (ppr con <+> ppr (tagForCon con)) $ tagForCon con -lfDynTag (LFReEntrant _ arity _ _) = pprTrace "reentrant" (ppr arity) $ tagForArity arity +lfDynTag (LFCon con) = tagForCon con +lfDynTag (LFReEntrant _ arity _ _) = tagForArity arity lfDynTag _other = 0 @@ -508,8 +508,7 @@ getCallMethod name caf (LFReEntrant _ arity _ _) n_args | n_args == 0 = ASSERT( arity /= 0 ) ReturnIt -- No args at all | n_args < arity = SlowCall -- Not enough args - | otherwise = pprTrace "getCallMethod" (ppr name <+> ppr arity) $ - DirectEntry (enterIdLabel name caf) arity + | otherwise = DirectEntry (enterIdLabel name caf) arity getCallMethod _name _ LFUnLifted n_args = ASSERT( n_args == 0 ) ReturnIt diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index e818bd7..beff73e 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -210,8 +210,7 @@ bindConArgs (DataAlt con) base args bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg bind_arg (arg, offset) = do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag - ; pprTrace "bind_arg gets tag" (ppr arg <+> ppr tag) $ - bindArgToReg arg } + ; bindArgToReg arg } bindConArgs _other_con _base args = ASSERT( null args ) return [] diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3b6aac9..47bf6c4 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -396,7 +396,7 @@ cgAltRhss gc_plan bndr alts cg_alt (con, bndrs, _uses, rhs) = getCodeR $ maybeAltHeapCheck gc_plan $ - do { pprTrace "binding args for" (ppr bndr <+> ppr con) $ bindConArgs con base_reg bndrs + do { bindConArgs con base_reg bndrs ; cgExpr rhs ; return con } diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 74bac43..5daceed 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -472,9 +472,7 @@ emitClosureProcAndInfoTable top_lvl bndr cl_info args body -- top-level binding, which this binding would incorrectly shadow. ; node <- if top_lvl then return $ idToReg (NonVoid bndr) else bindToReg (NonVoid bndr) lf_info - ; arg_regs <- - pprTrace "bindArgsToRegs" (ppr args) $ - bindArgsToRegs args + ; arg_regs <- bindArgsToRegs args ; emitClosureAndInfoTable cl_info (node : arg_regs) $ body (node, arg_regs) } diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 6940908..8298b68 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -82,7 +82,7 @@ cgOpApp (StgPrimOp primop) args res_ty | primOpOutOfLine primop = do { cmm_args <- getNonVoidArgAmodes args ; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop)) - ; pprTrace "cgOpApp" (ppr primop) $ emitCall PrimOp fun cmm_args } + ; emitCall PrimOp fun cmm_args } | ReturnsPrim VoidRep <- result_info = do cgPrimOp [] primop args diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index f054d25..fee24c6 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -673,7 +673,7 @@ hscGenHardCode cgguts mod_summary then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons dir_imps cost_centre_info stg_binds hpc_info - pprTrace "cmms" (ppr cmms) $ return cmms + return cmms else {-# SCC "CodeGen" #-} codeGen dflags this_mod data_tycons dir_imps cost_centre_info -- 1.7.10.4