import AbsCSyn
import CgMonad
-import StgSyn ( SRT(..) )
-import AbsCUtils ( mkAbstractCs )
+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 TyCon ( tyConDataCons, TyCon )
-import Type ( typePrimRep, Type )
-import BasicTypes ( TopLevelFlag(..) )
-import Outputable
+import ClosureInfo ( layOutStaticConstr, layOutDynConstr, ClosureInfo )
+import DataCon ( DataCon, dataConRepArgTys, isNullaryDataCon )
+import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon )
+import Type ( typePrimRep )
+import CmdLineOpts
\end{code}
For every constructor we generate the following info tables:
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.
\begin{code}
genStaticConBits :: CompilationInfo -- global info about the compilation
-> [TyCon] -- tycons to generate
- -> FiniteMap TyCon [(Bool, [Maybe Type])]
- -- tycon specialisation info
-> AbstractC -- output
-genStaticConBits comp_info gen_tycons tycon_specs
- = ASSERT( null (fmToList tycon_specs) )
- -- We don't do specialised type constructors any more
-
- -- for each type constructor:
+genStaticConBits comp_info gen_tycons
+ = -- for each type constructor:
-- grab all its data constructors;
-- for each one, generate an info table
-- for each specialised type constructor
-- 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))
+ 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}
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
- body = (initC comp_info (
- profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC`
- body_code))
+ static_body = initC comp_info (
+ profCtrC FSLIT("TICK_ENT_STATIC_CON") [CReg node] `thenC`
+ ldv_enter_and_body_code)
- entry_addr = CLbl entry_label CodePtrRep
- con_descr = getOccString data_con
+ closure_body = initC comp_info (
+ profCtrC FSLIT("TICK_ENT_DYN_CON") [CReg node] `thenC`
+ ldv_enter_and_body_code)
+
+ 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}
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
projects / ghc-hetmet.git / blobdiff