compiler/cmm/CLabel.hs

   1 {-# OPTIONS -w #-}
   2 -- The above warning supression flag is a temporary kludge.
   3 -- While working on this module you are encouraged to remove it and fix
   4 -- any warnings in the module. See
   5 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   6 -- for details
   7
   8 -----------------------------------------------------------------------------
   9 --
  10 -- Object-file symbols (called CLabel for histerical raisins).
  11 --
  12 -- (c) The University of Glasgow 2004-2006
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module CLabel (
  17         CLabel, -- abstract type
  18
  19         mkClosureLabel,
  20         mkSRTLabel,
  21         mkInfoTableLabel,
  22         mkEntryLabel,
  23         mkSlowEntryLabel,
  24         mkConEntryLabel,
  25         mkStaticConEntryLabel,
  26         mkRednCountsLabel,
  27         mkConInfoTableLabel,
  28         mkStaticInfoTableLabel,
  29         mkLargeSRTLabel,
  30         mkApEntryLabel,
  31         mkApInfoTableLabel,
  32         mkClosureTableLabel,
  33
  34         mkLocalClosureLabel,
  35         mkLocalInfoTableLabel,
  36         mkLocalEntryLabel,
  37         mkLocalConEntryLabel,
  38         mkLocalStaticConEntryLabel,
  39         mkLocalConInfoTableLabel,
  40         mkLocalStaticInfoTableLabel,
  41         mkLocalClosureTableLabel,
  42
  43         mkReturnPtLabel,
  44         mkReturnInfoLabel,
  45         mkAltLabel,
  46         mkDefaultLabel,
  47         mkBitmapLabel,
  48         mkStringLitLabel,
  49
  50         mkAsmTempLabel,
  51
  52         mkModuleInitLabel,
  53         mkPlainModuleInitLabel,
  54
  55         mkSplitMarkerLabel,
  56         mkDirty_MUT_VAR_Label,
  57         mkUpdInfoLabel,
  58         mkIndStaticInfoLabel,
  59         mkMainCapabilityLabel,
  60         mkMAP_FROZEN_infoLabel,
  61         mkMAP_DIRTY_infoLabel,
  62         mkEMPTY_MVAR_infoLabel,
  63
  64         mkTopTickyCtrLabel,
  65         mkCAFBlackHoleInfoTableLabel,
  66         mkSECAFBlackHoleInfoTableLabel,
  67         mkRtsPrimOpLabel,
  68         mkRtsSlowTickyCtrLabel,
  69
  70         moduleRegdLabel,
  71
  72         mkSelectorInfoLabel,
  73         mkSelectorEntryLabel,
  74
  75         mkRtsInfoLabel,
  76         mkRtsEntryLabel,
  77         mkRtsRetInfoLabel,
  78         mkRtsRetLabel,
  79         mkRtsCodeLabel,
  80         mkRtsDataLabel,
  81
  82         mkRtsInfoLabelFS,
  83         mkRtsEntryLabelFS,
  84         mkRtsRetInfoLabelFS,
  85         mkRtsRetLabelFS,
  86         mkRtsCodeLabelFS,
  87         mkRtsDataLabelFS,
  88
  89         mkRtsApFastLabel,
  90
  91         mkForeignLabel,
  92         addLabelSize,
  93
  94         mkCCLabel, mkCCSLabel,
  95
  96         DynamicLinkerLabelInfo(..),
  97         mkDynamicLinkerLabel,
  98         dynamicLinkerLabelInfo,
  99
 100         mkPicBaseLabel,
 101         mkDeadStripPreventer,
 102
 103         mkHpcTicksLabel,
 104         mkHpcModuleNameLabel,
 105
 106         infoLblToEntryLbl, entryLblToInfoLbl,
 107         needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
 108         isMathFun,
 109         CLabelType(..), labelType, labelDynamic,
 110
 111         pprCLabel
 112     ) where
 113
 114 #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 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 351                                     RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
 352                                   else  -- RTS won't have info table unless -ticky is on
 353                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 354 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 355
 356 moduleRegdLabel                 = ModuleRegdLabel
 357
 358 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
 359 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry   upd off)
 360
 361 mkApInfoTableLabel  upd off     = RtsLabel (RtsApInfoTable upd off)
 362 mkApEntryLabel upd off          = RtsLabel (RtsApEntry   upd off)
 363
 364         -- Foreign labels
 365
 366 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
 367 mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
 368
 369 addLabelSize :: CLabel -> Int -> CLabel
 370 addLabelSize (ForeignLabel str _ is_dynamic) sz
 371   = ForeignLabel str (Just sz) is_dynamic
 372 addLabelSize label _
 373   = label
 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")
 499    ]
 500 isMathFun _ = False
 501
 502 -- -----------------------------------------------------------------------------
 503 -- Is a CLabel visible outside this object file or not?
 504
 505 -- From the point of view of the code generator, a name is
 506 -- externally visible if it has to be declared as exported
 507 -- in the .o file's symbol table; that is, made non-static.
 508
 509 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 510 externallyVisibleCLabel (CaseLabel _ _)    = False
 511 externallyVisibleCLabel (StringLitLabel _) = False
 512 externallyVisibleCLabel (AsmTempLabel _)   = False
 513 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 514 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 515 externallyVisibleCLabel ModuleRegdLabel    = False
 516 externallyVisibleCLabel (RtsLabel _)       = True
 517 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 518 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 519 externallyVisibleCLabel (CC_Label _)       = True
 520 externallyVisibleCLabel (CCS_Label _)      = True
 521 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 522 externallyVisibleCLabel (HpcTicksLabel _)   = True
 523 externallyVisibleCLabel HpcModuleNameLabel      = False
 524 externallyVisibleCLabel (LargeBitmapLabel _) = False
 525 externallyVisibleCLabel (LargeSRTLabel _) = False
 526
 527 -- -----------------------------------------------------------------------------
 528 -- Finding the "type" of a CLabel
 529
 530 -- For generating correct types in label declarations:
 531
 532 data CLabelType
 533   = CodeLabel
 534   | DataLabel
 535
 536 labelType :: CLabel -> CLabelType
 537 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 538 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 539 labelType (RtsLabel (RtsData _))              = DataLabel
 540 labelType (RtsLabel (RtsCode _))              = CodeLabel
 541 labelType (RtsLabel (RtsInfo _))              = DataLabel
 542 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 543 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 544 labelType (RtsLabel (RtsRet _))               = CodeLabel
 545 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 546 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 547 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 548 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 549 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 550 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 551 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 552 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 553 labelType (CaseLabel _ _)                     = CodeLabel
 554 labelType (ModuleInitLabel _ _)               = CodeLabel
 555 labelType (PlainModuleInitLabel _)            = CodeLabel
 556 labelType (LargeSRTLabel _)                   = DataLabel
 557 labelType (LargeBitmapLabel _)                = DataLabel
 558
 559 labelType (IdLabel _ info) = idInfoLabelType info
 560 labelType _        = DataLabel
 561
 562 idInfoLabelType info =
 563   case info of
 564     InfoTable     -> DataLabel
 565     Closure       -> DataLabel
 566     ConInfoTable  -> DataLabel
 567     StaticInfoTable -> DataLabel
 568     ClosureTable  -> DataLabel
 569 -- krc: aie! a ticky counter label is data
 570     RednCounts    -> DataLabel
 571     _             -> CodeLabel
 572
 573
 574 -- -----------------------------------------------------------------------------
 575 -- Does a CLabel need dynamic linkage?
 576
 577 -- When referring to data in code, we need to know whether
 578 -- that data resides in a DLL or not. [Win32 only.]
 579 -- @labelDynamic@ returns @True@ if the label is located
 580 -- in a DLL, be it a data reference or not.
 581
 582 labelDynamic :: PackageId -> CLabel -> Bool
 583 labelDynamic this_pkg lbl =
 584   case lbl of
 585    RtsLabel _        -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 586    IdLabel n k       -> isDllName this_pkg n
 587 #if mingw32_TARGET_OS
 588    ForeignLabel _ _ d  -> d
 589 #else
 590    -- On Mac OS X and on ELF platforms, false positives are OK,
 591    -- so we claim that all foreign imports come from dynamic libraries
 592    ForeignLabel _ _ _ -> True
 593 #endif
 594    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
 595    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 596
 597    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 598    _                 -> False
 599
 600 {-
 601 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 602 right places. It is used to detect when the abstractC statement of an
 603 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 604
 605 We need at least @Eq@ for @CLabels@, because we want to avoid
 606 duplicate declarations in generating C (see @labelSeenTE@ in
 607 @PprAbsC@).
 608 -}
 609
 610 -----------------------------------------------------------------------------
 611 -- Printing out CLabels.
 612
 613 {-
 614 Convention:
 615
 616       <name>_<type>
 617
 618 where <name> is <Module>_<name> for external names and <unique> for
 619 internal names. <type> is one of the following:
 620
 621          info                   Info table
 622          srt                    Static reference table
 623          srtd                   Static reference table descriptor
 624          entry                  Entry code (function, closure)
 625          slow                   Slow entry code (if any)
 626          ret                    Direct return address
 627          vtbl                   Vector table
 628          <n>_alt                Case alternative (tag n)
 629          dflt                   Default case alternative
 630          btm                    Large bitmap vector
 631          closure                Static closure
 632          con_entry              Dynamic Constructor entry code
 633          con_info               Dynamic Constructor info table
 634          static_entry           Static Constructor entry code
 635          static_info            Static Constructor info table
 636          sel_info               Selector info table
 637          sel_entry              Selector entry code
 638          cc                     Cost centre
 639          ccs                    Cost centre stack
 640
 641 Many of these distinctions are only for documentation reasons.  For
 642 example, _ret is only distinguished from _entry to make it easy to
 643 tell whether a code fragment is a return point or a closure/function
 644 entry.
 645 -}
 646
 647 instance Outputable CLabel where
 648   ppr = pprCLabel
 649
 650 pprCLabel :: CLabel -> SDoc
 651
 652 #if ! OMIT_NATIVE_CODEGEN
 653 pprCLabel (AsmTempLabel u)
 654   =  getPprStyle $ \ sty ->
 655      if asmStyle sty then
 656         ptext asmTempLabelPrefix <> pprUnique u
 657      else
 658         char '_' <> pprUnique u
 659
 660 pprCLabel (DynamicLinkerLabel info lbl)
 661    = pprDynamicLinkerAsmLabel info lbl
 662
 663 pprCLabel PicBaseLabel
 664    = ptext (sLit "1b")
 665
 666 pprCLabel (DeadStripPreventer lbl)
 667    = pprCLabel lbl <> ptext (sLit "_dsp")
 668 #endif
 669
 670 pprCLabel lbl =
 671 #if ! OMIT_NATIVE_CODEGEN
 672     getPprStyle $ \ sty ->
 673     if asmStyle sty then
 674         maybe_underscore (pprAsmCLbl lbl)
 675     else
 676 #endif
 677        pprCLbl lbl
 678
 679 maybe_underscore doc
 680   | underscorePrefix = pp_cSEP <> doc
 681   | otherwise        = doc
 682
 683 #ifdef mingw32_TARGET_OS
 684 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 685 -- (The C compiler does this itself).
 686 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 687    = ftext fs <> char '@' <> int sz
 688 #endif
 689 pprAsmCLbl lbl
 690    = pprCLbl lbl
 691
 692 pprCLbl (StringLitLabel u)
 693   = pprUnique u <> ptext (sLit "_str")
 694
 695 pprCLbl (CaseLabel u CaseReturnPt)
 696   = hcat [pprUnique u, ptext (sLit "_ret")]
 697 pprCLbl (CaseLabel u CaseReturnInfo)
 698   = hcat [pprUnique u, ptext (sLit "_info")]
 699 pprCLbl (CaseLabel u (CaseAlt tag))
 700   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 701 pprCLbl (CaseLabel u CaseDefault)
 702   = hcat [pprUnique u, ptext (sLit "_dflt")]
 703
 704 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 705 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 706 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 707 -- until that gets resolved we'll just force them to start
 708 -- with a letter so the label will be legal assmbly code.
 709
 710
 711 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 712 pprCLbl (RtsLabel (RtsData str))   = ptext str
 713 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 714 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 715
 716 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
 717
 718 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 719   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 720                 ptext (if upd_reqd
 721                         then (sLit "_upd_info")
 722                         else (sLit "_noupd_info"))
 723         ]
 724
 725 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 726   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 727                 ptext (if upd_reqd
 728                         then (sLit "_upd_entry")
 729                         else (sLit "_noupd_entry"))
 730         ]
 731
 732 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 733   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 734                 ptext (if upd_reqd
 735                         then (sLit "_upd_info")
 736                         else (sLit "_noupd_info"))
 737         ]
 738
 739 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 740   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 741                 ptext (if upd_reqd
 742                         then (sLit "_upd_entry")
 743                         else (sLit "_noupd_entry"))
 744         ]
 745
 746 pprCLbl (RtsLabel (RtsInfo fs))
 747   = ptext fs <> ptext (sLit "_info")
 748
 749 pprCLbl (RtsLabel (RtsEntry fs))
 750   = ptext fs <> ptext (sLit "_entry")
 751
 752 pprCLbl (RtsLabel (RtsRetInfo fs))
 753   = ptext fs <> ptext (sLit "_info")
 754
 755 pprCLbl (RtsLabel (RtsRet fs))
 756   = ptext fs <> ptext (sLit "_ret")
 757
 758 pprCLbl (RtsLabel (RtsInfoFS fs))
 759   = ftext fs <> ptext (sLit "_info")
 760
 761 pprCLbl (RtsLabel (RtsEntryFS fs))
 762   = ftext fs <> ptext (sLit "_entry")
 763
 764 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 765   = ftext fs <> ptext (sLit "_info")
 766
 767 pprCLbl (RtsLabel (RtsRetFS fs))
 768   = ftext fs <> ptext (sLit "_ret")
 769
 770 pprCLbl (RtsLabel (RtsPrimOp primop))
 771   = ppr primop <> ptext (sLit "_fast")
 772
 773 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 774   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 775
 776 pprCLbl ModuleRegdLabel
 777   = ptext (sLit "_module_registered")
 778
 779 pprCLbl (ForeignLabel str _ _)
 780   = ftext str
 781
 782 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 783
 784 pprCLbl (CC_Label cc)           = ppr cc
 785 pprCLbl (CCS_Label ccs)         = ppr ccs
 786
 787 pprCLbl (ModuleInitLabel mod way)
 788    = ptext (sLit "__stginit_") <> ppr mod
 789         <> char '_' <> text way
 790 pprCLbl (PlainModuleInitLabel mod)
 791    = ptext (sLit "__stginit_") <> ppr mod
 792
 793 pprCLbl (HpcTicksLabel mod)
 794   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 795
 796 pprCLbl HpcModuleNameLabel
 797   = ptext (sLit "_hpc_module_name_str")
 798
 799 ppIdFlavor :: IdLabelInfo -> SDoc
 800 ppIdFlavor x = pp_cSEP <>
 801                (case x of
 802                        Closure          -> ptext (sLit "closure")
 803                        SRT              -> ptext (sLit "srt")
 804                        InfoTable        -> ptext (sLit "info")
 805                        Entry            -> ptext (sLit "entry")
 806                        Slow             -> ptext (sLit "slow")
 807                        RednCounts       -> ptext (sLit "ct")
 808                        ConEntry         -> ptext (sLit "con_entry")
 809                        ConInfoTable     -> ptext (sLit "con_info")
 810                        StaticConEntry   -> ptext (sLit "static_entry")
 811                        StaticInfoTable  -> ptext (sLit "static_info")
 812                        ClosureTable     -> ptext (sLit "closure_tbl")
 813                       )
 814
 815
 816 pp_cSEP = char '_'
 817
 818 -- -----------------------------------------------------------------------------
 819 -- Machine-dependent knowledge about labels.
 820
 821 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 822 underscorePrefix = (cLeadingUnderscore == "YES")
 823
 824 asmTempLabelPrefix :: LitString  -- for formatting labels
 825 asmTempLabelPrefix =
 826 #if alpha_TARGET_OS
 827      {- The alpha assembler likes temporary labels to look like $L123
 828         instead of L123.  (Don't toss the L, because then Lf28
 829         turns into $f28.)
 830      -}
 831      (sLit "$")
 832 #elif darwin_TARGET_OS
 833      (sLit "L")
 834 #else
 835      (sLit ".L")
 836 #endif
 837
 838 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 839
 840 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
 841 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 842   = pprCLabel lbl <> text "@GOTPCREL"
 843 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 844   = pprCLabel lbl
 845 pprDynamicLinkerAsmLabel _ _
 846   = panic "pprDynamicLinkerAsmLabel"
 847 #elif darwin_TARGET_OS
 848 pprDynamicLinkerAsmLabel CodeStub lbl
 849   = char 'L' <> pprCLabel lbl <> text "$stub"
 850 pprDynamicLinkerAsmLabel SymbolPtr lbl
 851   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 852 pprDynamicLinkerAsmLabel _ _
 853   = panic "pprDynamicLinkerAsmLabel"
 854 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 855 pprDynamicLinkerAsmLabel CodeStub lbl
 856   = pprCLabel lbl <> text "@plt"
 857 pprDynamicLinkerAsmLabel SymbolPtr lbl
 858   = text ".LC_" <> pprCLabel lbl
 859 pprDynamicLinkerAsmLabel _ _
 860   = panic "pprDynamicLinkerAsmLabel"
 861 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
 862 pprDynamicLinkerAsmLabel CodeStub lbl
 863   = pprCLabel lbl <> text "@plt"
 864 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 865   = pprCLabel lbl <> text "@gotpcrel"
 866 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 867   = pprCLabel lbl
 868 pprDynamicLinkerAsmLabel SymbolPtr lbl
 869   = text ".LC_" <> pprCLabel lbl
 870 #elif linux_TARGET_OS
 871 pprDynamicLinkerAsmLabel CodeStub lbl
 872   = pprCLabel lbl <> text "@plt"
 873 pprDynamicLinkerAsmLabel SymbolPtr lbl
 874   = text ".LC_" <> pprCLabel lbl
 875 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 876   = pprCLabel lbl <> text "@got"
 877 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 878   = pprCLabel lbl <> text "@gotoff"
 879 #elif mingw32_TARGET_OS
 880 pprDynamicLinkerAsmLabel SymbolPtr lbl
 881   = text "__imp_" <> pprCLabel lbl
 882 pprDynamicLinkerAsmLabel _ _
 883   = panic "pprDynamicLinkerAsmLabel"
 884 #else
 885 pprDynamicLinkerAsmLabel _ _
 886   = panic "pprDynamicLinkerAsmLabel"
 887 #endif