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 abovoid 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 #if ! OMIT_NATIVE_CODEGEN
 858 pprCLabel (AsmTempLabel u)
 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    = pprDynamicLinkerAsmLabel info lbl
 867
 868 pprCLabel PicBaseLabel
 869    = ptext (sLit "1b")
 870
 871 pprCLabel (DeadStripPreventer lbl)
 872    = pprCLabel lbl <> ptext (sLit "_dsp")
 873 #endif
 874
 875 pprCLabel lbl =
 876 #if ! OMIT_NATIVE_CODEGEN
 877     getPprStyle $ \ sty ->
 878     if asmStyle sty then
 879         maybe_underscore (pprAsmCLbl lbl)
 880     else
 881 #endif
 882        pprCLbl lbl
 883
 884 maybe_underscore doc
 885   | underscorePrefix = pp_cSEP <> doc
 886   | otherwise        = doc
 887
 888 #ifdef mingw32_TARGET_OS
 889 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 890 -- (The C compiler does this itself).
 891 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
 892    = ftext fs <> char '@' <> int sz
 893 #endif
 894 pprAsmCLbl lbl
 895    = pprCLbl lbl
 896
 897 pprCLbl (StringLitLabel u)
 898   = pprUnique u <> ptext (sLit "_str")
 899
 900 pprCLbl (CaseLabel u CaseReturnPt)
 901   = hcat [pprUnique u, ptext (sLit "_ret")]
 902 pprCLbl (CaseLabel u CaseReturnInfo)
 903   = hcat [pprUnique u, ptext (sLit "_info")]
 904 pprCLbl (CaseLabel u (CaseAlt tag))
 905   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 906 pprCLbl (CaseLabel u CaseDefault)
 907   = hcat [pprUnique u, ptext (sLit "_dflt")]
 908
 909 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 910 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 911 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 912 -- until that gets resolved we'll just force them to start
 913 -- with a letter so the label will be legal assmbly code.
 914
 915
 916 pprCLbl (CmmLabel _ str CmmCode)        = ftext str
 917 pprCLbl (CmmLabel _ str CmmData)        = ftext str
 918 pprCLbl (CmmLabel _ str CmmGcPtr)       = ftext str
 919 pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 920
 921 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 922
 923 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 924   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 925                 ptext (if upd_reqd
 926                         then (sLit "_upd_info")
 927                         else (sLit "_noupd_info"))
 928         ]
 929
 930 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 931   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 932                 ptext (if upd_reqd
 933                         then (sLit "_upd_entry")
 934                         else (sLit "_noupd_entry"))
 935         ]
 936
 937 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 938   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 939                 ptext (if upd_reqd
 940                         then (sLit "_upd_info")
 941                         else (sLit "_noupd_info"))
 942         ]
 943
 944 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 945   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 946                 ptext (if upd_reqd
 947                         then (sLit "_upd_entry")
 948                         else (sLit "_noupd_entry"))
 949         ]
 950
 951 pprCLbl (CmmLabel _ fs CmmInfo)
 952   = ftext fs <> ptext (sLit "_info")
 953
 954 pprCLbl (CmmLabel _ fs CmmEntry)
 955   = ftext fs <> ptext (sLit "_entry")
 956
 957 pprCLbl (CmmLabel _ fs CmmRetInfo)
 958   = ftext fs <> ptext (sLit "_info")
 959
 960 pprCLbl (CmmLabel _ fs CmmRet)
 961   = ftext fs <> ptext (sLit "_ret")
 962
 963 pprCLbl (RtsLabel (RtsPrimOp primop))
 964   = ptext (sLit "stg_") <> ppr primop
 965
 966 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 967   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
 968
 969 pprCLbl (ForeignLabel str _ _ _)
 970   = ftext str
 971
 972 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor name flavor
 973
 974 pprCLbl (CC_Label cc)           = ppr cc
 975 pprCLbl (CCS_Label ccs)         = ppr ccs
 976
 977 pprCLbl (PlainModuleInitLabel mod)
 978    = ptext (sLit "__stginit_") <> ppr mod
 979
 980 pprCLbl (HpcTicksLabel mod)
 981   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 982
 983 ppIdFlavor :: Name -> IdLabelInfo -> SDoc
 984 ppIdFlavor n x = pp_cSEP <> closureSuffix' n <>
 985                (case x of
 986                        Closure          -> ptext (sLit "closure")
 987                        SRT              -> ptext (sLit "srt")
 988                        InfoTable        -> ptext (sLit "info")
 989                        Entry            -> ptext (sLit "entry")
 990                        Slow             -> ptext (sLit "slow")
 991                        RednCounts       -> ptext (sLit "ct")
 992                        ConEntry         -> ptext (sLit "con_entry")
 993                        ConInfoTable     -> ptext (sLit "con_info")
 994                        StaticConEntry   -> ptext (sLit "static_entry")
 995                        StaticInfoTable  -> ptext (sLit "static_info")
 996                        ClosureTable     -> ptext (sLit "closure_tbl")
 997                       )
 998
 999
