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         mkSeqInfoLabel,
  52         mkIndStaticInfoLabel,
  53         mkMainCapabilityLabel,
  54         mkMAP_FROZEN_infoLabel,
  55         mkMAP_DIRTY_infoLabel,
  56         mkEMPTY_MVAR_infoLabel,
  57
  58         mkTopTickyCtrLabel,
  59         mkCAFBlackHoleInfoTableLabel,
  60         mkSECAFBlackHoleInfoTableLabel,
  61         mkRtsPrimOpLabel,
  62         mkRtsSlowTickyCtrLabel,
  63
  64         moduleRegdLabel,
  65
  66         mkSelectorInfoLabel,
  67         mkSelectorEntryLabel,
  68
  69         mkRtsInfoLabel,
  70         mkRtsEntryLabel,
  71         mkRtsRetInfoLabel,
  72         mkRtsRetLabel,
  73         mkRtsCodeLabel,
  74         mkRtsDataLabel,
  75
  76         mkRtsInfoLabelFS,
  77         mkRtsEntryLabelFS,
  78         mkRtsRetInfoLabelFS,
  79         mkRtsRetLabelFS,
  80         mkRtsCodeLabelFS,
  81         mkRtsDataLabelFS,
  82
  83         mkRtsApFastLabel,
  84
  85         mkForeignLabel,
  86
  87         mkCCLabel, mkCCSLabel,
  88
  89         DynamicLinkerLabelInfo(..),
  90         mkDynamicLinkerLabel,
  91         dynamicLinkerLabelInfo,
  92
  93         mkPicBaseLabel,
  94         mkDeadStripPreventer,
  95
  96         mkHpcTicksLabel,
  97         mkHpcModuleNameLabel,
  98
  99         infoLblToEntryLbl, entryLblToInfoLbl,
 100         needsCDecl, isAsmTemp, externallyVisibleCLabel,
 101         CLabelType(..), labelType, labelDynamic,
 102
 103         pprCLabel
 104     ) where
 105
 106
 107 #include "HsVersions.h"
 108
 109 import StaticFlags
 110 import Packages
 111 import DataCon
 112 import PackageConfig
 113 import Module
 114 import Name
 115 import Unique
 116 import PrimOp
 117 import Config
 118 import CostCentre
 119 import Outputable
 120 import FastString
 121
 122 -- -----------------------------------------------------------------------------
 123 -- The CLabel type
 124
 125 {-
 126 CLabel is an abstract type that supports the following operations:
 127
 128   - Pretty printing
 129
 130   - In a C file, does it need to be declared before use?  (i.e. is it
 131     guaranteed to be already in scope in the places we need to refer to it?)
 132
 133   - If it needs to be declared, what type (code or data) should it be
 134     declared to have?
 135
 136   - Is it visible outside this object file or not?
 137
 138   - Is it "dynamic" (see details below)
 139
 140   - Eq and Ord, so that we can make sets of CLabels (currently only
 141     used in outputting C as far as I can tell, to avoid generating
 142     more than one declaration for any given label).
 143
 144   - Converting an info table label into an entry label.
 145 -}
 146
 147 data CLabel
 148   = IdLabel                     -- A family of labels related to the
 149         Name                    -- definition of a particular Id or Con
 150         IdLabelInfo
 151
 152   | DynIdLabel                  -- like IdLabel, but in a separate package,
 153         Name                    -- and might therefore need a dynamic
 154         IdLabelInfo             -- reference.
 155
 156   | CaseLabel                   -- A family of labels related to a particular
 157                                 -- case expression.
 158         {-# UNPACK #-} !Unique  -- Unique says which case expression
 159         CaseLabelInfo
 160
 161   | AsmTempLabel
 162         {-# UNPACK #-} !Unique
 163
 164   | StringLitLabel
 165         {-# UNPACK #-} !Unique
 166
 167   | ModuleInitLabel
 168         Module                  -- the module name
 169         String                  -- its "way"
 170         Bool                    -- True <=> is in a different package
 171         -- at some point we might want some kind of version number in
 172         -- the module init label, to guard against compiling modules in
 173         -- the wrong order.  We can't use the interface file version however,
 174         -- because we don't always recompile modules which depend on a module
 175         -- whose version has changed.
 176
 177   | PlainModuleInitLabel        -- without the vesrion & way info
 178         Module
 179         Bool                    -- True <=> is in a different package
 180
 181   | ModuleRegdLabel
 182
 183   | RtsLabel RtsLabelInfo
 184
 185   | ForeignLabel FastString     -- a 'C' (or otherwise foreign) label
 186         (Maybe Int)             -- possible '@n' suffix for stdcall functions
 187                 -- When generating C, the '@n' suffix is omitted, but when
 188                 -- generating assembler we must add it to the label.
 189         Bool                    -- True <=> is dynamic
 190
 191   | CC_Label  CostCentre
 192   | CCS_Label CostCentreStack
 193
 194       -- Dynamic Linking in the NCG:
 195       -- generated and used inside the NCG only,
 196       -- see module PositionIndependentCode for details.
 197
 198   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 199         -- special variants of a label used for dynamic linking
 200
 201   | PicBaseLabel                -- a label used as a base for PIC calculations
 202                                 -- on some platforms.
 203                                 -- It takes the form of a local numeric
 204                                 -- assembler label '1'; it is pretty-printed
 205                                 -- as 1b, referring to the previous definition
 206                                 -- of 1: in the assembler source file.
 207
 208   | DeadStripPreventer CLabel
 209     -- label before an info table to prevent excessive dead-stripping on darwin
 210
 211   | HpcTicksLabel Module       -- Per-module table of tick locations
 212   | HpcModuleNameLabel         -- Per-module name of the module for Hpc
 213
 214   deriving (Eq, Ord)
 215
 216 data IdLabelInfo
 217   = Closure             -- Label for closure
 218   | SRT                 -- Static reference table
 219   | SRTDesc             -- Static reference table descriptor
 220   | InfoTable           -- Info tables for closures; always read-only
 221   | Entry               -- entry point
 222   | Slow                -- slow entry point
 223
 224   | RednCounts          -- Label of place to keep Ticky-ticky  info for
 225                         -- this Id
 226
 227   | Bitmap              -- A bitmap (function or case return)
 228
 229   | ConEntry            -- constructor entry point
 230   | ConInfoTable                -- corresponding info table
 231   | StaticConEntry      -- static constructor entry point
 232   | StaticInfoTable     -- corresponding info table
 233
 234   | ClosureTable        -- table of closures for Enum tycons
 235
 236   deriving (Eq, Ord)
 237
 238
 239 data CaseLabelInfo
 240   = CaseReturnPt
 241   | CaseReturnInfo
 242   | CaseAlt ConTag
 243   | CaseDefault
 244   deriving (Eq, Ord)
 245
 246
 247 data RtsLabelInfo
 248   = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}        -- Selector thunks
 249   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 250
 251   | RtsApInfoTable Bool{-updatable-} Int{-arity-}               -- AP thunks
 252   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 253
 254   | RtsPrimOp PrimOp
 255
 256   | RtsInfo       LitString     -- misc rts info tables
 257   | RtsEntry      LitString     -- misc rts entry points
 258   | RtsRetInfo    LitString     -- misc rts ret info tables
 259   | RtsRet        LitString     -- misc rts return points
 260   | RtsData       LitString     -- misc rts data bits, eg CHARLIKE_closure
 261   | RtsCode       LitString     -- misc rts code
 262
 263   | RtsInfoFS     FastString    -- misc rts info tables
 264   | RtsEntryFS    FastString    -- misc rts entry points
 265   | RtsRetInfoFS  FastString    -- misc rts ret info tables
 266   | RtsRetFS      FastString    -- misc rts return points
 267   | RtsDataFS     FastString    -- misc rts data bits, eg CHARLIKE_closure
 268   | RtsCodeFS     FastString    -- misc rts code
 269
 270   | RtsApFast   LitString       -- _fast versions of generic apply
 271
 272   | RtsSlowTickyCtr String
 273
 274   deriving (Eq, Ord)
 275         -- NOTE: Eq on LitString compares the pointer only, so this isn't
 276         -- a real equality.
 277
 278 data DynamicLinkerLabelInfo
 279   = CodeStub            -- MachO: Lfoo$stub, ELF: foo@plt
 280   | SymbolPtr           -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
 281   | GotSymbolPtr        -- ELF: foo@got
 282   | GotSymbolOffset     -- ELF: foo@gotoff
 283
 284   deriving (Eq, Ord)
 285
 286 -- -----------------------------------------------------------------------------
 287 -- Constructing CLabels
 288
 289 -- These are always local:
 290 mkSRTLabel              name    = IdLabel name  SRT
 291 mkSRTDescLabel          name    = IdLabel name  SRTDesc
 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
 338 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 339 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 340 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 341 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 342
 343 mkStringLitLabel                = StringLitLabel
 344 mkAsmTempLabel                  = AsmTempLabel
 345
 346 mkModuleInitLabel :: PackageId -> Module -> String -> CLabel
 347 mkModuleInitLabel this_pkg mod way
 348   = ModuleInitLabel mod way $! modulePackageId mod /= this_pkg
 349
 350 mkPlainModuleInitLabel :: PackageId -> Module -> CLabel
 351 mkPlainModuleInitLabel this_pkg mod
 352   = PlainModuleInitLabel mod $! modulePackageId mod /= this_pkg
 353
 354         -- Some fixed runtime system labels
 355
 356 mkSplitMarkerLabel              = RtsLabel (RtsCode SLIT("__stg_split_marker"))
 357 mkDirty_MUT_VAR_Label           = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
 358 mkUpdInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 359 mkSeqInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_seq_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 (IdLabel _ SRTDesc)          = 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 -- -----------------------------------------------------------------------------
 497 -- Is a CLabel visible outside this object file or not?
 498
 499 -- From the point of view of the code generator, a name is
 500 -- externally visible if it has to be declared as exported
 501 -- in the .o file's symbol table; that is, made non-static.
 502
 503 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 504 externallyVisibleCLabel (CaseLabel _ _)    = False
 505 externallyVisibleCLabel (StringLitLabel _) = False
 506 externallyVisibleCLabel (AsmTempLabel _)   = False
 507 externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
 508 externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
 509 externallyVisibleCLabel ModuleRegdLabel    = False
 510 externallyVisibleCLabel (RtsLabel _)       = True
 511 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 512 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 513 externallyVisibleCLabel (DynIdLabel name _)  = isExternalName name
 514 externallyVisibleCLabel (CC_Label _)       = True
 515 externallyVisibleCLabel (CCS_Label _)      = True
 516 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 517 externallyVisibleCLabel (HpcTicksLabel _)   = True
 518 externallyVisibleCLabel HpcModuleNameLabel      = False
 519
 520 -- -----------------------------------------------------------------------------
 521 -- Finding the "type" of a CLabel
 522
 523 -- For generating correct types in label declarations:
 524
 525 data CLabelType
 526   = CodeLabel
 527   | DataLabel
 528
 529 labelType :: CLabel -> CLabelType
 530 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 531 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 532 labelType (RtsLabel (RtsData _))              = DataLabel
 533 labelType (RtsLabel (RtsCode _))              = CodeLabel
 534 labelType (RtsLabel (RtsInfo _))              = DataLabel
 535 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 536 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 537 labelType (RtsLabel (RtsRet _))               = CodeLabel
 538 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 539 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 540 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 541 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 542 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 543 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 544 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 545 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 546 labelType (CaseLabel _ _)                     = CodeLabel
 547 labelType (ModuleInitLabel _ _ _)             = CodeLabel
 548 labelType (PlainModuleInitLabel _ _)          = CodeLabel
 549
 550 labelType (IdLabel _ info) = idInfoLabelType info
 551 labelType (DynIdLabel _ info) = idInfoLabelType info
 552 labelType _        = DataLabel
 553
 554 idInfoLabelType info =
 555   case info of
 556     InfoTable     -> DataLabel
 557     Closure       -> DataLabel
 558     Bitmap        -> DataLabel
 559     ConInfoTable  -> DataLabel
 560     StaticInfoTable -> DataLabel
 561     ClosureTable  -> DataLabel
 562     _             -> CodeLabel
 563
 564
 565 -- -----------------------------------------------------------------------------
 566 -- Does a CLabel need dynamic linkage?
 567
 568 -- When referring to data in code, we need to know whether
 569 -- that data resides in a DLL or not. [Win32 only.]
 570 -- @labelDynamic@ returns @True@ if the label is located
 571 -- in a DLL, be it a data reference or not.
 572
 573 labelDynamic :: CLabel -> Bool
 574 labelDynamic lbl =
 575   case lbl of
 576    RtsLabel _        -> not opt_Static  -- i.e., is the RTS in a DLL or not?
 577    IdLabel n k       -> False
 578    DynIdLabel n k    -> True
 579 #if mingw32_TARGET_OS
 580    ForeignLabel _ _ d  -> d
 581 #else
 582    -- On Mac OS X and on ELF platforms, false positives are OK,
 583    -- so we claim that all foreign imports come from dynamic libraries
 584    ForeignLabel _ _ _ -> True
 585 #endif
 586    ModuleInitLabel m _ dyn    -> not opt_Static && dyn
 587    PlainModuleInitLabel m dyn -> not opt_Static && dyn
 588
 589    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 590    _                 -> False
 591
 592 {-
 593 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 594 right places. It is used to detect when the abstractC statement of an
 595 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 596
 597 We need at least @Eq@ for @CLabels@, because we want to avoid
 598 duplicate declarations in generating C (see @labelSeenTE@ in
 599 @PprAbsC@).
 600 -}
 601
 602 -----------------------------------------------------------------------------
 603 -- Printing out CLabels.
 604
 605 {-
 606 Convention:
 607
 608       <name>_<type>
 609
 610 where <name> is <Module>_<name> for external names and <unique> for
 611 internal names. <type> is one of the following:
 612
 613          info                   Info table
 614          srt                    Static reference table
 615          srtd                   Static reference table descriptor
 616          entry                  Entry code (function, closure)
 617          slow                   Slow entry code (if any)
 618          ret                    Direct return address
 619          vtbl                   Vector table
 620          <n>_alt                Case alternative (tag n)
 621          dflt                   Default case alternative
 622          btm                    Large bitmap vector
 623          closure                Static closure
 624          con_entry              Dynamic Constructor entry code
 625          con_info               Dynamic Constructor info table
 626          static_entry           Static Constructor entry code
 627          static_info            Static Constructor info table
 628          sel_info               Selector info table
 629          sel_entry              Selector entry code
 630          cc                     Cost centre
 631          ccs                    Cost centre stack
 632
 633 Many of these distinctions are only for documentation reasons.  For
 634 example, _ret is only distinguished from _entry to make it easy to
 635 tell whether a code fragment is a return point or a closure/function
 636 entry.
 637 -}
 638
 639 instance Outputable CLabel where
 640   ppr = pprCLabel
 641
 642 pprCLabel :: CLabel -> SDoc
 643
 644 #if ! OMIT_NATIVE_CODEGEN
 645 pprCLabel (AsmTempLabel u)
 646   =  getPprStyle $ \ sty ->
 647      if asmStyle sty then
 648         ptext asmTempLabelPrefix <> pprUnique u
 649      else
 650         char '_' <> pprUnique u
 651
 652 pprCLabel (DynamicLinkerLabel info lbl)
 653    = pprDynamicLinkerAsmLabel info lbl
 654
 655 pprCLabel PicBaseLabel
 656    = ptext SLIT("1b")
 657
 658 pprCLabel (DeadStripPreventer lbl)
 659    = pprCLabel lbl <> ptext SLIT("_dsp")
 660 #endif
 661
 662 pprCLabel lbl =
 663 #if ! OMIT_NATIVE_CODEGEN
 664     getPprStyle $ \ sty ->
 665     if asmStyle sty then
 666         maybe_underscore (pprAsmCLbl lbl)
 667     else
 668 #endif
 669        pprCLbl lbl
 670
 671 maybe_underscore doc
 672   | underscorePrefix = pp_cSEP <> doc
 673   | otherwise        = doc
 674
 675 #ifdef mingw32_TARGET_OS
 676 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 677 -- (The C compiler does this itself).
 678 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 679    = ftext fs <> char '@' <> int sz
 680 #endif
 681 pprAsmCLbl lbl
 682    = pprCLbl lbl
 683
 684 pprCLbl (StringLitLabel u)
 685   = pprUnique u <> ptext SLIT("_str")
 686
 687 pprCLbl (CaseLabel u CaseReturnPt)
 688   = hcat [pprUnique u, ptext SLIT("_ret")]
 689 pprCLbl (CaseLabel u CaseReturnInfo)
 690   = hcat [pprUnique u, ptext SLIT("_info")]
 691 pprCLbl (CaseLabel u (CaseAlt tag))
 692   = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
 693 pprCLbl (CaseLabel u CaseDefault)
 694   = hcat [pprUnique u, ptext SLIT("_dflt")]
 695
 696 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 697 pprCLbl (RtsLabel (RtsData str))   = ptext str
 698 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 699 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 700
 701 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
 702
 703 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 704   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 705                 ptext (if upd_reqd
 706                         then SLIT("_upd_info")
 707                         else SLIT("_noupd_info"))
 708         ]
 709
 710 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 711   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 712                 ptext (if upd_reqd
 713                         then SLIT("_upd_entry")
 714                         else SLIT("_noupd_entry"))
 715         ]
 716
 717 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 718   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 719                 ptext (if upd_reqd
 720                         then SLIT("_upd_info")
 721                         else SLIT("_noupd_info"))
 722         ]
 723
 724 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 725   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 726                 ptext (if upd_reqd
 727                         then SLIT("_upd_entry")
 728                         else SLIT("_noupd_entry"))
 729         ]
 730
 731 pprCLbl (RtsLabel (RtsInfo fs))
 732   = ptext fs <> ptext SLIT("_info")
 733
 734 pprCLbl (RtsLabel (RtsEntry fs))
 735   = ptext fs <> ptext SLIT("_entry")
 736
 737 pprCLbl (RtsLabel (RtsRetInfo fs))
 738   = ptext fs <> ptext SLIT("_info")
 739
 740 pprCLbl (RtsLabel (RtsRet fs))
 741   = ptext fs <> ptext SLIT("_ret")
 742
 743 pprCLbl (RtsLabel (RtsInfoFS fs))
 744   = ftext fs <> ptext SLIT("_info")
 745
 746 pprCLbl (RtsLabel (RtsEntryFS fs))
 747   = ftext fs <> ptext SLIT("_entry")
 748
 749 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 750   = ftext fs <> ptext SLIT("_info")
 751
 752 pprCLbl (RtsLabel (RtsRetFS fs))
 753   = ftext fs <> ptext SLIT("_ret")
 754
 755 pprCLbl (RtsLabel (RtsPrimOp primop))
 756   = ppr primop <> ptext SLIT("_fast")
 757
 758 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 759   = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
 760
 761 pprCLbl ModuleRegdLabel
 762   = ptext SLIT("_module_registered")
 763
 764 pprCLbl (ForeignLabel str _ _)
 765   = ftext str
 766
 767 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 768 pprCLbl (DynIdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 769
 770 pprCLbl (CC_Label cc)           = ppr cc
 771 pprCLbl (CCS_Label ccs)         = ppr ccs
 772
 773 pprCLbl (ModuleInitLabel mod way _)
 774    = ptext SLIT("__stginit_") <> ppr mod
 775         <> char '_' <> text way
 776 pprCLbl (PlainModuleInitLabel mod _)
 777    = ptext SLIT("__stginit_") <> ppr mod
 778
 779 pprCLbl (HpcTicksLabel mod)
 780   = ptext SLIT("_tickboxes_")  <> ppr mod <> ptext SLIT("_hpc")
 781
 782 pprCLbl HpcModuleNameLabel
 783   = ptext SLIT("_hpc_module_name_str")
 784
 785 ppIdFlavor :: IdLabelInfo -> SDoc
 786 ppIdFlavor x = pp_cSEP <>
 787                (case x of
 788                        Closure          -> ptext SLIT("closure")
 789                        SRT              -> ptext SLIT("srt")
 790                        SRTDesc          -> ptext SLIT("srtd")
 791                        InfoTable        -> ptext SLIT("info")
 792                        Entry            -> ptext SLIT("entry")
 793                        Slow             -> ptext SLIT("slow")
 794                        RednCounts       -> ptext SLIT("ct")
 795                        Bitmap           -> ptext SLIT("btm")
 796                        ConEntry         -> ptext SLIT("con_entry")
 797                        ConInfoTable     -> ptext SLIT("con_info")
 798                        StaticConEntry   -> ptext SLIT("static_entry")
 799                        StaticInfoTable  -> ptext SLIT("static_info")
 800                        ClosureTable     -> ptext SLIT("closure_tbl")
 801                       )
 802
 803
 804 pp_cSEP = char '_'
 805
 806 -- -----------------------------------------------------------------------------
 807 -- Machine-dependent knowledge about labels.
 808
 809 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 810 underscorePrefix = (cLeadingUnderscore == "YES")
 811
 812 asmTempLabelPrefix :: LitString  -- for formatting labels
 813 asmTempLabelPrefix =
 814 #if alpha_TARGET_OS
 815      {- The alpha assembler likes temporary labels to look like $L123
 816         instead of L123.  (Don't toss the L, because then Lf28
 817         turns into $f28.)
 818      -}
 819      SLIT("$")
 820 #elif darwin_TARGET_OS
 821      SLIT("L")
 822 #else
 823      SLIT(".L")
 824 #endif
 825
 826 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 827
 828 #if darwin_TARGET_OS
 829 pprDynamicLinkerAsmLabel CodeStub lbl
 830   = char 'L' <> pprCLabel lbl <> text "$stub"
 831 pprDynamicLinkerAsmLabel SymbolPtr lbl
 832   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 833 pprDynamicLinkerAsmLabel _ _
 834   = panic "pprDynamicLinkerAsmLabel"
 835 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 836 pprDynamicLinkerAsmLabel CodeStub lbl
 837   = pprCLabel lbl <> text "@plt"
 838 pprDynamicLinkerAsmLabel SymbolPtr lbl
 839   = text ".LC_" <> pprCLabel lbl
 840 pprDynamicLinkerAsmLabel _ _
 841   = panic "pprDynamicLinkerAsmLabel"
 842 #elif linux_TARGET_OS
 843 pprDynamicLinkerAsmLabel CodeStub lbl
 844   = pprCLabel lbl <> text "@plt"
 845 pprDynamicLinkerAsmLabel SymbolPtr lbl
 846   = text ".LC_" <> pprCLabel lbl
 847 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 848   = pprCLabel lbl <> text "@got"
 849 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 850   = pprCLabel lbl <> text "@gotoff"
 851 #elif mingw32_TARGET_OS
 852 pprDynamicLinkerAsmLabel SymbolPtr lbl
 853   = text "__imp_" <> pprCLabel lbl
 854 pprDynamicLinkerAsmLabel _ _
 855   = panic "pprDynamicLinkerAsmLabel"
 856 #else
 857 pprDynamicLinkerAsmLabel _ _
 858   = panic "pprDynamicLinkerAsmLabel"
 859 #endif