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    -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
 812    CmmLabel pkg _ _
 813     -> not opt_Static && (this_pkg /= pkg)
 814
 815    IdLabel n _ k        -> isDllName this_pkg n
 816
 817 #if mingw32_TARGET_OS
 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 #endif
 835    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
 836    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 837    ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
 838
 839    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 840    _                 -> False
 841
 842 {-
 843 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 844 right places. It is used to detect when the abstractC statement of an
 845 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 846
 847 We need at least @Eq@ for @CLabels@, because we want to avoid
 848 duplicate declarations in generating C (see @labelSeenTE@ in
 849 @PprAbsC@).
 850 -}
 851
 852 -----------------------------------------------------------------------------
 853 -- Printing out CLabels.
 854
 855 {-
 856 Convention:
 857
 858       <name>_<type>
 859
 860 where <name> is <Module>_<name> for external names and <unique> for
 861 internal names. <type> is one of the following:
 862
 863          info                   Info table
 864          srt                    Static reference table
 865          srtd                   Static reference table descriptor
 866          entry                  Entry code (function, closure)
 867          slow                   Slow entry code (if any)
 868          ret                    Direct return address
 869          vtbl                   Vector table
 870          <n>_alt                Case alternative (tag n)
 871          dflt                   Default case alternative
 872          btm                    Large bitmap vector
 873          closure                Static closure
 874          con_entry              Dynamic Constructor entry code
 875          con_info               Dynamic Constructor info table
 876          static_entry           Static Constructor entry code
 877          static_info            Static Constructor info table
 878          sel_info               Selector info table
 879          sel_entry              Selector entry code
 880          cc                     Cost centre
 881          ccs                    Cost centre stack
 882
 883 Many of these distinctions are only for documentation reasons.  For
 884 example, _ret is only distinguished from _entry to make it easy to
 885 tell whether a code fragment is a return point or a closure/function
 886 entry.
 887 -}
 888
 889 instance Outputable CLabel where
 890   ppr = pprCLabel
 891
 892 pprCLabel :: CLabel -> SDoc
 893
 894 #if ! OMIT_NATIVE_CODEGEN
 895 pprCLabel (AsmTempLabel u)
 896   =  getPprStyle $ \ sty ->
 897      if asmStyle sty then
 898         ptext asmTempLabelPrefix <> pprUnique u
 899      else
 900         char '_' <> pprUnique u
 901
 902 pprCLabel (DynamicLinkerLabel info lbl)
 903    = pprDynamicLinkerAsmLabel info lbl
 904
 905 pprCLabel PicBaseLabel
 906    = ptext (sLit "1b")
 907
 908 pprCLabel (DeadStripPreventer lbl)
 909    = pprCLabel lbl <> ptext (sLit "_dsp")
 910 #endif
 911
 912 pprCLabel lbl =
 913 #if ! OMIT_NATIVE_CODEGEN
 914     getPprStyle $ \ sty ->
 915     if asmStyle sty then
 916         maybe_underscore (pprAsmCLbl lbl)
 917     else
 918 #endif
 919        pprCLbl lbl
 920
 921 maybe_underscore doc
 922   | underscorePrefix = pp_cSEP <> doc
 923   | otherwise        = doc
 924
 925 #ifdef mingw32_TARGET_OS
 926 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 927 -- (The C compiler does this itself).
 928 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
 929    = ftext fs <> char '@' <> int sz
 930 #endif
 931 pprAsmCLbl lbl
 932    = pprCLbl lbl
 933
 934 pprCLbl (StringLitLabel u)
 935   = pprUnique u <> ptext (sLit "_str")
 936
 937 pprCLbl (CaseLabel u CaseReturnPt)
 938   = hcat [pprUnique u, ptext (sLit "_ret")]
 939 pprCLbl (CaseLabel u CaseReturnInfo)
 940   = hcat [pprUnique u, ptext (sLit "_info")]
 941 pprCLbl (CaseLabel u (CaseAlt tag))
 942   = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
 943 pprCLbl (CaseLabel u CaseDefault)
 944   = hcat [pprUnique u, ptext (sLit "_dflt")]
 945
 946 pprCLbl (LargeSRTLabel u)  = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
 947 pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
 948 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
 949 -- until that gets resolved we'll just force them to start
 950 -- with a letter so the label will be legal assmbly code.
 951
 952
 953 pprCLbl (CmmLabel _ str CmmCode)        = ftext str
 954 pprCLbl (CmmLabel _ str CmmData)        = ftext str
 955 pprCLbl (CmmLabel _ str CmmGcPtr)       = ftext str
 956 pprCLbl (CmmLabel _ str CmmPrimCall)    = ftext str
 957
 958 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 959
 960 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 961   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 962                 ptext (if upd_reqd
 963                         then (sLit "_upd_info")
 964                         else (sLit "_noupd_info"))
 965         ]
 966
 967 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 968   = hcat [ptext (sLit "stg_sel_"), text (show offset),
 969                 ptext (if upd_reqd
 970                         then (sLit "_upd_entry")
 971                         else (sLit "_noupd_entry"))
 972         ]
 973
 974 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 975   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 976                 ptext (if upd_reqd
 977                         then (sLit "_upd_info")
 978                         else (sLit "_noupd_info"))
 979         ]
 980
 981 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 982   = hcat [ptext (sLit "stg_ap_"), text (show arity),
 983                 ptext (if upd_reqd
 984                         then (sLit "_upd_entry")
 985                         else (sLit "_noupd_entry"))
 986         ]
 987
 988 pprCLbl (CmmLabel _ fs CmmInfo)
 989   = ftext fs <> ptext (sLit "_info")
 990
 991 pprCLbl (CmmLabel _ fs CmmEntry)
 992   = ftext fs <> ptext (sLit "_entry")
 993
 994 pprCLbl (CmmLabel _ fs CmmRetInfo)
 995   = ftext fs <> ptext (sLit "_info")
 996
 997 pprCLbl (CmmLabel _ fs CmmRet)
 998   = ftext fs <> ptext (sLit "_ret")
 999
