[project @ 1996-06-11 13:18:54 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 a3113e4..2083d8f 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,18 +35,18 @@ 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-}
                        )
-import Outputable      ( getLocalName )
+import Name            ( nameOf, origName )
+import PrelInfo                ( maybeIntLikeTyCon )
 import PrimRep         ( getPrimRepSize, PrimRep(..) )
 import TyCon           ( tyConDataCons, mkSpecTyCon )
 import Type            ( typePrimRep )
 import Util            ( panic )
 
-maybeIntLikeTyCon = panic "CgConTbls.maybeIntLikeTyCon (ToDo)"
 mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
 \end{code}
 
@@ -209,7 +209,7 @@ genConInfo comp_info tycon data_con
                      body_code))
 
     entry_addr = CLbl entry_label CodePtrRep
-    con_descr  = _UNPK_ (getLocalName data_con)
+    con_descr  = _UNPK_ (nameOf (origName "con_descr" data_con))
 
     closure_code        = CClosureInfoAndCode closure_info body Nothing
                                              stdUpd con_descr
@@ -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}
 
 %************************************************************************
@@ -315,7 +337,7 @@ genPhantomUpdInfo comp_info tycon data_con
 
            phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
 
-           con_descr = _UNPK_ (getLocalName data_con)
+           con_descr = _UNPK_ (nameOf (origName "con_descr2" data_con))
 
            con_arity = dataConArity data_con