compiler/cmm/CLabel.hs

   1 {-# OPTIONS -w #-}
   2 -- The above warning supression flag is a temporary kludge.
   3 -- While working on this module you are encouraged to remove it and fix
   4 -- any warnings in the module. See
   5 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   6 -- for details
   7
   8 -----------------------------------------------------------------------------
   9 --
  10 -- Object-file symbols (called CLabel for histerical raisins).
  11 --
  12 -- (c) The University of Glasgow 2004-2006
  13 --
  14 -----------------------------------------------------------------------------
  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 :: Uniquable a => a -> CLabel
 329 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
 330
 331 mkModuleInitLabel :: Module -> String -> CLabel
 332 mkModuleInitLabel mod way        = ModuleInitLabel mod way
 333
 334 mkPlainModuleInitLabel :: Module -> CLabel
 335 mkPlainModuleInitLabel mod       = PlainModuleInitLabel mod
 336
 337         -- Some fixed runtime system labels
 338
 339 mkSplitMarkerLabel              = RtsLabel (RtsCode SLIT("__stg_split_marker"))
 340 mkDirty_MUT_VAR_Label           = RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
 341 mkUpdInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 342 mkIndStaticInfoLabel            = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
 343 mkMainCapabilityLabel           = RtsLabel (RtsData SLIT("MainCapability"))
 344 mkMAP_FROZEN_infoLabel          = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
 345 mkMAP_DIRTY_infoLabel           = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
 346 mkEMPTY_MVAR_infoLabel          = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
 347
 348 mkTopTickyCtrLabel              = RtsLabel (RtsData SLIT("top_ct"))
 349 mkCAFBlackHoleInfoTableLabel    = RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE"))
 350 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 351                                     RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE"))
 352                                   else  -- RTS won't have info table unless -ticky is on
 353                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 354 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 355
 356 moduleRegdLabel                 = ModuleRegdLabel
 357
 358 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
 359 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry   upd off)
 360
 361 mkApInfoTableLabel  upd off     = RtsLabel (RtsApInfoTable upd off)
 362 mkApEntryLabel upd off          = RtsLabel (RtsApEntry   upd off)
 363
 364         -- Foreign labels
 365
 366 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
 367 mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
 368
 369 addLabelSize :: CLabel -> Int -> CLabel
 370 addLabelSize (ForeignLabel str _ is_dynamic) sz
 371   = ForeignLabel str (Just sz) is_dynamic
 372 addLabelSize label _
 373   = label
 374
 375         -- Cost centres etc.
 376
 377 mkCCLabel       cc              = CC_Label cc
 378 mkCCSLabel      ccs             = CCS_Label ccs
 379
 380 mkRtsInfoLabel      str = RtsLabel (RtsInfo      str)
 381 mkRtsEntryLabel     str = RtsLabel (RtsEntry     str)
 382 mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
 383 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 384 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 385 mkRtsDataLabel      str = RtsLabel (RtsData      str)
 386
 387 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 388 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
 389 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
 390 mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
 391 mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
 392 mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
 393
 394 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 395
 396 mkRtsSlowTickyCtrLabel :: String -> CLabel
 397 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 398
 399         -- Coverage
 400
 401 mkHpcTicksLabel                = HpcTicksLabel
 402 mkHpcModuleNameLabel           = HpcModuleNameLabel
 403
 404         -- Dynamic linking
 405
 406 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
 407 mkDynamicLinkerLabel = DynamicLinkerLabel
 408
 409 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
 410 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
 411 dynamicLinkerLabelInfo _ = Nothing
 412
 413         -- Position independent code
 414
 415 mkPicBaseLabel :: CLabel
 416 mkPicBaseLabel = PicBaseLabel
 417
 418 mkDeadStripPreventer :: CLabel -> CLabel
 419 mkDeadStripPreventer lbl = DeadStripPreventer lbl
 420
 421 -- -----------------------------------------------------------------------------
 422 -- Converting between info labels and entry/ret labels.
 423
 424 infoLblToEntryLbl :: CLabel -> CLabel
 425 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
 426 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
 427 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
 428 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 429 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 430 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
 431 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
 432 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 433 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 434
 435 entryLblToInfoLbl :: CLabel -> CLabel
 436 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
 437 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
 438 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
 439 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 440 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 441 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
 442 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 443 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 444 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 445
 446 -- -----------------------------------------------------------------------------
 447 -- Does a CLabel need declaring before use or not?
 448
 449 needsCDecl :: CLabel -> Bool
 450   -- False <=> it's pre-declared; don't bother
 451   -- don't bother declaring SRT & Bitmap labels, we always make sure
 452   -- they are defined before use.
 453 needsCDecl (IdLabel _ SRT)              = False
 454 needsCDecl (LargeSRTLabel _)            = False
 455 needsCDecl (LargeBitmapLabel _)         = False
 456 needsCDecl (IdLabel _ _)                = True
 457 needsCDecl (CaseLabel _ _)              = True
 458 needsCDecl (ModuleInitLabel _ _)        = True
 459 needsCDecl (PlainModuleInitLabel _)     = True
 460 needsCDecl ModuleRegdLabel              = False
 461
 462 needsCDecl (StringLitLabel _)           = False
 463 needsCDecl (AsmTempLabel _)             = False
 464 needsCDecl (RtsLabel _)                 = False
 465 needsCDecl (ForeignLabel _ _ _)         = False
 466 needsCDecl (CC_Label _)                 = True
 467 needsCDecl (CCS_Label _)                = True
 468 needsCDecl (HpcTicksLabel _)            = True
 469 needsCDecl HpcModuleNameLabel           = False
 470
 471 -- Whether the label is an assembler temporary:
 472
 473 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 474 isAsmTemp (AsmTempLabel _) = True
 475 isAsmTemp _                = False
 476
 477 maybeAsmTemp :: CLabel -> Maybe Unique
 478 maybeAsmTemp (AsmTempLabel uq) = Just uq
 479 maybeAsmTemp _                 = Nothing
 480
 481 -- -----------------------------------------------------------------------------
 482 -- Is a CLabel visible outside this object file or not?
 483
 484 -- From the point of view of the code generator, a name is
 485 -- externally visible if it has to be declared as exported
 486 -- in the .o file's symbol table; that is, made non-static.
 487
 488 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 489 externallyVisibleCLabel (CaseLabel _ _)    = False
 490 externallyVisibleCLabel (StringLitLabel _) = False
 491 externallyVisibleCLabel (AsmTempLabel _)   = False
 492 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 493 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 494 externallyVisibleCLabel ModuleRegdLabel    = False
 495 externallyVisibleCLabel (RtsLabel _)       = True
 496 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 497 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 498 externallyVisibleCLabel (CC_Label _)       = True
 499 externallyVisibleCLabel (CCS_Label _)      = True
 500 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 501 externallyVisibleCLabel (HpcTicksLabel _)   = True
 502 externallyVisibleCLabel HpcModuleNameLabel      = False
 503 externallyVisibleCLabel (LargeBitmapLabel _) = False
 504 externallyVisibleCLabel (LargeSRTLabel _) = False
 505
 506 -- -----------------------------------------------------------------------------
 507 -- Finding the "type" of a CLabel
 508
 509 -- For generating correct types in label declarations:
 510
 511 data CLabelType
 512   = CodeLabel
 513   | DataLabel
 514
 515 labelType :: CLabel -> CLabelType
 516 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 517 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 518 labelType (RtsLabel (RtsData _))              = DataLabel
 519 labelType (RtsLabel (RtsCode _))              = CodeLabel
 520 labelType (RtsLabel (RtsInfo _))              = DataLabel
 521 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 522 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 523 labelType (RtsLabel (RtsRet _))               = CodeLabel
 524 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 525 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 526 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 527 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 528 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 529 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 530 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 531 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 532 labelType (CaseLabel _ _)                     = CodeLabel
 533 labelType (ModuleInitLabel _ _)               = CodeLabel
 534 labelType (PlainModuleInitLabel _)            = CodeLabel
 535 labelType (LargeSRTLabel _)                   = DataLabel
 536 labelType (LargeBitmapLabel _)                = DataLabel
 537
 538 labelType (IdLabel _ info) = idInfoLabelType info
 539 labelType _        = DataLabel
 540
 541 idInfoLabelType info =
 542   case info of
 543     InfoTable     -> DataLabel
 544     Closure       -> DataLabel
 545     ConInfoTable  -> DataLabel
 546     StaticInfoTable -> DataLabel
 547     ClosureTable  -> DataLabel
 548 -- krc: aie! a ticky counter label is data
 549     RednCounts    -> DataLabel
 550     _             -> CodeLabel
 551
 552
 553 -- -----------------------------------------------------------------------------
 554 -- Does a CLabel need dynamic linkage?
 555
 556 -- When referring to data in code, we need to know whether
 557 -- that data resides in a DLL or not. [Win32 only.]
 558 -- @labelDynamic@ returns @True@ if the label is located
 559 -- in a DLL, be it a data reference or not.
 560
 561 labelDynamic :: PackageId -> CLabel -> Bool
 562 labelDynamic this_pkg lbl =
 563   case lbl of
 564    RtsLabel _        -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 565    IdLabel n k       -> isDllName this_pkg n
 566 #if mingw32_TARGET_OS
 567    ForeignLabel _ _ d  -> d
 568 #else
 569    -- On Mac OS X and on ELF platforms, false positives are OK,
 570    -- so we claim that all foreign imports come from dynamic libraries
 571    ForeignLabel _ _ _ -> True
 572 #endif
 573    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
 574    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 575
 576    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 577    _                 -> False
 578
 579 {-
 580 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 581 right places. It is used to detect when the abstractC statement of an
 582 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 583
 584 We need at least @Eq@ for @CLabels@, because we want to avoid
 585 duplicate declarations in generating C (see @labelSeenTE@ in
 586 @PprAbsC@).
 587 -}
 588
 589 -----------------------------------------------------------------------------
 590 -- Printing out CLabels.
 591
 592 {-
 593 Convention:
 594
 595       <name>_<type>
 596
 597 where <name> is <Module>_<name> for external names and <unique> for
 598 internal names. <type> is one of the following:
 599
 600          info                   Info table
 601          srt                    Static reference table
 602          srtd                   Static reference table descriptor
 603          entry                  Entry code (function, closure)
 604          slow                   Slow entry code (if any)
 605          ret                    Direct return address
 606          vtbl                   Vector table
 607          <n>_alt                Case alternative (tag n)
 608          dflt                   Default case alternative
 609          btm                    Large bitmap vector
 610          closure                Static closure
 611          con_entry              Dynamic Constructor entry code
 612          con_info               Dynamic Constructor info table
 613          static_entry           Static Constructor entry code
 614          static_info            Static Constructor info table
 615          sel_info               Selector info table
 616          sel_entry              Selector entry code
 617          cc                     Cost centre
 618          ccs                    Cost centre stack
 619
 620 Many of these distinctions are only for documentation reasons.  For
 621 example, _ret is only distinguished from _entry to make it easy to
 622 tell whether a code fragment is a return point or a closure/function
 623 entry.
 624 -}
 625
 626 instance Outputable CLabel where
 627   ppr = pprCLabel
 628
 629 pprCLabel :: CLabel -> SDoc
 630
 631 #if ! OMIT_NATIVE_CODEGEN
 632 pprCLabel (AsmTempLabel u)
 633   =  getPprStyle $ \ sty ->
 634      if asmStyle sty then
 635         ptext asmTempLabelPrefix <> pprUnique u
 636      else
 637         char '_' <> pprUnique u
 638
 639 pprCLabel (DynamicLinkerLabel info lbl)
 640    = pprDynamicLinkerAsmLabel info lbl
 641
 642 pprCLabel PicBaseLabel
 643    = ptext SLIT("1b")
 644
 645 pprCLabel (DeadStripPreventer lbl)
 646    = pprCLabel lbl <> ptext SLIT("_dsp")
 647 #endif
 648
 649 pprCLabel lbl =
 650 #if ! OMIT_NATIVE_CODEGEN
 651     getPprStyle $ \ sty ->
 652     if asmStyle sty then
 653         maybe_underscore (pprAsmCLbl lbl)
 654     else
 655 #endif
 656        pprCLbl lbl
 657
 658 maybe_underscore doc
 659   | underscorePrefix = pp_cSEP <> doc
 660   | otherwise        = doc
 661
 662 #ifdef mingw32_TARGET_OS
 663 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 664 -- (The C compiler does this itself).
 665 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 666    = ftext fs <> char '@' <> int sz
 667 #endif
 668 pprAsmCLbl lbl
 669    = pprCLbl lbl
 670
 671 pprCLbl (StringLitLabel u)
 672   = pprUnique u <> ptext SLIT("_str")
 673
 674 pprCLbl (CaseLabel u CaseReturnPt)
 675   = hcat [pprUnique u, ptext SLIT("_ret")]
 676 pprCLbl (CaseLabel u CaseReturnInfo)
 677   = hcat [pprUnique u, ptext SLIT("_info")]
 678 pprCLbl (CaseLabel u (CaseAlt tag))
 679   = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
 680 pprCLbl (CaseLabel u CaseDefault)
 681   = hcat [pprUnique u, ptext SLIT("_dflt")]
 682
 683 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
 684 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
 685 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 686 -- until that gets resolved we'll just force them to start
 687 -- with a letter so the label will be legal assmbly code.
 688
 689
 690 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 691 pprCLbl (RtsLabel (RtsData str))   = ptext str
 692 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 693 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 694
 695 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
 696
 697 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 698   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 699                 ptext (if upd_reqd
 700                         then SLIT("_upd_info")
 701                         else SLIT("_noupd_info"))
 702         ]
 703
 704 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 705   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 706                 ptext (if upd_reqd
 707                         then SLIT("_upd_entry")
 708                         else SLIT("_noupd_entry"))
 709         ]
 710
 711 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 712   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 713                 ptext (if upd_reqd
 714                         then SLIT("_upd_info")
 715                         else SLIT("_noupd_info"))
 716         ]
 717
 718 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 719   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 720                 ptext (if upd_reqd
 721                         then SLIT("_upd_entry")
 722                         else SLIT("_noupd_entry"))
 723         ]
 724
 725 pprCLbl (RtsLabel (RtsInfo fs))
 726   = ptext fs <> ptext SLIT("_info")
 727
 728 pprCLbl (RtsLabel (RtsEntry fs))
 729   = ptext fs <> ptext SLIT("_entry")
 730
 731 pprCLbl (RtsLabel (RtsRetInfo fs))
 732   = ptext fs <> ptext SLIT("_info")
 733
 734 pprCLbl (RtsLabel (RtsRet fs))
 735   = ptext fs <> ptext SLIT("_ret")
 736
 737 pprCLbl (RtsLabel (RtsInfoFS fs))
 738   = ftext fs <> ptext SLIT("_info")
 739
 740 pprCLbl (RtsLabel (RtsEntryFS fs))
 741   = ftext fs <> ptext SLIT("_entry")
 742
 743 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 744   = ftext fs <> ptext SLIT("_info")
 745
 746 pprCLbl (RtsLabel (RtsRetFS fs))
 747   = ftext fs <> ptext SLIT("_ret")
 748
 749 pprCLbl (RtsLabel (RtsPrimOp primop))
 750   = ppr primop <> ptext SLIT("_fast")
 751
 752 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 753   = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
 754
 755 pprCLbl ModuleRegdLabel
 756   = ptext SLIT("_module_registered")
 757
 758 pprCLbl (ForeignLabel str _ _)
 759   = ftext str
 760
 761 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 762
 763 pprCLbl (CC_Label cc)           = ppr cc
 764 pprCLbl (CCS_Label ccs)         = ppr ccs
 765
 766 pprCLbl (ModuleInitLabel mod way)
 767    = ptext SLIT("__stginit_") <> ppr mod
 768         <> char '_' <> text way
 769 pprCLbl (PlainModuleInitLabel mod)
 770    = ptext SLIT("__stginit_") <> ppr mod
 771
 772 pprCLbl (HpcTicksLabel mod)
 773   = ptext SLIT("_hpc_tickboxes_")  <> ppr mod <> ptext SLIT("_hpc")
 774
 775 pprCLbl HpcModuleNameLabel
 776   = ptext SLIT("_hpc_module_name_str")
 777
 778 ppIdFlavor :: IdLabelInfo -> SDoc
 779 ppIdFlavor x = pp_cSEP <>
 780                (case x of
 781                        Closure          -> ptext SLIT("closure")
 782                        SRT              -> ptext SLIT("srt")
 783                        InfoTable        -> ptext SLIT("info")
 784                        Entry            -> ptext SLIT("entry")
 785                        Slow             -> ptext SLIT("slow")
 786                        RednCounts       -> ptext SLIT("ct")
 787                        ConEntry         -> ptext SLIT("con_entry")
 788                        ConInfoTable     -> ptext SLIT("con_info")
 789                        StaticConEntry   -> ptext SLIT("static_entry")
 790                        StaticInfoTable  -> ptext SLIT("static_info")
 791                        ClosureTable     -> ptext SLIT("closure_tbl")
 792                       )
 793
 794
 795 pp_cSEP = char '_'
 796
 797 -- -----------------------------------------------------------------------------
 798 -- Machine-dependent knowledge about labels.
 799
 800 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 801 underscorePrefix = (cLeadingUnderscore == "YES")
 802
 803 asmTempLabelPrefix :: LitString  -- for formatting labels
 804 asmTempLabelPrefix =
 805 #if alpha_TARGET_OS
 806      {- The alpha assembler likes temporary labels to look like $L123
 807         instead of L123.  (Don't toss the L, because then Lf28
 808         turns into $f28.)
 809      -}
 810      SLIT("$")
 811 #elif darwin_TARGET_OS
 812      SLIT("L")
 813 #else
 814      SLIT(".L")
 815 #endif
 816
 817 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 818
 819 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
 820 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 821   = pprCLabel lbl <> text "@GOTPCREL"
 822 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 823   = pprCLabel lbl
 824 pprDynamicLinkerAsmLabel _ _
 825   = panic "pprDynamicLinkerAsmLabel"
 826 #elif darwin_TARGET_OS
 827 pprDynamicLinkerAsmLabel CodeStub lbl
 828   = char 'L' <> pprCLabel lbl <> text "$stub"
 829 pprDynamicLinkerAsmLabel SymbolPtr lbl
 830   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 831 pprDynamicLinkerAsmLabel _ _
 832   = panic "pprDynamicLinkerAsmLabel"
 833 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 834 pprDynamicLinkerAsmLabel CodeStub lbl
 835   = pprCLabel lbl <> text "@plt"
 836 pprDynamicLinkerAsmLabel SymbolPtr lbl
 837   = text ".LC_" <> pprCLabel lbl
 838 pprDynamicLinkerAsmLabel _ _
 839   = panic "pprDynamicLinkerAsmLabel"
 840 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
 841 pprDynamicLinkerAsmLabel CodeStub lbl
 842   = pprCLabel lbl <> text "@plt"
 843 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 844   = pprCLabel lbl <> text "@gotpcrel"
 845 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 846   = pprCLabel lbl
 847 pprDynamicLinkerAsmLabel SymbolPtr lbl
 848   = text ".LC_" <> pprCLabel lbl
 849 #elif linux_TARGET_OS
 850 pprDynamicLinkerAsmLabel CodeStub lbl
 851   = pprCLabel lbl <> text "@plt"
 852 pprDynamicLinkerAsmLabel SymbolPtr lbl
 853   = text ".LC_" <> pprCLabel lbl
 854 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 855   = pprCLabel lbl <> text "@got"
 856 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 857   = pprCLabel lbl <> text "@gotoff"
 858 #elif mingw32_TARGET_OS
 859 pprDynamicLinkerAsmLabel SymbolPtr lbl
 860   = text "__imp_" <> pprCLabel lbl
 861 pprDynamicLinkerAsmLabel _ _
 862   = panic "pprDynamicLinkerAsmLabel"
 863 #else
 864 pprDynamicLinkerAsmLabel _ _
 865   = panic "pprDynamicLinkerAsmLabel"
 866 #endif