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