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