CLabel.hs 61.8 KB
Newer Older
1 2 3 4
-----------------------------------------------------------------------------
--
-- Object-file symbols (called CLabel for histerical raisins).
--
Simon Marlow's avatar
Simon Marlow committed
5
-- (c) The University of Glasgow 2004-2006
6 7 8
--
-----------------------------------------------------------------------------

9
{-# LANGUAGE CPP #-}
10
{-# LANGUAGE BangPatterns #-}
11
{-# LANGUAGE LambdaCase #-}
12

13
module GHC.Cmm.CLabel (
Ian Lynagh's avatar
Ian Lynagh committed
14
        CLabel, -- abstract type
15
        NeedExternDecl (..),
Ian Lynagh's avatar
Ian Lynagh committed
16 17 18 19
        ForeignLabelSource(..),
        pprDebugCLabel,

        mkClosureLabel,
20
        mkSRTLabel,
Ian Lynagh's avatar
Ian Lynagh committed
21 22 23 24 25 26 27
        mkInfoTableLabel,
        mkEntryLabel,
        mkRednCountsLabel,
        mkConInfoTableLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
        mkClosureTableLabel,
28
        mkBytesLabel,
Ian Lynagh's avatar
Ian Lynagh committed
29

30
        mkLocalBlockLabel,
Ian Lynagh's avatar
Ian Lynagh committed
31 32 33 34
        mkLocalClosureLabel,
        mkLocalInfoTableLabel,
        mkLocalClosureTableLabel,

35 36
        mkBlockInfoTableLabel,

Ian Lynagh's avatar
Ian Lynagh committed
37 38 39 40
        mkBitmapLabel,
        mkStringLitLabel,

        mkAsmTempLabel,
Peter Wortmann's avatar
Peter Wortmann committed
41 42
        mkAsmTempDerivedLabel,
        mkAsmTempEndLabel,
43
        mkAsmTempDieLabel,
44

Ian Lynagh's avatar
Ian Lynagh committed
45
        mkDirty_MUT_VAR_Label,
46
        mkNonmovingWriteBarrierEnabledLabel,
Ian Lynagh's avatar
Ian Lynagh committed
47 48 49
        mkUpdInfoLabel,
        mkBHUpdInfoLabel,
        mkIndStaticInfoLabel,
50
        mkMainCapabilityLabel,
51 52
        mkMAP_FROZEN_CLEAN_infoLabel,
        mkMAP_FROZEN_DIRTY_infoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
53
        mkMAP_DIRTY_infoLabel,
54 55
        mkSMAP_FROZEN_CLEAN_infoLabel,
        mkSMAP_FROZEN_DIRTY_infoLabel,
56
        mkSMAP_DIRTY_infoLabel,
Ben Gamari's avatar
Ben Gamari committed
57
        mkBadAlignmentLabel,
58
        mkArrWords_infoLabel,
59
        mkSRTInfoLabel,
60

Ian Lynagh's avatar
Ian Lynagh committed
61
        mkTopTickyCtrLabel,
62
        mkCAFBlackHoleInfoTableLabel,
Ian Lynagh's avatar
Ian Lynagh committed
63
        mkRtsPrimOpLabel,
nfrisby's avatar
nfrisby committed
64
        mkRtsSlowFastTickyCtrLabel,
65

66
        mkSelectorInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
67
        mkSelectorEntryLabel,
68

Ian Lynagh's avatar
Ian Lynagh committed
69 70 71 72 73 74
        mkCmmInfoLabel,
        mkCmmEntryLabel,
        mkCmmRetInfoLabel,
        mkCmmRetLabel,
        mkCmmCodeLabel,
        mkCmmDataLabel,
75
        mkRtsCmmDataLabel,
76
        mkCmmClosureLabel,
77

Ian Lynagh's avatar
Ian Lynagh committed
78
        mkRtsApFastLabel,
79

80 81
        mkPrimCallLabel,

Ian Lynagh's avatar
Ian Lynagh committed
82
        mkForeignLabel,
83
        addLabelSize,
84

85
        foreignLabelStdcallInfo,
86
        isBytesLabel,
87
        isForeignLabel,
88 89
        isSomeRODataLabel,
        isStaticClosureLabel,
Ian Lynagh's avatar
Ian Lynagh committed
90
        mkCCLabel, mkCCSLabel,
91

92 93 94
        DynamicLinkerLabelInfo(..),
        mkDynamicLinkerLabel,
        dynamicLinkerLabelInfo,
Ian Lynagh's avatar
Ian Lynagh committed
95

96
        mkPicBaseLabel,
97
        mkDeadStripPreventer,
98

andy@galois.com's avatar
andy@galois.com committed
99 100
        mkHpcTicksLabel,

101
        -- * Predicates
102
        hasCAF,
103
        needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
104
        isMathFun,
Ian Lynagh's avatar
Ian Lynagh committed
105
        isCFunctionLabel, isGcPtrLabel, labelDynamic,
106
        isLocalCLabel, mayRedirectTo,
107 108

        -- * Conversions
109
        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
110

111 112
        pprCLabel,
        isInfoTableLabel,
113
        isConInfoTableLabel,
114
        isIdLabel, isTickyLabel
115 116
    ) where

117 118
#include "HsVersions.h"

119
import GHC.Prelude
120

Sylvain Henry's avatar
Sylvain Henry committed
121 122
import GHC.Types.Id.Info
import GHC.Types.Basic
123
import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
Sylvain Henry's avatar
Sylvain Henry committed
124
import GHC.Unit
Sylvain Henry's avatar
Sylvain Henry committed
125 126
import GHC.Types.Name
import GHC.Types.Unique
Sylvain Henry's avatar
Sylvain Henry committed
127
import GHC.Builtin.PrimOps
Sylvain Henry's avatar
Sylvain Henry committed
128
import GHC.Types.CostCentre
129 130
import GHC.Utils.Outputable
import GHC.Data.FastString
Sylvain Henry's avatar
Sylvain Henry committed
131
import GHC.Driver.Session
Sylvain Henry's avatar
Sylvain Henry committed
132
import GHC.Driver.Backend
John Ericson's avatar
John Ericson committed
133
import GHC.Platform
Sylvain Henry's avatar
Sylvain Henry committed
134
import GHC.Types.Unique.Set
135
import GHC.Utils.Misc
Sylvain Henry's avatar
Sylvain Henry committed
136
import GHC.Core.Ppr ( {- instances -} )
137
import GHC.CmmToAsm.Config
138 139 140 141

-- -----------------------------------------------------------------------------
-- The CLabel type

Ben Gamari's avatar
Ben Gamari committed
142 143
{- |
  'CLabel' is an abstract type that supports the following operations:
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

  - Pretty printing

  - In a C file, does it need to be declared before use?  (i.e. is it
    guaranteed to be already in scope in the places we need to refer to it?)

  - If it needs to be declared, what type (code or data) should it be
    declared to have?

  - Is it visible outside this object file or not?

  - Is it "dynamic" (see details below)

  - Eq and Ord, so that we can make sets of CLabels (currently only
    used in outputting C as far as I can tell, to avoid generating
    more than one declaration for any given label).

  - Converting an info table label into an entry label.
Ben Gamari's avatar
Ben Gamari committed
162 163 164 165 166 167

  CLabel usage is a bit messy in GHC as they are used in a number of different
  contexts:

  - By the C-- AST to identify labels

168
  - By the unregisterised C code generator (\"PprC\") for naming functions (hence
Ben Gamari's avatar
Ben Gamari committed
169 170 171 172 173 174 175 176 177 178 179 180
    the name 'CLabel')

  - By the native and LLVM code generators to identify labels

  For extra fun, each of these uses a slightly different subset of constructors
  (e.g. 'AsmTempLabel' and 'AsmTempDerivedLabel' are used only in the NCG and
  LLVM backends).

  In general, we use 'IdLabel' to represent Haskell things early in the
  pipeline. However, later optimization passes will often represent blocks they
  create with 'LocalBlockLabel' where there is no obvious 'Name' to hang off the
  label.
181 182 183
-}

data CLabel
184
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
Ian Lynagh's avatar
Ian Lynagh committed
185 186
    IdLabel
        Name
187
        CafInfo
188
        IdLabelInfo             -- ^ encodes the suffix of the label
Ian Lynagh's avatar
Ian Lynagh committed
189

190
  -- | A label from a .cmm file that is not associated with a .hs level Id.
Ian Lynagh's avatar
Ian Lynagh committed
191
  | CmmLabel
192 193 194 195
        UnitId                  -- ^ what package the label belongs to.
        NeedExternDecl          -- ^ does the label need an "extern .." declaration
        FastString              -- ^ identifier giving the prefix of the label
        CmmLabelInfo            -- ^ encodes the suffix of the label
196 197 198

  -- | A label with a baked-in \/ algorithmically generated name that definitely
  --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
Ian Lynagh's avatar
Ian Lynagh committed
199
  --    If it doesn't have an algorithmically generated name then use a CmmLabel
200
  --    instead and give it an appropriate UnitId argument.
Ian Lynagh's avatar
Ian Lynagh committed
201 202
  | RtsLabel
        RtsLabelInfo
203

204 205 206 207 208 209 210 211
  -- | A label associated with a block. These aren't visible outside of the
  -- compilation unit in which they are defined. These are generally used to
  -- name blocks produced by Cmm-to-Cmm passes and the native code generator,
  -- where we don't have a 'Name' to associate the label to and therefore can't
  -- use 'IdLabel'.
  | LocalBlockLabel
        {-# UNPACK #-} !Unique

212 213
  -- | A 'C' (or otherwise foreign) label.
  --
Ian Lynagh's avatar
Ian Lynagh committed
214
  | ForeignLabel
215
        FastString              -- ^ name of the imported label.
Ian Lynagh's avatar
Ian Lynagh committed
216

217
        (Maybe Int)             -- ^ possible '@n' suffix for stdcall functions
Ian Lynagh's avatar
Ian Lynagh committed
218 219
                                -- When generating C, the '@n' suffix is omitted, but when
                                -- generating assembler we must add it to the label.
220

221
        ForeignLabelSource      -- ^ what package the foreign label is in.
222

223 224
        FunctionOrData

Ben Gamari's avatar
Ben Gamari committed
225 226
  -- | Local temporary label used for native (or LLVM) code generation; must not
  -- appear outside of these contexts. Use primarily for debug information
Ian Lynagh's avatar
Ian Lynagh committed
227 228
  | AsmTempLabel
        {-# UNPACK #-} !Unique
229

Ben Gamari's avatar
Ben Gamari committed
230 231
  -- | A label \"derived\" from another 'CLabel' by the addition of a suffix.
  -- Must not occur outside of the NCG or LLVM code generators.
Peter Wortmann's avatar
Peter Wortmann committed
232 233
  | AsmTempDerivedLabel
        CLabel
234
        FastString              -- ^ suffix
Peter Wortmann's avatar
Peter Wortmann committed
235

236
  | StringLitLabel
Ian Lynagh's avatar
Ian Lynagh committed
237
        {-# UNPACK #-} !Unique
238

239 240 241
  | CC_Label  CostCentre
  | CCS_Label CostCentreStack

Ian Lynagh's avatar
Ian Lynagh committed
242 243 244

  -- | These labels are generated and used inside the NCG only.
  --    They are special variants of a label used for dynamic linking
245
  --    see module PositionIndependentCode for details.
246
  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
Ian Lynagh's avatar
Ian Lynagh committed
247 248 249 250

  -- | This label is generated and used inside the NCG only.
  --    It is used as a base for PIC calculations on some platforms.
  --    It takes the form of a local numeric assembler label '1'; and
251 252
  --    is pretty-printed as 1b, referring to the previous definition
  --    of 1: in the assembler source file.
Ian Lynagh's avatar
Ian Lynagh committed
253 254
  | PicBaseLabel

255 256
  -- | A label before an info table to prevent excessive dead-stripping on darwin
  | DeadStripPreventer CLabel
257

258

259 260
  -- | Per-module table of tick locations
  | HpcTicksLabel Module
261

262
  -- | Static reference table
263
  | SRTLabel
264 265
        {-# UNPACK #-} !Unique

266 267
  -- | A bitmap (function or case return)
  | LargeBitmapLabel
268 269
        {-# UNPACK #-} !Unique

niteria's avatar
niteria committed
270 271
  deriving Eq

272 273 274 275
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = True
isIdLabel _ = False

276 277 278 279 280 281
-- Used in SRT analysis. See Note [Ticky labels in SRT analysis] in
-- GHC.Cmm.Info.Build.
isTickyLabel :: CLabel -> Bool
isTickyLabel (IdLabel _ _ RednCounts) = True
isTickyLabel _ = False

282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299
-- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
-- label (e.g. "extern StgWordArray(foo)").  The type is fixed to StgWordArray.
--
-- Symbols from the RTS don't need "extern" declarations because they are
-- exposed via "includes/Stg.h" with the appropriate type. See 'needsCDecl'.
--
-- The fixed StgWordArray type led to "conflicting types" issues with user
-- provided Cmm files (not in the RTS) that declare data of another type (#15467
-- and test for #17920).  Hence the Cmm parser considers that labels in data
-- sections don't need the "extern" declaration (just add one explicitly if you
-- need it).
--
-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
-- for why extern declaration are needed at all.
newtype NeedExternDecl
   = NeedExternDecl Bool
   deriving (Ord,Eq)

niteria's avatar
niteria committed
300 301 302 303 304 305 306 307 308 309
-- This is laborious, but necessary. We can't derive Ord because
-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
-- implementation. See Note [No Ord for Unique]
-- This is non-deterministic but we do not currently support deterministic
-- code-generation. See Note [Unique Determinism and code generation]
instance Ord CLabel where
  compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
    compare a1 a2 `thenCmp`
    compare b1 b2 `thenCmp`
    compare c1 c2
310
  compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
niteria's avatar
niteria committed
311 312
    compare a1 a2 `thenCmp`
    compare b1 b2 `thenCmp`
313 314
    compare c1 c2 `thenCmp`
    compare d1 d2
niteria's avatar
niteria committed
315
  compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
316
  compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
niteria's avatar
niteria committed
317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
  compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
    compare a1 a2 `thenCmp`
    compare b1 b2 `thenCmp`
    compare c1 c2 `thenCmp`
    compare d1 d2
  compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
  compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
    compare a1 a2 `thenCmp`
    compare b1 b2
  compare (StringLitLabel u1) (StringLitLabel u2) =
    nonDetCmpUnique u1 u2
  compare (CC_Label a1) (CC_Label a2) =
    compare a1 a2
  compare (CCS_Label a1) (CCS_Label a2) =
    compare a1 a2
  compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
    compare a1 a2 `thenCmp`
    compare b1 b2
  compare PicBaseLabel PicBaseLabel = EQ
  compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
    compare a1 a2
  compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
    compare a1 a2
  compare (SRTLabel u1) (SRTLabel u2) =
    nonDetCmpUnique u1 u2
  compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
    nonDetCmpUnique u1 u2
  compare IdLabel{} _ = LT
  compare _ IdLabel{} = GT
  compare CmmLabel{} _ = LT
  compare _ CmmLabel{} = GT
  compare RtsLabel{} _ = LT
  compare _ RtsLabel{} = GT
350 351
  compare LocalBlockLabel{} _ = LT
  compare _ LocalBlockLabel{} = GT
niteria's avatar
niteria committed
352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373
  compare ForeignLabel{} _ = LT
  compare _ ForeignLabel{} = GT
  compare AsmTempLabel{} _ = LT
  compare _ AsmTempLabel{} = GT
  compare AsmTempDerivedLabel{} _ = LT
  compare _ AsmTempDerivedLabel{} = GT
  compare StringLitLabel{} _ = LT
  compare _ StringLitLabel{} = GT
  compare CC_Label{} _ = LT
  compare _ CC_Label{} = GT
  compare CCS_Label{} _ = LT
  compare _ CCS_Label{} = GT
  compare DynamicLinkerLabel{} _ = LT
  compare _ DynamicLinkerLabel{} = GT
  compare PicBaseLabel{} _ = LT
  compare _ PicBaseLabel{} = GT
  compare DeadStripPreventer{} _ = LT
  compare _ DeadStripPreventer{} = GT
  compare HpcTicksLabel{} _ = LT
  compare _ HpcTicksLabel{} = GT
  compare SRTLabel{} _ = LT
  compare _ SRTLabel{} = GT
374 375 376 377 378

-- | Record where a foreign label is stored.
data ForeignLabelSource

   -- | Label is in a named package
379
   = ForeignLabelInPackage Unit
Ian Lynagh's avatar
Ian Lynagh committed
380

381
   -- | Label is in some external, system package that doesn't also
Ian Lynagh's avatar
Ian Lynagh committed
382 383 384 385
   --   contain compiled Haskell code, and is not associated with any .hi files.
   --   We don't have to worry about Haskell code being inlined from
   --   external packages. It is safe to treat the RTS package as "external".
   | ForeignLabelInExternalPackage
386

387
   -- | Label is in the package currently being compiled.
Ian Lynagh's avatar
Ian Lynagh committed
388 389 390 391
   --   This is only used for creating hacky tmp labels during code generation.
   --   Don't use it in any code that might be inlined across a package boundary
   --   (ie, core code) else the information will be wrong relative to the
   --   destination module.
392
   | ForeignLabelInThisPackage
Ian Lynagh's avatar
Ian Lynagh committed
393 394

   deriving (Eq, Ord)
395 396 397


-- | For debugging problems with the CLabel representation.
Ian Lynagh's avatar
Ian Lynagh committed
398 399
--      We can't make a Show instance for CLabel because lots of its components don't have instances.
--      The regular Outputable instance only shows the label name, and not its other info.
400
--
401 402
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
403
 = case lbl of
404 405
        IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
                                       <> whenPprDebug (text ":" <> text (show info)))
406
        CmmLabel pkg _ext _name _info
Ian Lynagh's avatar
Ian Lynagh committed
407
         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
408

Ian Lynagh's avatar
Ian Lynagh committed
409
        RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
410

Ian Lynagh's avatar
Ian Lynagh committed
411
        ForeignLabel _name mSuffix src funOrData
Ian Lynagh's avatar
Ian Lynagh committed
412
            -> ppr lbl <> (parens $ text "ForeignLabel"
Ian Lynagh's avatar
Ian Lynagh committed
413 414 415
                                <+> ppr mSuffix
                                <+> ppr src
                                <+> ppr funOrData)
416

417
        _               -> ppr lbl <> (parens $ text "other CLabel")
418 419


420
data IdLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
421
  = Closure             -- ^ Label for closure
422
  | InfoTable           -- ^ Info tables for closures; always read-only
Ian Lynagh's avatar
Ian Lynagh committed
423
  | Entry               -- ^ Entry point
424
  | Slow                -- ^ Slow entry point
425

426 427 428 429
  | LocalInfoTable      -- ^ Like InfoTable but not externally visible
  | LocalEntry          -- ^ Like Entry but not externally visible

  | RednCounts          -- ^ Label of place to keep Ticky-ticky  info for this Id
430

Ian Lynagh's avatar
Ian Lynagh committed
431 432
  | ConEntry            -- ^ Constructor entry point
  | ConInfoTable        -- ^ Corresponding info table
433

Ian Lynagh's avatar
Ian Lynagh committed
434
  | ClosureTable        -- ^ Table of closures for Enum tycons
435

436 437
  | Bytes               -- ^ Content of a string literal. See
                        -- Note [Bytes label].
438 439 440
  | BlockInfoTable      -- ^ Like LocalInfoTable but for a proc-point block
                        -- instead of a closure entry-point.
                        -- See Note [Proc-point local block entry-point].
441

442
  deriving (Eq, Ord, Show)
443 444 445


data RtsLabelInfo
446 447
  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
448

449 450
  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}
451 452

  | RtsPrimOp PrimOp
Ian Lynagh's avatar
Ian Lynagh committed
453
  | RtsApFast     FastString    -- ^ _fast versions of generic apply
nfrisby's avatar
nfrisby committed
454
  | RtsSlowFastTickyCtr String
455 456

  deriving (Eq, Ord)
Sylvain Henry's avatar
Sylvain Henry committed
457
  -- NOTE: Eq on PtrString compares the pointer only, so this isn't
458
  -- a real equality.
459

460 461

-- | What type of Cmm label we're dealing with.
Ian Lynagh's avatar
Ian Lynagh committed
462 463
--      Determines the suffix appended to the name when a CLabel.CmmLabel
--      is pretty printed.
464
data CmmLabelInfo
465
  = CmmInfo                     -- ^ misc rts info tables,      suffix _info
Ian Lynagh's avatar
Ian Lynagh committed
466 467 468
  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
  | CmmRet                      -- ^ misc rts return points,    suffix _ret
469
  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
Ian Lynagh's avatar
Ian Lynagh committed
470
  | CmmCode                     -- ^ misc rts code
471
  | CmmClosure                  -- ^ closures eg CHARLIKE_closure
Ian Lynagh's avatar
Ian Lynagh committed
472
  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
473 474
  deriving (Eq, Ord)

475
data DynamicLinkerLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
476 477 478 479 480
  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  | GotSymbolPtr                -- ELF: foo@got
  | GotSymbolOffset             -- ELF: foo@gotoff

481
  deriving (Eq, Ord)
Ian Lynagh's avatar
Ian Lynagh committed
482

483

484 485
-- -----------------------------------------------------------------------------
-- Constructing CLabels
486
-- -----------------------------------------------------------------------------
487

Ian Lynagh's avatar
Ian Lynagh committed
488
-- Constructing IdLabels
489
-- These are always local:
490

491 492
mkSRTLabel     :: Unique -> CLabel
mkSRTLabel u = SRTLabel u
493

nfrisby's avatar
nfrisby committed
494
mkRednCountsLabel :: Name -> CLabel
495
mkRednCountsLabel name = IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
496 497

-- These have local & (possibly) external variants:
Ian Lynagh's avatar
Ian Lynagh committed
498 499 500
mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
501
mkLocalClosureLabel   !name !c  = IdLabel name  c Closure
502
mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
503 504
mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable

Ian Lynagh's avatar
Ian Lynagh committed
505 506 507 508 509
mkClosureLabel              :: Name -> CafInfo -> CLabel
mkInfoTableLabel            :: Name -> CafInfo -> CLabel
mkEntryLabel                :: Name -> CafInfo -> CLabel
mkClosureTableLabel         :: Name -> CafInfo -> CLabel
mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
510
mkBytesLabel                :: Name -> CLabel
511
mkClosureLabel name         c     = IdLabel name c Closure
512
mkInfoTableLabel name       c     = IdLabel name c InfoTable
513
mkEntryLabel name           c     = IdLabel name c Entry
514
mkClosureTableLabel name    c     = IdLabel name c ClosureTable
515
mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
516
mkBytesLabel name                 = IdLabel name NoCafRefs Bytes
517

518 519 520 521
mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
                               -- See Note [Proc-point local block entry-point].

522
-- Constructing Cmm Labels
523 524 525
mkDirty_MUT_VAR_Label,
    mkNonmovingWriteBarrierEnabledLabel,
    mkUpdInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
526
    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
527 528
    mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
    mkMAP_DIRTY_infoLabel,
529 530 531
    mkArrWords_infoLabel,
    mkTopTickyCtrLabel,
    mkCAFBlackHoleInfoTableLabel,
532
    mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
Ben Gamari's avatar
Ben Gamari committed
533
    mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
534
mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
535
mkNonmovingWriteBarrierEnabledLabel
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550
                                = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
mkUpdInfoLabel                  = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame")         CmmInfo
mkBHUpdInfoLabel                = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" )     CmmInfo
mkIndStaticInfoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC")        CmmInfo
mkMainCapabilityLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "MainCapability")        CmmData
mkMAP_FROZEN_CLEAN_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
mkMAP_FROZEN_DIRTY_infoLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkTopTickyCtrLabel              = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct")                CmmData
mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
mkArrWords_infoLabel            = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS")         CmmInfo
mkSMAP_FROZEN_CLEAN_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
mkSMAP_FROZEN_DIRTY_infoLabel   = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
mkBadAlignmentLabel             = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment")      CmmEntry
551

552
mkSRTInfoLabel :: Int -> CLabel
553
mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574
 where
   lbl =
     case n of
       1 -> fsLit "stg_SRT_1"
       2 -> fsLit "stg_SRT_2"
       3 -> fsLit "stg_SRT_3"
       4 -> fsLit "stg_SRT_4"
       5 -> fsLit "stg_SRT_5"
       6 -> fsLit "stg_SRT_6"
       7 -> fsLit "stg_SRT_7"
       8 -> fsLit "stg_SRT_8"
       9 -> fsLit "stg_SRT_9"
       10 -> fsLit "stg_SRT_10"
       11 -> fsLit "stg_SRT_11"
       12 -> fsLit "stg_SRT_12"
       13 -> fsLit "stg_SRT_13"
       14 -> fsLit "stg_SRT_14"
       15 -> fsLit "stg_SRT_15"
       16 -> fsLit "stg_SRT_16"
       _ -> panic "mkSRTInfoLabel"

575
-----
576
mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
577
  mkCmmCodeLabel, mkCmmClosureLabel
Sylvain Henry's avatar
Sylvain Henry committed
578
        :: UnitId -> FastString -> CLabel
579

580 581 582 583 584 585 586 587 588 589 590 591 592 593
mkCmmDataLabel    :: UnitId -> NeedExternDecl -> FastString -> CLabel
mkRtsCmmDataLabel :: FastString -> CLabel

mkCmmInfoLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmInfo
mkCmmEntryLabel      pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmEntry
mkCmmRetInfoLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRetInfo
mkCmmRetLabel        pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmRet
mkCmmCodeLabel       pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmCode
mkCmmClosureLabel    pkg str     = CmmLabel pkg (NeedExternDecl True) str CmmClosure
mkCmmDataLabel       pkg ext str = CmmLabel pkg ext  str CmmData
mkRtsCmmDataLabel    str         = CmmLabel rtsUnitId (NeedExternDecl False)  str CmmData
                                    -- RTS symbols don't need "GHC.CmmToC" to
                                    -- generate \"extern\" declaration (they are
                                    -- exposed via includes/Stg.h)
594

595 596
mkLocalBlockLabel :: Unique -> CLabel
mkLocalBlockLabel u = LocalBlockLabel u
597 598

-- Constructing RtsLabels
Ian Lynagh's avatar
Ian Lynagh committed
599
mkRtsPrimOpLabel :: PrimOp -> CLabel
600
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
601

602 603 604
mkSelectorInfoLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorInfoLabel platform upd offset =
   ASSERT(offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform))
605
   RtsLabel (RtsSelectorInfoTable upd offset)
606

607 608 609
mkSelectorEntryLabel :: Platform -> Bool -> Int -> CLabel
mkSelectorEntryLabel platform upd offset =
   ASSERT(offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform))
610 611
   RtsLabel (RtsSelectorEntry upd offset)

612 613 614
mkApInfoTableLabel :: Platform -> Bool -> Int -> CLabel
mkApInfoTableLabel platform upd arity =
   ASSERT(arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform))
615 616
   RtsLabel (RtsApInfoTable upd arity)

617 618 619
mkApEntryLabel :: Platform -> Bool -> Int -> CLabel
mkApEntryLabel platform upd arity =
   ASSERT(arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform))
