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
  94         mkCCLabel, mkCCSLabel,
  95
  96         DynamicLinkerLabelInfo(..),
  97         mkDynamicLinkerLabel,
  98         dynamicLinkerLabelInfo,
  99
 100         mkPicBaseLabel,
 101         mkDeadStripPreventer,
 102
 103         mkHpcTicksLabel,
 104         mkHpcModuleNameLabel,
 105
 106         infoLblToEntryLbl, entryLblToInfoLbl,
 107         needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
 108         isMathFun,
 109         CLabelType(..), labelType, labelDynamic,
 110
 111         pprCLabel
 112     ) where
 113
 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         -- Cost centres etc.
 377
 378 mkCCLabel       cc              = CC_Label cc
 379 mkCCSLabel      ccs             = CCS_Label ccs
 380
 381 mkRtsInfoLabel      str = RtsLabel (RtsInfo      str)
 382 mkRtsEntryLabel     str = RtsLabel (RtsEntry     str)
 383 mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
 384 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 385 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 386 mkRtsDataLabel      str = RtsLabel (RtsData      str)
 387
 388 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 389 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
 390 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
 391 mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
 392 mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
 393 mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
 394
 395 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 396
 397 mkRtsSlowTickyCtrLabel :: String -> CLabel
 398 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 399
 400         -- Coverage
 401
 402 mkHpcTicksLabel                = HpcTicksLabel
 403 mkHpcModuleNameLabel           = HpcModuleNameLabel
 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 between info labels and entry/ret 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 (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 430 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 431 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
 432 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
 433 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 434 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 435
 436 entryLblToInfoLbl :: CLabel -> CLabel
 437 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
 438 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
 439 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
 440 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 441 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 442 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
 443 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 444 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 445 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 446
 447 -- -----------------------------------------------------------------------------
 448 -- Does a CLabel need declaring before use or not?
 449
 450 needsCDecl :: CLabel -> Bool
 451   -- False <=> it's pre-declared; don't bother
 452   -- don't bother declaring SRT & Bitmap labels, we always make sure
 453   -- they are defined before use.
 454 needsCDecl (IdLabel _ SRT)              = False
 455 needsCDecl (LargeSRTLabel _)            = False
 456 needsCDecl (LargeBitmapLabel _)         = False
 457 needsCDecl (IdLabel _ _)                = True
 458 needsCDecl (CaseLabel _ _)              = True
 459 needsCDecl (ModuleInitLabel _ _)        = True
 460 needsCDecl (PlainModuleInitLabel _)     = True
 461 needsCDecl ModuleRegdLabel              = False
 462
 463 needsCDecl (StringLitLabel _)           = False
 464 needsCDecl (AsmTempLabel _)             = False
 465 needsCDecl (RtsLabel _)                 = False
 466   -- RTS labels are declared in RTS header files.  Otherwise we'd need
 467   -- to give types for each label reference in the RTS .cmm files
 468   -- somehow; when generating .cmm code we know the types of labels (info,
 469   -- entry etc.) but for hand-written .cmm code we don't.
 470 needsCDecl l@(ForeignLabel _ _ _)       = not (isMathFun l)
 471 needsCDecl (CC_Label _)                 = True
 472 needsCDecl (CCS_Label _)                = True
 473 needsCDecl (HpcTicksLabel _)            = True
 474 needsCDecl HpcModuleNameLabel           = False
 475
 476 -- Whether the label is an assembler temporary:
 477
 478 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 479 isAsmTemp (AsmTempLabel _) = True
 480 isAsmTemp _                = False
 481
 482 maybeAsmTemp :: CLabel -> Maybe Unique
 483 maybeAsmTemp (AsmTempLabel uq) = Just uq
 484 maybeAsmTemp _                 = Nothing
 485
 486 -- some labels have C prototypes in scope when compiling via C, because
 487 -- they are builtin to the C compiler.  For these labels we avoid
 488 -- generating our own C prototypes.
 489 isMathFun :: CLabel -> Bool
 490 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
 491   where
 492   math_funs = [
 493         FSLIT("pow"),    FSLIT("sin"),   FSLIT("cos"),
 494         FSLIT("tan"),    FSLIT("sinh"),  FSLIT("cosh"),
 495         FSLIT("tanh"),   FSLIT("asin"),  FSLIT("acos"),
 496         FSLIT("atan"),   FSLIT("log"),   FSLIT("exp"),
 497         FSLIT("sqrt"),   FSLIT("powf"),  FSLIT("sinf"),
 498         FSLIT("cosf"),   FSLIT("tanf"),  FSLIT("sinhf"),
 499         FSLIT("coshf"),  FSLIT("tanhf"), FSLIT("asinf"),
 500         FSLIT("acosf"),  FSLIT("atanf"), FSLIT("logf"),
 501         FSLIT("expf"),   FSLIT("sqrtf")
 502    ]
 503 isMathFun _ = False
 504
 505 -- -----------------------------------------------------------------------------
 506 -- Is a CLabel visible outside this object file or not?
 507
 508 -- From the point of view of the code generator, a name is
 509 -- externally visible if it has to be declared as exported
 510 -- in the .o file's symbol table; that is, made non-static.
 511
 512 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 513 externallyVisibleCLabel (CaseLabel _ _)    = False
 514 externallyVisibleCLabel (StringLitLabel _) = False
 515 externallyVisibleCLabel (AsmTempLabel _)   = False
 516 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 517 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 518 externallyVisibleCLabel ModuleRegdLabel    = False
 519 externallyVisibleCLabel (RtsLabel _)       = True
 520 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 521 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 522 externallyVisibleCLabel (CC_Label _)       = True
 523 externallyVisibleCLabel (CCS_Label _)      = True
 524 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 525 externallyVisibleCLabel (HpcTicksLabel _)   = True
 526 externallyVisibleCLabel HpcModuleNameLabel      = False
 527 externallyVisibleCLabel (LargeBitmapLabel _) = False
 528 externallyVisibleCLabel (LargeSRTLabel _) = False
 529
 530 -- -----------------------------------------------------------------------------
 531 -- Finding the "type" of a CLabel
 532
 533 -- For generating correct types in label declarations:
 534
 535 data CLabelType
 536   = CodeLabel
 537   | DataLabel
 538
 539 labelType :: CLabel -> CLabelType
 540 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 541 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 542 labelType (RtsLabel (RtsData _))              = DataLabel
 543 labelType (RtsLabel (RtsCode _))              = CodeLabel
 544 labelType (RtsLabel (RtsInfo _))              = DataLabel
 545 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 546 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 547 labelType (RtsLabel (RtsRet _))               = CodeLabel
 548 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 549 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 550 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 551 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 552 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 553 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 554 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 555 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 556 labelType (CaseLabel _ _)                     = CodeLabel
 557 labelType (ModuleInitLabel _ _)               = CodeLabel
 558 labelType (PlainModuleInitLabel _)            = CodeLabel
 559 labelType (LargeSRTLabel _)                   = DataLabel
 560 labelType (LargeBitmapLabel _)                = DataLabel
 561
 562 labelType (IdLabel _ info) = idInfoLabelType info
 563 labelType _        = DataLabel
 564
 565 idInfoLabelType info =
 566   case info of
 567     InfoTable     -> DataLabel
 568     Closure       -> DataLabel
 569     ConInfoTable  -> DataLabel
 570     StaticInfoTable -> DataLabel
 571     ClosureTable  -> DataLabel
 572 -- krc: aie! a ticky counter label is data
 573     RednCounts    -> DataLabel
 574     _             -> CodeLabel
 575
 576
 577 -- -----------------------------------------------------------------------------
 578 -- Does a CLabel need dynamic linkage?
 579
 580 -- When referring to data in code, we need to know whether
 581 -- that data resides in a DLL or not. [Win32 only.]
 582 -- @labelDynamic@ returns @True@ if the label is located
 583 -- in a DLL, be it a data reference or not.
 584
 585 labelDynamic :: PackageId -> CLabel -> Bool
 586 labelDynamic this_pkg lbl =
 587   case lbl of
 588    RtsLabel _        -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 589    IdLabel n k       -> isDllName this_pkg n
 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 _    -> not opt_Static && this_pkg /= (modulePackageId m)
 598    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 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 (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
 708 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
 709 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 710 -- until that gets resolved we'll just force them to start
 711 -- with a letter so the label will be legal assmbly code.
 712
 713
 714 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 715 pprCLbl (RtsLabel (RtsData str))   = ptext str
 716 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 717 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 718
 719 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
 720
 721 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 722   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 723                 ptext (if upd_reqd
 724                         then SLIT("_upd_info")
 725                         else SLIT("_noupd_info"))
 726         ]
 727
 728 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 729   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 730                 ptext (if upd_reqd
 731                         then SLIT("_upd_entry")
 732                         else SLIT("_noupd_entry"))
 733         ]
 734
 735 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 736   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 737                 ptext (if upd_reqd
 738                         then SLIT("_upd_info")
 739                         else SLIT("_noupd_info"))
 740         ]
 741
 742 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 743   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 744                 ptext (if upd_reqd
 745                         then SLIT("_upd_entry")
 746                         else SLIT("_noupd_entry"))
 747         ]
 748
 749 pprCLbl (RtsLabel (RtsInfo fs))
 750   = ptext fs <> ptext SLIT("_info")
 751
 752 pprCLbl (RtsLabel (RtsEntry fs))
 753   = ptext fs <> ptext SLIT("_entry")
 754
 755 pprCLbl (RtsLabel (RtsRetInfo fs))
 756   = ptext fs <> ptext SLIT("_info")
 757
 758 pprCLbl (RtsLabel (RtsRet fs))
 759   = ptext fs <> ptext SLIT("_ret")
 760
 761 pprCLbl (RtsLabel (RtsInfoFS fs))
 762   = ftext fs <> ptext SLIT("_info")
 763
 764 pprCLbl (RtsLabel (RtsEntryFS fs))
 765   = ftext fs <> ptext SLIT("_entry")
 766
 767 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 768   = ftext fs <> ptext SLIT("_info")
 769
 770 pprCLbl (RtsLabel (RtsRetFS fs))
 771   = ftext fs <> ptext SLIT("_ret")
 772
 773 pprCLbl (RtsLabel (RtsPrimOp primop))
 774   = ppr primop <> ptext SLIT("_fast")
 775
 776 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 777   = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
 778
 779 pprCLbl ModuleRegdLabel
 780   = ptext SLIT("_module_registered")
 781
 782 pprCLbl (ForeignLabel str _ _)
 783   = ftext str
 784
 785 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 786
 787 pprCLbl (CC_Label cc)           = ppr cc
 788 pprCLbl (CCS_Label ccs)         = ppr ccs
 789
 790 pprCLbl (ModuleInitLabel mod way)
 791    = ptext SLIT("__stginit_") <> ppr mod
 792         <> char '_' <> text way
 793 pprCLbl (PlainModuleInitLabel mod)
 794    = ptext SLIT("__stginit_") <> ppr mod
 795
 796 pprCLbl (HpcTicksLabel mod)
 797   = ptext SLIT("_hpc_tickboxes_")  <> ppr mod <> ptext SLIT("_hpc")
 798
 799 pprCLbl HpcModuleNameLabel
 800   = ptext SLIT("_hpc_module_name_str")
 801
 802 ppIdFlavor :: IdLabelInfo -> SDoc
 803 ppIdFlavor x = pp_cSEP <>
 804                (case x of
 805                        Closure          -> ptext SLIT("closure")
 806                        SRT              -> ptext SLIT("srt")
 807                        InfoTable        -> ptext SLIT("info")
 808                        Entry            -> ptext SLIT("entry")
 809                        Slow             -> ptext SLIT("slow")
 810                        RednCounts       -> ptext SLIT("ct")
 811                        ConEntry         -> ptext SLIT("con_entry")
 812                        ConInfoTable     -> ptext SLIT("con_info")
 813                        StaticConEntry   -> ptext SLIT("static_entry")
 814                        StaticInfoTable  -> ptext SLIT("static_info")
 815                        ClosureTable     -> ptext SLIT("closure_tbl")
 816                       )
 817
 818
 819 pp_cSEP = char '_'
 820
 821 -- -----------------------------------------------------------------------------
 822 -- Machine-dependent knowledge about labels.
 823
 824 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 825 underscorePrefix = (cLeadingUnderscore == "YES")
 826
 827 asmTempLabelPrefix :: LitString  -- for formatting labels
 828 asmTempLabelPrefix =
 829 #if alpha_TARGET_OS
 830      {- The alpha assembler likes temporary labels to look like $L123
 831         instead of L123.  (Don't toss the L, because then Lf28
 832         turns into $f28.)
 833      -}
 834      SLIT("$")
 835 #elif darwin_TARGET_OS
 836      SLIT("L")
 837 #else
 838      SLIT(".L")
 839 #endif
 840
 841 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 842
 843 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
 844 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 845   = pprCLabel lbl <> text "@GOTPCREL"
 846 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 847   = pprCLabel lbl
 848 pprDynamicLinkerAsmLabel _ _
 849   = panic "pprDynamicLinkerAsmLabel"
 850 #elif darwin_TARGET_OS
 851 pprDynamicLinkerAsmLabel CodeStub lbl
 852   = char 'L' <> pprCLabel lbl <> text "$stub"
 853 pprDynamicLinkerAsmLabel SymbolPtr lbl
 854   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 855 pprDynamicLinkerAsmLabel _ _
 856   = panic "pprDynamicLinkerAsmLabel"
 857 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 858 pprDynamicLinkerAsmLabel CodeStub lbl
 859   = pprCLabel lbl <> text "@plt"
 860 pprDynamicLinkerAsmLabel SymbolPtr lbl
 861   = text ".LC_" <> pprCLabel lbl
 862 pprDynamicLinkerAsmLabel _ _
 863   = panic "pprDynamicLinkerAsmLabel"
 864 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
 865 pprDynamicLinkerAsmLabel CodeStub lbl
 866   = pprCLabel lbl <> text "@plt"
 867 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 868   = pprCLabel lbl <> text "@gotpcrel"
 869 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 870   = pprCLabel lbl
 871 pprDynamicLinkerAsmLabel SymbolPtr lbl
 872   = text ".LC_" <> pprCLabel lbl
 873 #elif linux_TARGET_OS
 874 pprDynamicLinkerAsmLabel CodeStub lbl
 875   = pprCLabel lbl <> text "@plt"
 876 pprDynamicLinkerAsmLabel SymbolPtr lbl
 877   = text ".LC_" <> pprCLabel lbl
 878 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 879   = pprCLabel lbl <> text "@got"
 880 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 881   = pprCLabel lbl <> text "@gotoff"
 882 #elif mingw32_TARGET_OS
 883 pprDynamicLinkerAsmLabel SymbolPtr lbl
 884   = text "__imp_" <> pprCLabel lbl
 885 pprDynamicLinkerAsmLabel _ _
 886   = panic "pprDynamicLinkerAsmLabel"
 887 #else
 888 pprDynamicLinkerAsmLabel _ _
 889   = panic "pprDynamicLinkerAsmLabel"
 890 #endif