[project @ 2002-10-18 13:36:17 by simonpj]

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

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index f6037d3..e91d94b 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.50 2001/12/12 18:12:45 sewardj Exp $
+% $Id: CLabel.lhs,v 1.55 2002/09/13 15:02:26 simonpj Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -34,6 +34,7 @@ module CLabel (
        mkAsmTempLabel,
 
        mkModuleInitLabel,
+       mkPlainModuleInitLabel,
 
        mkErrorStdEntryLabel,
 
@@ -84,12 +85,13 @@ import CStrings             ( pp_cSEP )
 import DataCon         ( ConTag )
 import Module          ( moduleName, moduleNameFS, 
                          Module, isHomeModule )
-import Name            ( Name, getName, isDllName, isExternallyVisibleName )
+import Name            ( Name, getName, isDllName, isExternalName )
 import TyCon           ( TyCon )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp )
 import CostCentre      ( CostCentre, CostCentreStack )
 import Outputable
+import FastString
 \end{code}
 
 things we want to find out:
@@ -122,11 +124,20 @@ data CLabel
 
   | AsmTempLabel    Unique
 
-  | ModuleInitLabel Module
+  | ModuleInitLabel 
+       Module                  -- the module name
+       String                  -- its "way"
+       -- at some point we might want some kind of version number in
+       -- the module init label, to guard against compiling modules in
+       -- the wrong order.  We can't use the interface file version however,
+       -- because we don't always recompile modules which depend on a module
+       -- whose version has changed.
+
+  | PlainModuleInitLabel Module         -- without the vesrion & way info
 
   | RtsLabel       RtsLabelInfo
 
-  | ForeignLabel FAST_STRING Bool  -- a 'C' (or otherwise foreign) label
+  | ForeignLabel FastString Bool  -- a 'C' (or otherwise foreign) label
                                   -- Bool <=> is dynamic
 
   | CC_Label CostCentre
@@ -173,7 +184,7 @@ data CaseLabelInfo
 data RtsLabelInfo
   = RtsShouldNeverHappenCode
 
-  | RtsBlackHoleInfoTbl FAST_STRING  -- black hole with info table name
+  | RtsBlackHoleInfoTbl FastString  -- black hole with info table name
 
   | RtsUpdInfo                 -- upd_frame_info
   | RtsSeqInfo                 -- seq_frame_info
@@ -236,6 +247,7 @@ mkClosureTblLabel tycon             = TyConLabel tycon
 mkAsmTempLabel                         = AsmTempLabel
 
 mkModuleInitLabel              = ModuleInitLabel
+mkPlainModuleInitLabel         = PlainModuleInitLabel
 
        -- Some fixed runtime system labels
 
@@ -254,10 +266,10 @@ mkMAP_FROZEN_infoLabel            = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
 mkEMPTY_MVAR_infoLabel         = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
 
 mkTopTickyCtrLabel             = RtsLabel RtsTopTickyCtr
-mkBlackHoleInfoTableLabel      = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
-mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
+mkBlackHoleInfoTableLabel      = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_BLACKHOLE_info"))
+mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_CAF_BLACKHOLE_info"))
 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
-                                    RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
+                                    RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_SE_CAF_BLACKHOLE_info"))
                                   else  -- RTS won't have info table unless -ticky is on
                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 mkRtsPrimOpLabel primop                = RtsLabel (RtsPrimOp primop)
@@ -272,7 +284,7 @@ mkApEntryLabel upd off              = RtsLabel (RtsApEntry   upd off)
 
        -- Foreign labels
 
-mkForeignLabel :: FAST_STRING -> Bool -> CLabel
+mkForeignLabel :: FastString -> Bool -> CLabel
 mkForeignLabel str is_dynamic  = ForeignLabel str is_dynamic
 
        -- Cost centres etc.
@@ -304,7 +316,8 @@ needsCDecl (IdLabel _ _)            = True
 needsCDecl (CaseLabel _ CaseReturnPt)  = True
 needsCDecl (DataConLabel _ _)          = True
 needsCDecl (TyConLabel _)              = True
-needsCDecl (ModuleInitLabel _)         = True
+needsCDecl (ModuleInitLabel _ _)       = True
+needsCDecl (PlainModuleInitLabel _)    = True
 
 needsCDecl (CaseLabel _ _)             = False
 needsCDecl (AsmTempLabel _)            = False
@@ -331,11 +344,12 @@ externallyVisibleCLabel (DataConLabel _ _) = True
 externallyVisibleCLabel (TyConLabel tc)    = True
 externallyVisibleCLabel (CaseLabel _ _)           = False
 externallyVisibleCLabel (AsmTempLabel _)   = False
-externallyVisibleCLabel (ModuleInitLabel _)= True
+externallyVisibleCLabel (ModuleInitLabel _ _)= True
+externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 externallyVisibleCLabel (RtsLabel _)      = True
 externallyVisibleCLabel (ForeignLabel _ _) = True
-externallyVisibleCLabel (IdLabel id _)     = isExternallyVisibleName id
+externallyVisibleCLabel (IdLabel id _)     = isExternalName id
 externallyVisibleCLabel (CC_Label _)      = False -- not strictly true
 externallyVisibleCLabel (CCS_Label _)     = False -- not strictly true
 \end{code}
@@ -353,7 +367,8 @@ labelType (CaseLabel _ CaseReturnInfo)        = InfoTblType
 labelType (CaseLabel _ CaseReturnPt)         = CodeType
 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
 labelType (TyConLabel _)                     = ClosureTblType
-labelType (ModuleInitLabel _ )                = CodeType
+labelType (ModuleInitLabel _ _)               = CodeType
+labelType (PlainModuleInitLabel _)            = CodeType
 
 labelType (IdLabel _ info) = 
   case info of
@@ -387,7 +402,8 @@ labelDynamic lbl =
    DataConLabel n k  -> isDllName n
    TyConLabel tc     -> isDllName (getName tc)
    ForeignLabel _ d  -> d
-   ModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
+   ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
+   PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
    _                -> False
 \end{code}
 
@@ -472,7 +488,7 @@ pprCLbl (RtsLabel (Rts_Code str))        = text str
 
 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
 
-pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
+pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ftext info
 
 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
   = hcat [ptext SLIT("stg_sel_"), text (show offset),
@@ -509,7 +525,7 @@ pprCLbl (RtsLabel RtsModuleRegd)
   = ptext SLIT("module_registered")
 
 pprCLbl (ForeignLabel str _)
-  = ptext str
+  = ftext str
 
 pprCLbl (TyConLabel tc)
   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
@@ -520,8 +536,12 @@ 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("__stginit_") <> ptext (moduleNameFS (moduleName mod))
+pprCLbl (ModuleInitLabel mod way)      
+   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+       <> char '_' <> text way
+
+pprCLbl (PlainModuleInitLabel mod)     
+   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 
 ppIdFlavor :: IdLabelInfo -> SDoc