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