[project @ 2004-08-13 10:45:16 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 437e5df..f2b3ff9 100644 (file)
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -9,6 +9,7 @@ module CLabel (
 
        mkClosureLabel,
        mkSRTLabel,
+       mkSRTDescLabel,
        mkInfoTableLabel,
        mkEntryLabel,
        mkSlowEntryLabel,
@@ -51,6 +52,7 @@ module CLabel (
 
        mkTopTickyCtrLabel,
        mkBlackHoleInfoTableLabel,
+       mkBlackHoleBQInfoTableLabel,
         mkCAFBlackHoleInfoTableLabel,
         mkSECAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
@@ -151,6 +153,7 @@ data CLabel
 data IdLabelInfo
   = Closure            -- Label for (static???) closure
   | SRT                 -- Static reference table
+  | SRTDesc             -- Static reference table descriptor
   | InfoTbl            -- Info tables for closures; always read-only
   | Entry              -- entry point
   | Slow               -- slow entry point
@@ -223,6 +226,7 @@ data CLabelType
 \begin{code}
 mkClosureLabel         id              = IdLabel id  Closure
 mkSRTLabel             id              = IdLabel id  SRT
+mkSRTDescLabel         id              = IdLabel id  SRTDesc
 mkInfoTableLabel       id              = IdLabel id  InfoTbl
 mkEntryLabel           id              = IdLabel id  Entry
 mkSlowEntryLabel       id              = IdLabel id  Slow
@@ -267,6 +271,7 @@ mkEMPTY_MVAR_infoLabel              = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
 
 mkTopTickyCtrLabel             = RtsLabel RtsTopTickyCtr
 mkBlackHoleInfoTableLabel      = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
+mkBlackHoleBQInfoTableLabel    = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_BQ_info"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
                                     RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
@@ -320,6 +325,7 @@ let-no-escapes, which can be recursive.
   -- don't bother declaring SRT & Bitmap labels, we always make sure
   -- they are defined before use.
 needsCDecl (IdLabel _ SRT)             = False
+needsCDecl (IdLabel _ SRTDesc)         = False
 needsCDecl (IdLabel _ Bitmap)          = False
 needsCDecl (IdLabel _ _)               = True
 needsCDecl (CaseLabel _ CaseReturnPt)  = True
@@ -446,6 +452,7 @@ internal names. <type> is one of the following:
 
         info                   Info table
         srt                    Static reference table
+        srtd                   Static reference table descriptor
         entry                  Entry code
         slow                   Slow entry code (if any)
         ret                    Direct return address    
@@ -562,7 +569,6 @@ pprCLbl (CCS_Label ccs)     = ppr ccs
 pprCLbl (ModuleInitLabel mod way)      
    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
        <> char '_' <> text way
-
 pprCLbl (PlainModuleInitLabel mod)     
    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 
@@ -572,6 +578,7 @@ ppIdFlavor x = pp_cSEP <>
               (case x of
                       Closure          -> ptext SLIT("closure")
                       SRT              -> ptext SLIT("srt")
+                      SRTDesc          -> ptext SLIT("srtd")
                       InfoTbl          -> ptext SLIT("info")
                       Entry            -> ptext SLIT("entry")
                       Slow             -> ptext SLIT("slow")