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