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