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