Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/bf32abdab86f1c88c502e1b5a7bd1ea419e6c8b5 >--------------------------------------------------------------- commit bf32abdab86f1c88c502e1b5a7bd1ea419e6c8b5 Author: Simon Marlow <[email protected]> Date: Mon Jul 9 16:46:02 2012 +0100 remove some redundant SRT-related stuff >--------------------------------------------------------------- compiler/codeGen/StgCmm.hs | 4 ++-- compiler/codeGen/StgCmmBind.hs | 8 +++----- compiler/codeGen/StgCmmCon.hs | 1 - compiler/codeGen/StgCmmExpr.hs | 18 +++++++++--------- compiler/codeGen/StgCmmHeap.hs | 5 ++--- compiler/codeGen/StgCmmUtils.hs | 20 ++------------------ 6 files changed, 18 insertions(+), 38 deletions(-) diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 696af81..dae0ad0 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -149,10 +149,10 @@ cgTopRhs :: Id -> StgRhs -> FCode CgIdInfo cgTopRhs bndr (StgRhsCon _cc con args) = forkStatics (cgTopRhsCon bndr con args) -cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body) +cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body) = ASSERT(null fvs) -- There should be no free variables setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $ - forkStatics (cgTopRhsClosure bndr cc bi upd_flag srt args body) + forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body) --------------------------------------------------------------- diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index f98283f..942a780 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -68,16 +68,14 @@ cgTopRhsClosure :: Id -> CostCentreStack -- Optional cost centre annotation -> StgBinderInfo -> UpdateFlag - -> SRT - -> [Id] -- Args + -> [Id] -- Args -> StgExpr -> FCode CgIdInfo -cgTopRhsClosure id ccs _ upd_flag srt args body = do +cgTopRhsClosure id ccs _ upd_flag args body = do { -- LAY OUT THE OBJECT let name = idName id ; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args - ; has_srt <- getSRTInfo srt ; mod_name <- getModuleName ; dflags <- getDynFlags ; let descr = closureDescription dflags mod_name name @@ -86,7 +84,7 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do cg_id_info = litIdInfo id lf_info (CmmLabel closure_label) caffy = idCafInfo id info_tbl = mkCmmInfo closure_info -- XXX short-cut - closure_rep = mkStaticClosureFields info_tbl ccs caffy has_srt [] + closure_rep = mkStaticClosureFields info_tbl ccs caffy [] -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY) ; emitDataLits closure_label closure_rep diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index c348570..a7af566 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -92,7 +92,6 @@ cgTopRhsCon id con args info_tbl dontCareCCS -- Because it's static data caffy -- Has CAF refs - False -- no SRT payload -- BUILD THE OBJECT diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index dd1abc2..e2789e7 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -79,8 +79,8 @@ cgExpr (StgLetNoEscape _ _ binds expr) = ; cgExpr expr ; emitLabel join_id} -cgExpr (StgCase expr _live_vars _save_vars bndr srt alt_type alts) = - cgCase expr bndr srt alt_type alts +cgExpr (StgCase expr _live_vars _save_vars bndr _srt alt_type alts) = + cgCase expr bndr alt_type alts cgExpr (StgLam {}) = panic "cgExpr: StgLam" @@ -283,9 +283,9 @@ data GcPlan -- of the case alternative(s) into the upstream check ------------------------------------- -cgCase :: StgExpr -> Id -> SRT -> AltType -> [StgAlt] -> FCode () +cgCase :: StgExpr -> Id -> AltType -> [StgAlt] -> FCode () -cgCase (StgOpApp (StgPrimOp op) args _) bndr _srt (AlgAlt tycon) alts +cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts | isEnumerationTyCon tycon -- Note [case on bool] = do { tag_expr <- do_enum_primop op args @@ -360,7 +360,7 @@ would make this special case go away. -- code that enters the HValue, then we'll get a runtime panic, because -- the HValue really is a MutVar#. The types are compatible though, -- so we can just generate an assignment. -cgCase (StgApp v []) bndr _ alt_type@(PrimAlt _) alts +cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts | isUnLiftedType (idType v) || reps_compatible = -- assignment suffices for unlifted types @@ -373,7 +373,7 @@ cgCase (StgApp v []) bndr _ alt_type@(PrimAlt _) alts where reps_compatible = idPrimRep v == idPrimRep bndr -cgCase scrut@(StgApp v []) _ _ (PrimAlt _) _ +cgCase scrut@(StgApp v []) _ (PrimAlt _) _ = -- fail at run-time, not compile-time do { mb_cc <- maybeSaveCostCentre True ; withSequel (AssignTo [idToReg (NonVoid v)] False) (cgExpr scrut) @@ -396,11 +396,11 @@ case a of v (taking advantage of the fact that the return convention for (# State#, a #) is the same as the return convention for just 'a') -} -cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr srt alt_type alts +cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts = -- handle seq#, same return convention as vanilla 'a'. - cgCase (StgApp a []) bndr srt alt_type alts + cgCase (StgApp a []) bndr alt_type alts -cgCase scrut bndr _srt alt_type alts +cgCase scrut bndr alt_type alts = -- the general case do { up_hp_usg <- getVirtHp -- Upstream heap usage ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index bc61cf5..f64d203 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -153,10 +153,9 @@ mkStaticClosureFields :: CmmInfoTable -> CostCentreStack -> CafInfo - -> Bool -- SRT is non-empty? -> [CmmLit] -- Payload -> [CmmLit] -- The full closure -mkStaticClosureFields info_tbl ccs caf_refs has_srt payload +mkStaticClosureFields info_tbl ccs caf_refs payload = mkStaticClosure info_lbl ccs payload padding static_link_field saved_info_field where @@ -181,7 +180,7 @@ mkStaticClosureFields info_tbl ccs caf_refs has_srt payload | otherwise = ASSERT(null payload) [mkIntCLit 0] static_link_field - | is_caf || staticClosureNeedsLink has_srt info_tbl + | is_caf || staticClosureNeedsLink (mayHaveCafRefs caf_refs) info_tbl = [static_link_value] | otherwise = [] diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 273e59b..733c2d4 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -44,9 +44,9 @@ module StgCmmUtils ( mkWordCLit, newStringCLit, newByteStringCLit, packHalfWordsCLit, - blankWord, + blankWord, - getSRTInfo, srt_escape + srt_escape ) where #include "HsVersions.h" @@ -66,12 +66,10 @@ import Type import TyCon import Constants import SMRep -import StgSyn ( SRT(..) ) import Module import Literal import Digraph import ListSetOps -import VarSet import Util import Unique import DynFlags @@ -804,19 +802,5 @@ assignTemp' e emitAssign reg e return (CmmReg reg) -------------------------------------------------------------------------- >--------------------------------------------------------------- --- Static Reference Tables >--------------------------------------------------------------- -------------------------------------------------------------------------- - --- | Returns 'True' if there is a non-empty SRT, or 'False' otherwise --- NB. the SRT attached to an StgBind is still used in the new codegen --- to decide whether we need a static link field on a static closure --- or not. -getSRTInfo :: SRT -> FCode Bool -getSRTInfo (SRTEntries vs) = return (not (isEmptyVarSet vs)) -getSRTInfo _ = return False - srt_escape :: StgHalfWord srt_escape = -1 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
