ghc/compiler/cmm/CLabel.hs

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