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         ForeignLabelSource(..),
  19         pprDebugCLabel,
  20
  21         mkClosureLabel,
  22         mkSRTLabel,
  23         mkInfoTableLabel,
  24         mkEntryLabel,
  25         mkSlowEntryLabel,
  26         mkConEntryLabel,
  27         mkStaticConEntryLabel,
  28         mkRednCountsLabel,
  29         mkConInfoTableLabel,
  30         mkStaticInfoTableLabel,
  31         mkLargeSRTLabel,
  32         mkApEntryLabel,
  33         mkApInfoTableLabel,
  34         mkClosureTableLabel,
  35
  36         mkLocalClosureLabel,
  37         mkLocalInfoTableLabel,
  38         mkLocalEntryLabel,
  39         mkLocalConEntryLabel,
  40         mkLocalStaticConEntryLabel,
  41         mkLocalConInfoTableLabel,
  42         mkLocalStaticInfoTableLabel,
  43         mkLocalClosureTableLabel,
  44
  45         mkReturnPtLabel,
  46         mkReturnInfoLabel,
  47         mkAltLabel,
  48         mkDefaultLabel,
  49         mkBitmapLabel,
  50         mkStringLitLabel,
  51
  52         mkAsmTempLabel,
  53
  54         mkPlainModuleInitLabel,
  55
  56         mkSplitMarkerLabel,
  57         mkDirty_MUT_VAR_Label,
  58         mkUpdInfoLabel,
  59         mkBHUpdInfoLabel,
  60         mkIndStaticInfoLabel,
  61         mkMainCapabilityLabel,
  62         mkMAP_FROZEN_infoLabel,
  63         mkMAP_DIRTY_infoLabel,
  64         mkEMPTY_MVAR_infoLabel,
  65
  66         mkTopTickyCtrLabel,
  67         mkCAFBlackHoleInfoTableLabel,
  68         mkRtsPrimOpLabel,
  69         mkRtsSlowTickyCtrLabel,
  70
  71         mkSelectorInfoLabel,
  72         mkSelectorEntryLabel,
  73
  74         mkCmmInfoLabel,
  75         mkCmmEntryLabel,
  76         mkCmmRetInfoLabel,
  77         mkCmmRetLabel,
  78         mkCmmCodeLabel,
  79         mkCmmDataLabel,
  80         mkCmmGcPtrLabel,
  81
  82         mkRtsApFastLabel,
  83
  84         mkPrimCallLabel,
  85
  86         mkForeignLabel,
  87         addLabelSize,
  88         foreignLabelStdcallInfo,
  89
  90         mkCCLabel, mkCCSLabel,
  91
  92         DynamicLinkerLabelInfo(..),
  93         mkDynamicLinkerLabel,
  94         dynamicLinkerLabelInfo,
  95
  96         mkPicBaseLabel,
  97         mkDeadStripPreventer,
  98
  99         mkHpcTicksLabel,
 100
 101         hasCAF,
 102         infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
 103         needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
 104         isMathFun,
 105         isCFunctionLabel, isGcPtrLabel, labelDynamic,
 106
 107         pprCLabel
 108     ) where
 109
 110 #include "HsVersions.h"
 111
 112 import IdInfo
 113 import StaticFlags
 114 import BasicTypes
 115 import Literal
 116 import Packages
 117 import DataCon
 118 import PackageConfig
 119 import Module
 120 import Name
 121 import Unique
 122 import PrimOp
 123 import Config
 124 import CostCentre
 125 import Outputable
 126 import FastString
 127 import DynFlags
 128 import UniqSet
 129
 130 -- -----------------------------------------------------------------------------
 131 -- The CLabel type
 132
 133 {-
 134   | CLabel is an abstract type that supports the following operations:
 135
 136   - Pretty printing
 137
 138   - In a C file, does it need to be declared before use?  (i.e. is it
 139     guaranteed to be already in scope in the places we need to refer to it?)
 140
 141   - If it needs to be declared, what type (code or data) should it be
 142     declared to have?
 143
 144   - Is it visible outside this object file or not?
 145
 146   - Is it "dynamic" (see details below)
 147
 148   - Eq and Ord, so that we can make sets of CLabels (currently only
 149     used in outputting C as far as I can tell, to avoid generating
 150     more than one declaration for any given label).
 151
 152   - Converting an info table label into an entry label.
 153 -}
 154
 155 data CLabel
 156   = -- | A label related to the definition of a particular Id or Con in a .hs file.
 157     IdLabel
 158         Name
 159         CafInfo
 160         IdLabelInfo             -- encodes the suffix of the label
 161
 162   -- | A label from a .cmm file that is not associated with a .hs level Id.
 163   | CmmLabel
 164         PackageId               -- what package the label belongs to.
 165         FastString              -- identifier giving the prefix of the label
 166         CmmLabelInfo            -- encodes the suffix of the label
 167
 168   -- | A label with a baked-in \/ algorithmically generated name that definitely
 169   --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
 170   --    If it doesn't have an algorithmically generated name then use a CmmLabel
 171   --    instead and give it an appropriate PackageId argument.
 172   | RtsLabel
 173         RtsLabelInfo
 174
 175   -- | A 'C' (or otherwise foreign) label.
 176   --
 177   | ForeignLabel
 178         FastString              -- name of the imported label.
 179
 180         (Maybe Int)             -- possible '@n' suffix for stdcall functions
 181                                 -- When generating C, the '@n' suffix is omitted, but when
 182                                 -- generating assembler we must add it to the label.
 183
 184         ForeignLabelSource      -- what package the foreign label is in.
 185
 186         FunctionOrData
 187
 188   -- | A family of labels related to a particular case expression.
 189   | CaseLabel
 190         {-# UNPACK #-} !Unique  -- Unique says which case expression
 191         CaseLabelInfo
 192
 193   | AsmTempLabel
 194         {-# UNPACK #-} !Unique
 195
 196   | StringLitLabel
 197         {-# UNPACK #-} !Unique
 198
 199   | PlainModuleInitLabel        -- without the version & way info
 200         Module
 201
 202   | CC_Label  CostCentre
 203   | CCS_Label CostCentreStack
 204
 205
 206   -- | These labels are generated and used inside the NCG only.
 207   --    They are special variants of a label used for dynamic linking
 208   --    see module PositionIndependentCode for details.
 209   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 210
 211   -- | This label is generated and used inside the NCG only.
 212   --    It is used as a base for PIC calculations on some platforms.
 213   --    It takes the form of a local numeric assembler label '1'; and
 214   --    is pretty-printed as 1b, referring to the previous definition
 215   --    of 1: in the assembler source file.
 216   | PicBaseLabel
 217
 218   -- | A label before an info table to prevent excessive dead-stripping on darwin
 219   | DeadStripPreventer CLabel
 220
 221
 222   -- | Per-module table of tick locations
 223   | HpcTicksLabel Module
 224
 225   -- | Label of an StgLargeSRT
 226   | LargeSRTLabel
 227         {-# UNPACK #-} !Unique
 228
 229   -- | A bitmap (function or case return)
 230   | LargeBitmapLabel
 231         {-# UNPACK #-} !Unique
 232
 233   deriving (Eq, Ord)
 234
 235
 236 -- | Record where a foreign label is stored.
 237 data ForeignLabelSource
 238
 239    -- | Label is in a named package
 240    = ForeignLabelInPackage      PackageId
 241
 242    -- | Label is in some external, system package that doesn't also
 243    --   contain compiled Haskell code, and is not associated with any .hi files.
 244    --   We don't have to worry about Haskell code being inlined from
 245    --   external packages. It is safe to treat the RTS package as "external".
 246    | ForeignLabelInExternalPackage
 247
 248    -- | Label is in the package currenly being compiled.
 249    --   This is only used for creating hacky tmp labels during code generation.
 250    --   Don't use it in any code that might be inlined across a package boundary
 251    --   (ie, core code) else the information will be wrong relative to the
 252    --   destination module.
 253    | ForeignLabelInThisPackage
 254
 255    deriving (Eq, Ord)
 256
 257
 258 -- | For debugging problems with the CLabel representation.
 259 --      We can't make a Show instance for CLabel because lots of its components don't have instances.
 260 --      The regular Outputable instance only shows the label name, and not its other info.
 261 --
 262 pprDebugCLabel :: CLabel -> SDoc
 263 pprDebugCLabel lbl
 264  = case lbl of
 265         IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
 266         CmmLabel pkg name _info
 267          -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 268
 269         RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
 270
 271         ForeignLabel name mSuffix src funOrData
 272          -> ppr lbl <> (parens
 273                                 $ text "ForeignLabel"
 274                                 <+> ppr mSuffix
 275                                 <+> ppr src
 276                                 <+> ppr funOrData)
 277
 278         _               -> ppr lbl <> (parens $ text "other CLabel)")
 279
 280
 281 data IdLabelInfo
 282   = Closure             -- ^ Label for closure
 283   | SRT                 -- ^ Static reference table
 284   | InfoTable           -- ^ Info tables for closures; always read-only
 285   | Entry               -- ^ Entry point
 286   | Slow                -- ^ Slow entry point
 287
 288   | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id
 289
 290   | ConEntry            -- ^ Constructor entry point
 291   | ConInfoTable        -- ^ Corresponding info table
 292   | StaticConEntry      -- ^ Static constructor entry point
 293   | StaticInfoTable     -- ^ Corresponding info table
 294
 295   | ClosureTable        -- ^ Table of closures for Enum tycons
 296
 297   deriving (Eq, Ord)
 298
 299
 300 data CaseLabelInfo
 301   = CaseReturnPt
 302   | CaseReturnInfo
 303   | CaseAlt ConTag
 304   | CaseDefault
 305   deriving (Eq, Ord)
 306
 307
 308 data RtsLabelInfo
 309   = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
 310   | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
 311
 312   | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
 313   | RtsApEntry           Bool{-updatable-} Int{-arity-}
 314
 315   | RtsPrimOp PrimOp
 316   | RtsApFast     FastString    -- ^ _fast versions of generic apply
 317   | RtsSlowTickyCtr String
 318
 319   deriving (Eq, Ord)
 320   -- NOTE: Eq on LitString compares the pointer only, so this isn't
 321   -- a real equality.
 322
 323
 324 -- | What type of Cmm label we're dealing with.
 325 --      Determines the suffix appended to the name when a CLabel.CmmLabel
 326 --      is pretty printed.
 327 data CmmLabelInfo
 328   = CmmInfo                     -- ^ misc rts info tabless,     suffix _info
 329   | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
 330   | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
 331   | CmmRet                      -- ^ misc rts return points,    suffix _ret
 332   | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
 333   | CmmCode                     -- ^ misc rts code
 334   | CmmGcPtr                    -- ^ GcPtrs eg CHARLIKE_closure
 335   | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
 336   deriving (Eq, Ord)
 337
 338 data DynamicLinkerLabelInfo
 339   = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
 340   | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
 341   | GotSymbolPtr                -- ELF: foo@got
 342   | GotSymbolOffset             -- ELF: foo@gotoff
 343
 344   deriving (Eq, Ord)
 345
 346
 347 -- -----------------------------------------------------------------------------
 348 -- Constructing CLabels
 349 -- -----------------------------------------------------------------------------
 350
 351 -- Constructing IdLabels
 352 -- These are always local:
 353 mkSRTLabel              name c  = IdLabel name  c SRT
 354 mkSlowEntryLabel        name c  = IdLabel name  c Slow
 355 mkRednCountsLabel       name c  = IdLabel name  c RednCounts
 356
 357 -- These have local & (possibly) external variants:
 358 mkLocalClosureLabel     name c  = IdLabel name  c Closure
 359 mkLocalInfoTableLabel   name c  = IdLabel name  c InfoTable
 360 mkLocalEntryLabel       name c  = IdLabel name  c Entry
 361 mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
 362
 363 mkClosureLabel name         c     = IdLabel name c Closure
 364 mkInfoTableLabel name       c     = IdLabel name c InfoTable
 365 mkEntryLabel name           c     = IdLabel name c Entry
 366 mkClosureTableLabel name    c     = IdLabel name c ClosureTable
 367 mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
 368 mkLocalConEntryLabel        c con = IdLabel con c ConEntry
 369 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
 370 mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
 371 mkConInfoTableLabel name    c     = IdLabel    name c ConInfoTable
 372 mkStaticInfoTableLabel name c     = IdLabel    name c StaticInfoTable
 373
 374 mkConEntryLabel name        c     = IdLabel name c ConEntry
 375 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 376
 377 -- Constructing Cmm Labels
 378 mkSplitMarkerLabel              = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
 379 mkDirty_MUT_VAR_Label           = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")         CmmCode
 380 mkUpdInfoLabel                  = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
 381 mkBHUpdInfoLabel                = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
 382 mkIndStaticInfoLabel            = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
 383 mkMainCapabilityLabel           = CmmLabel rtsPackageId (fsLit "MainCapability")        CmmData
 384 mkMAP_FROZEN_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
 385 mkMAP_DIRTY_infoLabel           = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
 386 mkEMPTY_MVAR_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")        CmmInfo
 387 mkTopTickyCtrLabel              = CmmLabel rtsPackageId (fsLit "top_ct")                CmmData
 388 mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
 389
 390 -----
 391 mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
 392   mkCmmCodeLabel, mkCmmDataLabel,  mkCmmGcPtrLabel
 393         :: PackageId -> FastString -> CLabel
 394
 395 mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
 396 mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
 397 mkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo
 398 mkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet
 399 mkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode
 400 mkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData
 401 mkCmmGcPtrLabel     pkg str     = CmmLabel pkg str CmmGcPtr
 402
 403
 404 -- Constructing RtsLabels
 405 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 406
 407 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
 408 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
 409
 410 mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
 411 mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
 412
 413
 414 -- A call to some primitive hand written Cmm code
 415 mkPrimCallLabel :: PrimCall -> CLabel
 416 mkPrimCallLabel (PrimCall str pkg)
 417         = CmmLabel pkg str CmmPrimCall
 418
 419
 420 -- Constructing ForeignLabels
 421
 422 -- | Make a foreign label
 423 mkForeignLabel
 424         :: FastString           -- name
 425         -> Maybe Int            -- size prefix
 426         -> ForeignLabelSource   -- what package it's in
 427         -> FunctionOrData
 428         -> CLabel
 429
 430 mkForeignLabel str mb_sz src fod
 431     = ForeignLabel str mb_sz src  fod
 432
 433
 434 -- | Update the label size field in a ForeignLabel
 435 addLabelSize :: CLabel -> Int -> CLabel
 436 addLabelSize (ForeignLabel str _ src  fod) sz
 437     = ForeignLabel str (Just sz) src fod
 438 addLabelSize label _
 439     = label
 440
 441 -- | Get the label size field from a ForeignLabel
 442 foreignLabelStdcallInfo :: CLabel -> Maybe Int
 443 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
 444 foreignLabelStdcallInfo _lbl = Nothing
 445
 446
 447 -- Constructing Large*Labels
 448 mkLargeSRTLabel uniq            = LargeSRTLabel uniq
 449 mkBitmapLabel   uniq            = LargeBitmapLabel uniq
 450
 451
 452 -- Constructin CaseLabels
 453 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 454 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 455 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 456 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 457
 458 -- Constructing Cost Center Labels
 459 mkCCLabel           cc          = CC_Label cc
 460 mkCCSLabel          ccs         = CCS_Label ccs
 461
 462 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 463
 464 mkRtsSlowTickyCtrLabel :: String -> CLabel
 465 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 466
 467
 468 -- Constructing Code Coverage Labels
 469 mkHpcTicksLabel                = HpcTicksLabel
 470
 471
 472 -- Constructing labels used for dynamic linking
 473 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
 474 mkDynamicLinkerLabel            = DynamicLinkerLabel
 475
 476 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
 477 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
 478 dynamicLinkerLabelInfo _        = Nothing
 479
 480 mkPicBaseLabel :: CLabel
 481 mkPicBaseLabel                  = PicBaseLabel
 482
 483
 484 -- Constructing miscellaneous other labels
 485 mkDeadStripPreventer :: CLabel -> CLabel
 486 mkDeadStripPreventer lbl        = DeadStripPreventer lbl
 487
 488 mkStringLitLabel :: Unique -> CLabel
 489 mkStringLitLabel                = StringLitLabel
 490
 491 mkAsmTempLabel :: Uniquable a => a -> CLabel
 492 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
 493
 494 mkPlainModuleInitLabel :: Module -> CLabel
 495 mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
 496
 497 -- -----------------------------------------------------------------------------
 498 -- Converting between info labels and entry/ret labels.
 499
 500 infoLblToEntryLbl :: CLabel -> CLabel
 501 infoLblToEntryLbl (IdLabel n c InfoTable)       = IdLabel n c Entry
 502 infoLblToEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
 503 infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
 504 infoLblToEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
 505 infoLblToEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
 506 infoLblToEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
 507 infoLblToEntryLbl _
 508         = panic "CLabel.infoLblToEntryLbl"
 509
 510
 511 entryLblToInfoLbl :: CLabel -> CLabel
 512 entryLblToInfoLbl (IdLabel n c Entry)           = IdLabel n c InfoTable
 513 entryLblToInfoLbl (IdLabel n c ConEntry)        = IdLabel n c ConInfoTable
 514 entryLblToInfoLbl (IdLabel n c StaticConEntry)  = IdLabel n c StaticInfoTable
 515 entryLblToInfoLbl (CaseLabel n CaseReturnPt)    = CaseLabel n CaseReturnInfo
 516 entryLblToInfoLbl (CmmLabel m str CmmEntry)     = CmmLabel m str CmmInfo
 517 entryLblToInfoLbl (CmmLabel m str CmmRet)       = CmmLabel m str CmmRetInfo
 518 entryLblToInfoLbl l
 519         = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 520
 521
 522 cvtToClosureLbl   (IdLabel n c InfoTable)       = IdLabel n c Closure
 523 cvtToClosureLbl   (IdLabel n c Entry)           = IdLabel n c Closure
 524 cvtToClosureLbl   (IdLabel n c ConEntry)        = IdLabel n c Closure
 525 cvtToClosureLbl   (IdLabel n c RednCounts)      = IdLabel n c Closure
 526 cvtToClosureLbl l@(IdLabel n c Closure)         = l
 527 cvtToClosureLbl l
 528         = pprPanic "cvtToClosureLbl" (pprCLabel l)
 529
 530
 531 cvtToSRTLbl   (IdLabel n c InfoTable)           = mkSRTLabel n c
 532 cvtToSRTLbl   (IdLabel n c Entry)               = mkSRTLabel n c
 533 cvtToSRTLbl   (IdLabel n c ConEntry)            = mkSRTLabel n c
 534 cvtToSRTLbl l@(IdLabel n c Closure)             = mkSRTLabel n c
 535 cvtToSRTLbl l
 536         = pprPanic "cvtToSRTLbl" (pprCLabel l)
 537
 538
 539 -- -----------------------------------------------------------------------------
 540 -- Does a CLabel refer to a CAF?
 541 hasCAF :: CLabel -> Bool
 542 hasCAF (IdLabel _ MayHaveCafRefs _) = True
 543 hasCAF _                            = False
 544
 545
 546 -- -----------------------------------------------------------------------------
 547 -- Does a CLabel need declaring before use or not?
 548 --
 549 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
 550
 551 needsCDecl :: CLabel -> Bool
 552   -- False <=> it's pre-declared; don't bother
 553   -- don't bother declaring SRT & Bitmap labels, we always make sure
 554   -- they are defined before use.
 555 needsCDecl (IdLabel _ _ SRT)            = False
 556 needsCDecl (LargeSRTLabel _)            = False
 557 needsCDecl (LargeBitmapLabel _)         = False
 558 needsCDecl (IdLabel _ _ _)              = True
 559 needsCDecl (CaseLabel _ _)              = True
 560 needsCDecl (PlainModuleInitLabel _)     = True
 561
 562 needsCDecl (StringLitLabel _)           = False
 563 needsCDecl (AsmTempLabel _)             = False
 564 needsCDecl (RtsLabel _)                 = False
 565
 566 needsCDecl (CmmLabel pkgId _ _)
 567         -- Prototypes for labels defined in the runtime system are imported
 568         --      into HC files via includes/Stg.h.
 569         | pkgId == rtsPackageId         = False
 570
 571         -- For other labels we inline one into the HC file directly.
 572         | otherwise                     = True
 573
 574 needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
 575 needsCDecl (CC_Label _)                 = True
 576 needsCDecl (CCS_Label _)                = True
 577 needsCDecl (HpcTicksLabel _)            = True
 578
 579
 580 -- | Check whether a label is a local temporary for native code generation
 581 isAsmTemp  :: CLabel -> Bool
 582 isAsmTemp (AsmTempLabel _)              = True
 583 isAsmTemp _                             = False
 584
 585
 586 -- | If a label is a local temporary used for native code generation
 587 --      then return just its unique, otherwise nothing.
 588 maybeAsmTemp :: CLabel -> Maybe Unique
 589 maybeAsmTemp (AsmTempLabel uq)          = Just uq
 590 maybeAsmTemp _                          = Nothing
 591
 592
 593 -- | Check whether a label corresponds to a C function that has
 594 --      a prototype in a system header somehere, or is built-in
 595 --      to the C compiler. For these labels we avoid generating our
 596 --      own C prototypes.
 597 isMathFun :: CLabel -> Bool
 598 isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
 599 isMathFun _ = False
 600
 601 math_funs = mkUniqSet [
 602         -- _ISOC99_SOURCE
 603         (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
 604         (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
 605         (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
 606         (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
 607         (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
 608         (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
 609         (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
 610         (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
 611         (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
 612         (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
 613         (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
 614         (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
 615         (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
 616         (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
 617         (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
 618         (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
 619         (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
 620         (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
 621         (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
 622         (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
 623         (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
 624         (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
 625         (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
 626         (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
 627         (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
 628         (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
 629         (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
 630         (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
 631         (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
 632         (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
 633         (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
 634         (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
 635         (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
 636         (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
 637         (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
 638         (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
 639         (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
 640         (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
 641         (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
 642         (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
 643         (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
 644         (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
 645         (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
 646         (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
 647         (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
 648         (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
 649         (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
 650         (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
 651         (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
 652         (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
 653         (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
 654         (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
 655         (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
 656         (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
 657         (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
 658         (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
 659         (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
 660         -- ISO C 99 also defines these function-like macros in math.h:
 661         -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
 662         -- isgreaterequal, isless, islessequal, islessgreater, isunordered
 663
 664         -- additional symbols from _BSD_SOURCE
 665         (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
 666         (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
 667         (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
 668         (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
 669         (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
 670         (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
 671         (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
 672         (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
 673         (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
 674         (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
 675         (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
 676         (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
 677         (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
 678         (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl")
 679     ]
 680
 681 -- -----------------------------------------------------------------------------
 682 -- | Is a CLabel visible outside this object file or not?
 683 --      From the point of view of the code generator, a name is
 684 --      externally visible if it has to be declared as exported
 685 --      in the .o file's symbol table; that is, made non-static.
 686 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 687 externallyVisibleCLabel (CaseLabel _ _)         = False
 688 externallyVisibleCLabel (StringLitLabel _)      = False
 689 externallyVisibleCLabel (AsmTempLabel _)        = False
 690 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 691 externallyVisibleCLabel (RtsLabel _)            = True
 692 externallyVisibleCLabel (CmmLabel _ _ _)        = True
 693 externallyVisibleCLabel (ForeignLabel{})        = True
 694 externallyVisibleCLabel (IdLabel name _ _)      = isExternalName name
 695 externallyVisibleCLabel (CC_Label _)            = True
 696 externallyVisibleCLabel (CCS_Label _)           = True
 697 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 698 externallyVisibleCLabel (HpcTicksLabel _)       = True
 699 externallyVisibleCLabel (LargeBitmapLabel _)    = False
 700 externallyVisibleCLabel (LargeSRTLabel _)       = False
 701
 702 -- -----------------------------------------------------------------------------
 703 -- Finding the "type" of a CLabel
 704
 705 -- For generating correct types in label declarations:
 706
 707 data CLabelType
 708   = CodeLabel   -- Address of some executable instructions
 709   | DataLabel   -- Address of data, not a GC ptr
 710   | GcPtrLabel  -- Address of a (presumably static) GC object
 711
 712 isCFunctionLabel :: CLabel -> Bool
 713 isCFunctionLabel lbl = case labelType lbl of
 714                         CodeLabel -> True
 715                         _other    -> False
 716
 717 isGcPtrLabel :: CLabel -> Bool
 718 isGcPtrLabel lbl = case labelType lbl of
 719                         GcPtrLabel -> True
 720                         _other     -> False
 721
 722
 723 -- | Work out the general type of data at the address of this label
 724 --    whether it be code, data, or static GC object.
 725 labelType :: CLabel -> CLabelType
 726 labelType (CmmLabel _ _ CmmData)                = DataLabel
 727 labelType (CmmLabel _ _ CmmGcPtr)               = GcPtrLabel
 728 labelType (CmmLabel _ _ CmmCode)                = CodeLabel
 729 labelType (CmmLabel _ _ CmmInfo)                = DataLabel
 730 labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
 731 labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
 732 labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
 733 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 734 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 735 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 736 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
 737 labelType (CaseLabel _ _)                       = CodeLabel
 738 labelType (PlainModuleInitLabel _)              = CodeLabel
 739 labelType (LargeSRTLabel _)                     = DataLabel
 740 labelType (LargeBitmapLabel _)                  = DataLabel
 741 labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
 742 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 743 labelType _                                     = DataLabel
 744
 745 idInfoLabelType info =
 746   case info of
 747     InfoTable     -> DataLabel
 748     Closure       -> GcPtrLabel
 749     ConInfoTable  -> DataLabel
 750     StaticInfoTable -> DataLabel
 751     ClosureTable  -> DataLabel
 752     RednCounts    -> DataLabel
 753     _             -> CodeLabel
 754
 755
 756 -- -----------------------------------------------------------------------------
 757 -- Does a CLabel need dynamic linkage?
 758
 759 -- When referring to data in code, we need to know whether
 760 -- that data resides in a DLL or not. [Win32 only.]
 761 -- @labelDynamic@ returns @True@ if the label is located
 762 -- in a DLL, be it a data reference or not.
 763
 764 labelDynamic :: PackageId -> CLabel -> Bool
 765 labelDynamic this_pkg lbl =
 766   case lbl of
 767    -- is the RTS in a DLL or not?
 768    RtsLabel _           -> not opt_Static && (this_pkg /= rtsPackageId)
 769
 770    IdLabel n _ k        -> isDllName this_pkg n
 771
 772 #if mingw32_TARGET_OS
 773    -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
 774    CmmLabel pkg _ _
 775     -> not opt_Static && (this_pkg /= pkg)
 776
 777    -- Foreign label is in some un-named foreign package (or DLL)
 778    ForeignLabel _ _ ForeignLabelInExternalPackage _  -> True
 779
 780    -- Foreign label is linked into the same package as the source file currently being compiled.
 781    ForeignLabel _ _ ForeignLabelInThisPackage  _     -> False
 782
 783    -- Foreign label is in some named package.
 784    --   When compiling in the "dyn" way, each package is to be linked into its own DLL.
 785    ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
 786     -> (not opt_Static) && (this_pkg /= pkgId)
 787
 788 #else
 789    -- On Mac OS X and on ELF platforms, false positives are OK,
 790    -- so we claim that all foreign imports come from dynamic libraries
 791    ForeignLabel _ _ _ _ -> True
 792
 793    CmmLabel pkg _ _     -> True
 794
 795 #endif
 796    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 797
 798    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 799    _                 -> False
 800
 801 {-
 802 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 803 right places. It is used to detect when the abstractC statement of an
 804 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 805
 806 We need at least @Eq@ for @CLabels@, because we want to avoid
 807 duplicate declarations in generating C (see @labelSeenTE@ in
 808 @PprAbsC@).
 809 -}
 810
 811 -----------------------------------------------------------------------------
 812 -- Printing out CLabels.
 813
 814 {-
 815 Convention:
 816
 817       <name>_<type>
 818
 819 where <name> is <Module>_<name> for external names and <unique> for
 820 internal names. <type> is one of the following:
 821
 822          info                   Info table
 823          srt                    Static reference table
 824          srtd                   Static reference table descriptor
 825          entry                  Entry code (function, closure)
 826          slow                   Slow entry code (if any)
 827          ret                    Direct return address
 828          vtbl                   Vector table
 829          <n>_alt                Case alternative (tag n)
 830          dflt                   Default case alternative
 831          btm                    Large bitmap vector
 832          closure                Static closure
 833          con_entry              Dynamic Constructor entry code
 834          con_info               Dynamic Constructor info table
 835          static_entry           Static Constructor entry code
 836          static_info            Static Constructor info table
 837          sel_info               Selector info table
 838          sel_entry              Selector entry code
 839          cc                     Cost centre
 840          ccs                    Cost centre stack
 841
 842 Many of these distinctions are only for documentation reasons.  For
 843 example, _ret is only distinguished from _entry to make it easy to
 844 tell whether a code fragment is a return point or a closure/function
 845 entry.
 846 -}
 847
 848 instance Outputable CLabel where
 849   ppr = pprCLabel
 850
 851 pprCLabel :: CLabel -> SDoc
 852
 853 #if ! OMIT_NATIVE_CODEGEN
 854 pprCLabel (AsmTempLabel u)
 855   =  getPprStyle $ \ sty ->
 856      if asmStyle sty then
 857         ptext asmTempLabelPrefix <> pprUnique u
 858      else
 859         char '_' <> pprUnique u
 860
 861 pprCLabel (DynamicLinkerLabel info lbl)
 862    = pprDynamicLinkerAsmLabel info lbl
 863
 864 pprCLabel PicBaseLabel
 865    = ptext (sLit "1b")
 866
 867 pprCLabel (DeadStripPreventer lbl)
 868    = pprCLabel lbl <> ptext (sLit "_dsp")
 869 #endif
 870
 871 pprCLabel lbl =
 872 #if ! OMIT_NATIVE_CODEGEN
 873     getPprStyle $ \ sty ->
 874     if asmStyle sty then
 875         maybe_underscore (pprAsmCLbl lbl)
 876     else
 877 #endif
 878        pprCLbl lbl
 879
 880 maybe_underscore doc
 881   | underscorePrefix = pp_cSEP <> doc
 882   | otherwise        = doc
 883
 884 #ifdef mingw32_TARGET_OS
 885 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 886 -- (The C compiler does this itself).
 887 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
 888    = ftext fs <> char '@' <> int sz
 889 #endif
 890 pprAsmCLbl lbl
 891    = pprCLbl lbl
 892
 893 pprCLbl (StringLitLabel u)
 894   = pprUnique u <> ptext (sLit "_str")
 895
 896 pprCLbl (CaseLabel u CaseReturnPt)
 897   = hcat [pprUnique u, ptext (sLit "_ret")]
 898 pprCLbl (CaseLabel u CaseReturnInfo)
 899   = hcat [pprUnique u, ptext (sLit "_info")]
 900 pprCLbl (CaseLabel u (CaseAlt tag))
 901   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 902 pprCLbl (CaseLabel u CaseDefault)
 903   = hcat [pprUnique u, ptext (sLit "_dflt")]
 904
 905 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 906 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 907 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 908 -- until that gets resolved we'll just force them to start
 909 -- with a letter so the label will be legal assmbly code.
 910
 911
 912 pprCLbl (CmmLabel _ str CmmCode)        = ftext str
 913 pprCLbl (CmmLabel _ str CmmData)        = ftext str
 914 pprCLbl (CmmLabel _ str CmmGcPtr)       = ftext str
 915 pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 916
 917 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 918
 919 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 920   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 921                 ptext (if upd_reqd
 922                         then (sLit "_upd_info")
 923                         else (sLit "_noupd_info"))
 924         ]
 925
 926 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 927   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 928                 ptext (if upd_reqd
 929                         then (sLit "_upd_entry")
 930                         else (sLit "_noupd_entry"))
 931         ]
 932
 933 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 934   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 935                 ptext (if upd_reqd
 936                         then (sLit "_upd_info")
 937                         else (sLit "_noupd_info"))
 938         ]
 939
 940 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 941   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 942                 ptext (if upd_reqd
 943                         then (sLit "_upd_entry")
 944                         else (sLit "_noupd_entry"))
 945         ]
 946
 947 pprCLbl (CmmLabel _ fs CmmInfo)
 948   = ftext fs <> ptext (sLit "_info")
 949
 950 pprCLbl (CmmLabel _ fs CmmEntry)
 951   = ftext fs <> ptext (sLit "_entry")
 952
 953 pprCLbl (CmmLabel _ fs CmmRetInfo)
 954   = ftext fs <> ptext (sLit "_info")
 955
 956 pprCLbl (CmmLabel _ fs CmmRet)
 957   = ftext fs <> ptext (sLit "_ret")
 958
 959 pprCLbl (RtsLabel (RtsPrimOp primop))
 960   = ptext (sLit "stg_") <> ppr primop
 961
 962 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 963   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 964
 965 pprCLbl (ForeignLabel str _ _ _)
 966   = ftext str
 967
 968 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
 969
 970 pprCLbl (CC_Label cc)           = ppr cc
 971 pprCLbl (CCS_Label ccs)         = ppr ccs
 972
 973 pprCLbl (PlainModuleInitLabel mod)
 974    = ptext (sLit "__stginit_") <> ppr mod
 975
 976 pprCLbl (HpcTicksLabel mod)
 977   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 978
 979 ppIdFlavor :: IdLabelInfo -> SDoc
 980 ppIdFlavor x = pp_cSEP <>
 981                (case x of
 982                        Closure          -> ptext (sLit "closure")
 983                        SRT              -> ptext (sLit "srt")
 984                        InfoTable        -> ptext (sLit "info")
 985                        Entry            -> ptext (sLit "entry")
 986                        Slow             -> ptext (sLit "slow")
 987                        RednCounts       -> ptext (sLit "ct")
 988                        ConEntry         -> ptext (sLit "con_entry")
 989                        ConInfoTable     -> ptext (sLit "con_info")
 990                        StaticConEntry   -> ptext (sLit "static_entry")
 991                        StaticInfoTable  -> ptext (sLit "static_info")
 992                        ClosureTable     -> ptext (sLit "closure_tbl")
 993                       )
 994
 995
 996 pp_cSEP = char '_'
 997
 998
 999 instance Outputable ForeignLabelSource where
1000  ppr fs
1001   = case fs of
1002         ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
1003         ForeignLabelInThisPackage       -> parens $ text "this package"
1004         ForeignLabelInExternalPackage   -> parens $ text "external package"
1005
1006 -- -----------------------------------------------------------------------------
1007 -- Machine-dependent knowledge about labels.
1008
1009 underscorePrefix :: Bool   -- leading underscore on assembler labels?
1010 underscorePrefix = (cLeadingUnderscore == "YES")
1011
1012 asmTempLabelPrefix :: LitString  -- for formatting labels
1013 asmTempLabelPrefix =
1014 #if alpha_TARGET_OS
1015      {- The alpha assembler likes temporary labels to look like $L123
1016         instead of L123.  (Don't toss the L, because then Lf28
1017         turns into $f28.)
1018      -}
1019      (sLit "$")
1020 #elif darwin_TARGET_OS
1021      (sLit "L")
1022 #else
1023      (sLit ".L")
1024 #endif
1025
1026 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
1027
1028 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
1029 pprDynamicLinkerAsmLabel CodeStub lbl
1030   = char 'L' <> pprCLabel lbl <> text "$stub"
1031 pprDynamicLinkerAsmLabel SymbolPtr lbl
1032   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1033 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1034   = pprCLabel lbl <> text "@GOTPCREL"
1035 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1036   = pprCLabel lbl
1037 pprDynamicLinkerAsmLabel _ _
1038   = panic "pprDynamicLinkerAsmLabel"
1039
1040 #elif darwin_TARGET_OS
1041 pprDynamicLinkerAsmLabel CodeStub lbl
1042   = char 'L' <> pprCLabel lbl <> text "$stub"
1043 pprDynamicLinkerAsmLabel SymbolPtr lbl
1044   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1045 pprDynamicLinkerAsmLabel _ _
1046   = panic "pprDynamicLinkerAsmLabel"
1047
1048 #elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
1049 pprDynamicLinkerAsmLabel CodeStub lbl
1050   = pprCLabel lbl <> text "@plt"
1051 pprDynamicLinkerAsmLabel SymbolPtr lbl
1052   = text ".LC_" <> pprCLabel lbl
1053 pprDynamicLinkerAsmLabel _ _
1054   = panic "pprDynamicLinkerAsmLabel"
1055
1056 #elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
1057 pprDynamicLinkerAsmLabel CodeStub lbl
1058   = pprCLabel lbl <> text "@plt"
1059 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1060   = pprCLabel lbl <> text "@gotpcrel"
1061 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1062   = pprCLabel lbl
1063 pprDynamicLinkerAsmLabel SymbolPtr lbl
1064   = text ".LC_" <> pprCLabel lbl
1065
1066 #elif elf_OBJ_FORMAT
1067 pprDynamicLinkerAsmLabel CodeStub lbl
1068   = pprCLabel lbl <> text "@plt"
1069 pprDynamicLinkerAsmLabel SymbolPtr lbl
1070   = text ".LC_" <> pprCLabel lbl
1071 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1072   = pprCLabel lbl <> text "@got"
1073 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1074   = pprCLabel lbl <> text "@gotoff"
1075
1076 #elif mingw32_TARGET_OS
1077 pprDynamicLinkerAsmLabel SymbolPtr lbl
1078   = text "__imp_" <> pprCLabel lbl
1079 pprDynamicLinkerAsmLabel _ _
1080   = panic "pprDynamicLinkerAsmLabel"
1081
1082 #else
1083 pprDynamicLinkerAsmLabel _ _
1084   = panic "pprDynamicLinkerAsmLabel"
1085 #endif