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