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