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