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