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