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