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