compiler/cmm/CLabel.hs

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