1000 pprCLbl (RtsLabel (RtsPrimOp primop))
1001   = ptext (sLit "stg_") <> ppr primop
1002
1003 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
1004   = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
1005
1006 pprCLbl ModuleRegdLabel
1007   = ptext (sLit "_module_registered")
1008
1009 pprCLbl (ForeignLabel str _ _ _)
1010   = ftext str
1011
1012 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
1013
1014 pprCLbl (CC_Label cc)           = ppr cc
1015 pprCLbl (CCS_Label ccs)         = ppr ccs
1016
1017 pprCLbl (ModuleInitLabel mod way)
1018    = ptext (sLit "__stginit_") <> ppr mod
1019         <> char '_' <> text way
1020
1021 pprCLbl (PlainModuleInitLabel mod)
1022    = ptext (sLit "__stginit_") <> ppr mod
1023
1024 pprCLbl (ModuleInitTableLabel mod)
1025    = ptext (sLit "__stginittable_") <> ppr mod
1026
1027 pprCLbl (HpcTicksLabel mod)
1028   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
1029
1030 pprCLbl HpcModuleNameLabel
1031   = ptext (sLit "_hpc_module_name_str")
1032
1033 ppIdFlavor :: IdLabelInfo -> SDoc
1034 ppIdFlavor x = pp_cSEP <>
1035                (case x of
1036                        Closure          -> ptext (sLit "closure")
1037                        SRT              -> ptext (sLit "srt")
1038                        InfoTable        -> ptext (sLit "info")
1039                        Entry            -> ptext (sLit "entry")
1040                        Slow             -> ptext (sLit "slow")
1041                        RednCounts       -> ptext (sLit "ct")
1042                        ConEntry         -> ptext (sLit "con_entry")
1043                        ConInfoTable     -> ptext (sLit "con_info")
1044                        StaticConEntry   -> ptext (sLit "static_entry")
1045                        StaticInfoTable  -> ptext (sLit "static_info")
1046                        ClosureTable     -> ptext (sLit "closure_tbl")
1047                       )
1048
1049
1050 pp_cSEP = char '_'
1051
1052
1053 instance Outputable ForeignLabelSource where
1054  ppr fs
1055   = case fs of
1056         ForeignLabelInPackage pkgId     -> parens $ text "package: " <> ppr pkgId
1057         ForeignLabelInThisPackage       -> parens $ text "this package"
1058         ForeignLabelInExternalPackage   -> parens $ text "external package"
1059
1060 -- -----------------------------------------------------------------------------
1061 -- Machine-dependent knowledge about labels.
1062
1063 underscorePrefix :: Bool   -- leading underscore on assembler labels?
1064 underscorePrefix = (cLeadingUnderscore == "YES")
1065
1066 asmTempLabelPrefix :: LitString  -- for formatting labels
1067 asmTempLabelPrefix =
1068 #if alpha_TARGET_OS
1069      {- The alpha assembler likes temporary labels to look like $L123
1070         instead of L123.  (Don't toss the L, because then Lf28
1071         turns into $f28.)
1072      -}
1073      (sLit "$")
1074 #elif darwin_TARGET_OS
1075      (sLit "L")
1076 #else
1077      (sLit ".L")
1078 #endif
1079
1080 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
1081
1082 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
1083 pprDynamicLinkerAsmLabel CodeStub lbl
1084   = char 'L' <> pprCLabel lbl <> text "$stub"
1085 pprDynamicLinkerAsmLabel SymbolPtr lbl
1086   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1087 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1088   = pprCLabel lbl <> text "@GOTPCREL"
1089 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1090   = pprCLabel lbl
1091 pprDynamicLinkerAsmLabel _ _
1092   = panic "pprDynamicLinkerAsmLabel"
1093
1094 #elif darwin_TARGET_OS
1095 pprDynamicLinkerAsmLabel CodeStub lbl
1096   = char 'L' <> pprCLabel lbl <> text "$stub"
1097 pprDynamicLinkerAsmLabel SymbolPtr lbl
1098   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1099 pprDynamicLinkerAsmLabel _ _
1100   = panic "pprDynamicLinkerAsmLabel"
1101
1102 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
1103 pprDynamicLinkerAsmLabel CodeStub lbl
1104   = pprCLabel lbl <> text "@plt"
1105 pprDynamicLinkerAsmLabel SymbolPtr lbl
1106   = text ".LC_" <> pprCLabel lbl
1107 pprDynamicLinkerAsmLabel _ _
1108   = panic "pprDynamicLinkerAsmLabel"
1109
1110 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
1111 pprDynamicLinkerAsmLabel CodeStub lbl
1112   = pprCLabel lbl <> text "@plt"
1113 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1114   = pprCLabel lbl <> text "@gotpcrel"
1115 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1116   = pprCLabel lbl
1117 pprDynamicLinkerAsmLabel SymbolPtr lbl
1118   = text ".LC_" <> pprCLabel lbl
1119
1120 #elif linux_TARGET_OS
1121 pprDynamicLinkerAsmLabel CodeStub lbl
1122   = pprCLabel lbl <> text "@plt"
1123 pprDynamicLinkerAsmLabel SymbolPtr lbl
1124   = text ".LC_" <> pprCLabel lbl
1125 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1126   = pprCLabel lbl <> text "@got"
1127 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1128   = pprCLabel lbl <> text "@gotoff"
1129
1130 #elif mingw32_TARGET_OS
1131 pprDynamicLinkerAsmLabel SymbolPtr lbl
1132   = text "__imp_" <> pprCLabel lbl
1133 pprDynamicLinkerAsmLabel _ _
1134   = panic "pprDynamicLinkerAsmLabel"
1135
1136 #else
1137 pprDynamicLinkerAsmLabel _ _
1138   = panic "pprDynamicLinkerAsmLabel"
1139 #endif