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