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