[project @ 2000-05-15 15:03:36 by simonmar]

[ghc-hetmet.git] / ghc / compiler / absCSyn / CLabel.lhs

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 636a2f3..705da74 100644 (file)
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.28 1999/10/13 16:39:10 simonmar Exp $
+% $Id: CLabel.lhs,v 1.34 2000/05/15 15:03:36 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -18,7 +18,6 @@ module CLabel (
        mkStaticConEntryLabel,
        mkRednCountsLabel,
        mkConInfoTableLabel,
-       mkStaticClosureLabel,
        mkStaticInfoTableLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
@@ -34,13 +33,18 @@ module CLabel (
 
        mkAsmTempLabel,
 
+       mkModuleInitLabel,
+
        mkErrorStdEntryLabel,
        mkUpdInfoLabel,
        mkTopTickyCtrLabel,
+       mkBlackHoleInfoTableLabel,
         mkCAFBlackHoleInfoTableLabel,
         mkSECAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
 
+       moduleRegdLabel,
+
        mkSelectorInfoLabel,
        mkSelectorEntryLabel,
 
@@ -66,8 +70,8 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
 import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
 import CStrings                ( pp_cSEP )
 import DataCon         ( ConTag, DataCon )
-import Module          ( isDynamicModule )
-import Name            ( Name, getName, isExternallyVisibleName, nameModule, isLocallyDefinedName )
+import Module          ( ModuleName )
+import Name            ( Name, getName, isDllName, isExternallyVisibleName )
 import TyCon           ( TyCon )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp, pprPrimOp )
@@ -106,6 +110,8 @@ data CLabel
 
   | AsmTempLabel    Unique
 
+  | ModuleInitLabel ModuleName
+
   | RtsLabel       RtsLabelInfo
 
   | CC_Label CostCentre
@@ -136,9 +142,6 @@ data IdLabelInfo
 data DataConLabelInfo
   = ConEntry           -- the only kind of entry pt for constructors
   | ConInfoTbl         -- corresponding info table
-
-  | StaticClosure      -- Static constructor closure
-                       -- e.g., nullary constructor
   | StaticConEntry     -- static constructor entry point
   | StaticInfoTbl      -- corresponding info table
   deriving (Eq, Ord)
@@ -169,6 +172,8 @@ data RtsLabelInfo
 
   | RtsTopTickyCtr
 
+  | RtsModuleRegd
+
   deriving (Eq, Ord)
 
 -- Label Type: for generating C declarations.
@@ -192,7 +197,6 @@ mkFastEntryLabel            id arity        = ASSERT(arity > 0)
 
 mkRednCountsLabel      id              = IdLabel id  RednCounts
 
-mkStaticClosureLabel   con             = DataConLabel con StaticClosure
 mkStaticInfoTableLabel  con            = DataConLabel con StaticInfoTbl
 mkConInfoTableLabel     con            = DataConLabel con ConInfoTbl
 mkConEntryLabel                con             = DataConLabel con ConEntry
@@ -210,11 +214,14 @@ mkClosureTblLabel tycon           = TyConLabel tycon
 
 mkAsmTempLabel                         = AsmTempLabel
 
+mkModuleInitLabel              = ModuleInitLabel
+
        -- Some fixed runtime system labels
 
 mkErrorStdEntryLabel           = RtsLabel RtsShouldNeverHappenCode
 mkUpdInfoLabel                 = RtsLabel RtsUpdInfo
 mkTopTickyCtrLabel             = RtsLabel RtsTopTickyCtr
+mkBlackHoleInfoTableLabel      = RtsLabel (RtsBlackHoleInfoTbl SLIT("BLACKHOLE_info"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl SLIT("CAF_BLACKHOLE_info"))
 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
                                     RtsLabel (RtsBlackHoleInfoTbl SLIT("SE_CAF_BLACKHOLE_info"))
@@ -222,6 +229,8 @@ mkSECAFBlackHoleInfoTableLabel      = if opt_DoTickyProfiling then
                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
 
+moduleRegdLabel                        = RtsLabel RtsModuleRegd
+
 mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTbl upd off)
 mkSelectorEntryLabel upd off   = RtsLabel (RtsSelectorEntry   upd off)
 
@@ -260,6 +269,7 @@ needsCDecl (CaseLabel _ _)          = False
 needsCDecl (TyConLabel _)              = True
 
 needsCDecl (AsmTempLabel _)            = False
+needsCDecl (ModuleInitLabel _)         = False
 needsCDecl (RtsLabel _)                        = False
 needsCDecl (CC_Label _)                        = False
 needsCDecl (CCS_Label _)               = False
@@ -282,6 +292,8 @@ externallyVisibleCLabel (DataConLabel _ _) = True
 externallyVisibleCLabel (TyConLabel tc)    = True
 externallyVisibleCLabel (CaseLabel _ _)           = False
 externallyVisibleCLabel (AsmTempLabel _)   = False
+externallyVisibleCLabel (ModuleInitLabel _)= True
+externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 externallyVisibleCLabel (RtsLabel _)      = True
 externallyVisibleCLabel (IdLabel id _)     = isExternallyVisibleName id
 externallyVisibleCLabel (CC_Label _)      = False -- not strictly true
@@ -311,7 +323,6 @@ labelType (DataConLabel _ info) =
   case info of
      ConInfoTbl    -> InfoTblType
      StaticInfoTbl -> InfoTblType
-     StaticClosure -> ClosureType
      _            -> CodeType
 
 labelType _        = DataType
@@ -326,12 +337,11 @@ in a DLL, be it a data reference or not.
 labelDynamic :: CLabel -> Bool
 labelDynamic lbl = 
   case lbl of
-   RtsLabel _  -> not opt_Static  -- i.e., is the RTS in a DLL or not?
-   IdLabel n k      | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
-   DataConLabel n k | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
-   TyConLabel tc    | not (isLocallyDefinedName (getName tc)) -> isDynamicModule (nameModule (getName tc))
-   _ -> False
-
+   RtsLabel _              -> not opt_Static  -- i.e., is the RTS in a DLL or not?
+   IdLabel n k      -> isDllName n
+   DataConLabel n k -> isDllName n
+   TyConLabel tc    -> isDllName (getName tc)
+   _               -> False
 \end{code}
 
 
@@ -362,13 +372,14 @@ internal names. <type> is one of the following:
         dflt                   Default case alternative
         btm                    Large bitmap vector
         closure                Static closure
-        static_closure         Static closure (???)
         con_entry              Dynamic Constructor entry code
         con_info               Dynamic Constructor info table
         static_entry           Static Constructor entry code
         static_info            Static Constructor info table
         sel_info               Selector info table
         sel_entry              Selector entry code
+        cc                     Cost centre
+        ccs                    Cost centre stack
 
 \begin{code}
 -- specialised for PprAsm: saves lots of arg passing in NCG
@@ -407,7 +418,7 @@ pprCLbl (CaseLabel u CaseBitmap)
 
 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
 
-pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
+pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("upd_frame_info")
 
 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
 
@@ -444,6 +455,9 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 pprCLbl (RtsLabel (RtsPrimOp primop)) 
   = pprPrimOp primop <> ptext SLIT("_fast")
 
+pprCLbl (RtsLabel RtsModuleRegd)
+  = ptext SLIT("module_registered")
+
 pprCLbl (TyConLabel tc)
   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
 
@@ -453,6 +467,8 @@ pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
 pprCLbl (CC_Label cc)          = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
 
+pprCLbl (ModuleInitLabel mod)  = ptext SLIT("__init_") <> ptext mod
+
 ppIdFlavor :: IdLabelInfo -> SDoc
 
 ppIdFlavor x = pp_cSEP <>
@@ -468,7 +484,6 @@ ppIdFlavor x = pp_cSEP <>
 
 ppConFlavor x = pp_cSEP <>
                (case x of
-                      StaticClosure    -> ptext SLIT("static_closure")
                       ConEntry         -> ptext SLIT("con_entry")
                       ConInfoTbl       -> ptext SLIT("con_info")
                       StaticConEntry   -> ptext SLIT("static_entry")