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