[project @ 1996-06-05 06:44:31 by partain]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgConTbls.lhs

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 29a89a5..7745466 100644 (file)
--- 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}
 
 %************************************************************************