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