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