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