compiler/cmm/CLabel.hs

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