X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgConTbls.lhs;h=37ced1ee2b5e6e860fb1cb9b717855deea740aca;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=6b75ee50d9adffe131bf13f1b5bf7eddac55be6c;hpb=506fa77d392191e46c12b2c19387ff5b0888f6a2;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs index 6b75ee5..37ced1e 100644 --- a/ghc/compiler/codeGen/CgConTbls.lhs +++ b/ghc/compiler/codeGen/CgConTbls.lhs @@ -11,22 +11,13 @@ module CgConTbls ( genStaticConBits ) where import AbsCSyn import CgMonad -import StgSyn ( SRT(..) ) import AbsCUtils ( mkAbstractCs, mkAbsCStmts ) import CgTailCall ( performReturn, mkStaticAlgReturnCode ) -import CLabel ( mkConEntryLabel, mkStaticClosureLabel ) -import ClosureInfo ( layOutStaticClosure, layOutDynCon, - mkConLFInfo, ClosureInfo - ) -import CostCentre ( dontCareCCS ) -import FiniteMap ( fmToList, FiniteMap ) -import DataCon ( DataCon, dataConName, dataConRawArgTys ) -import Const ( Con(..) ) -import Name ( getOccString ) -import PrimRep ( getPrimRepSize, PrimRep(..) ) +import ClosureInfo ( layOutStaticConstr, layOutDynConstr, ClosureInfo ) +import DataCon ( DataCon, dataConRepArgTys, isNullaryDataCon ) import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon ) -import Type ( typePrimRep, Type ) -import Outputable +import Type ( typePrimRep ) +import CmdLineOpts \end{code} For every constructor we generate the following info tables: @@ -58,12 +49,9 @@ Static occurrences of the constructor macro: @STATIC_INFO_TABLE@. \end{description} -For zero-arity constructors, \tr{con}, we also generate a static closure: -\begin{description} -\item[@_closure@:] -A single static copy of the (zero-arity) constructor itself. -\end{description} +For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure; +it's place is taken by the top level defn of the constructor. For charlike and intlike closures there is a fixed array of static closures predeclared. @@ -86,19 +74,22 @@ genStaticConBits comp_info gen_tycons -- C labels are local to this module i.e. static -- since they may be duplicated in other modules - mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ] + mkAbstractCs [ gen_for_tycon tc `mkAbsCStmts` enum_closure_table tc + | tc <- gen_tycons ] where gen_for_tycon :: TyCon -> AbstractC - gen_for_tycon tycon - = mkAbstractCs (map (genConInfo comp_info tycon) (tyConDataCons tycon)) - `mkAbsCStmts` ( - -- after the con decls, so we don't need to declare the constructor labels - if (isEnumerationTyCon tycon) - then CClosureTbl tycon - else AbsCNop - ) + gen_for_tycon tycon = mkAbstractCs [ genConInfo comp_info data_con + | data_con <- tyConDataCons tycon ] + + enum_closure_table tycon + | isEnumerationTyCon tycon = CClosureTbl tycon + | otherwise = AbsCNop + -- Put the table after the data constructor decls, because the + -- datatype closure table (for enumeration types) + -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff \end{code} + %************************************************************************ %* * \subsection[CgConTbls-info-tables]{Generating info tables for constructors} @@ -109,62 +100,45 @@ Generate the entry code, info tables, and (for niladic constructor) the static closure, for a constructor. \begin{code} -genConInfo :: CompilationInfo -> TyCon -> DataCon -> AbstractC +genConInfo :: CompilationInfo -> DataCon -> AbstractC -genConInfo comp_info tycon data_con - = mkAbstractCs [ - CSplitMarker, +genConInfo comp_info data_con + = -- Order of things is to reduce forward references + mkAbstractCs [if opt_EnsureSplittableC then CSplitMarker else AbsCNop, closure_code, - static_code, - closure_maybe] - -- Order of things is to reduce forward references + static_code] where (closure_info, body_code) = mkConCodeAndInfo data_con -- To allow the debuggers, interpreters, etc to cope with static -- data structures (ie those built at compile time), we take care that -- info-table contains the information we need. - (static_ci,_) = layOutStaticClosure con_name typePrimRep arg_tys - (mkConLFInfo data_con) + (static_ci,_) = layOutStaticConstr data_con typePrimRep arg_tys + + static_body = initC comp_info ( + profCtrC FSLIT("TICK_ENT_STATIC_CON") [CReg node] `thenC` + ldv_enter_and_body_code) - body = (initC comp_info ( - profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC` - body_code)) + closure_body = initC comp_info ( + profCtrC FSLIT("TICK_ENT_DYN_CON") [CReg node] `thenC` + ldv_enter_and_body_code) - entry_addr = CLbl entry_label CodePtrRep - con_descr = getOccString data_con + ldv_enter_and_body_code = ldvEnter `thenC` body_code -- Don't need any dynamic closure code for zero-arity constructors closure_code = if zero_arity_con then AbsCNop else - CClosureInfoAndCode closure_info body Nothing con_descr - - static_code = CClosureInfoAndCode static_ci body Nothing con_descr - - cost_centre = mkCCostCentreStack dontCareCCS -- not worried about static data costs - - -- For zero-arity data constructors, or, more accurately, - -- those which only have VoidRep args (or none): - -- We make the closure too (not just info tbl), so that we can share - -- one copy throughout. - closure_maybe = if not zero_arity_con then - AbsCNop - else - CStaticClosure closure_label -- Label for closure - static_ci -- Info table - cost_centre - [{-No args! A slight lie for constrs - with VoidRep args-}] + CClosureInfoAndCode closure_info closure_body - zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0 + static_code = CClosureInfoAndCode static_ci static_body - zero_arity_con = all zero_size arg_tys + zero_arity_con = isNullaryDataCon data_con + -- We used to check that all the arg-sizes were zero, but we don't + -- really have any constructors with only zero-size args, and it's + -- just one more thing to go wrong. - arg_tys = dataConRawArgTys data_con - entry_label = mkConEntryLabel con_name - closure_label = mkStaticClosureLabel con_name - con_name = dataConName data_con + arg_tys = dataConRepArgTys data_con \end{code} \begin{code} @@ -173,14 +147,13 @@ mkConCodeAndInfo :: DataCon -- Data constructor mkConCodeAndInfo con = let - arg_tys = dataConRawArgTys con + arg_tys = dataConRepArgTys con - (closure_info, arg_things) - = layOutDynCon con typePrimRep arg_tys + (closure_info, arg_things) = layOutDynConstr con typePrimRep arg_tys body_code = -- NB: We don't set CC when entering data (WDP 94/06) - profCtrC SLIT("TICK_RET_OLD") + profCtrC FSLIT("TICK_RET_OLD") [mkIntCLit (length arg_things)] `thenC` performReturn AbsCNop -- Ptr to thing already in Node