compiler/cmm/CLabel.hs

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