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, isCas,
 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 our cas function.
 594 --      We #include the prototype for this, so we need to avoid
 595 --      generating out own C prototypes.
 596 isCas :: CLabel -> Bool
 597 isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
 598 isCas _                     = False
 599
 600
 601 -- | Check whether a label corresponds to a C function that has
 602 --      a prototype in a system header somehere, or is built-in
 603 --      to the C compiler. For these labels we avoid generating our
 604 --      own C prototypes.
 605 isMathFun :: CLabel -> Bool
 606 isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
 607 isMathFun _ = False
 608
 609 math_funs = mkUniqSet [
 610         -- _ISOC99_SOURCE
 611         (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
 612         (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
 613         (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
 614         (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
 615         (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
 616         (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
 617         (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
 618         (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
 619         (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
 620         (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
 621         (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
 622         (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
 623         (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
 624         (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
 625         (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
 626         (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
 627         (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
 628         (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
 629         (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
 630         (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
 631         (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
 632         (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
 633         (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
 634         (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
 635         (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
 636         (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
 637         (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
 638         (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
 639         (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
 640         (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
 641         (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
 642         (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
 643         (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
 644         (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
 645         (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
 646         (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
 647         (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
 648         (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
 649         (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
 650         (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
 651         (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
 652         (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
 653         (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
 654         (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
 655         (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
 656         (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
 657         (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
 658         (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
 659         (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
 660         (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
 661         (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
 662         (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
 663         (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
 664         (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
 665         (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
 666         (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
 667         (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
 668         -- ISO C 99 also defines these function-like macros in math.h:
 669         -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
 670         -- isgreaterequal, isless, islessequal, islessgreater, isunordered
 671
 672         -- additional symbols from _BSD_SOURCE
 673         (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
 674         (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
 675         (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
 676         (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
 677         (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
 678         (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
 679         (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
 680         (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
 681         (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
 682         (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
 683         (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
 684         (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
 685         (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
 686         (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl")
 687     ]
 688
 689 -- -----------------------------------------------------------------------------
 690 -- | Is a CLabel visible outside this object file or not?
 691 --      From the point of view of the code generator, a name is
 692 --      externally visible if it has to be declared as exported
 693 --      in the .o file's symbol table; that is, made non-static.
 694 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 695 externallyVisibleCLabel (CaseLabel _ _)         = False
 696 externallyVisibleCLabel (StringLitLabel _)      = False
 697 externallyVisibleCLabel (AsmTempLabel _)        = False
 698 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 699 externallyVisibleCLabel (RtsLabel _)            = True
 700 externallyVisibleCLabel (CmmLabel _ _ _)        = True
 701 externallyVisibleCLabel (ForeignLabel{})        = True
 702 externallyVisibleCLabel (IdLabel name _ _)      = isExternalName name
 703 externallyVisibleCLabel (CC_Label _)            = True
 704 externallyVisibleCLabel (CCS_Label _)           = True
 705 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 706 externallyVisibleCLabel (HpcTicksLabel _)       = True
 707 externallyVisibleCLabel (LargeBitmapLabel _)    = False
 708 externallyVisibleCLabel (LargeSRTLabel _)       = False
 709
 710 -- -----------------------------------------------------------------------------
 711 -- Finding the "type" of a CLabel
 712
 713 -- For generating correct types in label declarations:
 714
 715 data CLabelType
 716   = CodeLabel   -- Address of some executable instructions
 717   | DataLabel   -- Address of data, not a GC ptr
 718   | GcPtrLabel  -- Address of a (presumably static) GC object
 719
 720 isCFunctionLabel :: CLabel -> Bool
 721 isCFunctionLabel lbl = case labelType lbl of
 722                         CodeLabel -> True
 723                         _other    -> False
 724
 725 isGcPtrLabel :: CLabel -> Bool
 726 isGcPtrLabel lbl = case labelType lbl of
 727                         GcPtrLabel -> True
 728                         _other     -> False
 729
 730
 731 -- | Work out the general type of data at the address of this label
 732 --    whether it be code, data, or static GC object.
 733 labelType :: CLabel -> CLabelType
 734 labelType (CmmLabel _ _ CmmData)                = DataLabel
 735 labelType (CmmLabel _ _ CmmGcPtr)               = GcPtrLabel
 736 labelType (CmmLabel _ _ CmmCode)                = CodeLabel
 737 labelType (CmmLabel _ _ CmmInfo)                = DataLabel
 738 labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
 739 labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
 740 labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
 741 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 742 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 743 labelType (RtsLabel (RtsApFast _))              = CodeLabel
 744 labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
 745 labelType (CaseLabel _ _)                       = CodeLabel
 746 labelType (PlainModuleInitLabel _)              = CodeLabel
 747 labelType (LargeSRTLabel _)                     = DataLabel
 748 labelType (LargeBitmapLabel _)                  = DataLabel
 749 labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
 750 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 751 labelType _                                     = DataLabel
 752
 753 idInfoLabelType info =
 754   case info of
 755     InfoTable     -> DataLabel
 756     Closure       -> GcPtrLabel
 757     ConInfoTable  -> DataLabel
 758     StaticInfoTable -> DataLabel
 759     ClosureTable  -> DataLabel
 760     RednCounts    -> DataLabel
 761     _             -> CodeLabel
 762
 763
 764 -- -----------------------------------------------------------------------------
 765 -- Does a CLabel need dynamic linkage?
 766
 767 -- When referring to data in code, we need to know whether
 768 -- that data resides in a DLL or not. [Win32 only.]
 769 -- @labelDynamic@ returns @True@ if the label is located
 770 -- in a DLL, be it a data reference or not.
 771
 772 labelDynamic :: PackageId -> CLabel -> Bool
 773 labelDynamic this_pkg lbl =
 774   case lbl of
 775    -- is the RTS in a DLL or not?
 776    RtsLabel _           -> not opt_Static && (this_pkg /= rtsPackageId)
 777
 778    IdLabel n _ k        -> isDllName this_pkg n
 779
 780 #if mingw32_TARGET_OS
 781    -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
 782    CmmLabel pkg _ _
 783     -> not opt_Static && (this_pkg /= pkg)
 784
 785    -- Foreign label is in some un-named foreign package (or DLL)
 786    ForeignLabel _ _ ForeignLabelInExternalPackage _  -> True
 787
 788    -- Foreign label is linked into the same package as the source file currently being compiled.
 789    ForeignLabel _ _ ForeignLabelInThisPackage  _     -> False
 790
 791    -- Foreign label is in some named package.
 792    --   When compiling in the "dyn" way, each package is to be linked into its own DLL.
 793    ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
 794     -> (not opt_Static) && (this_pkg /= pkgId)
 795
 796 #else
 797    -- On Mac OS X and on ELF platforms, false positives are OK,
 798    -- so we claim that all foreign imports come from dynamic libraries
 799    ForeignLabel _ _ _ _ -> True
 800
 801    CmmLabel pkg _ _     -> True
 802
 803 #endif
 804    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 805
 806    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 807    _                 -> False
 808
 809 {-
 810 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 811 right places. It is used to detect when the abstractC statement of an
 812 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 813
 814 We need at least @Eq@ for @CLabels@, because we want to avoid
 815 duplicate declarations in generating C (see @labelSeenTE@ in
 816 @PprAbsC@).
 817 -}
 818
 819 -----------------------------------------------------------------------------
 820 -- Printing out CLabels.
 821
 822 {-
 823 Convention:
 824
 825       <name>_<type>
 826
 827 where <name> is <Module>_<name> for external names and <unique> for
 828 internal names. <type> is one of the following:
 829
 830          info                   Info table
 831          srt                    Static reference table
 832          srtd                   Static reference table descriptor
 833          entry                  Entry code (function, closure)
 834          slow                   Slow entry code (if any)
 835          ret                    Direct return address
 836          vtbl                   Vector table
 837          <n>_alt                Case alternative (tag n)
 838          dflt                   Default case alternative
 839          btm                    Large bitmap vector
 840          closure                Static closure
 841          con_entry              Dynamic Constructor entry code
 842          con_info               Dynamic Constructor info table
 843          static_entry           Static Constructor entry code
 844          static_info            Static Constructor info table
 845          sel_info               Selector info table
 846          sel_entry              Selector entry code
 847          cc                     Cost centre
 848          ccs                    Cost centre stack
 849
 850 Many of these distinctions are only for documentation reasons.  For
 851 example, _ret is only distinguished from _entry to make it easy to
 852 tell whether a code fragment is a return point or a closure/function
 853 entry.
 854 -}
 855
 856 instance Outputable CLabel where
 857   ppr = pprCLabel
 858
 859 pprCLabel :: CLabel -> SDoc
 860
 861 #if ! OMIT_NATIVE_CODEGEN
 862 pprCLabel (AsmTempLabel u)
 863   =  getPprStyle $ \ sty ->
 864      if asmStyle sty then
 865         ptext asmTempLabelPrefix <> pprUnique u
 866      else
 867         char '_' <> pprUnique u
 868
 869 pprCLabel (DynamicLinkerLabel info lbl)
 870    = pprDynamicLinkerAsmLabel info lbl
 871
 872 pprCLabel PicBaseLabel
 873    = ptext (sLit "1b")
 874
 875 pprCLabel (DeadStripPreventer lbl)
 876    = pprCLabel lbl <> ptext (sLit "_dsp")
 877 #endif
 878
 879 pprCLabel lbl =
 880 #if ! OMIT_NATIVE_CODEGEN
 881     getPprStyle $ \ sty ->
 882     if asmStyle sty then
 883         maybe_underscore (pprAsmCLbl lbl)
 884     else
 885 #endif
 886        pprCLbl lbl
 887
 888 maybe_underscore doc
 889   | underscorePrefix = pp_cSEP <> doc
 890   | otherwise        = doc
 891
 892 #ifdef mingw32_TARGET_OS
 893 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 894 -- (The C compiler does this itself).
 895 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
 896    = ftext fs <> char '@' <> int sz
 897 #endif
 898 pprAsmCLbl lbl
 899    = pprCLbl lbl
 900
 901 pprCLbl (StringLitLabel u)
 902   = pprUnique u <> ptext (sLit "_str")
 903
 904 pprCLbl (CaseLabel u CaseReturnPt)
 905   = hcat [pprUnique u, ptext (sLit "_ret")]
 906 pprCLbl (CaseLabel u CaseReturnInfo)
 907   = hcat [pprUnique u, ptext (sLit "_info")]
 908 pprCLbl (CaseLabel u (CaseAlt tag))
 909   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 910 pprCLbl (CaseLabel u CaseDefault)
 911   = hcat [pprUnique u, ptext (sLit "_dflt")]
 912
 913 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 914 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 915 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 916 -- until that gets resolved we'll just force them to start
 917 -- with a letter so the label will be legal assmbly code.
 918
 919
 920 pprCLbl (CmmLabel _ str CmmCode)        = ftext str
 921 pprCLbl (CmmLabel _ str CmmData)        = ftext str
 922 pprCLbl (CmmLabel _ str CmmGcPtr)       = ftext str
 923 pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 924
 925 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 926
 927 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 928   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 929                 ptext (if upd_reqd
 930                         then (sLit "_upd_info")
 931                         else (sLit "_noupd_info"))
 932         ]
 933
 934 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 935   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 936                 ptext (if upd_reqd
 937                         then (sLit "_upd_entry")
 938                         else (sLit "_noupd_entry"))
 939         ]
 940
 941 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 942   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 943                 ptext (if upd_reqd
 944                         then (sLit "_upd_info")
 945                         else (sLit "_noupd_info"))
 946         ]
 947
 948 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 949   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 950                 ptext (if upd_reqd
 951                         then (sLit "_upd_entry")
 952                         else (sLit "_noupd_entry"))
 953         ]
 954
 955 pprCLbl (CmmLabel _ fs CmmInfo)
 956   = ftext fs <> ptext (sLit "_info")
 957
 958 pprCLbl (CmmLabel _ fs CmmEntry)
 959   = ftext fs <> ptext (sLit "_entry")
 960
 961 pprCLbl (CmmLabel _ fs CmmRetInfo)
 962   = ftext fs <> ptext (sLit "_info")
 963
 964 pprCLbl (CmmLabel _ fs CmmRet)
 965   = ftext fs <> ptext (sLit "_ret")
 966
 967 pprCLbl (RtsLabel (RtsPrimOp primop))
 968   = ptext (sLit "stg_") <> ppr primop
 969
 970 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 971   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 972
 973 pprCLbl (ForeignLabel str _ _ _)
 974   = ftext str
 975
 976 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
 977
 978 pprCLbl (CC_Label cc)           = ppr cc
 979 pprCLbl (CCS_Label ccs)         = ppr ccs
 980
 981 pprCLbl (PlainModuleInitLabel mod)
 982    = ptext (sLit "__stginit_") <> ppr mod
 983
 984 pprCLbl (HpcTicksLabel mod)
 985   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 986
 987 ppIdFlavor :: IdLabelInfo -> SDoc
 988 ppIdFlavor x = pp_cSEP <>
 989                (case x of
 990                        Closure          -> ptext (sLit "closure")
 991                        SRT              -> ptext (sLit "srt")
 992                        InfoTable        -> ptext (sLit "info")
 993                        Entry            -> ptext (sLit "entry")
 994                        Slow             -> ptext (sLit "slow")
 995                        RednCounts       -> ptext (sLit "ct")
 996                        ConEntry         -> ptext (sLit "con_entry")
 997                        ConInfoTable     -> ptext (sLit "con_info")
 998                        StaticConEntry   -> ptext (sLit "static_entry")
 999                        StaticInfoTable  -> ptext (sLit "static_info")
1000                        ClosureTable     -> ptext (sLit "closure_tbl")
1001                       )
1002
1003
1004 pp_cSEP = char '_'
1005
1006
1007 instance Outputable ForeignLabelSource where
1008  ppr fs
1009   = case fs of
1010         ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
1011         ForeignLabelInThisPackage       -> parens $ text "this package"
1012         ForeignLabelInExternalPackage   -> parens $ text "external package"
1013
1014 -- -----------------------------------------------------------------------------
1015 -- Machine-dependent knowledge about labels.
1016
1017 underscorePrefix :: Bool   -- leading underscore on assembler labels?
1018 underscorePrefix = (cLeadingUnderscore == "YES")
1019
1020 asmTempLabelPrefix :: LitString  -- for formatting labels
1021 asmTempLabelPrefix =
1022 #if alpha_TARGET_OS
1023      {- The alpha assembler likes temporary labels to look like $L123
1024         instead of L123.  (Don't toss the L, because then Lf28
1025         turns into $f28.)
1026      -}
1027      (sLit "$")
1028 #elif darwin_TARGET_OS
1029      (sLit "L")
1030 #else
1031      (sLit ".L")
1032 #endif
1033
1034 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
1035
1036 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
1037 pprDynamicLinkerAsmLabel CodeStub lbl
1038   = char 'L' <> pprCLabel lbl <> text "$stub"
1039 pprDynamicLinkerAsmLabel SymbolPtr lbl
1040   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1041 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1042   = pprCLabel lbl <> text "@GOTPCREL"
1043 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1044   = pprCLabel lbl
1045 pprDynamicLinkerAsmLabel _ _
1046   = panic "pprDynamicLinkerAsmLabel"
1047
1048 #elif darwin_TARGET_OS
1049 pprDynamicLinkerAsmLabel CodeStub lbl
1050   = char 'L' <> pprCLabel lbl <> text "$stub"
1051 pprDynamicLinkerAsmLabel SymbolPtr lbl
1052   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1053 pprDynamicLinkerAsmLabel _ _
1054   = panic "pprDynamicLinkerAsmLabel"
1055
1056 #elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
1057 pprDynamicLinkerAsmLabel CodeStub lbl
1058   = pprCLabel lbl <> text "@plt"
1059 pprDynamicLinkerAsmLabel SymbolPtr lbl
1060   = text ".LC_" <> pprCLabel lbl
1061 pprDynamicLinkerAsmLabel _ _
1062   = panic "pprDynamicLinkerAsmLabel"
1063
1064 #elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
1065 pprDynamicLinkerAsmLabel CodeStub lbl
1066   = pprCLabel lbl <> text "@plt"
1067 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1068   = pprCLabel lbl <> text "@gotpcrel"
1069 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1070   = pprCLabel lbl
1071 pprDynamicLinkerAsmLabel SymbolPtr lbl
1072   = text ".LC_" <> pprCLabel lbl
1073
1074 #elif elf_OBJ_FORMAT
1075 pprDynamicLinkerAsmLabel CodeStub lbl
1076   = pprCLabel lbl <> text "@plt"
1077 pprDynamicLinkerAsmLabel SymbolPtr lbl
1078   = text ".LC_" <> pprCLabel lbl
1079 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1080   = pprCLabel lbl <> text "@got"
1081 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1082   = pprCLabel lbl <> text "@gotoff"
1083
1084 #elif mingw32_TARGET_OS
1085 pprDynamicLinkerAsmLabel SymbolPtr lbl
1086   = text "__imp_" <> pprCLabel lbl
1087 pprDynamicLinkerAsmLabel _ _
1088   = panic "pprDynamicLinkerAsmLabel"
1089
1090 #else
1091 pprDynamicLinkerAsmLabel _ _
1092   = panic "pprDynamicLinkerAsmLabel"
1093 #endif