620
   RtsLabel (RtsApEntry upd arity)
621

622

623
-- A call to some primitive hand written Cmm code
624
mkPrimCallLabel :: PrimCall -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
625
mkPrimCallLabel (PrimCall str pkg)
626
        = CmmLabel (toUnitId pkg) (NeedExternDecl True) str CmmPrimCall
627

628

629
-- Constructing ForeignLabels
630

631
-- | Make a foreign label
Ian Lynagh's avatar
Ian Lynagh committed
632 633 634 635 636 637
mkForeignLabel
        :: FastString           -- name
        -> Maybe Int            -- size prefix
        -> ForeignLabelSource   -- what package it's in
        -> FunctionOrData
        -> CLabel
638

639
mkForeignLabel = ForeignLabel
640 641 642


-- | Update the label size field in a ForeignLabel
643
addLabelSize :: CLabel -> Int -> CLabel
644 645
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
646
addLabelSize label _
647
    = label
648

649 650 651 652 653
-- | Whether label is a top-level string literal
isBytesLabel :: CLabel -> Bool
isBytesLabel (IdLabel _ _ Bytes) = True
isBytesLabel _lbl = False

654 655 656 657 658
-- | Whether label is a non-haskell label (defined in C code)
isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel _ _ _ _) = True
isForeignLabel _lbl = False

