compiler/cmm/CLabel.hs

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