ghc/compiler/cmm/CLabel.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Object-file symbols (called CLabel for histerical raisins).
   4 --
   5 -- (c) The University of Glasgow 2004
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CLabel (
  10         CLabel, -- abstract type
  11
  12         mkClosureLabel,
  13         mkSRTLabel,
  14         mkSRTDescLabel,
  15         mkInfoTableLabel,
  16         mkEntryLabel,
  17         mkSlowEntryLabel,
  18         mkConEntryLabel,
  19         mkStaticConEntryLabel,
  20         mkRednCountsLabel,
  21         mkConInfoTableLabel,
  22         mkStaticInfoTableLabel,
  23         mkApEntryLabel,
  24         mkApInfoTableLabel,
  25         mkClosureTableLabel,
  26
  27         mkLocalClosureLabel,
  28         mkLocalInfoTableLabel,
  29         mkLocalEntryLabel,
  30         mkLocalConEntryLabel,
  31         mkLocalStaticConEntryLabel,
  32         mkLocalConInfoTableLabel,
  33         mkLocalStaticInfoTableLabel,
  34         mkLocalClosureTableLabel,
  35
  36         mkReturnPtLabel,
  37         mkReturnInfoLabel,
  38         mkAltLabel,
  39         mkDefaultLabel,
  40         mkBitmapLabel,
  41         mkStringLitLabel,
  42
  43         mkAsmTempLabel,
  44
  45         mkModuleInitLabel,
  46         mkPlainModuleInitLabel,
  47
  48         mkSplitMarkerLabel,
  49         mkUpdInfoLabel,
  50         mkSeqInfoLabel,
  51         mkIndStaticInfoLabel,
  52         mkMainCapabilityLabel,
  53         mkMAP_FROZEN_infoLabel,
  54         mkEMPTY_MVAR_infoLabel,
  55
  56         mkTopTickyCtrLabel,
  57         mkCAFBlackHoleInfoTableLabel,
  58         mkSECAFBlackHoleInfoTableLabel,
  59         mkRtsPrimOpLabel,
  60         mkRtsSlowTickyCtrLabel,
  61
  62         moduleRegdLabel,
  63
  64         mkSelectorInfoLabel,
  65         mkSelectorEntryLabel,
  66
  67         mkRtsInfoLabel,
  68         mkRtsEntryLabel,
  69         mkRtsRetInfoLabel,
  70         mkRtsRetLabel,
  71         mkRtsCodeLabel,
  72         mkRtsDataLabel,
  73
  74         mkRtsInfoLabelFS,
  75         mkRtsEntryLabelFS,
  76         mkRtsRetInfoLabelFS,
  77         mkRtsRetLabelFS,
  78         mkRtsCodeLabelFS,
  79         mkRtsDataLabelFS,
  80
  81         mkForeignLabel,
  82
  83         mkCCLabel, mkCCSLabel,
  84
  85         DynamicLinkerLabelInfo(..),
  86         mkDynamicLinkerLabel,
  87         dynamicLinkerLabelInfo,
  88
  89         mkPicBaseLabel,
  90         mkDeadStripPreventer,
  91
  92         infoLblToEntryLbl, entryLblToInfoLbl,
  93         needsCDecl, isAsmTemp, externallyVisibleCLabel,
  94         CLabelType(..), labelType, labelDynamic,
  95
  96         pprCLabel
  97     ) where
  98
  99
 100 #include "HsVersions.h"
 101
 102 import CmdLineOpts      ( DynFlags, opt_Static, opt_DoTickyProfiling )
 103 import Packages         ( isHomeModule, isDllName )
 104 import DataCon          ( ConTag )
 105 import Module           ( moduleFS, Module )
 106 import Name             ( Name, isExternalName )
 107 import Unique           ( pprUnique, Unique )
 108 import PrimOp           ( PrimOp )
 109 import Config           ( cLeadingUnderscore )
 110 import CostCentre       ( CostCentre, CostCentreStack )
 111 import Outputable
 112 import FastString
 113
 114 -- -----------------------------------------------------------------------------
 115 -- The CLabel type
 116
 117 {-
 118 CLabel is an abstract type that supports the following operations:
 119
 120   - Pretty printing
 121
 122   - In a C file, does it need to be declared before use?  (i.e. is it
 123     guaranteed to be already in scope in the places we need to refer to it?)
 124
 125   - If it needs to be declared, what type (code or data) should it be
 126     declared to have?
 127
 128   - Is it visible outside this object file or not?
 129
 130   - Is it "dynamic" (see details below)
 131
 132   - Eq and Ord, so that we can make sets of CLabels (currently only
 133     used in outputting C as far as I can tell, to avoid generating
 134     more than one declaration for any given label).
 135
 136   - Converting an info table label into an entry label.
 137 -}
 138
 139 data CLabel
 140   = IdLabel                     -- A family of labels related to the
 141         Name                    -- definition of a particular Id or Con
 142         IdLabelInfo
 143
 144   | DynIdLabel                  -- like IdLabel, but in a separate package,
 145         Name                    -- and might therefore need a dynamic
 146         IdLabelInfo             -- reference.
 147
 148   | CaseLabel                   -- A family of labels related to a particular
 149                                 -- case expression.
 150         {-# UNPACK #-} !Unique  -- Unique says which case expression
 151         CaseLabelInfo
 152
 153   | AsmTempLabel
 154         {-# UNPACK #-} !Unique
 155
 156   | StringLitLabel
 157         {-# UNPACK #-} !Unique
 158
 159   | ModuleInitLabel
 160         Module                  -- the module name
 161         String                  -- its "way"
 162         Bool                    -- True <=> is in a different package
 163         -- at some point we might want some kind of version number in
 164         -- the module init label, to guard against compiling modules in
 165         -- the wrong order.  We can't use the interface file version however,
 166         -- because we don't always recompile modules which depend on a module
 167         -- whose version has changed.
 168
 169   | PlainModuleInitLabel        -- without the vesrion & way info
 170         Module
 171         Bool                    -- True <=> is in a different package
 172
 173   | ModuleRegdLabel
 174
 175   | RtsLabel RtsLabelInfo
 176
 177   | ForeignLabel FastString     -- a 'C' (or otherwise foreign) label
 178         (Maybe Int)             -- possible '@n' suffix for stdcall functions
 179                 -- When generating C, the '@n' suffix is omitted, but when
 180                 -- generating assembler we must add it to the label.
 181         Bool                    -- True <=> is dynamic
 182
 183   | CC_Label  CostCentre
 184   | CCS_Label CostCentreStack
 185
 186       -- Dynamic Linking in the NCG:
 187       -- generated and used inside the NCG only,
 188       -- see module PositionIndependentCode for details.
 189
 190   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 191         -- special variants of a label used for dynamic linking
 192
 193   | PicBaseLabel                -- a label used as a base for PIC calculations
 194                                 -- on some platforms.
 195                                 -- It takes the form of a local numeric
 196                                 -- assembler label '1'; it is pretty-printed
 197                                 -- as 1b, referring to the previous definition
 198                                 -- of 1: in the assembler source file.
 199
 200   | DeadStripPreventer CLabel
 201     -- label before an info table to prevent excessive dead-stripping on darwin
 202
 203   deriving (Eq, Ord)
 204
 205 data IdLabelInfo
 206   = Closure             -- Label for closure
 207   | SRT                 -- Static reference table
 208   | SRTDesc             -- Static reference table descriptor
 209   | InfoTable           -- Info tables for closures; always read-only
 210   | Entry               -- entry point
 211   | Slow                -- slow entry point
 212
 213   | RednCounts          -- Label of place to keep Ticky-ticky  info for
 214                         -- this Id
 215
 216   | Bitmap              -- A bitmap (function or case return)
 217
 218   | ConEntry            -- constructor entry point
 219   | ConInfoTable                -- corresponding info table
 220   | StaticConEntry      -- static constructor entry point
 221   | StaticInfoTable     -- corresponding info table
 222
 223   | ClosureTable        -- table of closures for Enum tycons
 224
 225   deriving (Eq, Ord)
 226
 227
 228 data CaseLabelInfo
 229   = CaseReturnPt
 230   | CaseReturnInfo
 231   | CaseAlt ConTag
 232   | CaseDefault
 233   deriving (Eq, Ord)
 234
 235
 236 data RtsLabelInfo
 237   = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}        -- Selector thunks
 238   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 239
 240   | RtsApInfoTable Bool{-updatable-} Int{-arity-}               -- AP thunks
 241   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 242
 243   | RtsPrimOp PrimOp
 244
 245   | RtsInfo       LitString     -- misc rts info tables
 246   | RtsEntry      LitString     -- misc rts entry points
 247   | RtsRetInfo    LitString     -- misc rts ret info tables
 248   | RtsRet        LitString     -- misc rts return points
 249   | RtsData       LitString     -- misc rts data bits, eg CHARLIKE_closure
 250   | RtsCode       LitString     -- misc rts code
 251
 252   | RtsInfoFS     FastString    -- misc rts info tables
 253   | RtsEntryFS    FastString    -- misc rts entry points
 254   | RtsRetInfoFS  FastString    -- misc rts ret info tables
 255   | RtsRetFS      FastString    -- misc rts return points
 256   | RtsDataFS     FastString    -- misc rts data bits, eg CHARLIKE_closure
 257   | RtsCodeFS     FastString    -- misc rts code
 258
 259   | RtsSlowTickyCtr String
 260
 261   deriving (Eq, Ord)
 262         -- NOTE: Eq on LitString compares the pointer only, so this isn't
 263         -- a real equality.
 264
 265 data DynamicLinkerLabelInfo
 266   = CodeStub            -- MachO: Lfoo$stub, ELF: foo@plt
 267   | SymbolPtr           -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
 268   | GotSymbolPtr        -- ELF: foo@got
 269   | GotSymbolOffset     -- ELF: foo@gotoff
 270
 271   deriving (Eq, Ord)
 272
 273 -- -----------------------------------------------------------------------------
 274 -- Constructing CLabels
 275
 276 -- These are always local:
 277 mkSRTLabel              name    = IdLabel name  SRT
 278 mkSRTDescLabel          name    = IdLabel name  SRTDesc
 279 mkSlowEntryLabel        name    = IdLabel name  Slow
 280 mkBitmapLabel           name    = IdLabel name  Bitmap
 281 mkRednCountsLabel       name    = IdLabel name  RednCounts
 282
 283 -- These have local & (possibly) external variants:
 284 mkLocalClosureLabel     name    = IdLabel name  Closure
 285 mkLocalInfoTableLabel   name    = IdLabel name  InfoTable
 286 mkLocalEntryLabel       name    = IdLabel name  Entry
 287 mkLocalClosureTableLabel name   = IdLabel name ClosureTable
 288
 289 mkClosureLabel dflags name
 290   | isDllName dflags name = DynIdLabel    name Closure
 291   | otherwise             = IdLabel name Closure
 292
 293 mkInfoTableLabel dflags name
 294   | isDllName dflags name = DynIdLabel    name InfoTable
 295   | otherwise            = IdLabel name InfoTable
 296
 297 mkEntryLabel dflags name
 298   | isDllName dflags name = DynIdLabel    name Entry
 299   | otherwise             = IdLabel name Entry
 300
 301 mkClosureTableLabel dflags name
 302   | isDllName dflags name = DynIdLabel    name ClosureTable
 303   | otherwise             = IdLabel name ClosureTable
 304
 305 mkLocalConInfoTableLabel     con = IdLabel con ConInfoTable
 306 mkLocalConEntryLabel         con = IdLabel con ConEntry
 307 mkLocalStaticInfoTableLabel  con = IdLabel con StaticInfoTable
 308 mkLocalStaticConEntryLabel   con = IdLabel con StaticConEntry
 309
 310 mkConInfoTableLabel name False = IdLabel    name ConInfoTable
 311 mkConInfoTableLabel name True  = DynIdLabel name ConInfoTable
 312
 313 mkStaticInfoTableLabel name False = IdLabel    name StaticInfoTable
 314 mkStaticInfoTableLabel name True  = DynIdLabel name StaticInfoTable
 315
 316 mkConEntryLabel dflags name
 317   | isDllName dflags name = DynIdLabel    name ConEntry
 318   | otherwise             = IdLabel name ConEntry
 319
 320 mkStaticConEntryLabel dflags name
 321   | isDllName dflags name = DynIdLabel    name StaticConEntry
 322   | otherwise             = IdLabel name StaticConEntry
 323
 324
 325 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 326 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 327 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 328 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 329
 330 mkStringLitLabel                = StringLitLabel
 331 mkAsmTempLabel                  = AsmTempLabel
 332
 333 mkModuleInitLabel :: DynFlags -> Module -> String -> CLabel
 334 mkModuleInitLabel dflags mod way
 335   = ModuleInitLabel mod way $! (not (isHomeModule dflags mod))
 336
 337 mkPlainModuleInitLabel :: DynFlags -> Module -> CLabel
 338 mkPlainModuleInitLabel dflags mod
 339   = PlainModuleInitLabel mod $! (not (isHomeModule dflags mod))
 340
 341         -- Some fixed runtime system labels
 342
 343 mkSplitMarkerLabel              = RtsLabel (RtsCode SLIT("__stg_split_marker"))
 344 mkUpdInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_upd_frame"))
 345 mkSeqInfoLabel                  = RtsLabel (RtsInfo SLIT("stg_seq_frame"))
 346 mkIndStaticInfoLabel            = RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
 347 mkMainCapabilityLabel           = RtsLabel (RtsData SLIT("MainCapability"))
 348 mkMAP_FROZEN_infoLabel          = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN"))
 349 mkEMPTY_MVAR_infoLabel          = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
 350
 351 mkTopTickyCtrLabel              = RtsLabel (RtsData SLIT("top_ct"))
 352 mkCAFBlackHoleInfoTableLabel    = RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE"))
 353 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 354                                     RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE"))
 355                                   else  -- RTS won't have info table unless -ticky is on
 356                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 357 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 358
 359 moduleRegdLabel                 = ModuleRegdLabel
 360
 361 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
 362 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry   upd off)
 363
 364 mkApInfoTableLabel  upd off     = RtsLabel (RtsApInfoTable upd off)
 365 mkApEntryLabel upd off          = RtsLabel (RtsApEntry   upd off)
 366
 367         -- Foreign labels
 368
 369 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
 370 mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
 371
 372         -- Cost centres etc.
 373
 374 mkCCLabel       cc              = CC_Label cc
 375 mkCCSLabel      ccs             = CCS_Label ccs
 376
 377 mkRtsInfoLabel      str = RtsLabel (RtsInfo      str)
 378 mkRtsEntryLabel     str = RtsLabel (RtsEntry     str)
 379 mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
 380 mkRtsRetLabel       str = RtsLabel (RtsRet       str)
 381 mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
 382 mkRtsDataLabel      str = RtsLabel (RtsData      str)
 383
 384 mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
 385 mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
 386 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
 387 mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
 388 mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
 389 mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
 390
 391 mkRtsSlowTickyCtrLabel :: String -> CLabel
 392 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
 393
 394         -- Dynamic linking
 395
 396 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
 397 mkDynamicLinkerLabel = DynamicLinkerLabel
 398
 399 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
 400 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
 401 dynamicLinkerLabelInfo _ = Nothing
 402
 403         -- Position independent code
 404
 405 mkPicBaseLabel :: CLabel
 406 mkPicBaseLabel = PicBaseLabel
 407
 408 mkDeadStripPreventer :: CLabel -> CLabel
 409 mkDeadStripPreventer lbl = DeadStripPreventer lbl
 410
 411 -- -----------------------------------------------------------------------------
 412 -- Converting info labels to entry labels.
 413
 414 infoLblToEntryLbl :: CLabel -> CLabel
 415 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
 416 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
 417 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
 418 infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
 419 infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
 420 infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry
 421 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 422 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 423 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
 424 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
 425 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 426 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 427
 428 entryLblToInfoLbl :: CLabel -> CLabel
 429 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
 430 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
 431 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
 432 entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
 433 entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
 434 entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
 435 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 436 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 437 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
 438 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 439 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 440 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 441
 442 -- -----------------------------------------------------------------------------
 443 -- Does a CLabel need declaring before use or not?
 444
 445 needsCDecl :: CLabel -> Bool
 446   -- False <=> it's pre-declared; don't bother
 447   -- don't bother declaring SRT & Bitmap labels, we always make sure
 448   -- they are defined before use.
 449 needsCDecl (IdLabel _ SRT)              = False
 450 needsCDecl (IdLabel _ SRTDesc)          = False
 451 needsCDecl (IdLabel _ Bitmap)           = False
 452 needsCDecl (IdLabel _ _)                = True
 453 needsCDecl (DynIdLabel _ _)             = True
 454 needsCDecl (CaseLabel _ _)              = True
 455 needsCDecl (ModuleInitLabel _ _ _)      = True
 456 needsCDecl (PlainModuleInitLabel _ _)   = True
 457 needsCDecl ModuleRegdLabel              = False
 458
 459 needsCDecl (CaseLabel _ _)              = False
 460 needsCDecl (StringLitLabel _)           = False
 461 needsCDecl (AsmTempLabel _)             = False
 462 needsCDecl (RtsLabel _)                 = False
 463 needsCDecl (ForeignLabel _ _ _)         = False
 464 needsCDecl (CC_Label _)                 = True
 465 needsCDecl (CCS_Label _)                = True
 466
 467 -- Whether the label is an assembler temporary:
 468
 469 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 470 isAsmTemp (AsmTempLabel _) = True
 471 isAsmTemp _                = False
 472
 473 -- -----------------------------------------------------------------------------
 474 -- Is a CLabel visible outside this object file or not?
 475
 476 -- From the point of view of the code generator, a name is
 477 -- externally visible if it has to be declared as exported
 478 -- in the .o file's symbol table; that is, made non-static.
 479
 480 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 481 externallyVisibleCLabel (CaseLabel _ _)    = False
 482 externallyVisibleCLabel (StringLitLabel _) = False
 483 externallyVisibleCLabel (AsmTempLabel _)   = False
 484 externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
 485 externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
 486 externallyVisibleCLabel ModuleRegdLabel    = False
 487 externallyVisibleCLabel (RtsLabel _)       = True
 488 externallyVisibleCLabel (ForeignLabel _ _ _) = True
 489 externallyVisibleCLabel (IdLabel name _)     = isExternalName name
 490 externallyVisibleCLabel (DynIdLabel name _)  = isExternalName name
 491 externallyVisibleCLabel (CC_Label _)       = True
 492 externallyVisibleCLabel (CCS_Label _)      = True
 493 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 494
 495 -- -----------------------------------------------------------------------------
 496 -- Finding the "type" of a CLabel
 497
 498 -- For generating correct types in label declarations:
 499
 500 data CLabelType
 501   = CodeLabel
 502   | DataLabel
 503
 504 labelType :: CLabel -> CLabelType
 505 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
 506 labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 507 labelType (RtsLabel (RtsData _))              = DataLabel
 508 labelType (RtsLabel (RtsCode _))              = CodeLabel
 509 labelType (RtsLabel (RtsInfo _))              = DataLabel
 510 labelType (RtsLabel (RtsEntry _))             = CodeLabel
 511 labelType (RtsLabel (RtsRetInfo _))           = DataLabel
 512 labelType (RtsLabel (RtsRet _))               = CodeLabel
 513 labelType (RtsLabel (RtsDataFS _))            = DataLabel
 514 labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
 515 labelType (RtsLabel (RtsInfoFS _))            = DataLabel
 516 labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
 517 labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 518 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 519 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 520 labelType (CaseLabel _ _)                     = CodeLabel
 521 labelType (ModuleInitLabel _ _ _)             = CodeLabel
 522 labelType (PlainModuleInitLabel _ _)          = CodeLabel
 523
 524 labelType (IdLabel _ info) = idInfoLabelType info
 525 labelType (DynIdLabel _ info) = idInfoLabelType info
 526 labelType _        = DataLabel
 527
 528 idInfoLabelType info =
 529   case info of
 530     InfoTable     -> DataLabel
 531     Closure       -> DataLabel
 532     Bitmap        -> DataLabel
 533     ConInfoTable  -> DataLabel
 534     StaticInfoTable -> DataLabel
 535     ClosureTable  -> DataLabel
 536     _             -> CodeLabel
 537
 538
 539 -- -----------------------------------------------------------------------------
 540 -- Does a CLabel need dynamic linkage?
 541
 542 -- When referring to data in code, we need to know whether
 543 -- that data resides in a DLL or not. [Win32 only.]
 544 -- @labelDynamic@ returns @True@ if the label is located
 545 -- in a DLL, be it a data reference or not.
 546
 547 labelDynamic :: CLabel -> Bool
 548 labelDynamic lbl =
 549   case lbl of
 550    RtsLabel _        -> not opt_Static  -- i.e., is the RTS in a DLL or not?
 551    IdLabel n k       -> False
 552    DynIdLabel n k    -> True
 553 #if mingw32_TARGET_OS
 554    ForeignLabel _ _ d  -> d
 555 #else
 556    -- On Mac OS X and on ELF platforms, false positives are OK,
 557    -- so we claim that all foreign imports come from dynamic libraries
 558    ForeignLabel _ _ _ -> True
 559 #endif
 560    ModuleInitLabel m _ dyn    -> not opt_Static && dyn
 561    PlainModuleInitLabel m dyn -> not opt_Static && dyn
 562
 563    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
 564    _                 -> False
 565
 566 {-
 567 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 568 right places. It is used to detect when the abstractC statement of an
 569 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 570
 571 We need at least @Eq@ for @CLabels@, because we want to avoid
 572 duplicate declarations in generating C (see @labelSeenTE@ in
 573 @PprAbsC@).
 574 -}
 575
 576 -----------------------------------------------------------------------------
 577 -- Printing out CLabels.
 578
 579 {-
 580 Convention:
 581
 582       <name>_<type>
 583
 584 where <name> is <Module>_<name> for external names and <unique> for
 585 internal names. <type> is one of the following:
 586
 587          info                   Info table
 588          srt                    Static reference table
 589          srtd                   Static reference table descriptor
 590          entry                  Entry code (function, closure)
 591          slow                   Slow entry code (if any)
 592          ret                    Direct return address
 593          vtbl                   Vector table
 594          <n>_alt                Case alternative (tag n)
 595          dflt                   Default case alternative
 596          btm                    Large bitmap vector
 597          closure                Static closure
 598          con_entry              Dynamic Constructor entry code
 599          con_info               Dynamic Constructor info table
 600          static_entry           Static Constructor entry code
 601          static_info            Static Constructor info table
 602          sel_info               Selector info table
 603          sel_entry              Selector entry code
 604          cc                     Cost centre
 605          ccs                    Cost centre stack
 606
 607 Many of these distinctions are only for documentation reasons.  For
 608 example, _ret is only distinguished from _entry to make it easy to
 609 tell whether a code fragment is a return point or a closure/function
 610 entry.
 611 -}
 612
 613 pprCLabel :: CLabel -> SDoc
 614
 615 #if ! OMIT_NATIVE_CODEGEN
 616 pprCLabel (AsmTempLabel u)
 617   =  getPprStyle $ \ sty ->
 618      if asmStyle sty then
 619         ptext asmTempLabelPrefix <> pprUnique u
 620      else
 621         char '_' <> pprUnique u
 622
 623 pprCLabel (DynamicLinkerLabel info lbl)
 624    = pprDynamicLinkerAsmLabel info lbl
 625
 626 pprCLabel PicBaseLabel
 627    = ptext SLIT("1b")
 628
 629 pprCLabel (DeadStripPreventer lbl)
 630    = pprCLabel lbl <> ptext SLIT("_dsp")
 631 #endif
 632
 633 pprCLabel lbl =
 634 #if ! OMIT_NATIVE_CODEGEN
 635     getPprStyle $ \ sty ->
 636     if asmStyle sty then
 637         maybe_underscore (pprAsmCLbl lbl)
 638     else
 639 #endif
 640        pprCLbl lbl
 641
 642 maybe_underscore doc
 643   | underscorePrefix = pp_cSEP <> doc
 644   | otherwise        = doc
 645
 646 #ifdef mingw32_TARGET_OS
 647 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
 648 -- (The C compiler does this itself).
 649 pprAsmCLbl (ForeignLabel fs (Just sz) _)
 650    = ftext fs <> char '@' <> int sz
 651 #endif
 652 pprAsmCLbl lbl
 653    = pprCLbl lbl
 654
 655 pprCLbl (StringLitLabel u)
 656   = pprUnique u <> ptext SLIT("_str")
 657
 658 pprCLbl (CaseLabel u CaseReturnPt)
 659   = hcat [pprUnique u, ptext SLIT("_ret")]
 660 pprCLbl (CaseLabel u CaseReturnInfo)
 661   = hcat [pprUnique u, ptext SLIT("_info")]
 662 pprCLbl (CaseLabel u (CaseAlt tag))
 663   = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
 664 pprCLbl (CaseLabel u CaseDefault)
 665   = hcat [pprUnique u, ptext SLIT("_dflt")]
 666
 667 pprCLbl (RtsLabel (RtsCode str))   = ptext str
 668 pprCLbl (RtsLabel (RtsData str))   = ptext str
 669 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 670 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 671
 672 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
 673   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 674                 ptext (if upd_reqd
 675                         then SLIT("_upd_info")
 676                         else SLIT("_noupd_info"))
 677         ]
 678
 679 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 680   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 681                 ptext (if upd_reqd
 682                         then SLIT("_upd_entry")
 683                         else SLIT("_noupd_entry"))
 684         ]
 685
 686 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
 687   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 688                 ptext (if upd_reqd
 689                         then SLIT("_upd_info")
 690                         else SLIT("_noupd_info"))
 691         ]
 692
 693 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 694   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 695                 ptext (if upd_reqd
 696                         then SLIT("_upd_entry")
 697                         else SLIT("_noupd_entry"))
 698         ]
 699
 700 pprCLbl (RtsLabel (RtsInfo fs))
 701   = ptext fs <> ptext SLIT("_info")
 702
 703 pprCLbl (RtsLabel (RtsEntry fs))
 704   = ptext fs <> ptext SLIT("_entry")
 705
 706 pprCLbl (RtsLabel (RtsRetInfo fs))
 707   = ptext fs <> ptext SLIT("_info")
 708
 709 pprCLbl (RtsLabel (RtsRet fs))
 710   = ptext fs <> ptext SLIT("_ret")
 711
 712 pprCLbl (RtsLabel (RtsInfoFS fs))
 713   = ftext fs <> ptext SLIT("_info")
 714
 715 pprCLbl (RtsLabel (RtsEntryFS fs))
 716   = ftext fs <> ptext SLIT("_entry")
 717
 718 pprCLbl (RtsLabel (RtsRetInfoFS fs))
 719   = ftext fs <> ptext SLIT("_info")
 720
 721 pprCLbl (RtsLabel (RtsRetFS fs))
 722   = ftext fs <> ptext SLIT("_ret")
 723
 724 pprCLbl (RtsLabel (RtsPrimOp primop))
 725   = ppr primop <> ptext SLIT("_fast")
 726
 727 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 728   = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
 729
 730 pprCLbl ModuleRegdLabel
 731   = ptext SLIT("_module_registered")
 732
 733 pprCLbl (ForeignLabel str _ _)
 734   = ftext str
 735
 736 pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 737 pprCLbl (DynIdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 738
 739 pprCLbl (CC_Label cc)           = ppr cc
 740 pprCLbl (CCS_Label ccs)         = ppr ccs
 741
 742 pprCLbl (ModuleInitLabel mod way _)
 743    = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
 744         <> char '_' <> text way
 745 pprCLbl (PlainModuleInitLabel mod _)
 746    = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
 747
 748 ppIdFlavor :: IdLabelInfo -> SDoc
 749 ppIdFlavor x = pp_cSEP <>
 750                (case x of
 751                        Closure          -> ptext SLIT("closure")
 752                        SRT              -> ptext SLIT("srt")
 753                        SRTDesc          -> ptext SLIT("srtd")
 754                        InfoTable        -> ptext SLIT("info")
 755                        Entry            -> ptext SLIT("entry")
 756                        Slow             -> ptext SLIT("slow")
 757                        RednCounts       -> ptext SLIT("ct")
 758                        Bitmap           -> ptext SLIT("btm")
 759                        ConEntry         -> ptext SLIT("con_entry")
 760                        ConInfoTable     -> ptext SLIT("con_info")
 761                        StaticConEntry   -> ptext SLIT("static_entry")
 762                        StaticInfoTable  -> ptext SLIT("static_info")
 763                        ClosureTable     -> ptext SLIT("closure_tbl")
 764                       )
 765
 766
 767 pp_cSEP = char '_'
 768
 769 -- -----------------------------------------------------------------------------
 770 -- Machine-dependent knowledge about labels.
 771
 772 underscorePrefix :: Bool   -- leading underscore on assembler labels?
 773 underscorePrefix = (cLeadingUnderscore == "YES")
 774
 775 asmTempLabelPrefix :: LitString  -- for formatting labels
 776 asmTempLabelPrefix =
 777 #if alpha_TARGET_OS
 778      {- The alpha assembler likes temporary labels to look like $L123
 779         instead of L123.  (Don't toss the L, because then Lf28
 780         turns into $f28.)
 781      -}
 782      SLIT("$")
 783 #elif darwin_TARGET_OS
 784      SLIT("L")
 785 #else
 786      SLIT(".L")
 787 #endif
 788
 789 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
 790
 791 #if darwin_TARGET_OS
 792 pprDynamicLinkerAsmLabel SymbolPtr lbl
 793   = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
 794 pprDynamicLinkerAsmLabel CodeStub lbl
 795   = char 'L' <> pprCLabel lbl <> text "$stub"
 796 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
 797 pprDynamicLinkerAsmLabel CodeStub lbl
 798   = pprCLabel lbl <> text "@plt"
 799 pprDynamicLinkerAsmLabel SymbolPtr lbl
 800   = text ".LC_" <> pprCLabel lbl
 801 #elif linux_TARGET_OS
 802 pprDynamicLinkerAsmLabel CodeStub lbl
 803   = pprCLabel lbl <> text "@plt"
 804 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
 805   = pprCLabel lbl <> text "@got"
 806 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
 807   = pprCLabel lbl <> text "@gotoff"
 808 pprDynamicLinkerAsmLabel SymbolPtr lbl
 809   = text ".LC_" <> pprCLabel lbl
 810 #elif mingw32_TARGET_OS
 811 pprDynamicLinkerAsmLabel SymbolPtr lbl
 812   = text "__imp_" <> pprCLabel lbl
 813 #endif
 814 pprDynamicLinkerAsmLabel _ _
 815   = panic "pprDynamicLinkerAsmLabel"