1000 pp_cSEP = char '_'
1001
1002
1003 instance Outputable ForeignLabelSource where
1004  ppr fs
1005   = case fs of
1006         ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
1007         ForeignLabelInThisPackage       -> parens $ text "this package"
1008         ForeignLabelInExternalPackage   -> parens $ text "external package"
1009
1010 -- -----------------------------------------------------------------------------
1011 -- Machine-dependent knowledge about labels.
1012
1013 underscorePrefix :: Bool   -- leading underscore on assembler labels?
1014 underscorePrefix = (cLeadingUnderscore == "YES")
1015
1016 asmTempLabelPrefix :: LitString  -- for formatting labels
1017 asmTempLabelPrefix =
1018 #if alpha_TARGET_OS
1019      {- The alpha assembler likes temporary labels to look like $L123
1020         instead of L123.  (Don't toss the L, because then Lf28
1021         turns into $f28.)
1022      -}
1023      (sLit "$")
1024 #elif darwin_TARGET_OS
1025      (sLit "L")
1026 #else
1027      (sLit ".L")
1028 #endif
1029
1030 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
1031
1032 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
1033 pprDynamicLinkerAsmLabel CodeStub lbl
1034   = char 'L' <> pprCLabel lbl <> text "$stub"
1035 pprDynamicLinkerAsmLabel SymbolPtr lbl
1036   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1037 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1038   = pprCLabel lbl <> text "@GOTPCREL"
1039 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1040   = pprCLabel lbl
1041 pprDynamicLinkerAsmLabel _ _
1042   = panic "pprDynamicLinkerAsmLabel"
1043
1044 #elif darwin_TARGET_OS
1045 pprDynamicLinkerAsmLabel CodeStub lbl
1046   = char 'L' <> pprCLabel lbl <> text "$stub"
1047 pprDynamicLinkerAsmLabel SymbolPtr lbl
1048   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1049 pprDynamicLinkerAsmLabel _ _
1050   = panic "pprDynamicLinkerAsmLabel"
1051
1052 #elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
1053 pprDynamicLinkerAsmLabel CodeStub lbl
1054   = pprCLabel lbl <> text "@plt"
1055 pprDynamicLinkerAsmLabel SymbolPtr lbl
1056   = text ".LC_" <> pprCLabel lbl
1057 pprDynamicLinkerAsmLabel _ _
1058   = panic "pprDynamicLinkerAsmLabel"
1059
1060 #elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
1061 pprDynamicLinkerAsmLabel CodeStub lbl
1062   = pprCLabel lbl <> text "@plt"
1063 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1064   = pprCLabel lbl <> text "@gotpcrel"
1065 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1066   = pprCLabel lbl
1067 pprDynamicLinkerAsmLabel SymbolPtr lbl
1068   = text ".LC_" <> pprCLabel lbl
1069
1070 #elif elf_OBJ_FORMAT
1071 pprDynamicLinkerAsmLabel CodeStub lbl
1072   = pprCLabel lbl <> text "@plt"
1073 pprDynamicLinkerAsmLabel SymbolPtr lbl
1074   = text ".LC_" <> pprCLabel lbl
1075 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1076   = pprCLabel lbl <> text "@got"
1077 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1078   = pprCLabel lbl <> text "@gotoff"
1079
1080 #elif mingw32_TARGET_OS
1081 pprDynamicLinkerAsmLabel SymbolPtr lbl
1082   = text "__imp_" <> pprCLabel lbl
1083 pprDynamicLinkerAsmLabel _ _
1084   = panic "pprDynamicLinkerAsmLabel"
1085
1086 #else
1087 pprDynamicLinkerAsmLabel _ _
1088   = panic "pprDynamicLinkerAsmLabel"
1089 #endif