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