X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgConTbls.lhs;h=37ced1ee2b5e6e860fb1cb9b717855deea740aca;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=a20e0ee097dd6d76ec3152e6aadae577a7f85ce5;hpb=111cee3f1ad93816cb828e38b38521d85c3bcebb;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index a20e0ee..37ced1e 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -11,21 +11,13 @@ module CgConTbls ( genStaticConBits ) where
 import AbsCSyn
 import CgMonad
 
-import StgSyn		( SRT(..) )
 import AbsCUtils	( mkAbstractCs, mkAbsCStmts )
 import CgTailCall	( performReturn, mkStaticAlgReturnCode )
-import CLabel		( mkConEntryLabel )
-import ClosureInfo	( layOutStaticClosure, layOutDynCon,
-			  mkConLFInfo, ClosureInfo
-			)
-import CostCentre	( dontCareCCS )
-import FiniteMap	( fmToList, FiniteMap )
-import DataCon		( DataCon, dataConName, dataConRepArgTys, isNullaryDataCon )
-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:
@@ -82,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}
@@ -105,41 +100,38 @@ 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]
-	-- Order of things is to reduce forward references
   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
+			CClosureInfoAndCode closure_info closure_body
 
-    zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
+    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
@@ -147,8 +139,6 @@ genConInfo comp_info tycon data_con
 	-- just one more thing to go wrong.
 
     arg_tys	    = dataConRepArgTys  data_con
-    entry_label     = mkConEntryLabel      con_name
-    con_name	    = dataConName data_con
 \end{code}
 
 \begin{code}
@@ -159,12 +149,11 @@ mkConCodeAndInfo con
   = let
 	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