ghc/compiler/absCSyn/CLabel.lhs

   1 %
   2 % (c) The University of Glasgow, 1992-2002
   3 %
   4 \section[CLabel]{@CLabel@: Information to make C Labels}
   5
   6 \begin{code}
   7 module CLabel (
   8         CLabel, -- abstract type
   9
  10         mkClosureLabel,
  11         mkSRTLabel,
  12         mkInfoTableLabel,
  13         mkEntryLabel,
  14         mkSlowEntryLabel,
  15         mkConEntryLabel,
  16         mkStaticConEntryLabel,
  17         mkRednCountsLabel,
  18         mkConInfoTableLabel,
  19         mkStaticInfoTableLabel,
  20         mkApEntryLabel,
  21         mkApInfoTableLabel,
  22
  23         mkReturnPtLabel,
  24         mkReturnInfoLabel,
  25         mkVecTblLabel,
  26         mkAltLabel,
  27         mkDefaultLabel,
  28         mkBitmapLabel,
  29
  30         mkClosureTblLabel,
  31
  32         mkAsmTempLabel,
  33
  34         mkModuleInitLabel,
  35         mkPlainModuleInitLabel,
  36
  37         mkErrorStdEntryLabel,
  38
  39         mkStgUpdatePAPLabel,
  40         mkSplitMarkerLabel,
  41         mkUpdInfoLabel,
  42         mkSeqInfoLabel,
  43         mkIndInfoLabel,
  44         mkIndStaticInfoLabel,
  45         mkRtsGCEntryLabel,
  46         mkMainCapabilityLabel,
  47         mkCharlikeClosureLabel,
  48         mkIntlikeClosureLabel,
  49         mkMAP_FROZEN_infoLabel,
  50         mkEMPTY_MVAR_infoLabel,
  51
  52         mkTopTickyCtrLabel,
  53         mkBlackHoleInfoTableLabel,
  54         mkCAFBlackHoleInfoTableLabel,
  55         mkSECAFBlackHoleInfoTableLabel,
  56         mkRtsPrimOpLabel,
  57
  58         moduleRegdLabel,
  59
  60         mkSelectorInfoLabel,
  61         mkSelectorEntryLabel,
  62
  63         mkRtsApplyInfoLabel,
  64         mkRtsApplyEntryLabel,
  65
  66         mkForeignLabel,
  67
  68         mkCC_Label, mkCCS_Label,
  69
  70         needsCDecl, isAsmTemp, externallyVisibleCLabel,
  71
  72         CLabelType(..), labelType, labelDynamic,
  73
  74         pprCLabel
  75     ) where
  76
  77
  78 #include "HsVersions.h"
  79
  80 #if ! OMIT_NATIVE_CODEGEN
  81 import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
  82 #endif
  83
  84 import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
  85 import CStrings         ( pp_cSEP )
  86 import DataCon          ( ConTag )
  87 import Module           ( moduleName, moduleNameFS,
  88                           Module, isHomeModule )
  89 import Name             ( Name, getName, isDllName, isExternalName )
  90 import TyCon            ( TyCon )
  91 import Unique           ( pprUnique, Unique )
  92 import PrimOp           ( PrimOp )
  93 import CostCentre       ( CostCentre, CostCentreStack )
  94 import Outputable
  95 import FastString
  96 \end{code}
  97
  98 things we want to find out:
  99
 100 * should the labelled things be declared "static" (visible only in this file)?
 101
 102 * should it be declared "const" (read-only text space)?
 103
 104 * does it need declarations at all? (v common Prelude things are pre-declared)
 105
 106 * what type does it have? (for generating accurate enough C declarations
 107   so that the C compiler won't complain).
 108
 109 \begin{code}
 110 data CLabel
 111   = IdLabel                     -- A family of labels related to the
 112         Name                    -- definition of a particular Id
 113         IdLabelInfo
 114
 115   | DataConLabel                -- Ditto data constructors
 116         Name
 117         DataConLabelInfo
 118
 119   | CaseLabel                   -- A family of labels related to a particular case expression
 120         Unique                  -- Unique says which case expression
 121         CaseLabelInfo
 122
 123   | TyConLabel TyCon            -- currently only one kind of TyconLabel,
 124                                 -- a 'Closure Table'.
 125
 126   | AsmTempLabel    Unique
 127
 128   | ModuleInitLabel
 129         Module                  -- the module name
 130         String                  -- its "way"
 131         -- at some point we might want some kind of version number in
 132         -- the module init label, to guard against compiling modules in
 133         -- the wrong order.  We can't use the interface file version however,
 134         -- because we don't always recompile modules which depend on a module
 135         -- whose version has changed.
 136
 137   | PlainModuleInitLabel Module  -- without the vesrion & way info
 138
 139   | RtsLabel        RtsLabelInfo
 140
 141   | ForeignLabel FastString Bool  -- a 'C' (or otherwise foreign) label
 142                                    -- Bool <=> is dynamic
 143
 144   | CC_Label CostCentre
 145   | CCS_Label CostCentreStack
 146
 147   deriving (Eq, Ord)
 148 \end{code}
 149
 150 \begin{code}
 151 data IdLabelInfo
 152   = Closure             -- Label for (static???) closure
 153   | SRT                 -- Static reference table
 154   | InfoTbl             -- Info tables for closures; always read-only
 155   | Entry               -- entry point
 156   | Slow                -- slow entry point
 157
 158                         -- Ticky-ticky counting
 159   | RednCounts          -- Label of place to keep reduction-count info for
 160                         -- this Id
 161
 162   | Bitmap              -- A bitmap (function or case return)
 163
 164   deriving (Eq, Ord)
 165
 166 data DataConLabelInfo
 167   = ConEntry            -- the only kind of entry pt for constructors
 168   | ConInfoTbl          -- corresponding info table
 169   | StaticConEntry      -- static constructor entry point
 170   | StaticInfoTbl       -- corresponding info table
 171   deriving (Eq, Ord)
 172
 173 data CaseLabelInfo
 174   = CaseReturnPt
 175   | CaseReturnInfo
 176   | CaseVecTbl
 177   | CaseAlt ConTag
 178   | CaseDefault
 179   deriving (Eq, Ord)
 180
 181 data RtsLabelInfo
 182   = RtsShouldNeverHappenCode
 183
 184   | RtsBlackHoleInfoTbl LitString  -- black hole with info table name
 185
 186   | RtsUpdInfo                  -- upd_frame_info
 187   | RtsSeqInfo                  -- seq_frame_info
 188   | RtsGCEntryLabel String      -- a heap check fail handler, eg  stg_chk_2
 189   | RtsMainCapability           -- MainCapability
 190   | Rts_Closure String          -- misc rts closures, eg CHARLIKE_closure
 191   | Rts_Info String             -- misc rts itbls, eg MUT_ARR_PTRS_FROZEN_info
 192   | Rts_Code String             -- misc rts code
 193
 194   | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-}  -- Selector thunks
 195   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 196
 197   | RtsApInfoTbl Bool{-updatable-} Int{-arity-}         -- AP thunks
 198   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 199
 200   | RtsPrimOp PrimOp
 201
 202   | RtsTopTickyCtr
 203
 204   | RtsModuleRegd
 205
 206   | RtsApplyInfoLabel  LitString
 207   | RtsApplyEntryLabel LitString
 208
 209   deriving (Eq, Ord)
 210
 211 -- Label Type: for generating C declarations.
 212
 213 data CLabelType
 214   = RetInfoTblType
 215   | InfoTblType
 216   | ClosureType
 217   | VecTblType
 218   | ClosureTblType
 219   | CodeType
 220   | DataType
 221 \end{code}
 222
 223 \begin{code}
 224 mkClosureLabel          id              = IdLabel id  Closure
 225 mkSRTLabel              id              = IdLabel id  SRT
 226 mkInfoTableLabel        id              = IdLabel id  InfoTbl
 227 mkEntryLabel            id              = IdLabel id  Entry
 228 mkSlowEntryLabel        id              = IdLabel id  Slow
 229 mkBitmapLabel           id              = IdLabel id  Bitmap
 230 mkRednCountsLabel       id              = IdLabel id  RednCounts
 231
 232 mkStaticInfoTableLabel  con             = DataConLabel con StaticInfoTbl
 233 mkConInfoTableLabel     con             = DataConLabel con ConInfoTbl
 234 mkConEntryLabel         con             = DataConLabel con ConEntry
 235 mkStaticConEntryLabel   con             = DataConLabel con StaticConEntry
 236
 237
 238 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 239 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 240 mkVecTblLabel   uniq            = CaseLabel uniq CaseVecTbl
 241 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 242 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 243
 244
 245 mkClosureTblLabel tycon         = TyConLabel tycon
 246
 247 mkAsmTempLabel                  = AsmTempLabel
 248
 249 mkModuleInitLabel               = ModuleInitLabel
 250 mkPlainModuleInitLabel          = PlainModuleInitLabel
 251
 252         -- Some fixed runtime system labels
 253
 254 mkErrorStdEntryLabel            = RtsLabel RtsShouldNeverHappenCode
 255 mkStgUpdatePAPLabel             = RtsLabel (Rts_Code "stg_update_PAP")
 256 mkSplitMarkerLabel              = RtsLabel (Rts_Code "__stg_split_marker")
 257 mkUpdInfoLabel                  = RtsLabel RtsUpdInfo
 258 mkSeqInfoLabel                  = RtsLabel RtsSeqInfo
 259 mkIndInfoLabel                  = RtsLabel (Rts_Info "stg_IND_info")
 260 mkIndStaticInfoLabel            = RtsLabel (Rts_Info "stg_IND_STATIC_info")
 261 mkRtsGCEntryLabel str           = RtsLabel (RtsGCEntryLabel str)
 262 mkMainCapabilityLabel           = RtsLabel RtsMainCapability
 263 mkCharlikeClosureLabel          = RtsLabel (Rts_Closure "stg_CHARLIKE_closure")
 264 mkIntlikeClosureLabel           = RtsLabel (Rts_Closure "stg_INTLIKE_closure")
 265 mkMAP_FROZEN_infoLabel          = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
 266 mkEMPTY_MVAR_infoLabel          = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
 267
 268 mkTopTickyCtrLabel              = RtsLabel RtsTopTickyCtr
 269 mkBlackHoleInfoTableLabel       = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
 270 mkCAFBlackHoleInfoTableLabel    = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
 271 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 272                                     RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))
 273                                   else  -- RTS won't have info table unless -ticky is on
 274                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 275 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 276
 277 moduleRegdLabel                 = RtsLabel RtsModuleRegd
 278
 279 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTbl upd off)
 280 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry   upd off)
 281
 282 mkApInfoTableLabel  upd off     = RtsLabel (RtsApInfoTbl upd off)
 283 mkApEntryLabel upd off          = RtsLabel (RtsApEntry   upd off)
 284
 285         -- Foreign labels
 286
 287 mkForeignLabel :: FastString -> Bool -> CLabel
 288 mkForeignLabel str is_dynamic   = ForeignLabel str is_dynamic
 289
 290         -- Cost centres etc.
 291
 292 mkCC_Label      cc              = CC_Label cc
 293 mkCCS_Label     ccs             = CCS_Label ccs
 294
 295 -- Std RTS application routines
 296
 297 mkRtsApplyInfoLabel  = RtsLabel . RtsApplyInfoLabel
 298 mkRtsApplyEntryLabel = RtsLabel . RtsApplyEntryLabel
 299 \end{code}
 300
 301 \begin{code}
 302 needsCDecl :: CLabel -> Bool    -- False <=> it's pre-declared; don't bother
 303 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 304 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 305 \end{code}
 306
 307 @needsCDecl@ is @True@ unless the thing is a deeply-@PreludeCore@-ish
 308 object.  {\em Also:} No need to spit out labels for things generated
 309 by the flattener (in @AbsCUtils@)---it is careful to ensure references
 310 to them are always backwards.  These are return-point and vector-table
 311 labels.
 312
 313 Declarations for (non-prelude) @Id@-based things are needed because of
 314 mutual recursion.
 315
 316 Declarations for direct return points are needed, because they may be
 317 let-no-escapes, which can be recursive.
 318
 319 \begin{code}
 320   -- don't bother declaring SRT & Bitmap labels, we always make sure
 321   -- they are defined before use.
 322 needsCDecl (IdLabel _ SRT)              = False
 323 needsCDecl (IdLabel _ Bitmap)           = False
 324 needsCDecl (IdLabel _ _)                = True
 325 needsCDecl (CaseLabel _ CaseReturnPt)   = True
 326 needsCDecl (DataConLabel _ _)           = True
 327 needsCDecl (TyConLabel _)               = True
 328 needsCDecl (ModuleInitLabel _ _)        = True
 329 needsCDecl (PlainModuleInitLabel _)     = True
 330
 331 needsCDecl (CaseLabel _ _)              = False
 332 needsCDecl (AsmTempLabel _)             = False
 333 needsCDecl (RtsLabel _)                 = False
 334 needsCDecl (ForeignLabel _ _)           = False
 335 needsCDecl (CC_Label _)                 = False
 336 needsCDecl (CCS_Label _)                = False
 337 \end{code}
 338
 339 Whether the label is an assembler temporary:
 340
 341 \begin{code}
 342 isAsmTemp (AsmTempLabel _) = True
 343 isAsmTemp _                = False
 344 \end{code}
 345
 346 C ``static'' or not...
 347 From the point of view of the code generator, a name is
 348 externally visible if it has to be declared as exported
 349 in the .o file's symbol table; that is, made non-static.
 350
 351 \begin{code}
 352 externallyVisibleCLabel (DataConLabel _ _) = True
 353 externallyVisibleCLabel (TyConLabel tc)    = True
 354 externallyVisibleCLabel (CaseLabel _ _)    = False
 355 externallyVisibleCLabel (AsmTempLabel _)   = False
 356 externallyVisibleCLabel (ModuleInitLabel _ _)= True
 357 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 358 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 359 externallyVisibleCLabel (RtsLabel _)       = True
 360 externallyVisibleCLabel (ForeignLabel _ _) = True
 361 externallyVisibleCLabel (IdLabel id _)     = isExternalName id
 362 externallyVisibleCLabel (CC_Label _)       = False -- not strictly true
 363 externallyVisibleCLabel (CCS_Label _)      = False -- not strictly true
 364 \end{code}
 365
 366 For generating correct types in label declarations, and also for
 367 deciding whether the C compiler would like us to use '&' before the
 368 label to get its address:
 369
 370 \begin{code}
 371 labelType :: CLabel -> CLabelType
 372 labelType (RtsLabel (RtsBlackHoleInfoTbl _))  = InfoTblType
 373 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
 374 labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
 375 labelType (RtsLabel RtsUpdInfo)               = RetInfoTblType
 376 labelType (RtsLabel RtsSeqInfo)               = RetInfoTblType
 377 labelType (RtsLabel RtsTopTickyCtr)           = CodeType -- XXX
 378 labelType (RtsLabel (Rts_Info _))             = InfoTblType
 379 labelType (RtsLabel (RtsApplyInfoLabel _))    = RetInfoTblType
 380 labelType (RtsLabel (RtsApplyEntryLabel _))   = CodeType
 381 labelType (CaseLabel _ CaseReturnInfo)        = RetInfoTblType
 382 labelType (CaseLabel _ CaseReturnPt)          = CodeType
 383 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
 384 labelType (TyConLabel _)                      = ClosureTblType
 385 labelType (ModuleInitLabel _ _)               = CodeType
 386 labelType (PlainModuleInitLabel _)            = CodeType
 387 labelType (CC_Label _)                        = CodeType -- hack
 388 labelType (CCS_Label _)                       = CodeType -- hack
 389
 390 labelType (IdLabel _ info) =
 391   case info of
 392     InfoTbl   -> InfoTblType
 393     Closure   -> ClosureType
 394     Bitmap    -> DataType
 395     _         -> CodeType
 396
 397 labelType (DataConLabel _ info) =
 398   case info of
 399      ConInfoTbl    -> InfoTblType
 400      StaticInfoTbl -> InfoTblType
 401      _             -> CodeType
 402
 403 labelType _        = DataType
 404 \end{code}
 405
 406 When referring to data in code, we need to know whether
 407 that data resides in a DLL or not. [Win32 only.]
 408 @labelDynamic@ returns @True@ if the label is located
 409 in a DLL, be it a data reference or not.
 410
 411 \begin{code}
 412 labelDynamic :: CLabel -> Bool
 413 labelDynamic lbl =
 414   case lbl of
 415    -- The special case for RtsShouldNeverHappenCode is because the associated address is
 416    -- NULL, i.e. not a DLL entry point
 417    RtsLabel RtsShouldNeverHappenCode -> False
 418    RtsLabel _        -> not opt_Static  -- i.e., is the RTS in a DLL or not?
 419    IdLabel n k       -> isDllName n
 420    DataConLabel n k  -> isDllName n
 421    TyConLabel tc     -> isDllName (getName tc)
 422    ForeignLabel _ d  -> d
 423    ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
 424    PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
 425    _                 -> False
 426 \end{code}
 427
 428
 429 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 430 right places. It is used to detect when the abstractC statement of an
 431 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 432
 433 We need at least @Eq@ for @CLabels@, because we want to avoid
 434 duplicate declarations in generating C (see @labelSeenTE@ in
 435 @PprAbsC@).
 436
 437 -----------------------------------------------------------------------------
 438 Printing out CLabels.
 439
 440 Convention:
 441
 442       <name>_<type>
 443
 444 where <name> is <Module>_<name> for external names and <unique> for
 445 internal names. <type> is one of the following:
 446
 447          info                   Info table
 448          srt                    Static reference table
 449          entry                  Entry code
 450          slow                   Slow entry code (if any)
 451          ret                    Direct return address
 452          vtbl                   Vector table
 453          <n>_alt                Case alternative (tag n)
 454          dflt                   Default case alternative
 455          btm                    Large bitmap vector
 456          closure                Static closure
 457          con_entry              Dynamic Constructor entry code
 458          con_info               Dynamic Constructor info table
 459          static_entry           Static Constructor entry code
 460          static_info            Static Constructor info table
 461          sel_info               Selector info table
 462          sel_entry              Selector entry code
 463          cc                     Cost centre
 464          ccs                    Cost centre stack
 465
 466 \begin{code}
 467 pprCLabel :: CLabel -> SDoc
 468
 469 #if ! OMIT_NATIVE_CODEGEN
 470 pprCLabel (AsmTempLabel u)
 471   = text (fmtAsmLbl (show u))
 472 #endif
 473
 474 pprCLabel lbl =
 475 #if ! OMIT_NATIVE_CODEGEN
 476     getPprStyle $ \ sty ->
 477     if asmStyle sty && underscorePrefix then
 478        pp_cSEP <> pprCLbl lbl
 479     else
 480 #endif
 481        pprCLbl lbl
 482
 483 pprCLbl (CaseLabel u CaseReturnPt)
 484   = hcat [pprUnique u, pp_cSEP, ptext SLIT("ret")]
 485 pprCLbl (CaseLabel u CaseReturnInfo)
 486   = hcat [pprUnique u, pp_cSEP, ptext SLIT("info")]
 487 pprCLbl (CaseLabel u CaseVecTbl)
 488   = hcat [pprUnique u, pp_cSEP, ptext SLIT("vtbl")]
 489 pprCLbl (CaseLabel u (CaseAlt tag))
 490   = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
 491 pprCLbl (CaseLabel u CaseDefault)
 492   = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]
 493
 494 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
 495 -- used to be stg_error_entry but Windows can't have DLL entry points as static
 496 -- initialisers, and besides, this ShouldNeverHappen, right?
 497
 498 pprCLbl (RtsLabel RtsUpdInfo)            = ptext SLIT("stg_upd_frame_info")
 499 pprCLbl (RtsLabel RtsSeqInfo)            = ptext SLIT("stg_seq_frame_info")
 500 pprCLbl (RtsLabel RtsMainCapability)     = ptext SLIT("MainCapability")
 501 pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str
 502 pprCLbl (RtsLabel (Rts_Closure str))     = text str
 503 pprCLbl (RtsLabel (Rts_Info str))        = text str
 504 pprCLbl (RtsLabel (Rts_Code str))        = text str
 505
 506 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
 507
 508 pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ptext info
 509
 510 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
 511   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 512                 ptext (if upd_reqd
 513                         then SLIT("_upd_info")
 514                         else SLIT("_noupd_info"))
 515         ]
 516
 517 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 518   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 519                 ptext (if upd_reqd
 520                         then SLIT("_upd_entry")
 521                         else SLIT("_noupd_entry"))
 522         ]
 523
 524 pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
 525   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 526                 ptext (if upd_reqd
 527                         then SLIT("_upd_info")
 528                         else SLIT("_noupd_info"))
 529         ]
 530
 531 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 532   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 533                 ptext (if upd_reqd
 534                         then SLIT("_upd_entry")
 535                         else SLIT("_noupd_entry"))
 536         ]
 537
 538 pprCLbl (RtsLabel (RtsApplyInfoLabel  fs))
 539   = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_info")
 540
 541 pprCLbl (RtsLabel (RtsApplyEntryLabel fs))
 542   = ptext SLIT("stg_ap_") <> ptext fs <> ptext SLIT("_ret")
 543
 544 pprCLbl (RtsLabel (RtsPrimOp primop))
 545   = ppr primop <> ptext SLIT("_fast")
 546
 547 pprCLbl (RtsLabel RtsModuleRegd)
 548   = ptext SLIT("module_registered")
 549
 550 pprCLbl (ForeignLabel str _)
 551   = ftext str
 552
 553 pprCLbl (TyConLabel tc)
 554   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
 555
 556 pprCLbl (IdLabel      id  flavor) = ppr id <> ppIdFlavor flavor
 557 pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
 558
 559 pprCLbl (CC_Label cc)           = ppr cc
 560 pprCLbl (CCS_Label ccs)         = ppr ccs
 561
 562 pprCLbl (ModuleInitLabel mod way)
 563    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 564         <> char '_' <> text way
 565
 566 pprCLbl (PlainModuleInitLabel mod)
 567    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 568
 569 ppIdFlavor :: IdLabelInfo -> SDoc
 570
 571 ppIdFlavor x = pp_cSEP <>
 572                (case x of
 573                        Closure          -> ptext SLIT("closure")
 574                        SRT              -> ptext SLIT("srt")
 575                        InfoTbl          -> ptext SLIT("info")
 576                        Entry            -> ptext SLIT("entry")
 577                        Slow             -> ptext SLIT("slow")
 578                        RednCounts       -> ptext SLIT("ct")
 579                        Bitmap           -> ptext SLIT("btm")
 580                       )
 581
 582 ppConFlavor x = pp_cSEP <>
 583                 (case x of
 584                        ConEntry         -> ptext SLIT("con_entry")
 585                        ConInfoTbl       -> ptext SLIT("con_info")
 586                        StaticConEntry   -> ptext SLIT("static_entry")
 587                        StaticInfoTbl    -> ptext SLIT("static_info")
 588                 )
 589 \end{code}