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