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"), (fsLit "frexp"),
 504         (fsLit "modf"),   (fsLit "ilogb"), (fsLit "copysign"),
 505         (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
 506         (fsLit "cbrt"),   (fsLit "atanh"), (fsLit "asinh"),
 507         (fsLit "acosh"),  (fsLit "lgamma"),(fsLit "hypot"),
 508         (fsLit "erfc"),   (fsLit "erf"),   (fsLit "trunc"),
 509         (fsLit "round"),  (fsLit "fmod"),  (fsLit "floor"),
 510         (fsLit "fabs"),   (fsLit "ceil"),  (fsLit "log10"),
 511         (fsLit "ldexp"),  (fsLit "atan2"), (fsLit "rint")
 512     ]
 513 isMathFun _ = False
 514
 515 -- -----------------------------------------------------------------------------
 516 -- Is a CLabel visible outside this object file or not?
 517
 518 -- From the point of view of the code generator, a name is
 519 -- externally visible if it has to be declared as exported
 520 -- in the .o file's symbol table; that is, made non-static.
 521
 522 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 523 externallyVisibleCLabel (CaseLabel _ _)    = False
 524 externallyVisibleCLabel (StringLitLabel _) = False
 525 externallyVisibleCLabel (AsmTempLabel _)   = False
 526 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 527 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 528 externallyVisibleCLabel ModuleRegdLabel    = False
 529 externallyVisibleCLabel (RtsLabel _)       = True
 530 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 531 externallyVisibleCLabel (IdLabel name SRT)   = False
 532                          -- SRTs don't need to be external
 533 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 534 externallyVisibleCLabel (CC_Label _)       = True
 535 externallyVisibleCLabel (CCS_Label _)      = True
 536 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 537 externallyVisibleCLabel (HpcTicksLabel _)   = True
 538 externallyVisibleCLabel HpcModuleNameLabel      = False
 539 externallyVisibleCLabel (LargeBitmapLabel _) = False
 540 externallyVisibleCLabel (LargeSRTLabel _) = False
 541
 542 -- -----------------------------------------------------------------------------
 543 -- Finding the "type" of a CLabel
 544
 545 -- For generating correct types in label declarations:
 546
 547 data CLabelType
 548   = CodeLabel
 549   | DataLabel
 550
 551 labelType :: CLabel -> CLabelType
 552 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 553 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 554 labelType (RtsLabel (RtsData _))              = DataLabel
 555 labelType (RtsLabel (RtsCode _))              = CodeLabel
 556 labelType (RtsLabel (RtsInfo _))              = DataLabel
 557 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 558 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 559 labelType (RtsLabel (RtsRet _))               = CodeLabel
 560 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 561 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 562 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 563 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 564 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 565 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 566 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 567 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 568 labelType (CaseLabel _ _)                     = CodeLabel
 569 labelType (ModuleInitLabel _ _)               = CodeLabel
 570 labelType (PlainModuleInitLabel _)            = CodeLabel
 571 labelType (LargeSRTLabel _)                   = DataLabel
 572 labelType (LargeBitmapLabel _)                = DataLabel
 573
 574 labelType (IdLabel _ info) = idInfoLabelType info
 575 labelType _        = DataLabel
 576
 577 idInfoLabelType info =
 578   case info of
 579     InfoTable     -> DataLabel
 580     Closure       -> DataLabel
 581     ConInfoTable  -> DataLabel
 582     StaticInfoTable -> DataLabel
 583     ClosureTable  -> DataLabel
 584 -- krc: aie! a ticky counter label is data
 585     RednCounts    -> DataLabel
 586     _             -> CodeLabel
 587
 588
 589 -- -----------------------------------------------------------------------------
 590 -- Does a CLabel need dynamic linkage?
 591
 592 -- When referring to data in code, we need to know whether
 593 -- that data resides in a DLL or not. [Win32 only.]
 594 -- @labelDynamic@ returns @True@ if the label is located
 595 -- in a DLL, be it a data reference or not.
 596
 597 labelDynamic :: PackageId -> CLabel -> Bool
 598 labelDynamic this_pkg lbl =
 599   case lbl of
 600    RtsLabel _        -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 601    IdLabel n k       -> isDllName this_pkg n
 602 #if mingw32_TARGET_OS
 603    ForeignLabel _ _ d  -> d
 604 #else
 605    -- On Mac OS X and on ELF platforms, false positives are OK,
 606    -- so we claim that all foreign imports come from dynamic libraries
 607    ForeignLabel _ _ _ -> True
 608 #endif
 609    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
 610    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 611
 612    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 613    _                 -> False
 614
 615 {-
 616 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 617 right places. It is used to detect when the abstractC statement of an
 618 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 619
 620 We need at least @Eq@ for @CLabels@, because we want to avoid
 621 duplicate declarations in generating C (see @labelSeenTE@ in
 622 @PprAbsC@).
 623 -}
 624
 625 -----------------------------------------------------------------------------
 626 -- Printing out CLabels.
 627
 628 {-
 629 Convention:
 630
 631       <name>_<type>
 632
 633 where <name> is <Module>_<name> for external names and <unique> for
 634 internal names. <type> is one of the following:
 635
 636          info                   Info table
 637          srt                    Static reference table
 638          srtd                   Static reference table descriptor
 639          entry                  Entry code (function, closure)
 640          slow                   Slow entry code (if any)
 641          ret                    Direct return address
 642          vtbl                   Vector table
 643          <n>_alt                Case alternative (tag n)
 644          dflt                   Default case alternative
 645          btm                    Large bitmap vector
 646          closure                Static closure
 647          con_entry              Dynamic Constructor entry code
 648          con_info               Dynamic Constructor info table
 649          static_entry           Static Constructor entry code
 650          static_info            Static Constructor info table
 651          sel_info               Selector info table
 652          sel_entry              Selector entry code
 653          cc                     Cost centre
 654          ccs                    Cost centre stack
 655
 656 Many of these distinctions are only for documentation reasons.  For
 657 example, _ret is only distinguished from _entry to make it easy to
 658 tell whether a code fragment is a return point or a closure/function
 659 entry.
 660 -}
 661
 662 instance Outputable CLabel where
 663   ppr = pprCLabel
 664
 665 pprCLabel :: CLabel -> SDoc
 666
 667 #if ! OMIT_NATIVE_CODEGEN
 668 pprCLabel (AsmTempLabel u)
 669   =  getPprStyle $ \ sty ->
 670      if asmStyle sty then
 671         ptext asmTempLabelPrefix <> pprUnique u
 672      else
 673         char '_' <> pprUnique u
 674
 675 pprCLabel (DynamicLinkerLabel info lbl)
 676    = pprDynamicLinkerAsmLabel info lbl
 677
 678 pprCLabel PicBaseLabel
 679    = ptext (sLit "1b")
 680
 681 pprCLabel (DeadStripPreventer lbl)
 682    = pprCLabel lbl <> ptext (sLit "_dsp")
 683 #endif
 684
 685 pprCLabel lbl =
 686 #if ! OMIT_NATIVE_CODEGEN
 687     getPprStyle $ \ sty ->
 688     if asmStyle sty then
 689         maybe_underscore (pprAsmCLbl lbl)
 690     else
 691 #endif
 692        pprCLbl lbl
 693
 694 maybe_underscore doc
 695   | underscorePrefix = pp_cSEP <> doc
 696   | otherwise        = doc
 697
 698 #ifdef mingw32_TARGET_OS
 699 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 700 -- (The C compiler does this itself).
 701 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 702    = ftext fs <> char '@' <> int sz
 703 #endif
 704 pprAsmCLbl lbl
 705    = pprCLbl lbl
 706
 707 pprCLbl (StringLitLabel u)
 708   = pprUnique u <> ptext (sLit "_str")
 709
 710 pprCLbl (CaseLabel u CaseReturnPt)
 711   = hcat [pprUnique u, ptext (sLit "_ret")]
 712 pprCLbl (CaseLabel u CaseReturnInfo)
 713   = hcat [pprUnique u, ptext (sLit "_info")]
 714 pprCLbl (CaseLabel u (CaseAlt tag))
 715   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 716 pprCLbl (CaseLabel u CaseDefault)
 717   = hcat [pprUnique u, ptext (sLit "_dflt")]
 718
 719 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 720 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 721 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 722 -- until that gets resolved we'll just force them to start
 723 -- with a letter so the label will be legal assmbly code.
 724
 725
 726 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 727 pprCLbl (RtsLabel (RtsData str))   = ptext str
 728 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 729 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 730
 731 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
 732
 733 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 734   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 735                 ptext (if upd_reqd
 736                         then (sLit "_upd_info")
 737                         else (sLit "_noupd_info"))
 738         ]
 739
 740 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 741   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 742                 ptext (if upd_reqd
 743                         then (sLit "_upd_entry")
 744                         else (sLit "_noupd_entry"))
 745         ]
 746
 747 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 748   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 749                 ptext (if upd_reqd
 750                         then (sLit "_upd_info")
 751                         else (sLit "_noupd_info"))
 752         ]
 753
 754 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 755   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 756                 ptext (if upd_reqd
 757                         then (sLit "_upd_entry")
 758                         else (sLit "_noupd_entry"))
 759         ]
 760
 761 pprCLbl (RtsLabel (RtsInfo fs))
 762   = ptext fs <> ptext (sLit "_info")
 763
 764 pprCLbl (RtsLabel (RtsEntry fs))
 765   = ptext fs <> ptext (sLit "_entry")
 766
 767 pprCLbl (RtsLabel (RtsRetInfo fs))
 768   = ptext fs <> ptext (sLit "_info")
 769
 770 pprCLbl (RtsLabel (RtsRet fs))
 771   = ptext fs <> ptext (sLit "_ret")
 772
 773 pprCLbl (RtsLabel (RtsInfoFS fs))
 774   = ftext fs <> ptext (sLit "_info")
 775
 776 pprCLbl (RtsLabel (RtsEntryFS fs))
 777   = ftext fs <> ptext (sLit "_entry")
 778
 779 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 780   = ftext fs <> ptext (sLit "_info")
 781
 782 pprCLbl (RtsLabel (RtsRetFS fs))
 783   = ftext fs <> ptext (sLit "_ret")
 784
 785 pprCLbl (RtsLabel (RtsPrimOp primop))
 786   = ppr primop <> ptext (sLit "_fast")
 787
 788 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 789   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 790
 791 pprCLbl ModuleRegdLabel
 792   = ptext (sLit "_module_registered")
 793
 794 pprCLbl (ForeignLabel str _ _)
 795   = ftext str
 796
 797 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 798
 799 pprCLbl (CC_Label cc)           = ppr cc
 800 pprCLbl (CCS_Label ccs)         = ppr ccs
 801
 802 pprCLbl (ModuleInitLabel mod way)
 803    = ptext (sLit "__stginit_") <> ppr mod
 804         <> char '_' <> text way
 805 pprCLbl (PlainModuleInitLabel mod)
 806    = ptext (sLit "__stginit_") <> ppr mod
 807
 808 pprCLbl (HpcTicksLabel mod)
 809   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 810
 811 pprCLbl HpcModuleNameLabel
 812   = ptext (sLit "_hpc_module_name_str")
 813
 814 ppIdFlavor :: IdLabelInfo -> SDoc
 815 ppIdFlavor x = pp_cSEP <>
 816                (case x of
 817                        Closure          -> ptext (sLit "closure")
 818                        SRT              -> ptext (sLit "srt")
 819                        InfoTable        -> ptext (sLit "info")
 820                        Entry            -> ptext (sLit "entry")
 821                        Slow             -> ptext (sLit "slow")
 822                        RednCounts       -> ptext (sLit "ct")
 823                        ConEntry         -> ptext (sLit "con_entry")
 824                        ConInfoTable     -> ptext (sLit "con_info")
 825                        StaticConEntry   -> ptext (sLit "static_entry")
 826                        StaticInfoTable  -> ptext (sLit "static_info")
 827                        ClosureTable     -> ptext (sLit "closure_tbl")
 828                       )
 829
 830
 831 pp_cSEP = char '_'
 832
 833 -- -----------------------------------------------------------------------------
 834 -- Machine-dependent knowledge about labels.
 835
 836 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 837 underscorePrefix = (cLeadingUnderscore == "YES")
 838
 839 asmTempLabelPrefix :: LitString  -- for formatting labels
 840 asmTempLabelPrefix =
 841 #if alpha_TARGET_OS
 842      {- The alpha assembler likes temporary labels to look like $L123
 843         instead of L123.  (Don't toss the L, because then Lf28
 844         turns into $f28.)
 845      -}
 846      (sLit "$")
 847 #elif darwin_TARGET_OS
 848      (sLit "L")
 849 #else
 850      (sLit ".L")
 851 #endif
 852
 853 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 854
 855 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
 856 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 857   = pprCLabel lbl <> text "@GOTPCREL"
 858 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 859   = pprCLabel lbl
 860 pprDynamicLinkerAsmLabel _ _
 861   = panic "pprDynamicLinkerAsmLabel"
 862 #elif darwin_TARGET_OS
 863 pprDynamicLinkerAsmLabel CodeStub lbl
 864   = char 'L' <> pprCLabel lbl <> text "$stub"
 865 pprDynamicLinkerAsmLabel SymbolPtr lbl
 866   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 867 pprDynamicLinkerAsmLabel _ _
 868   = panic "pprDynamicLinkerAsmLabel"
 869 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 870 pprDynamicLinkerAsmLabel CodeStub lbl
 871   = pprCLabel lbl <> text "@plt"
 872 pprDynamicLinkerAsmLabel SymbolPtr lbl
 873   = text ".LC_" <> pprCLabel lbl
 874 pprDynamicLinkerAsmLabel _ _
 875   = panic "pprDynamicLinkerAsmLabel"
 876 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
 877 pprDynamicLinkerAsmLabel CodeStub lbl
 878   = pprCLabel lbl <> text "@plt"
 879 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 880   = pprCLabel lbl <> text "@gotpcrel"
 881 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 882   = pprCLabel lbl
 883 pprDynamicLinkerAsmLabel SymbolPtr lbl
 884   = text ".LC_" <> pprCLabel lbl
 885 #elif linux_TARGET_OS
 886 pprDynamicLinkerAsmLabel CodeStub lbl
 887   = pprCLabel lbl <> text "@plt"
 888 pprDynamicLinkerAsmLabel SymbolPtr lbl
 889   = text ".LC_" <> pprCLabel lbl
 890 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 891   = pprCLabel lbl <> text "@got"
 892 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 893   = pprCLabel lbl <> text "@gotoff"
 894 #elif mingw32_TARGET_OS
 895 pprDynamicLinkerAsmLabel SymbolPtr lbl
 896   = text "__imp_" <> pprCLabel lbl
 897 pprDynamicLinkerAsmLabel _ _
 898   = panic "pprDynamicLinkerAsmLabel"
 899 #else
 900 pprDynamicLinkerAsmLabel _ _
 901   = panic "pprDynamicLinkerAsmLabel"
 902 #endif