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