X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgConTbls.lhs;h=b61e43380fa5898e884ca2694a3ed095e0519298;hb=32c62212b35b2b631f3753d432b508de5c79c783;hp=5b862fdf52d439d4a39e000abfdabae1e07d902f;hpb=4a1e12a1edfd959c133d922b1adc733c137610d7;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 5b862fd..b61e433 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -9,23 +9,17 @@ module CgConTbls ( genStaticConBits ) where
 #include "HsVersions.h"
 
 import AbsCSyn
-import StgSyn
 import CgMonad
 
 import AbsCUtils	( mkAbstractCs, mkAbsCStmts )
-import CostCentre	( noCCS )
-import CgCon		( cgTopRhsCon )
-import CgClosure	( cgTopRhsClosure )
 import CgTailCall	( performReturn, mkStaticAlgReturnCode )
-import ClosureInfo	( layOutStaticConstr, layOutDynConstr, mkClosureLFInfo, ClosureInfo )
-import DataCon		( DataCon, dataConName, dataConRepArgTys, dataConId, isNullaryDataCon )
-import Id		( mkTemplateLocals )
+import ClosureInfo	( layOutStaticConstr, layOutDynConstr, ClosureInfo )
+import DataCon		( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
 import Name		( getOccName )
 import OccName		( occNameUserString )
 import TyCon		( tyConDataCons, isEnumerationTyCon, TyCon )
 import Type		( typePrimRep )
-import BasicTypes	( TopLevelFlag(..) )
-import Outputable
+import CmdLineOpts
 \end{code}
 
 For every constructor we generate the following info tables:
@@ -112,10 +106,9 @@ 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,
-		  wrkr_code]
+    	    	  static_code]
   where
     (closure_info, body_code) = mkConCodeAndInfo data_con
 
@@ -124,20 +117,25 @@ genConInfo comp_info data_con
     -- info-table contains the information we need.
     (static_ci,_) = layOutStaticConstr con_name 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)
+
+    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
 
-    wrkr_code  = initC comp_info (cgWorker data_con `thenFC` \ _ -> returnFC ())
     con_descr  = occNameUserString (getOccName data_con)
 
     -- 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 Nothing con_descr
 
-    static_code  = CClosureInfoAndCode static_ci body Nothing con_descr
+    static_code  = CClosureInfoAndCode static_ci static_body Nothing con_descr
 
     zero_arity_con   = isNullaryDataCon data_con
 	-- We used to check that all the arg-sizes were zero, but we don't
@@ -161,7 +159,7 @@ mkConCodeAndInfo con
 
 	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
@@ -169,27 +167,3 @@ mkConCodeAndInfo con
 	in
 	(closure_info, body_code)
 \end{code}
-
-For a constructor C, make a binding
-
-	$wC = \x y -> $wC x y
-
-i.e. a curried constructor that allocates.  This means that we can treat
-the worker for a constructor like any other function in the rest of the compiler.
-
-\begin{code}
-cgWorker data_con
-  | isNullaryDataCon data_con
-  = cgTopRhsCon work_id data_con []
-
-  | otherwise
-  = cgTopRhsClosure work_id
-	    noCCS noBinderInfo NoSRT
-	    arg_ids rhs
-	    lf_info
-  where
-    work_id = dataConId data_con
-    arg_ids = mkTemplateLocals (dataConRepArgTys data_con)
-    rhs     = StgConApp data_con [StgVarArg id | id <- arg_ids]
-    lf_info = mkClosureLFInfo work_id TopLevel [{-no fvs-}] ReEntrant arg_ids
-\end{code}