ghc/compiler/cmm/CLabel.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Object-file symbols (called CLabel for histerical raisins).
   4 --
   5 -- (c) The University of Glasgow 2004
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CLabel (
  10         CLabel, -- abstract type
  11
  12         mkClosureLabel,
  13         mkSRTLabel,
  14         mkSRTDescLabel,
  15         mkInfoTableLabel,
  16         mkEntryLabel,
  17         mkSlowEntryLabel,
  18         mkConEntryLabel,
  19         mkStaticConEntryLabel,
  20         mkRednCountsLabel,
  21         mkConInfoTableLabel,
  22         mkStaticInfoTableLabel,
  23         mkApEntryLabel,
  24         mkApInfoTableLabel,
  25
  26         mkReturnPtLabel,
  27         mkReturnInfoLabel,
  28         mkAltLabel,
  29         mkDefaultLabel,
  30         mkBitmapLabel,
  31         mkStringLitLabel,
  32
  33         mkClosureTblLabel,
  34
  35         mkAsmTempLabel,
  36
  37         mkModuleInitLabel,
  38         mkPlainModuleInitLabel,
  39
  40         mkSplitMarkerLabel,
  41         mkUpdInfoLabel,
  42         mkSeqInfoLabel,
  43         mkIndStaticInfoLabel,
  44         mkMainCapabilityLabel,
  45         mkMAP_FROZEN_infoLabel,
  46         mkEMPTY_MVAR_infoLabel,
  47
  48         mkTopTickyCtrLabel,
  49         mkCAFBlackHoleInfoTableLabel,
  50         mkSECAFBlackHoleInfoTableLabel,
  51         mkRtsPrimOpLabel,
  52         mkRtsSlowTickyCtrLabel,
  53
  54         moduleRegdLabel,
  55
  56         mkSelectorInfoLabel,
  57         mkSelectorEntryLabel,
  58
  59         mkRtsInfoLabel,
  60         mkRtsEntryLabel,
  61         mkRtsRetInfoLabel,
  62         mkRtsRetLabel,
  63         mkRtsCodeLabel,
  64         mkRtsDataLabel,
  65
  66         mkRtsInfoLabelFS,
  67         mkRtsEntryLabelFS,
  68         mkRtsRetInfoLabelFS,
  69         mkRtsRetLabelFS,
  70         mkRtsCodeLabelFS,
  71         mkRtsDataLabelFS,
  72
  73         mkForeignLabel,
  74
  75         mkCCLabel, mkCCSLabel,
  76
  77         infoLblToEntryLbl, entryLblToInfoLbl,
  78         needsCDecl, isAsmTemp, externallyVisibleCLabel,
  79         CLabelType(..), labelType, labelDynamic, labelCouldBeDynamic,
  80
  81         pprCLabel
  82     ) where
  83
  84
  85 #include "HsVersions.h"
  86 #include "../includes/ghcconfig.h"
  87
  88 import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
  89 import DataCon          ( ConTag )
  90 import Module           ( moduleName, moduleNameFS,
  91                           Module, isHomeModule )
  92 import Name             ( Name, isDllName, isExternalName )
  93 import Unique           ( pprUnique, Unique )
  94 import PrimOp           ( PrimOp )
  95 import Config           ( cLeadingUnderscore )
  96 import CostCentre       ( CostCentre, CostCentreStack )
  97 import Outputable
  98 import FastString
  99
 100
 101 -- -----------------------------------------------------------------------------
 102 -- The CLabel type
 103
 104 {-
 105 CLabel is an abstract type that supports the following operations:
 106
 107   - Pretty printing
 108
 109   - In a C file, does it need to be declared before use?  (i.e. is it
 110     guaranteed to be already in scope in the places we need to refer to it?)
 111
 112   - If it needs to be declared, what type (code or data) should it be
 113     declared to have?
 114
 115   - Is it visible outside this object file or not?
 116
 117   - Is it "dynamic" (see details below)
 118
 119   - Eq and Ord, so that we can make sets of CLabels (currently only
 120     used in outputting C as far as I can tell, to avoid generating
 121     more than one declaration for any given label).
 122
 123   - Converting an info table label into an entry label.
 124 -}
 125
 126 data CLabel
 127   = IdLabel                     -- A family of labels related to the
 128         Name                    -- definition of a particular Id or Con
 129         IdLabelInfo
 130
 131   | CaseLabel                   -- A family of labels related to a particular
 132                                 -- case expression.
 133         {-# UNPACK #-} !Unique  -- Unique says which case expression
 134         CaseLabelInfo
 135
 136   | AsmTempLabel
 137         {-# UNPACK #-} !Unique
 138
 139   | StringLitLabel
 140         {-# UNPACK #-} !Unique
 141
 142   | ModuleInitLabel
 143         Module                  -- the module name
 144         String                  -- its "way"
 145         -- at some point we might want some kind of version number in
 146         -- the module init label, to guard against compiling modules in
 147         -- the wrong order.  We can't use the interface file version however,
 148         -- because we don't always recompile modules which depend on a module
 149         -- whose version has changed.
 150
 151   | PlainModuleInitLabel Module  -- without the vesrion & way info
 152
 153   | ModuleRegdLabel
 154
 155   | RtsLabel RtsLabelInfo
 156
 157   | ForeignLabel FastString     -- a 'C' (or otherwise foreign) label
 158         (Maybe Int)             -- possible '@n' suffix for stdcall functions
 159                 -- When generating C, the '@n' suffix is omitted, but when
 160                 -- generating assembler we must add it to the label.
 161         Bool                    -- True <=> is dynamic
 162
 163   | CC_Label  CostCentre
 164   | CCS_Label CostCentreStack
 165
 166   deriving (Eq, Ord)
 167
 168
 169 data IdLabelInfo
 170   = Closure             -- Label for closure
 171   | SRT                 -- Static reference table
 172   | SRTDesc             -- Static reference table descriptor
 173   | InfoTbl             -- Info tables for closures; always read-only
 174   | Entry               -- entry point
 175   | Slow                -- slow entry point
 176
 177   | RednCounts          -- Label of place to keep Ticky-ticky  info for
 178                         -- this Id
 179
 180   | Bitmap              -- A bitmap (function or case return)
 181
 182   | ConEntry            -- constructor entry point
 183   | ConInfoTbl          -- corresponding info table
 184   | StaticConEntry      -- static constructor entry point
 185   | StaticInfoTbl       -- corresponding info table
 186
 187   | ClosureTable        -- table of closures for Enum tycons
 188
 189   deriving (Eq, Ord)
 190
 191
 192 data CaseLabelInfo
 193   = CaseReturnPt
 194   | CaseReturnInfo
 195   | CaseAlt ConTag
 196   | CaseDefault
 197   deriving (Eq, Ord)
 198
 199
 200 data RtsLabelInfo
 201   = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-}  -- Selector thunks
 202   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 203
 204   | RtsApInfoTbl Bool{-updatable-} Int{-arity-}         -- AP thunks
 205   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 206
 207   | RtsPrimOp PrimOp
 208
 209   | RtsInfo       LitString     -- misc rts info tables
 210   | RtsEntry      LitString     -- misc rts entry points
 211   | RtsRetInfo    LitString     -- misc rts ret info tables
 212   | RtsRet        LitString     -- misc rts return points
 213   | RtsData       LitString     -- misc rts data bits, eg CHARLIKE_closure
 214   | RtsCode       LitString     -- misc rts code
 215
 216   | RtsInfoFS     FastString    -- misc rts info tables
 217   | RtsEntryFS    FastString    -- misc rts entry points
 218   | RtsRetInfoFS  FastString    -- misc rts ret info tables
 219   | RtsRetFS      FastString    -- misc rts return points
 220   | RtsDataFS     FastString    -- misc rts data bits, eg CHARLIKE_closure
 221   | RtsCodeFS     FastString    -- misc rts code
 222
 223   | RtsSlowTickyCtr String
 224
 225   deriving (Eq, Ord)
 226         -- NOTE: Eq on LitString compares the pointer only, so this isn't
 227         -- a real equality.
 228
 229 -- -----------------------------------------------------------------------------
 230 -- Constructing CLabels
 231
 232 mkClosureLabel          id      = IdLabel id  Closure
 233 mkSRTLabel              id      = IdLabel id  SRT
 234 mkSRTDescLabel          id      = IdLabel id  SRTDesc
 235 mkInfoTableLabel        id      = IdLabel id  InfoTbl
 236 mkEntryLabel            id      = IdLabel id  Entry
 237 mkSlowEntryLabel        id      = IdLabel id  Slow
 238 mkBitmapLabel           id      = IdLabel id  Bitmap
 239 mkRednCountsLabel       id      = IdLabel id  RednCounts
 240
 241 mkConInfoTableLabel     con     = IdLabel con ConInfoTbl
 242 mkConEntryLabel         con     = IdLabel con ConEntry
 243 mkStaticInfoTableLabel  con     = IdLabel con StaticInfoTbl
 244 mkStaticConEntryLabel   con     = IdLabel con StaticConEntry
 245
 246 mkClosureTblLabel       id      = IdLabel id ClosureTable
 247
 248 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 249 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 250 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 251 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 252
 253 mkStringLitLabel                = StringLitLabel
 254 mkAsmTempLabel                  = AsmTempLabel
 255
 256 mkModuleInitLabel               = ModuleInitLabel
 257 mkPlainModuleInitLabel          = PlainModuleInitLabel
 258
 259         -- Some fixed runtime system labels
 260
 261 mkSplitMarkerLabel              = RtsLabel (RtsCode SLIT("__stg_split_marker"))
 262 mkUpdInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 263 mkSeqInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
 264 mkIndStaticInfoLabel            = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
 265 mkMainCapabilityLabel           = RtsLabel (RtsData SLIT("MainCapability"))
 266 mkMAP_FROZEN_infoLabel          = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN"))
 267 mkEMPTY_MVAR_infoLabel          = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
 268
 269 mkTopTickyCtrLabel              = RtsLabel (RtsData SLIT("top_ct"))
 270 mkCAFBlackHoleInfoTableLabel    = RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE"))
 271 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 272                                     RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE"))
 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                 = ModuleRegdLabel
 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 -> Maybe Int -> Bool -> CLabel
 288 mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
 289
 290         -- Cost centres etc.
 291
 292 mkCCLabel       cc              = CC_Label cc
 293 mkCCSLabel      ccs             = CCS_Label ccs
 294
 295 mkRtsInfoLabel      str = RtsLabel (RtsInfo      str)
 296 mkRtsEntryLabel     str = RtsLabel (RtsEntry     str)
 297 mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
 298 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 299 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 300 mkRtsDataLabel      str = RtsLabel (RtsData      str)
 301
 302 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 303 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
 304 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
 305 mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
 306 mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
 307 mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
 308
 309 mkRtsSlowTickyCtrLabel :: String -> CLabel
 310 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 311
 312 -- -----------------------------------------------------------------------------
 313 -- Converting info labels to entry labels.
 314
 315 infoLblToEntryLbl :: CLabel -> CLabel
 316 infoLblToEntryLbl (IdLabel n InfoTbl) = IdLabel n Entry
 317 infoLblToEntryLbl (IdLabel n ConInfoTbl) = IdLabel n ConEntry
 318 infoLblToEntryLbl (IdLabel n StaticInfoTbl) = IdLabel n StaticConEntry
 319 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 320 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 321 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
 322 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
 323 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 324 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 325
 326 entryLblToInfoLbl :: CLabel -> CLabel
 327 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTbl
 328 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTbl
 329 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTbl
 330 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 331 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 332 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
 333 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 334 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 335 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 336
 337 -- -----------------------------------------------------------------------------
 338 -- Does a CLabel need declaring before use or not?
 339
 340 needsCDecl :: CLabel -> Bool
 341   -- False <=> it's pre-declared; don't bother
 342   -- don't bother declaring SRT & Bitmap labels, we always make sure
 343   -- they are defined before use.
 344 needsCDecl (IdLabel _ SRT)              = False
 345 needsCDecl (IdLabel _ SRTDesc)          = False
 346 needsCDecl (IdLabel _ Bitmap)           = False
 347 needsCDecl (IdLabel _ _)                = True
 348 needsCDecl (CaseLabel _ CaseReturnPt)   = True
 349 needsCDecl (CaseLabel _ CaseReturnInfo) = True
 350 needsCDecl (ModuleInitLabel _ _)        = True
 351 needsCDecl (PlainModuleInitLabel _)     = True
 352 needsCDecl ModuleRegdLabel              = False
 353
 354 needsCDecl (CaseLabel _ _)              = False
 355 needsCDecl (StringLitLabel _)           = False
 356 needsCDecl (AsmTempLabel _)             = False
 357 needsCDecl (RtsLabel _)                 = False
 358 needsCDecl (ForeignLabel _ _ _)         = False
 359 needsCDecl (CC_Label _)                 = True
 360 needsCDecl (CCS_Label _)                = True
 361
 362 -- Whether the label is an assembler temporary:
 363
 364 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 365 isAsmTemp (AsmTempLabel _) = True
 366 isAsmTemp _                = False
 367
 368 -- -----------------------------------------------------------------------------
 369 -- Is a CLabel visible outside this object file or not?
 370
 371 -- From the point of view of the code generator, a name is
 372 -- externally visible if it has to be declared as exported
 373 -- in the .o file's symbol table; that is, made non-static.
 374
 375 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 376 externallyVisibleCLabel (CaseLabel _ _)    = False
 377 externallyVisibleCLabel (StringLitLabel _) = False
 378 externallyVisibleCLabel (AsmTempLabel _)   = False
 379 externallyVisibleCLabel (ModuleInitLabel _ _)= True
 380 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 381 externallyVisibleCLabel ModuleRegdLabel    = False
 382 externallyVisibleCLabel (RtsLabel _)       = True
 383 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 384 externallyVisibleCLabel (IdLabel id _)     = isExternalName id
 385 externallyVisibleCLabel (CC_Label _)       = True
 386 externallyVisibleCLabel (CCS_Label _)      = True
 387
 388
 389 -- -----------------------------------------------------------------------------
 390 -- Finding the "type" of a CLabel
 391
 392 -- For generating correct types in label declarations:
 393
 394 data CLabelType
 395   = CodeLabel
 396   | DataLabel
 397
 398 labelType :: CLabel -> CLabelType
 399 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = DataLabel
 400 labelType (RtsLabel (RtsApInfoTbl _ _))       = DataLabel
 401 labelType (RtsLabel (RtsData _))              = DataLabel
 402 labelType (RtsLabel (RtsCode _))              = CodeLabel
 403 labelType (RtsLabel (RtsInfo _))              = DataLabel
 404 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 405 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 406 labelType (RtsLabel (RtsRet _))               = CodeLabel
 407 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 408 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 409 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 410 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 411 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 412 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 413 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 414 labelType (CaseLabel _ CaseReturnPt)          = CodeLabel
 415 labelType (ModuleInitLabel _ _)               = CodeLabel
 416 labelType (PlainModuleInitLabel _)            = CodeLabel
 417
 418 labelType (IdLabel _ info) =
 419   case info of
 420     InfoTbl       -> DataLabel
 421     Closure       -> DataLabel
 422     Bitmap        -> DataLabel
 423     ConInfoTbl    -> DataLabel
 424     StaticInfoTbl -> DataLabel
 425     ClosureTable  -> DataLabel
 426     _             -> CodeLabel
 427
 428 labelType _        = DataLabel
 429
 430
 431 -- -----------------------------------------------------------------------------
 432 -- Does a CLabel need dynamic linkage?
 433
 434 -- When referring to data in code, we need to know whether
 435 -- that data resides in a DLL or not. [Win32 only.]
 436 -- @labelDynamic@ returns @True@ if the label is located
 437 -- in a DLL, be it a data reference or not.
 438
 439 labelDynamic :: CLabel -> Bool
 440 labelDynamic lbl =
 441   case lbl of
 442    RtsLabel _        -> not opt_Static  -- i.e., is the RTS in a DLL or not?
 443    IdLabel n k       -> isDllName n
 444    ForeignLabel _ _ d  -> d
 445    ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
 446    PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
 447    _                 -> False
 448
 449 -- Basically the same as above, but this time for Darwin only.
 450 -- The things that GHC does when labelDynamic returns true are not quite right
 451 -- for Darwin. Also, every ForeignLabel might possibly be from a dynamic library,
 452 -- and a 'false positive' doesn't really hurt on Darwin, so this just returns
 453 -- True for every ForeignLabel.
 454 --
 455 -- ToDo: Clean up DLL-related code so we can do away with the distinction
 456 --       between this and labelDynamic above.
 457
 458 labelCouldBeDynamic (ForeignLabel _ _ _) = True
 459 labelCouldBeDynamic lbl = labelDynamic lbl
 460
 461 {-
 462 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 463 right places. It is used to detect when the abstractC statement of an
 464 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 465
 466 We need at least @Eq@ for @CLabels@, because we want to avoid
 467 duplicate declarations in generating C (see @labelSeenTE@ in
 468 @PprAbsC@).
 469 -}
 470
 471 -----------------------------------------------------------------------------
 472 -- Printing out CLabels.
 473
 474 {-
 475 Convention:
 476
 477       <name>_<type>
 478
 479 where <name> is <Module>_<name> for external names and <unique> for
 480 internal names. <type> is one of the following:
 481
 482          info                   Info table
 483          srt                    Static reference table
 484          srtd                   Static reference table descriptor
 485          entry                  Entry code (function, closure)
 486          slow                   Slow entry code (if any)
 487          ret                    Direct return address
 488          vtbl                   Vector table
 489          <n>_alt                Case alternative (tag n)
 490          dflt                   Default case alternative
 491          btm                    Large bitmap vector
 492          closure                Static closure
 493          con_entry              Dynamic Constructor entry code
 494          con_info               Dynamic Constructor info table
 495          static_entry           Static Constructor entry code
 496          static_info            Static Constructor info table
 497          sel_info               Selector info table
 498          sel_entry              Selector entry code
 499          cc                     Cost centre
 500          ccs                    Cost centre stack
 501
 502 Many of these distinctions are only for documentation reasons.  For
 503 example, _ret is only distinguished from _entry to make it easy to
 504 tell whether a code fragment is a return point or a closure/function
 505 entry.
 506 -}
 507
 508 pprCLabel :: CLabel -> SDoc
 509
 510 #if ! OMIT_NATIVE_CODEGEN
 511 pprCLabel (AsmTempLabel u)
 512   =  getPprStyle $ \ sty ->
 513      if asmStyle sty then
 514         ptext asmTempLabelPrefix <> pprUnique u
 515      else
 516         char '_' <> pprUnique u
 517 #endif
 518
 519 pprCLabel lbl =
 520 #if ! OMIT_NATIVE_CODEGEN
 521     getPprStyle $ \ sty ->
 522     if asmStyle sty then
 523         maybe_underscore (pprAsmCLbl lbl)
 524     else
 525 #endif
 526        pprCLbl lbl
 527
 528 maybe_underscore doc
 529   | underscorePrefix = pp_cSEP <> doc
 530   | otherwise        = doc
 531
 532 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 533 -- (The C compiler does this itself).
 534 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 535    = ftext fs <> char '@' <> int sz
 536 pprAsmCLbl lbl
 537    = pprCLbl lbl
 538
 539 pprCLbl (StringLitLabel u)
 540   = pprUnique u <> ptext SLIT("_str")
 541
 542 pprCLbl (CaseLabel u CaseReturnPt)
 543   = hcat [pprUnique u, ptext SLIT("_ret")]
 544 pprCLbl (CaseLabel u CaseReturnInfo)
 545   = hcat [pprUnique u, ptext SLIT("_info")]
 546 pprCLbl (CaseLabel u (CaseAlt tag))
 547   = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
 548 pprCLbl (CaseLabel u CaseDefault)
 549   = hcat [pprUnique u, ptext SLIT("_dflt")]
 550
 551 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 552 pprCLbl (RtsLabel (RtsData str))   = ptext str
 553 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 554 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 555
 556 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
 557   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 558                 ptext (if upd_reqd
 559                         then SLIT("_upd_info")
 560                         else SLIT("_noupd_info"))
 561         ]
 562
 563 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 564   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 565                 ptext (if upd_reqd
 566                         then SLIT("_upd_entry")
 567                         else SLIT("_noupd_entry"))
 568         ]
 569
 570 pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
 571   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 572                 ptext (if upd_reqd
 573                         then SLIT("_upd_info")
 574                         else SLIT("_noupd_info"))
 575         ]
 576
 577 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 578   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 579                 ptext (if upd_reqd
 580                         then SLIT("_upd_entry")
 581                         else SLIT("_noupd_entry"))
 582         ]
 583
 584 pprCLbl (RtsLabel (RtsInfo fs))
 585   = ptext fs <> ptext SLIT("_info")
 586
 587 pprCLbl (RtsLabel (RtsEntry fs))
 588   = ptext fs <> ptext SLIT("_entry")
 589
 590 pprCLbl (RtsLabel (RtsRetInfo fs))
 591   = ptext fs <> ptext SLIT("_info")
 592
 593 pprCLbl (RtsLabel (RtsRet fs))
 594   = ptext fs <> ptext SLIT("_ret")
 595
 596 pprCLbl (RtsLabel (RtsInfoFS fs))
 597   = ftext fs <> ptext SLIT("_info")
 598
 599 pprCLbl (RtsLabel (RtsEntryFS fs))
 600   = ftext fs <> ptext SLIT("_entry")
 601
 602 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 603   = ftext fs <> ptext SLIT("_info")
 604
 605 pprCLbl (RtsLabel (RtsRetFS fs))
 606   = ftext fs <> ptext SLIT("_ret")
 607
 608 pprCLbl (RtsLabel (RtsPrimOp primop))
 609   = ppr primop <> ptext SLIT("_fast")
 610
 611 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 612   = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
 613
 614 pprCLbl ModuleRegdLabel
 615   = ptext SLIT("_module_registered")
 616
 617 pprCLbl (ForeignLabel str _ _)
 618   = ftext str
 619
 620 pprCLbl (IdLabel id  flavor) = ppr id <> ppIdFlavor flavor
 621
 622 pprCLbl (CC_Label cc)           = ppr cc
 623 pprCLbl (CCS_Label ccs)         = ppr ccs
 624
 625 pprCLbl (ModuleInitLabel mod way)
 626    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 627         <> char '_' <> text way
 628 pprCLbl (PlainModuleInitLabel mod)
 629    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 630
 631 ppIdFlavor :: IdLabelInfo -> SDoc
 632 ppIdFlavor x = pp_cSEP <>
 633                (case x of
 634                        Closure          -> ptext SLIT("closure")
 635                        SRT              -> ptext SLIT("srt")
 636                        SRTDesc          -> ptext SLIT("srtd")
 637                        InfoTbl          -> ptext SLIT("info")
 638                        Entry            -> ptext SLIT("entry")
 639                        Slow             -> ptext SLIT("slow")
 640                        RednCounts       -> ptext SLIT("ct")
 641                        Bitmap           -> ptext SLIT("btm")
 642                        ConEntry         -> ptext SLIT("con_entry")
 643                        ConInfoTbl       -> ptext SLIT("con_info")
 644                        StaticConEntry   -> ptext SLIT("static_entry")
 645                        StaticInfoTbl    -> ptext SLIT("static_info")
 646                        ClosureTable     -> ptext SLIT("closure_tbl")
 647                       )
 648
 649
 650 pp_cSEP = char '_'
 651
 652 -- -----------------------------------------------------------------------------
 653 -- Machine-dependent knowledge about labels.
 654
 655 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 656 underscorePrefix = (cLeadingUnderscore == "YES")
 657
 658 asmTempLabelPrefix :: LitString  -- for formatting labels
 659 asmTempLabelPrefix =
 660 #if alpha_TARGET_OS
 661      {- The alpha assembler likes temporary labels to look like $L123
 662         instead of L123.  (Don't toss the L, because then Lf28
 663         turns into $f28.)
 664      -}
 665      SLIT("$")
 666 #elif darwin_TARGET_OS
 667      SLIT("L")
 668 #else
 669      SLIT(".L")
 670 #endif