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