Commit 5892af0e authored by dias@eecs.harvard.edu's avatar dias@eecs.harvard.edu
Browse files

drop some debugging traces and use only one flag for new codegen

parent df54e4b6
......@@ -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"
......
......@@ -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
......
......@@ -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
-----------------------------------------
......
......@@ -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
......
......@@ -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 []
......
......@@ -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 }
......
......@@ -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)
}
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment