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