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