659 660 661 662 663
-- | Whether label is a static closure label (can come from haskell or cmm)
isStaticClosureLabel :: CLabel -> Bool
-- Closure defined in haskell (.hs)
isStaticClosureLabel (IdLabel _ _ Closure) = True
-- Closure defined in cmm
664
isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True
665 666 667 668 669 670 671 672 673
isStaticClosureLabel _lbl = False

-- | Whether label is a .rodata label
isSomeRODataLabel :: CLabel -> Bool
-- info table defined in haskell (.hs)
isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True
isSomeRODataLabel (IdLabel _ _ InfoTable) = True
isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
674
isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
675
-- info table defined in cmm (.cmm)
676
isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True
677 678
isSomeRODataLabel _lbl = False

679 680 681 682 683 684 685 686 687 688 689 690 691
-- | Whether label is points to some kind of info table
isInfoTableLabel :: CLabel -> Bool
isInfoTableLabel (IdLabel _ _ InfoTable)      = True
isInfoTableLabel (IdLabel _ _ LocalInfoTable) = True
isInfoTableLabel (IdLabel _ _ ConInfoTable)   = True
isInfoTableLabel (IdLabel _ _ BlockInfoTable) = True
isInfoTableLabel _                            = False

-- | Whether label is points to constructor info table
isConInfoTableLabel :: CLabel -> Bool
isConInfoTableLabel (IdLabel _ _ ConInfoTable)   = True
isConInfoTableLabel _                            = False

