compiler/cmm/CLabel.hs

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