[project @ 1997-12-08 10:06:34 by simonm]

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

diff --git a/ghc/compiler/codeGen/CgConTbls.lhs b/ghc/compiler/codeGen/CgConTbls.lhs
index 4252890..09d9c10 100644 (file)
--- a/ghc/compiler/codeGen/CgConTbls.lhs
+++ b/ghc/compiler/codeGen/CgConTbls.lhs
@@ -8,44 +8,45 @@
 
 module CgConTbls ( genStaticConBits ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import AbsCSyn
 import CgMonad
 
 import AbsCUtils       ( mkAbsCStmts, mkAbstractCs, magicIdPrimRep )
-import CgCompInfo      ( uF_UPDATEE )
+import Constants       ( uF_UPDATEE )
 import CgHeapery       ( heapCheck, allocDynClosure )
-import CgRetConv       ( mkLiveRegsMask,
-                         dataReturnConvAlg, ctrlReturnConvAlg,
+import CgRetConv       ( dataReturnConvAlg, ctrlReturnConvAlg,
                          CtrlReturnConvention(..),
                          DataReturnConvention(..)
                        )
 import CgTailCall      ( performReturn, mkStaticAlgReturnCode )
 import CgUsages                ( getHpRelOffset )
-import CLabel          ( mkConEntryLabel, mkClosureLabel,
+import CLabel          ( mkConEntryLabel, mkStaticClosureLabel,
                          mkConUpdCodePtrVecLabel,
                          mkStdUpdCodePtrVecLabel, mkStdUpdVecTblLabel
                        )
 import ClosureInfo     ( layOutStaticClosure, layOutDynCon,
                          layOutPhantomClosure, closurePtrsSize,
                          fitsMinUpdSize, mkConLFInfo,
-                         infoTableLabelFromCI, dataConLiveness
+                         infoTableLabelFromCI, dataConLiveness,
+                         ClosureInfo
                        )
-import CostCentre      ( dontCareCostCentre )
-import FiniteMap       ( fmToList )
-import HeapOffs                ( zeroOff, VirtualHeapOffset(..) )
-import Id              ( dataConTag, dataConSig,
-                         dataConArity, fIRST_TAG,
+import CostCentre      ( dontCareCostCentre, CostCentre )
+import FiniteMap       ( fmToList, FiniteMap )
+import HeapOffs                ( zeroOff, SYN_IE(VirtualHeapOffset) )
+import Id              ( dataConTag, dataConRawArgTys,
+                         dataConNumFields, fIRST_TAG,
                          emptyIdSet,
-                         GenId{-instance NamedThing-}
+                         GenId{-instance NamedThing-}, SYN_IE(Id)
                        )
+import Name            ( getOccString )
+import PrelInfo                ( maybeIntLikeTyCon )
 import PrimRep         ( getPrimRepSize, PrimRep(..) )
-import TyCon           ( tyConDataCons, mkSpecTyCon )
-import Type            ( typePrimRep )
+import TyCon           ( tyConDataCons, mkSpecTyCon, TyCon )
+import Type            ( typePrimRep, SYN_IE(Type) )
 import Util            ( panic )
 
-maybeIntLikeTyCon = panic "CgConTbls.maybeIntLikeTyCon (ToDo)"
 mkSameSpecCon = panic "CgConTbls.mkSameSpecCon (ToDo)"
 \end{code}
 
@@ -208,7 +209,7 @@ genConInfo comp_info tycon data_con
                      body_code))
 
     entry_addr = CLbl entry_label CodePtrRep
-    con_descr  = _UNPK_ (getOccurrenceName data_con)
+    con_descr  = getOccString data_con
 
     closure_code        = CClosureInfoAndCode closure_info body Nothing
                                              stdUpd con_descr
@@ -239,12 +240,30 @@ 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
+    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
@@ -260,7 +279,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
@@ -268,7 +287,7 @@ mkConCodeAndInfo con
 
     ReturnInHeap ->
        let
-           (_, _, arg_tys, _) = dataConSig con
+           arg_tys = dataConRawArgTys con
 
            (closure_info, arg_things)
                = layOutDynCon con typePrimRep arg_tys
@@ -277,7 +296,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
@@ -287,6 +306,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}
 
 %************************************************************************
@@ -314,9 +336,9 @@ genPhantomUpdInfo comp_info tycon data_con
 
            phantom_ci = layOutPhantomClosure data_con (mkConLFInfo data_con)
 
-           con_descr = _UNPK_ (getOccurrenceName data_con)
+           con_descr = getOccString data_con
 
-           con_arity = dataConArity data_con
+           con_arity = dataConNumFields data_con
 
            upd_code = CLabelledCode upd_label (mkAbsCStmts build_closure perform_return)
            upd_label = mkConUpdCodePtrVecLabel tycon tag