692
-- | Get the label size field from a ForeignLabel
693
foreignLabelStdcallInfo :: CLabel -> Maybe Int
694
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
695 696
foreignLabelStdcallInfo _lbl = Nothing

697

698
-- Constructing Large*Labels
Ian Lynagh's avatar
Ian Lynagh committed
699
mkBitmapLabel   :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
700
mkBitmapLabel   uniq            = LargeBitmapLabel uniq
701 702

-- Constructing Cost Center Labels
Ian Lynagh's avatar
Ian Lynagh committed
703 704
mkCCLabel  :: CostCentre      -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
705 706
mkCCLabel           cc          = CC_Label cc
mkCCSLabel          ccs         = CCS_Label ccs
707

Ian Lynagh's avatar
Ian Lynagh committed
708
mkRtsApFastLabel :: FastString -> CLabel
709 710
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

nfrisby's avatar
nfrisby committed
711 712
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
713

andy@galois.com's avatar
andy@galois.com committed
714

715
-- Constructing Code Coverage Labels
Ian Lynagh's avatar
Ian Lynagh committed
716
mkHpcTicksLabel :: Module -> CLabel
andy@galois.com's avatar
andy@galois.com committed
717 718
mkHpcTicksLabel                = HpcTicksLabel

719 720

-- Constructing labels used for dynamic linking
721
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
722
mkDynamicLinkerLabel            = DynamicLinkerLabel
723 724 725

dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
Ian Lynagh's avatar
Ian Lynagh committed
726 727
dynamicLinkerLabelInfo _        = Nothing

728
mkPicBaseLabel :: CLabel
Ian Lynagh's avatar
Ian Lynagh committed
729
mkPicBaseLabel                  = PicBaseLabel
730

731 732

-- Constructing miscellaneous other labels
733
mkDeadStripPreventer :: CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
734
mkDeadStripPreventer lbl        = DeadStripPreventer lbl
735 736

mkStringLitLabel :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
737
mkStringLitLabel                = StringLitLabel
738 739

mkAsmTempLabel :: Uniquable a => a -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
740
mkAsmTempLabel a                = AsmTempLabel (getUnique a)
741

Peter Wortmann's avatar
Peter Wortmann committed
742 743 744 745 746
mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel = AsmTempDerivedLabel

mkAsmTempEndLabel :: CLabel -> CLabel
mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
747

748 749 750 751 752
-- | Construct a label for a DWARF Debug Information Entity (DIE)
-- describing another symbol.
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")

753
-- -----------------------------------------------------------------------------
754 755
-- Convert between different kinds of label

756 757
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
758
toClosureLbl (CmmLabel m ext str _) = CmmLabel m ext str CmmClosure
759 760 761
toClosureLbl l = pprPanic "toClosureLbl" (ppr l)

