X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgConTbls.lhs;h=7745466706932fe64bf53b1fba975d0d3e9cf26e;hb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;hp=29a89a57f4c71ae8f1e2cf73dad85d6bc51e6291;hpb=5cf27e8f1731c52fe63a5b9615f927484164c61b;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 29a89a5..7745466 100644
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -8,7 +8,7 @@
 
 module CgConTbls ( genStaticConBits ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import AbsCSyn
 import CgMonad
@@ -23,7 +23,7 @@ import CgRetConv	( mkLiveRegsMask,
 			)
 import CgTailCall	( performReturn, mkStaticAlgReturnCode )
 import CgUsages		( getHpRelOffset )
-import CLabel		( mkConEntryLabel, mkClosureLabel,
+import CLabel		( mkConEntryLabel, mkStaticClosureLabel,
 			  mkConUpdCodePtrVecLabel,
 			  mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel
 			)
@@ -35,7 +35,7 @@ import ClosureInfo	( layOutStaticClosure, layOutDynCon,
 import CostCentre	( dontCareCostCentre )
 import FiniteMap	( fmToList )
 import HeapOffs		( zeroOff, VirtualHeapOffset(..) )
-import Id		( dataConTag, dataConSig,
+import Id		( dataConTag, dataConRawArgTys,
 			  dataConArity, fIRST_TAG,
 			  emptyIdSet,
 			  GenId{-instance NamedThing-}
@@ -240,12 +240,31 @@ genConInfo comp_info tycon data_con
 
     zero_size arg_ty = getPrimRepSize (typePrimRep arg_ty) == 0
 
-    (_,_,arg_tys,_) = dataConSig   data_con
-    con_arity	    = dataConArity data_con
-    entry_label     = mkConEntryLabel data_con
-    closure_label   = mkClosureLabel  data_con
+    arg_tys	    = dataConRawArgTys 	   data_con
+    con_arity	    = dataConArity 	   data_con
+    entry_label     = mkConEntryLabel      data_con
+    closure_label   = mkStaticClosureLabel data_con
 \end{code}
 
+The entry code for a constructor now loads the info ptr by indirecting
+node.  The alternative is to load the info ptr in the enter-via-node
+sequence.  There's is a trade-off here:
+
+	* If the architecture can perform an indirect jump through a
+	  register in one instruction, or if the info ptr is not a
+	  real register, then *not* loading the info ptr on an enter
+	  is a win.
+
+	* If the enter-via-node code is identical whether we load the
+	  info ptr or not, then doing it is a win (it means we don't
+	  have to do it here).
+
+However, the gratuitous load here is miniscule compared to the
+gratuitous loads of the info ptr on each enter, so we go for the first
+option.
+
+-- Simon M. (6/5/96)
+
 \begin{code}
 mkConCodeAndInfo :: Id 			-- Data constructor
 		 -> (ClosureInfo, Code)	-- The info table
@@ -261,7 +280,7 @@ mkConCodeAndInfo con
 	    body_code
 	      = profCtrC SLIT("RET_OLD_IN_REGS") [mkIntCLit (length regs_w_offsets)] `thenC`
 
-		performReturn (mkAbstractCs (map move_to_reg regs_w_offsets))
+		performReturn (mkAbstractCs (load_infoptr : map move_to_reg regs_w_offsets))
 			      (mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 			      emptyIdSet{-no live vars-}
 	in
@@ -269,7 +288,7 @@ mkConCodeAndInfo con
 
     ReturnInHeap ->
 	let
-	    (_, _, arg_tys, _) = dataConSig con
+	    arg_tys = dataConRawArgTys con
 
 	    (closure_info, arg_things)
 		= layOutDynCon con typePrimRep arg_tys
@@ -278,7 +297,7 @@ mkConCodeAndInfo con
 		= -- NB: We don't set CC when entering data (WDP 94/06)
 		  profCtrC SLIT("RET_OLD_IN_HEAP") [mkIntCLit (length arg_things)] `thenC`
 
-		  performReturn AbsCNop	-- Ptr to thing already in Node
+		  performReturn (mkAbstractCs [load_infoptr])	-- Ptr to thing already in Node
 				(mkStaticAlgReturnCode con Nothing {- Info-ptr already loaded-})
 				emptyIdSet{-no live vars-}
 	in
@@ -288,6 +307,9 @@ mkConCodeAndInfo con
     move_to_reg :: (MagicId, VirtualHeapOffset {-from Node-}) -> AbstractC
     move_to_reg (reg, offset)
       = CAssign (CReg reg) (CVal (NodeRel offset) (magicIdPrimRep reg))
+
+    load_infoptr 
+      = CAssign (CReg infoptr) (CMacroExpr DataPtrRep INFO_PTR [CReg node])
 \end{code}
 
 %************************************************************************