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