[project @ 2002-07-10 09:28:54 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 4da5c57..a26d9d7 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.48 2001/11/08 12:56:01 simonmar Exp $
+% $Id: CLabel.lhs,v 1.52 2002/04/29 14:03:39 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -44,7 +44,7 @@ module CLabel (
        mkIndInfoLabel,
        mkIndStaticInfoLabel,
        mkRtsGCEntryLabel,
-        mkMainRegTableLabel,
+        mkMainCapabilityLabel,
        mkCharlikeClosureLabel,
        mkIntlikeClosureLabel,
        mkMAP_FROZEN_infoLabel,
@@ -84,12 +84,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:
@@ -126,7 +127,7 @@ data CLabel
 
   | 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,12 +174,12 @@ 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
   | RtsGCEntryLabel String     -- a heap check fail handler, eg  stg_chk_2
-  | RtsMainRegTable             -- MainRegTable (??? Capabilities wurble ???)
+  | RtsMainCapability           -- MainCapability
   | Rts_Closure String         -- misc rts closures, eg CHARLIKE_closure
   | Rts_Info String            -- misc rts itbls, eg MUT_ARR_PTRS_FROZEN_info
   | Rts_Code String            -- misc rts code
@@ -247,17 +248,17 @@ mkSeqInfoLabel                    = RtsLabel RtsSeqInfo
 mkIndInfoLabel                 = RtsLabel (Rts_Info "stg_IND_info")
 mkIndStaticInfoLabel           = RtsLabel (Rts_Info "stg_IND_STATIC_info")
 mkRtsGCEntryLabel str          = RtsLabel (RtsGCEntryLabel str)
-mkMainRegTableLabel            = RtsLabel RtsMainRegTable
+mkMainCapabilityLabel          = RtsLabel RtsMainCapability
 mkCharlikeClosureLabel         = RtsLabel (Rts_Closure "stg_CHARLIKE_closure")
 mkIntlikeClosureLabel          = RtsLabel (Rts_Closure "stg_INTLIKE_closure")
 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 +273,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.
@@ -335,7 +336,7 @@ externallyVisibleCLabel (ModuleInitLabel _)= 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}
@@ -348,6 +349,7 @@ labelType (RtsLabel (RtsBlackHoleInfoTbl _))  = InfoTblType
 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
 labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
 labelType (RtsLabel RtsUpdInfo)              = InfoTblType
+labelType (RtsLabel (Rts_Info _))             = InfoTblType
 labelType (CaseLabel _ CaseReturnInfo)        = InfoTblType
 labelType (CaseLabel _ CaseReturnPt)         = CodeType
 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
@@ -463,7 +465,7 @@ pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
 
 pprCLbl (RtsLabel RtsUpdInfo)            = ptext SLIT("stg_upd_frame_info")
 pprCLbl (RtsLabel RtsSeqInfo)            = ptext SLIT("stg_seq_frame_info")
-pprCLbl (RtsLabel RtsMainRegTable)       = ptext SLIT("MainRegTable")
+pprCLbl (RtsLabel RtsMainCapability)     = ptext SLIT("MainCapability")
 pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str
 pprCLbl (RtsLabel (Rts_Closure str))     = text str
 pprCLbl (RtsLabel (Rts_Info str))        = text str
@@ -471,7 +473,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),
@@ -508,7 +510,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,7 +522,7 @@ pprCLbl (CC_Label cc)               = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
 
 pprCLbl (ModuleInitLabel mod)  
-   = ptext SLIT("__stginit_") <> ptext (moduleNameFS (moduleName mod))
+   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 
 ppIdFlavor :: IdLabelInfo -> SDoc