X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgConTbls.lhs;h=37ced1ee2b5e6e860fb1cb9b717855deea740aca;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=6666b1453ea05d9d977ab8d18f8b0e5009040eea;hpb=685e04e4af2e2332f2555990122596c7931cb543;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs index 6666b14..37ced1e 100644 --- a/ghc/compiler/codeGen/CgConTbls.lhs +++ b/ghc/compiler/codeGen/CgConTbls.lhs @@ -12,15 +12,12 @@ import AbsCSyn import CgMonad import AbsCUtils ( mkAbstractCs, mkAbsCStmts ) -import CostCentre ( subsumedCCS ) import CgTailCall ( performReturn, mkStaticAlgReturnCode ) import ClosureInfo ( layOutStaticConstr, layOutDynConstr, ClosureInfo ) -import DataCon ( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon ) -import Name ( getOccName ) -import OccName ( occNameUserString ) +import DataCon ( DataCon, dataConRepArgTys, isNullaryDataCon ) import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon ) import Type ( typePrimRep ) -import Outputable +import CmdLineOpts \end{code} For every constructor we generate the following info tables: @@ -107,7 +104,7 @@ genConInfo :: CompilationInfo -> DataCon -> AbstractC genConInfo comp_info data_con = -- Order of things is to reduce forward references - mkAbstractCs [CSplitMarker, + mkAbstractCs [if opt_EnsureSplittableC then CSplitMarker else AbsCNop, closure_code, static_code] where @@ -116,21 +113,25 @@ genConInfo comp_info 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,_) = layOutStaticConstr con_name data_con typePrimRep arg_tys + (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) - con_descr = occNameUserString (getOccName 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 + CClosureInfoAndCode closure_info closure_body - static_code = CClosureInfoAndCode static_ci body Nothing con_descr + static_code = CClosureInfoAndCode static_ci static_body zero_arity_con = isNullaryDataCon data_con -- We used to check that all the arg-sizes were zero, but we don't @@ -138,7 +139,6 @@ genConInfo comp_info data_con -- just one more thing to go wrong. arg_tys = dataConRepArgTys data_con - con_name = dataConName data_con \end{code} \begin{code} @@ -149,12 +149,11 @@ mkConCodeAndInfo con = let arg_tys = dataConRepArgTys con - (closure_info, arg_things) - = layOutDynConstr (dataConName con) 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