toSlowEntryLbl :: CLabel -> CLabel
762 763
toSlowEntryLbl (IdLabel n _ BlockInfoTable)
  = pprPanic "toSlowEntryLbl" (ppr n)
764 765 766 767 768 769
toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)

toEntryLbl :: CLabel -> CLabel
toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
770
toEntryLbl (IdLabel n _ BlockInfoTable)  = mkLocalBlockLabel (nameUnique n)
771
                              -- See Note [Proc-point local block entry-point].
772
toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
773 774
toEntryLbl (CmmLabel m ext str CmmInfo)    = CmmLabel m ext str CmmEntry
toEntryLbl (CmmLabel m ext str CmmRetInfo) = CmmLabel m ext str CmmRet
775 776 777 778 779 780
toEntryLbl l = pprPanic "toEntryLbl" (ppr l)

toInfoLbl :: CLabel -> CLabel
toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
781 782
toInfoLbl (CmmLabel m ext str CmmEntry)= CmmLabel m ext str CmmInfo
toInfoLbl (CmmLabel m ext str CmmRet)  = CmmLabel m ext str CmmRetInfo
783
toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
784

nfrisby's avatar
nfrisby committed
785 786 787 788
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel n _ _) = Just n
hasHaskellName _               = Nothing

789
-- -----------------------------------------------------------------------------
nfrisby's avatar
nfrisby committed
790
-- Does a CLabel's referent itself refer to a CAF?
791
hasCAF :: CLabel -> Bool
nfrisby's avatar
nfrisby committed
792
hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
793 794
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
795

