[project @ 2004-09-10 18:54:21 by panne]

[ghc-hetmet.git] / ghc / compiler / cmm / CLabel.hs

diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
index ae470ca..c0c6e34 100644 (file)
--- a/ghc/compiler/cmm/CLabel.hs
+++ b/ghc/compiler/cmm/CLabel.hs
@@ -28,6 +28,7 @@ module CLabel (
        mkAltLabel,
        mkDefaultLabel,
        mkBitmapLabel,
+       mkStringLitLabel,
 
        mkClosureTblLabel,
 
@@ -36,7 +37,6 @@ module CLabel (
        mkModuleInitLabel,
        mkPlainModuleInitLabel,
 
-       mkErrorStdEntryLabel,
        mkSplitMarkerLabel,
        mkUpdInfoLabel,
        mkSeqInfoLabel,
@@ -136,6 +136,9 @@ data CLabel
   | AsmTempLabel 
        {-# UNPACK #-} !Unique
 
+  | StringLitLabel
+       {-# UNPACK #-} !Unique
+
   | ModuleInitLabel 
        Module                  -- the module name
        String                  -- its "way"
@@ -195,9 +198,7 @@ data CaseLabelInfo
 
 
 data RtsLabelInfo
-  = RtsShouldNeverHappenCode
-
-  | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
+  = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 
   | RtsApInfoTbl Bool{-updatable-} Int{-arity-}                -- AP thunks
@@ -249,6 +250,7 @@ mkReturnInfoLabel uniq              = CaseLabel uniq CaseReturnInfo
 mkAltLabel      uniq tag       = CaseLabel uniq (CaseAlt tag)
 mkDefaultLabel  uniq           = CaseLabel uniq CaseDefault
 
+mkStringLitLabel               = StringLitLabel
 mkAsmTempLabel                         = AsmTempLabel
 
 mkModuleInitLabel              = ModuleInitLabel
@@ -256,7 +258,6 @@ mkPlainModuleInitLabel              = PlainModuleInitLabel
 
        -- Some fixed runtime system labels
 
-mkErrorStdEntryLabel           = RtsLabel RtsShouldNeverHappenCode
 mkSplitMarkerLabel             = RtsLabel (RtsCode SLIT("__stg_split_marker"))
 mkUpdInfoLabel                 = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 mkSeqInfoLabel                 = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
@@ -351,6 +352,7 @@ needsCDecl (PlainModuleInitLabel _) = True
 needsCDecl ModuleRegdLabel             = False
 
 needsCDecl (CaseLabel _ _)             = False
+needsCDecl (StringLitLabel _)          = False
 needsCDecl (AsmTempLabel _)            = False
 needsCDecl (RtsLabel _)                        = False
 needsCDecl (ForeignLabel _ _ _)                = False
@@ -372,6 +374,7 @@ isAsmTemp _                    = False
 
 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)           = False
+externallyVisibleCLabel (StringLitLabel _) = False
 externallyVisibleCLabel (AsmTempLabel _)   = False
 externallyVisibleCLabel (ModuleInitLabel _ _)= True
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
@@ -436,9 +439,6 @@ labelType _        = DataLabel
 labelDynamic :: CLabel -> Bool
 labelDynamic lbl = 
   case lbl of
-   -- The special case for RtsShouldNeverHappenCode is because the associated address is
-   -- NULL, i.e. not a DLL entry point
-   RtsLabel RtsShouldNeverHappenCode -> False
    RtsLabel _               -> not opt_Static  -- i.e., is the RTS in a DLL or not?
    IdLabel n k       -> isDllName n
    ForeignLabel _ _ d  -> d
@@ -536,6 +536,9 @@ pprAsmCLbl (ForeignLabel fs (Just sz) _)
 pprAsmCLbl lbl
    = pprCLbl lbl
 
+pprCLbl (StringLitLabel u)
+  = pprUnique u <> ptext SLIT("_str")
+
 pprCLbl (CaseLabel u CaseReturnPt)
   = hcat [pprUnique u, ptext SLIT("_ret")]
 pprCLbl (CaseLabel u CaseReturnInfo)
@@ -545,10 +548,6 @@ pprCLbl (CaseLabel u (CaseAlt tag))
 pprCLbl (CaseLabel u CaseDefault)
   = hcat [pprUnique u, ptext SLIT("_dflt")]
 
-pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("0")
--- used to be stg_error_entry but Windows can't have DLL entry points as static
--- initialisers, and besides, this ShouldNeverHappen, right?
-
 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 pprCLbl (RtsLabel (RtsData str))   = ptext str
 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str