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,
 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 -- -----------------------------------------------------------------------------
 462 -- Does a CLabel refer to a CAF?
 463 hasCAF :: CLabel -> Bool
 464 hasCAF (IdLabel _ MayHaveCafRefs Closure) = True
 465 hasCAF _                                  = False
 466
 467 -- -----------------------------------------------------------------------------
 468 -- Does a CLabel need declaring before use or not?
 469 --
 470 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
 471
 472 needsCDecl :: CLabel -> Bool
 473   -- False <=> it's pre-declared; don't bother
 474   -- don't bother declaring SRT & Bitmap labels, we always make sure
 475   -- they are defined before use.
 476 needsCDecl (IdLabel _ _ SRT)            = False
 477 needsCDecl (LargeSRTLabel _)            = False
 478 needsCDecl (LargeBitmapLabel _)         = False
 479 needsCDecl (IdLabel _ _ _)              = True
 480 needsCDecl (CaseLabel _ _)              = True
 481 needsCDecl (ModuleInitLabel _ _)        = True
 482 needsCDecl (PlainModuleInitLabel _)     = True
 483 needsCDecl (ModuleInitTableLabel _)     = True
 484 needsCDecl ModuleRegdLabel              = False
 485
 486 needsCDecl (StringLitLabel _)           = False
 487 needsCDecl (AsmTempLabel _)             = False
 488 needsCDecl (RtsLabel _)                 = False
 489 needsCDecl l@(ForeignLabel _ _ _)       = not (isMathFun l)
 490 needsCDecl (CC_Label _)                 = True
 491 needsCDecl (CCS_Label _)                = True
 492 needsCDecl (HpcTicksLabel _)            = True
 493 needsCDecl HpcModuleNameLabel           = False
 494
 495 -- Whether the label is an assembler temporary:
 496
 497 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 498 isAsmTemp (AsmTempLabel _) = True
 499 isAsmTemp _                = False
 500
 501 maybeAsmTemp :: CLabel -> Maybe Unique
 502 maybeAsmTemp (AsmTempLabel uq) = Just uq
 503 maybeAsmTemp _                 = Nothing
 504
 505 -- some labels have C prototypes in scope when compiling via C, because
 506 -- they are builtin to the C compiler.  For these labels we avoid
 507 -- generating our own C prototypes.
 508 isMathFun :: CLabel -> Bool
 509 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
 510   where
 511   math_funs = [
 512         (fsLit "pow"),    (fsLit "sin"),   (fsLit "cos"),
 513         (fsLit "tan"),    (fsLit "sinh"),  (fsLit "cosh"),
 514         (fsLit "tanh"),   (fsLit "asin"),  (fsLit "acos"),
 515         (fsLit "atan"),   (fsLit "log"),   (fsLit "exp"),
 516         (fsLit "sqrt"),   (fsLit "powf"),  (fsLit "sinf"),
 517         (fsLit "cosf"),   (fsLit "tanf"),  (fsLit "sinhf"),
 518         (fsLit "coshf"),  (fsLit "tanhf"), (fsLit "asinf"),
 519         (fsLit "acosf"),  (fsLit "atanf"), (fsLit "logf"),
 520         (fsLit "expf"),   (fsLit "sqrtf"), (fsLit "frexp"),
 521         (fsLit "modf"),   (fsLit "ilogb"), (fsLit "copysign"),
 522         (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
 523         (fsLit "cbrt"),   (fsLit "atanh"), (fsLit "asinh"),
 524         (fsLit "acosh"),  (fsLit "lgamma"),(fsLit "hypot"),
 525         (fsLit "erfc"),   (fsLit "erf"),   (fsLit "trunc"),
 526         (fsLit "round"),  (fsLit "fmod"),  (fsLit "floor"),
 527         (fsLit "fabs"),   (fsLit "ceil"),  (fsLit "log10"),
 528         (fsLit "ldexp"),  (fsLit "atan2"), (fsLit "rint")
 529     ]
 530 isMathFun _ = False
 531
 532 -- -----------------------------------------------------------------------------
 533 -- Is a CLabel visible outside this object file or not?
 534
 535 -- From the point of view of the code generator, a name is
 536 -- externally visible if it has to be declared as exported
 537 -- in the .o file's symbol table; that is, made non-static.
 538
 539 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 540 externallyVisibleCLabel (CaseLabel _ _)    = False
 541 externallyVisibleCLabel (StringLitLabel _) = False
 542 externallyVisibleCLabel (AsmTempLabel _)   = False
 543 externallyVisibleCLabel (ModuleInitLabel _ _) = True
 544 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 545 externallyVisibleCLabel (ModuleInitTableLabel _)= False
 546 externallyVisibleCLabel ModuleRegdLabel    = False
 547 externallyVisibleCLabel (RtsLabel _)       = True
 548 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 549 externallyVisibleCLabel (IdLabel name _ _)     = isExternalName name
 550 externallyVisibleCLabel (CC_Label _)       = True
 551 externallyVisibleCLabel (CCS_Label _)      = True
 552 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 553 externallyVisibleCLabel (HpcTicksLabel _)   = True
 554 externallyVisibleCLabel HpcModuleNameLabel      = False
 555 externallyVisibleCLabel (LargeBitmapLabel _) = False
 556 externallyVisibleCLabel (LargeSRTLabel _) = False
 557
 558 -- -----------------------------------------------------------------------------
 559 -- Finding the "type" of a CLabel
 560
 561 -- For generating correct types in label declarations:
 562
 563 data CLabelType
 564   = CodeLabel   -- Address of some executable instructions
 565   | DataLabel   -- Address of data, not a GC ptr
 566   | GcPtrLabel  -- Address of a (presumably static) GC object
 567
 568 isCFunctionLabel :: CLabel -> Bool
 569 isCFunctionLabel lbl = case labelType lbl of
 570                         CodeLabel -> True
 571                         _other    -> False
 572
 573 isGcPtrLabel :: CLabel -> Bool
 574 isGcPtrLabel lbl = case labelType lbl of
 575                         GcPtrLabel -> True
 576                         _other     -> False
 577
 578 labelType :: CLabel -> CLabelType
 579 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 580 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 581 labelType (RtsLabel (RtsData _))              = DataLabel
 582 labelType (RtsLabel (RtsGcPtr _))             = GcPtrLabel
 583 labelType (RtsLabel (RtsCode _))              = CodeLabel
 584 labelType (RtsLabel (RtsInfo _))              = DataLabel
 585 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 586 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 587 labelType (RtsLabel (RtsRet _))               = CodeLabel
 588 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 589 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 590 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 591 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 592 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 593 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 594 labelType (RtsLabel (RtsApFast _))            = CodeLabel
 595 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 596 labelType (CaseLabel _ _)                     = CodeLabel
 597 labelType (ModuleInitLabel _ _)               = CodeLabel
 598 labelType (PlainModuleInitLabel _)            = CodeLabel
 599 labelType (ModuleInitTableLabel _)            = DataLabel
 600 labelType (LargeSRTLabel _)                   = DataLabel
 601 labelType (LargeBitmapLabel _)                = DataLabel
 602 labelType (IdLabel _ _ info) = idInfoLabelType info
 603 labelType _                = DataLabel
 604
 605 idInfoLabelType info =
 606   case info of
 607     InfoTable     -> DataLabel
 608     Closure       -> GcPtrLabel
 609     ConInfoTable  -> DataLabel
 610     StaticInfoTable -> DataLabel
 611     ClosureTable  -> DataLabel
 612     RednCounts    -> DataLabel
 613     _             -> CodeLabel
 614
 615
 616 -- -----------------------------------------------------------------------------
 617 -- Does a CLabel need dynamic linkage?
 618
 619 -- When referring to data in code, we need to know whether
 620 -- that data resides in a DLL or not. [Win32 only.]
 621 -- @labelDynamic@ returns @True@ if the label is located
 622 -- in a DLL, be it a data reference or not.
 623
 624 labelDynamic :: PackageId -> CLabel -> Bool
 625 labelDynamic this_pkg lbl =
 626   case lbl of
 627    RtsLabel _        -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
 628    IdLabel n _ k       -> isDllName this_pkg n
 629 #if mingw32_TARGET_OS
 630    ForeignLabel _ _ d  -> d
 631 #else
 632    -- On Mac OS X and on ELF platforms, false positives are OK,
 633    -- so we claim that all foreign imports come from dynamic libraries
 634    ForeignLabel _ _ _ -> True
 635 #endif
 636    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
 637    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 638    ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 639
 640    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 641    _                 -> False
 642
 643 {-
 644 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 645 right places. It is used to detect when the abstractC statement of an
 646 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 647
 648 We need at least @Eq@ for @CLabels@, because we want to avoid
 649 duplicate declarations in generating C (see @labelSeenTE@ in
 650 @PprAbsC@).
 651 -}
 652
 653 -----------------------------------------------------------------------------
 654 -- Printing out CLabels.
 655
 656 {-
 657 Convention:
 658
 659       <name>_<type>
 660
 661 where <name> is <Module>_<name> for external names and <unique> for
 662 internal names. <type> is one of the following:
 663
 664          info                   Info table
 665          srt                    Static reference table
 666          srtd                   Static reference table descriptor
 667          entry                  Entry code (function, closure)
 668          slow                   Slow entry code (if any)
 669          ret                    Direct return address
 670          vtbl                   Vector table
 671          <n>_alt                Case alternative (tag n)
 672          dflt                   Default case alternative
 673          btm                    Large bitmap vector
 674          closure                Static closure
 675          con_entry              Dynamic Constructor entry code
 676          con_info               Dynamic Constructor info table
 677          static_entry           Static Constructor entry code
 678          static_info            Static Constructor info table
 679          sel_info               Selector info table
 680          sel_entry              Selector entry code
 681          cc                     Cost centre
 682          ccs                    Cost centre stack
 683
 684 Many of these distinctions are only for documentation reasons.  For
 685 example, _ret is only distinguished from _entry to make it easy to
 686 tell whether a code fragment is a return point or a closure/function
 687 entry.
 688 -}
 689
 690 instance Outputable CLabel where
 691   ppr = pprCLabel
 692
 693 pprCLabel :: CLabel -> SDoc
 694
 695 #if ! OMIT_NATIVE_CODEGEN
 696 pprCLabel (AsmTempLabel u)
 697   =  getPprStyle $ \ sty ->
 698      if asmStyle sty then
 699         ptext asmTempLabelPrefix <> pprUnique u
 700      else
 701         char '_' <> pprUnique u
 702
 703 pprCLabel (DynamicLinkerLabel info lbl)
 704    = pprDynamicLinkerAsmLabel info lbl
 705
 706 pprCLabel PicBaseLabel
 707    = ptext (sLit "1b")
 708
 709 pprCLabel (DeadStripPreventer lbl)
 710    = pprCLabel lbl <> ptext (sLit "_dsp")
 711 #endif
 712
 713 pprCLabel lbl =
 714 #if ! OMIT_NATIVE_CODEGEN
 715     getPprStyle $ \ sty ->
 716     if asmStyle sty then
 717         maybe_underscore (pprAsmCLbl lbl)
 718     else
 719 #endif
 720        pprCLbl lbl
 721
 722 maybe_underscore doc
 723   | underscorePrefix = pp_cSEP <> doc
 724   | otherwise        = doc
 725
 726 #ifdef mingw32_TARGET_OS
 727 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 728 -- (The C compiler does this itself).
 729 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 730    = ftext fs <> char '@' <> int sz
 731 #endif
 732 pprAsmCLbl lbl
 733    = pprCLbl lbl
 734
 735 pprCLbl (StringLitLabel u)
 736   = pprUnique u <> ptext (sLit "_str")
 737
 738 pprCLbl (CaseLabel u CaseReturnPt)
 739   = hcat [pprUnique u, ptext (sLit "_ret")]
 740 pprCLbl (CaseLabel u CaseReturnInfo)
 741   = hcat [pprUnique u, ptext (sLit "_info")]
 742 pprCLbl (CaseLabel u (CaseAlt tag))
 743   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 744 pprCLbl (CaseLabel u CaseDefault)
 745   = hcat [pprUnique u, ptext (sLit "_dflt")]
 746
 747 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 748 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 749 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 750 -- until that gets resolved we'll just force them to start
 751 -- with a letter so the label will be legal assmbly code.
 752
 753
 754 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 755 pprCLbl (RtsLabel (RtsData str))   = ptext str
 756 pprCLbl (RtsLabel (RtsGcPtr str))  = ptext str
 757 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 758 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 759
 760 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
 761
 762 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 763   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 764                 ptext (if upd_reqd
 765                         then (sLit "_upd_info")
 766                         else (sLit "_noupd_info"))
 767         ]
 768
 769 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 770   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 771                 ptext (if upd_reqd
 772                         then (sLit "_upd_entry")
 773                         else (sLit "_noupd_entry"))
 774         ]
 775
 776 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 777   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 778                 ptext (if upd_reqd
 779                         then (sLit "_upd_info")
 780                         else (sLit "_noupd_info"))
 781         ]
 782
 783 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 784   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 785                 ptext (if upd_reqd
 786                         then (sLit "_upd_entry")
 787                         else (sLit "_noupd_entry"))
 788         ]
 789
 790 pprCLbl (RtsLabel (RtsInfo fs))
 791   = ptext fs <> ptext (sLit "_info")
 792
 793 pprCLbl (RtsLabel (RtsEntry fs))
 794   = ptext fs <> ptext (sLit "_entry")
 795
 796 pprCLbl (RtsLabel (RtsRetInfo fs))
 797   = ptext fs <> ptext (sLit "_info")
 798
 799 pprCLbl (RtsLabel (RtsRet fs))
 800   = ptext fs <> ptext (sLit "_ret")
 801
 802 pprCLbl (RtsLabel (RtsInfoFS fs))
 803   = ftext fs <> ptext (sLit "_info")
 804
 805 pprCLbl (RtsLabel (RtsEntryFS fs))
 806   = ftext fs <> ptext (sLit "_entry")
 807
 808 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 809   = ftext fs <> ptext (sLit "_info")
 810
 811 pprCLbl (RtsLabel (RtsRetFS fs))
 812   = ftext fs <> ptext (sLit "_ret")
 813
 814 pprCLbl (RtsLabel (RtsPrimOp primop))
 815   = ppr primop <> ptext (sLit "_fast")
 816
 817 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 818   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 819
 820 pprCLbl ModuleRegdLabel
 821   = ptext (sLit "_module_registered")
 822
 823 pprCLbl (ForeignLabel str _ _)
 824   = ftext str
 825
 826 pprCLbl (IdLabel name _ flavor) = ppr name <> ppIdFlavor flavor
 827
 828 pprCLbl (CC_Label cc)           = ppr cc
 829 pprCLbl (CCS_Label ccs)         = ppr ccs
 830
 831 pprCLbl (ModuleInitLabel mod way)
 832    = ptext (sLit "__stginit_") <> ppr mod
 833         <> char '_' <> text way
 834 pprCLbl (PlainModuleInitLabel mod)
 835    = ptext (sLit "__stginit_") <> ppr mod
 836 pprCLbl (ModuleInitTableLabel mod)
 837    = ptext (sLit "__stginittable_") <> ppr mod
 838
 839 pprCLbl (HpcTicksLabel mod)
 840   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 841
 842 pprCLbl HpcModuleNameLabel
 843   = ptext (sLit "_hpc_module_name_str")
 844
 845 ppIdFlavor :: IdLabelInfo -> SDoc
 846 ppIdFlavor x = pp_cSEP <>
 847                (case x of
 848                        Closure          -> ptext (sLit "closure")
 849                        SRT              -> ptext (sLit "srt")
 850                        InfoTable        -> ptext (sLit "info")
 851                        Entry            -> ptext (sLit "entry")
 852                        Slow             -> ptext (sLit "slow")
 853                        RednCounts       -> ptext (sLit "ct")
 854                        ConEntry         -> ptext (sLit "con_entry")
 855                        ConInfoTable     -> ptext (sLit "con_info")
 856                        StaticConEntry   -> ptext (sLit "static_entry")
 857                        StaticInfoTable  -> ptext (sLit "static_info")
 858                        ClosureTable     -> ptext (sLit "closure_tbl")
 859                       )
 860
 861
 862 pp_cSEP = char '_'
 863
 864 -- -----------------------------------------------------------------------------
 865 -- Machine-dependent knowledge about labels.
 866
 867 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 868 underscorePrefix = (cLeadingUnderscore == "YES")
 869
 870 asmTempLabelPrefix :: LitString  -- for formatting labels
 871 asmTempLabelPrefix =
 872 #if alpha_TARGET_OS
 873      {- The alpha assembler likes temporary labels to look like $L123
 874         instead of L123.  (Don't toss the L, because then Lf28
 875         turns into $f28.)
 876      -}
 877      (sLit "$")
 878 #elif darwin_TARGET_OS
 879      (sLit "L")
 880 #else
 881      (sLit ".L")
 882 #endif
 883
 884 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 885
 886 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
 887 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 888   = pprCLabel lbl <> text "@GOTPCREL"
 889 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 890   = pprCLabel lbl
 891 pprDynamicLinkerAsmLabel _ _
 892   = panic "pprDynamicLinkerAsmLabel"
 893 #elif darwin_TARGET_OS
 894 pprDynamicLinkerAsmLabel CodeStub lbl
 895   = char 'L' <> pprCLabel lbl <> text "$stub"
 896 pprDynamicLinkerAsmLabel SymbolPtr lbl
 897   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 898 pprDynamicLinkerAsmLabel _ _
 899   = panic "pprDynamicLinkerAsmLabel"
 900 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 901 pprDynamicLinkerAsmLabel CodeStub lbl
 902   = pprCLabel lbl <> text "@plt"
 903 pprDynamicLinkerAsmLabel SymbolPtr lbl
 904   = text ".LC_" <> pprCLabel lbl
 905 pprDynamicLinkerAsmLabel _ _
 906   = panic "pprDynamicLinkerAsmLabel"
 907 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
 908 pprDynamicLinkerAsmLabel CodeStub lbl
 909   = pprCLabel lbl <> text "@plt"
 910 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 911   = pprCLabel lbl <> text "@gotpcrel"
 912 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 913   = pprCLabel lbl
 914 pprDynamicLinkerAsmLabel SymbolPtr lbl
 915   = text ".LC_" <> pprCLabel lbl
 916 #elif linux_TARGET_OS
 917 pprDynamicLinkerAsmLabel CodeStub lbl
 918   = pprCLabel lbl <> text "@plt"
 919 pprDynamicLinkerAsmLabel SymbolPtr lbl
 920   = text ".LC_" <> pprCLabel lbl
 921 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 922   = pprCLabel lbl <> text "@got"
 923 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 924   = pprCLabel lbl <> text "@gotoff"
 925 #elif mingw32_TARGET_OS
 926 pprDynamicLinkerAsmLabel SymbolPtr lbl
 927   = text "__imp_" <> pprCLabel lbl
 928 pprDynamicLinkerAsmLabel _ _
 929   = panic "pprDynamicLinkerAsmLabel"
 930 #else
 931 pprDynamicLinkerAsmLabel _ _
 932   = panic "pprDynamicLinkerAsmLabel"
 933 #endif