nfrisby's avatar
nfrisby committed
796 797 798 799 800
-- Note [ticky for LNE]
-- ~~~~~~~~~~~~~~~~~~~~~

-- Until 14 Feb 2013, every ticky counter was associated with a
-- closure. Thus, ticky labels used IdLabel. It is odd that
801
-- GHC.Cmm.Info.Build.cafTransfers would consider such a ticky label
nfrisby's avatar
nfrisby committed
802 803 804 805 806 807 808 809 810 811 812 813
-- reason to add the name to the CAFEnv (and thus eventually the SRT),
-- but it was harmless because the ticky was only used if the closure
-- was also.
--
-- Since we now have ticky counters for LNEs, it is no longer the case
-- that every ticky counter has an actual closure. So I changed the
-- generation of ticky counters' CLabels to not result in their
-- associated id ending up in the SRT.
--
-- NB IdLabel is still appropriate for ticky ids (as opposed to
-- CmmLabel) because the LNE's counter is still related to an .hs Id,
-- that Id just isn't for a proper closure.
814

815 816
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
817
--
818
-- See wiki:commentary/compiler/backends/ppr-c#prototypes
819 820 821

needsCDecl :: CLabel -> Bool
  -- False <=> it's pre-declared; don't bother
822
  -- don't bother declaring Bitmap labels, we always make sure
823
  -- they are defined before use.
824
needsCDecl (SRTLabel _)                 = True
Ian Lynagh's avatar
Ian Lynagh committed
825 826
needsCDecl (LargeBitmapLabel _)         = False
needsCDecl (IdLabel _ _ _)              = True
827
needsCDecl (LocalBlockLabel _)          = True
828

Ian Lynagh's avatar
Ian Lynagh committed
829 830
needsCDecl (StringLitLabel _)           = False
needsCDecl (AsmTempLabel _)             = False
Peter Wortmann's avatar
Peter Wortmann committed
831
needsCDecl (AsmTempDerivedLabel _ _)    = False
Ian Lynagh's avatar
Ian Lynagh committed
832 833
needsCDecl (RtsLabel _)                 = False

834 835 836 837
needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _)
        -- local labels mustn't have it
        | not external                  = False

Ian Lynagh's avatar
Ian Lynagh committed
838 839
        -- Prototypes for labels defined in the runtime system are imported
        --      into HC files via includes/Stg.h.
840
        | pkgId == rtsUnitId            = False
Ian Lynagh's avatar
Ian Lynagh committed
841 842 843 844 845 846 847

        -- For other labels we inline one into the HC file directly.
        | otherwise                     = True

needsCDecl