CLabel.hs 51.6 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 10
{-# LANGUAGE CPP #-}

11
module CLabel (
Ian Lynagh's avatar
Ian Lynagh committed
12 13 14 15 16
        CLabel, -- abstract type
        ForeignLabelSource(..),
        pprDebugCLabel,

        mkClosureLabel,
17
        mkTopSRTLabel,
Ian Lynagh's avatar
Ian Lynagh committed
18 19 20 21 22 23 24 25
        mkInfoTableLabel,
        mkEntryLabel,
        mkRednCountsLabel,
        mkConInfoTableLabel,
        mkLargeSRTLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
        mkClosureTableLabel,
26
        mkBytesLabel,
Ian Lynagh's avatar
Ian Lynagh committed
27 28 29 30 31

        mkLocalClosureLabel,
        mkLocalInfoTableLabel,
        mkLocalClosureTableLabel,

32 33
        mkBlockInfoTableLabel,

Ian Lynagh's avatar
Ian Lynagh committed
34 35 36 37
        mkBitmapLabel,
        mkStringLitLabel,

        mkAsmTempLabel,
Peter Wortmann's avatar
Peter Wortmann committed
38 39
        mkAsmTempDerivedLabel,
        mkAsmTempEndLabel,
40
        mkAsmTempDieLabel,
41

Ian Lynagh's avatar
Ian Lynagh committed
42 43 44 45 46
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
        mkBHUpdInfoLabel,
        mkIndStaticInfoLabel,
47
        mkMainCapabilityLabel,
Ian Lynagh's avatar
Ian Lynagh committed
48
        mkMAP_FROZEN_infoLabel,
49
        mkMAP_FROZEN0_infoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
50
        mkMAP_DIRTY_infoLabel,
51 52 53
        mkSMAP_FROZEN_infoLabel,
        mkSMAP_FROZEN0_infoLabel,
        mkSMAP_DIRTY_infoLabel,
Ben Gamari's avatar
Ben Gamari committed
54
        mkBadAlignmentLabel,
55
        mkArrWords_infoLabel,
56

Ian Lynagh's avatar
Ian Lynagh committed
57
        mkTopTickyCtrLabel,
58
        mkCAFBlackHoleInfoTableLabel,
Ian Lynagh's avatar
Ian Lynagh committed
59
        mkRtsPrimOpLabel,
nfrisby's avatar
nfrisby committed
60
        mkRtsSlowFastTickyCtrLabel,
61

62
        mkSelectorInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
63
        mkSelectorEntryLabel,
64

Ian Lynagh's avatar
Ian Lynagh committed
65 66 67 68 69 70
        mkCmmInfoLabel,
        mkCmmEntryLabel,
        mkCmmRetInfoLabel,
        mkCmmRetLabel,
        mkCmmCodeLabel,
        mkCmmDataLabel,
71
        mkCmmClosureLabel,
72

Ian Lynagh's avatar
Ian Lynagh committed
73
        mkRtsApFastLabel,
74

75 76
        mkPrimCallLabel,

Ian Lynagh's avatar
Ian Lynagh committed
77
        mkForeignLabel,
78
        addLabelSize,
79

80
        foreignLabelStdcallInfo,
81
        isBytesLabel,
82
        isForeignLabel,
83 84
        isSomeRODataLabel,
        isStaticClosureLabel,
Ian Lynagh's avatar
Ian Lynagh committed
85
        mkCCLabel, mkCCSLabel,
86

87 88 89
        DynamicLinkerLabelInfo(..),
        mkDynamicLinkerLabel,
        dynamicLinkerLabelInfo,
Ian Lynagh's avatar
Ian Lynagh committed
90

91
        mkPicBaseLabel,
92
        mkDeadStripPreventer,
93

andy@galois.com's avatar
andy@galois.com committed
94 95
        mkHpcTicksLabel,

96
        hasCAF,
Peter Wortmann's avatar
Peter Wortmann committed
97
        needsCDecl, maybeAsmTemp, externallyVisibleCLabel,
98
        isMathFun,
Ian Lynagh's avatar
Ian Lynagh committed
99
        isCFunctionLabel, isGcPtrLabel, labelDynamic,
100 101

        -- * Conversions
102
        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
103

104
        pprCLabel
105 106
    ) where

107 108
#include "HsVersions.h"

109 110
import GhcPrelude

111
import IdInfo
112
import BasicTypes
Simon Marlow's avatar
Simon Marlow committed
113 114 115 116 117 118 119
import Packages
import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
120 121
import Outputable
import FastString
122
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
123
import Platform
124
import UniqSet
125
import Util
Peter Wortmann's avatar
Peter Wortmann committed
126
import PprCore ( {- instances -} )
127 128 129 130 131

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

{-
132
  | CLabel is an abstract type that supports the following operations:
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153

  - 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.
-}

data CLabel
154
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
Ian Lynagh's avatar
Ian Lynagh committed
155 156
    IdLabel
        Name
157
        CafInfo
Ian Lynagh's avatar
Ian Lynagh committed
158 159
        IdLabelInfo             -- encodes the suffix of the label

160
  -- | A label from a .cmm file that is not associated with a .hs level Id.
Ian Lynagh's avatar
Ian Lynagh committed
161
  | CmmLabel
162
        UnitId               -- what package the label belongs to.
Ian Lynagh's avatar
Ian Lynagh committed
163 164
        FastString              -- identifier giving the prefix of the label
        CmmLabelInfo            -- encodes the suffix of the label
165 166 167

  -- | 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
168
  --    If it doesn't have an algorithmically generated name then use a CmmLabel
169
  --    instead and give it an appropriate UnitId argument.
Ian Lynagh's avatar
Ian Lynagh committed
170 171
  | RtsLabel
        RtsLabelInfo
172

173 174
  -- | A 'C' (or otherwise foreign) label.
  --
Ian Lynagh's avatar
Ian Lynagh committed
175 176 177 178 179 180
  | ForeignLabel
        FastString              -- name of the imported label.

        (Maybe Int)             -- possible '@n' suffix for stdcall functions
                                -- When generating C, the '@n' suffix is omitted, but when
                                -- generating assembler we must add it to the label.
181

Ian Lynagh's avatar
Ian Lynagh committed
182
        ForeignLabelSource      -- what package the foreign label is in.
183

184 185 186
        FunctionOrData

  -- | A family of labels related to a particular case expression.
Ian Lynagh's avatar
Ian Lynagh committed
187 188 189
  | CaseLabel
        {-# UNPACK #-} !Unique  -- Unique says which case expression
        CaseLabelInfo
190

191
  -- | Local temporary label used for native (or LLVM) code generation
Ian Lynagh's avatar
Ian Lynagh committed
192 193
  | AsmTempLabel
        {-# UNPACK #-} !Unique
194

Peter Wortmann's avatar
Peter Wortmann committed
195 196 197 198
  | AsmTempDerivedLabel
        CLabel
        FastString              -- suffix

199
  | StringLitLabel
Ian Lynagh's avatar
Ian Lynagh committed
200
        {-# UNPACK #-} !Unique
201

202 203 204
  | CC_Label  CostCentre
  | CCS_Label CostCentreStack

Ian Lynagh's avatar
Ian Lynagh committed
205 206 207

  -- | These labels are generated and used inside the NCG only.
  --    They are special variants of a label used for dynamic linking
208
  --    see module PositionIndependentCode for details.
209
  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
Ian Lynagh's avatar
Ian Lynagh committed
210 211 212 213

  -- | 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
214 215
  --    is pretty-printed as 1b, referring to the previous definition
  --    of 1: in the assembler source file.
Ian Lynagh's avatar
Ian Lynagh committed
216 217
  | PicBaseLabel

218 219
  -- | A label before an info table to prevent excessive dead-stripping on darwin
  | DeadStripPreventer CLabel
220

221

222 223
  -- | Per-module table of tick locations
  | HpcTicksLabel Module
224

225
  -- | Static reference table
226
  | SRTLabel !Unique
227

228 229
  -- | Label of an StgLargeSRT
  | LargeSRTLabel
230 231
        {-# UNPACK #-} !Unique

232 233
  -- | A bitmap (function or case return)
  | LargeBitmapLabel
234 235
        {-# UNPACK #-} !Unique

niteria's avatar
niteria committed
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316
  deriving Eq

-- 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
  compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =
    compare a1 a2 `thenCmp`
    compare b1 b2 `thenCmp`
    compare c1 c2
  compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
  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 (CaseLabel u1 a1) (CaseLabel u2 a2) =
    nonDetCmpUnique u1 u2 `thenCmp`
    compare a1 a2
  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 (LargeSRTLabel u1) (LargeSRTLabel 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
  compare ForeignLabel{} _ = LT
  compare _ ForeignLabel{} = GT
  compare CaseLabel{} _ = LT
  compare _ CaseLabel{} = 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
  compare LargeSRTLabel{} _ = LT
  compare _ LargeSRTLabel{} = GT
317 318 319 320 321

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

   -- | Label is in a named package
322
   = ForeignLabelInPackage      UnitId
Ian Lynagh's avatar
Ian Lynagh committed
323

324
   -- | Label is in some external, system package that doesn't also
Ian Lynagh's avatar
Ian Lynagh committed
325 326 327 328
   --   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
329 330

   -- | Label is in the package currenly being compiled.
Ian Lynagh's avatar
Ian Lynagh committed
331 332 333 334
   --   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.
335
   | ForeignLabelInThisPackage
Ian Lynagh's avatar
Ian Lynagh committed
336 337

   deriving (Eq, Ord)
338 339 340


-- | For debugging problems with the CLabel representation.
Ian Lynagh's avatar
Ian Lynagh committed
341 342
--      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.
343
--
344 345
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
346
 = case lbl of
Ian Lynagh's avatar
Ian Lynagh committed
347
        IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
Ian Lynagh's avatar
Ian Lynagh committed
348
        CmmLabel pkg _name _info
Ian Lynagh's avatar
Ian Lynagh committed
349
         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
350

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

Ian Lynagh's avatar
Ian Lynagh committed
353
        ForeignLabel _name mSuffix src funOrData
Ian Lynagh's avatar
Ian Lynagh committed
354
            -> ppr lbl <> (parens $ text "ForeignLabel"
Ian Lynagh's avatar
Ian Lynagh committed
355 356 357
                                <+> ppr mSuffix
                                <+> ppr src
                                <+> ppr funOrData)
358

359
        _               -> ppr lbl <> (parens $ text "other CLabel")
360 361


362
data IdLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
363
  = Closure             -- ^ Label for closure
364 365 366
  | SRT                 -- ^ Static reference table (TODO: could be removed
                        -- with the old code generator, but might be needed
                        -- when we implement the New SRT Plan)
367
  | InfoTable           -- ^ Info tables for closures; always read-only
Ian Lynagh's avatar
Ian Lynagh committed
368
  | Entry               -- ^ Entry point
369
  | Slow                -- ^ Slow entry point
370

371 372 373 374
  | 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
375

Ian Lynagh's avatar
Ian Lynagh committed
376 377
  | ConEntry            -- ^ Constructor entry point
  | ConInfoTable        -- ^ Corresponding info table
378

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

381 382
  | Bytes               -- ^ Content of a string literal. See
                        -- Note [Bytes label].
383 384 385
  | BlockInfoTable      -- ^ Like LocalInfoTable but for a proc-point block
                        -- instead of a closure entry-point.
                        -- See Note [Proc-point local block entry-point].
386

387 388 389 390 391 392 393 394 395 396 397 398
  deriving (Eq, Ord)


data CaseLabelInfo
  = CaseReturnPt
  | CaseReturnInfo
  | CaseAlt ConTag
  | CaseDefault
  deriving (Eq, Ord)


data RtsLabelInfo
399 400
  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
401

402 403
  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}
404 405

  | RtsPrimOp PrimOp
Ian Lynagh's avatar
Ian Lynagh committed
406
  | RtsApFast     FastString    -- ^ _fast versions of generic apply
nfrisby's avatar
nfrisby committed
407
  | RtsSlowFastTickyCtr String
408 409

  deriving (Eq, Ord)
410 411
  -- NOTE: Eq on LitString compares the pointer only, so this isn't
  -- a real equality.
412

413 414

-- | What type of Cmm label we're dealing with.
Ian Lynagh's avatar
Ian Lynagh committed
415 416
--      Determines the suffix appended to the name when a CLabel.CmmLabel
--      is pretty printed.
417
data CmmLabelInfo
418
  = CmmInfo                     -- ^ misc rts info tables,      suffix _info
Ian Lynagh's avatar
Ian Lynagh committed
419 420 421
  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
  | CmmRet                      -- ^ misc rts return points,    suffix _ret
422
  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
Ian Lynagh's avatar
Ian Lynagh committed
423
  | CmmCode                     -- ^ misc rts code
424
  | CmmClosure                  -- ^ closures eg CHARLIKE_closure
Ian Lynagh's avatar
Ian Lynagh committed
425
  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
426 427
  deriving (Eq, Ord)

428
data DynamicLinkerLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
429 430 431 432 433
  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  | GotSymbolPtr                -- ELF: foo@got
  | GotSymbolOffset             -- ELF: foo@gotoff

434
  deriving (Eq, Ord)
Ian Lynagh's avatar
Ian Lynagh committed
435

436

437 438
-- -----------------------------------------------------------------------------
-- Constructing CLabels
439
-- -----------------------------------------------------------------------------
440

Ian Lynagh's avatar
Ian Lynagh committed
441
-- Constructing IdLabels
442
-- These are always local:
443

444 445
mkTopSRTLabel     :: Unique -> CLabel
mkTopSRTLabel u = SRTLabel u
446

nfrisby's avatar
nfrisby committed
447 448 449
mkRednCountsLabel :: Name -> CLabel
mkRednCountsLabel       name    =
  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
450 451

-- These have local & (possibly) external variants:
Ian Lynagh's avatar
Ian Lynagh committed
452 453 454
mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
455
mkLocalClosureLabel     name c  = IdLabel name  c Closure
456
mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
457 458
mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable

Ian Lynagh's avatar
Ian Lynagh committed
459 460 461 462 463
mkClosureLabel              :: Name -> CafInfo -> CLabel
mkInfoTableLabel            :: Name -> CafInfo -> CLabel
mkEntryLabel                :: Name -> CafInfo -> CLabel
mkClosureTableLabel         :: Name -> CafInfo -> CLabel
mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
464
mkBytesLabel                :: Name -> CLabel
465
mkClosureLabel name         c     = IdLabel name c Closure
466
mkInfoTableLabel name       c     = IdLabel name c InfoTable
467
mkEntryLabel name           c     = IdLabel name c Entry
468
mkClosureTableLabel name    c     = IdLabel name c ClosureTable
469
mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
470
mkBytesLabel name                 = IdLabel name NoCafRefs Bytes
471

472 473 474 475
mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
                               -- See Note [Proc-point local block entry-point].

476
-- Constructing Cmm Labels
477
mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
478
    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
479
    mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
480 481 482 483
    mkArrWords_infoLabel,
    mkTopTickyCtrLabel,
    mkCAFBlackHoleInfoTableLabel,
    mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
Ben Gamari's avatar
Ben Gamari committed
484
    mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
485
mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
486 487 488 489 490 491 492 493 494 495 496 497 498 499
mkSplitMarkerLabel              = CmmLabel rtsUnitId (fsLit "__stg_split_marker")    CmmCode
mkUpdInfoLabel                  = CmmLabel rtsUnitId (fsLit "stg_upd_frame")         CmmInfo
mkBHUpdInfoLabel                = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" )     CmmInfo
mkIndStaticInfoLabel            = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC")        CmmInfo
mkMainCapabilityLabel           = CmmLabel rtsUnitId (fsLit "MainCapability")        CmmData
mkMAP_FROZEN_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
mkMAP_FROZEN0_infoLabel         = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkMAP_DIRTY_infoLabel           = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkTopTickyCtrLabel              = CmmLabel rtsUnitId (fsLit "top_ct")                CmmData
mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
mkArrWords_infoLabel            = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS")         CmmInfo
mkSMAP_FROZEN_infoLabel         = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel        = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel          = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
Ben Gamari's avatar
Ben Gamari committed
500
mkBadAlignmentLabel             = CmmLabel rtsUnitId (fsLit "stg_badAlignment")      CmmEntry
501 502

-----
503
mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
504
  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel
505
        :: UnitId -> FastString -> CLabel
506

Ian Lynagh's avatar
Ian Lynagh committed
507 508 509 510 511 512
mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
mkCmmRetInfoLabel   pkg str     = CmmLabel pkg str CmmRetInfo
mkCmmRetLabel       pkg str     = CmmLabel pkg str CmmRet
mkCmmCodeLabel      pkg str     = CmmLabel pkg str CmmCode
mkCmmDataLabel      pkg str     = CmmLabel pkg str CmmData
513
mkCmmClosureLabel   pkg str     = CmmLabel pkg str CmmClosure
514 515 516


-- Constructing RtsLabels
Ian Lynagh's avatar
Ian Lynagh committed
517
mkRtsPrimOpLabel :: PrimOp -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
518
mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
519

Ian Lynagh's avatar
Ian Lynagh committed
520 521
mkSelectorInfoLabel  :: Bool -> Int -> CLabel
mkSelectorEntryLabel :: Bool -> Int -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
522 523
mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
524

Ian Lynagh's avatar
Ian Lynagh committed
525 526
mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApEntryLabel     :: Bool -> Int -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
527 528
mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
529

530

531
-- A call to some primitive hand written Cmm code
532
mkPrimCallLabel :: PrimCall -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
533 534
mkPrimCallLabel (PrimCall str pkg)
        = CmmLabel pkg str CmmPrimCall
535

536

537
-- Constructing ForeignLabels
538

539
-- | Make a foreign label
Ian Lynagh's avatar
Ian Lynagh committed
540 541 542 543 544 545
mkForeignLabel
        :: FastString           -- name
        -> Maybe Int            -- size prefix
        -> ForeignLabelSource   -- what package it's in
        -> FunctionOrData
        -> CLabel
546 547 548 549 550 551

mkForeignLabel str mb_sz src fod
    = ForeignLabel str mb_sz src  fod


-- | Update the label size field in a ForeignLabel
552
addLabelSize :: CLabel -> Int -> CLabel
553 554
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
555
addLabelSize label _
556
    = label
557

558 559 560 561 562
-- | Whether label is a top-level string literal
isBytesLabel :: CLabel -> Bool
isBytesLabel (IdLabel _ _ Bytes) = True
isBytesLabel _lbl = False

563 564 565 566 567
-- | Whether label is a non-haskell label (defined in C code)
isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel _ _ _ _) = True
isForeignLabel _lbl = False

568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589
-- | 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
isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True
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
-- static reference tables defined in haskell (.hs)
isSomeRODataLabel (IdLabel _ _ SRT) = True
isSomeRODataLabel (SRTLabel _) = True
-- info table defined in cmm (.cmm)
isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
isSomeRODataLabel _lbl = False

590
-- | Get the label size field from a ForeignLabel
591
foreignLabelStdcallInfo :: CLabel -> Maybe Int
592
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
593 594
foreignLabelStdcallInfo _lbl = Nothing

595

596
-- Constructing Large*Labels
Ian Lynagh's avatar
Ian Lynagh committed
597 598
mkLargeSRTLabel :: Unique -> CLabel
mkBitmapLabel   :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
599 600
mkLargeSRTLabel uniq            = LargeSRTLabel uniq
mkBitmapLabel   uniq            = LargeBitmapLabel uniq
601 602

-- Constructing Cost Center Labels
Ian Lynagh's avatar
Ian Lynagh committed
603 604
mkCCLabel  :: CostCentre      -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
605 606
mkCCLabel           cc          = CC_Label cc
mkCCSLabel          ccs         = CCS_Label ccs
607

Ian Lynagh's avatar
Ian Lynagh committed
608
mkRtsApFastLabel :: FastString -> CLabel
609 610
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

nfrisby's avatar
nfrisby committed
611 612
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
613

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

615
-- Constructing Code Coverage Labels
Ian Lynagh's avatar
Ian Lynagh committed
616
mkHpcTicksLabel :: Module -> CLabel
andy@galois.com's avatar
andy@galois.com committed
617 618
mkHpcTicksLabel                = HpcTicksLabel

619 620

-- Constructing labels used for dynamic linking
621
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
622
mkDynamicLinkerLabel            = DynamicLinkerLabel
623 624 625

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

628
mkPicBaseLabel :: CLabel
Ian Lynagh's avatar
Ian Lynagh committed
629
mkPicBaseLabel                  = PicBaseLabel
630

631 632

-- Constructing miscellaneous other labels
633
mkDeadStripPreventer :: CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
634
mkDeadStripPreventer lbl        = DeadStripPreventer lbl
635 636

mkStringLitLabel :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
637
mkStringLitLabel                = StringLitLabel
638 639

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

Peter Wortmann's avatar
Peter Wortmann committed
642 643 644 645 646
mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel = AsmTempDerivedLabel

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

648 649 650 651 652
-- | Construct a label for a DWARF Debug Information Entity (DIE)
-- describing another symbol.
mkAsmTempDieLabel :: CLabel -> CLabel
mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")

653
-- -----------------------------------------------------------------------------
654 655
-- Convert between different kinds of label

656
toClosureLbl :: CLabel -> CLabel
657 658
toClosureLbl (IdLabel n _ BlockInfoTable)
  = pprPanic "toClosureLbl: BlockInfoTable" (ppr n)
659
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
660
toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
661 662 663
toClosureLbl l = pprPanic "toClosureLbl" (ppr l)

toSlowEntryLbl :: CLabel -> CLabel
664 665
toSlowEntryLbl (IdLabel n _ BlockInfoTable)
  = pprPanic "toSlowEntryLbl" (ppr n)
666 667 668 669 670 671
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
672 673
toEntryLbl (IdLabel n _ BlockInfoTable)  = mkAsmTempLabel (nameUnique n)
                              -- See Note [Proc-point local block entry-point].
674 675 676 677 678 679 680 681 682 683 684 685 686 687
toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
toEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
toEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
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
toInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
688

nfrisby's avatar
nfrisby committed
689 690 691 692
hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel n _ _) = Just n
hasHaskellName _               = Nothing

693
-- -----------------------------------------------------------------------------
nfrisby's avatar
nfrisby committed
694
-- Does a CLabel's referent itself refer to a CAF?
695
hasCAF :: CLabel -> Bool
nfrisby's avatar
nfrisby committed
696
hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
697 698
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
699

nfrisby's avatar
nfrisby committed
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717
-- 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
-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
-- 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.
718

719 720
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
721 722
--
-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
723 724 725

needsCDecl :: CLabel -> Bool
  -- False <=> it's pre-declared; don't bother
726
  -- don't bother declaring Bitmap labels, we always make sure
727
  -- they are defined before use.
728
needsCDecl (SRTLabel _)                 = True
Ian Lynagh's avatar
Ian Lynagh committed
729 730 731 732
needsCDecl (LargeSRTLabel _)            = False
needsCDecl (LargeBitmapLabel _)         = False
needsCDecl (IdLabel _ _ _)              = True
needsCDecl (CaseLabel _ _)              = True
733

Ian Lynagh's avatar
Ian Lynagh committed
734 735
needsCDecl (StringLitLabel _)           = False
needsCDecl (AsmTempLabel _)             = False
Peter Wortmann's avatar
Peter Wortmann committed
736
needsCDecl (AsmTempDerivedLabel _ _)    = False
Ian Lynagh's avatar
Ian Lynagh committed
737 738 739 740 741
needsCDecl (RtsLabel _)                 = False

needsCDecl (CmmLabel pkgId _ _)
        -- Prototypes for labels defined in the runtime system are imported
        --      into HC files via includes/Stg.h.
742
        | pkgId == rtsUnitId         = False
Ian Lynagh's avatar
Ian Lynagh committed
743 744 745 746 747 748 749

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

needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
needsCDecl (CC_Label _)                 = True
needsCDecl (CCS_Label _)                = True
andy@galois.com's avatar
andy@galois.com committed
750
needsCDecl (HpcTicksLabel _)            = True
Ian Lynagh's avatar
Ian Lynagh committed
751 752 753
needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
754

755 756
-- | If a label is a local temporary used for native code generation
--      then return just its unique, otherwise nothing.
757
maybeAsmTemp :: CLabel -> Maybe Unique
Ian Lynagh's avatar
Ian Lynagh committed
758 759
maybeAsmTemp (AsmTempLabel uq)          = Just uq
maybeAsmTemp _                          = Nothing
760

761

Ian Lynagh's avatar
Ian Lynagh committed
762
-- | Check whether a label corresponds to a C function that has
763
--      a prototype in a system header somehere, or is built-in
764
--      to the C compiler. For these labels we avoid generating our
765
--      own C prototypes.
766
isMathFun :: CLabel -> Bool
Ian Lynagh's avatar
Ian Lynagh committed
767
isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
768 769
isMathFun _ = False

Ian Lynagh's avatar
Ian Lynagh committed
770
math_funs :: UniqSet FastString
771
math_funs = mkUniqSet [
772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847
        -- _ISOC99_SOURCE
        (fsLit "acos"),         (fsLit "acosf"),        (fsLit "acosh"),
        (fsLit "acoshf"),       (fsLit "acoshl"),       (fsLit "acosl"),
        (fsLit "asin"),         (fsLit "asinf"),        (fsLit "asinl"),
        (fsLit "asinh"),        (fsLit "asinhf"),       (fsLit "asinhl"),
        (fsLit "atan"),         (fsLit "atanf"),        (fsLit "atanl"),
        (fsLit "atan2"),        (fsLit "atan2f"),       (fsLit "atan2l"),
        (fsLit "atanh"),        (fsLit "atanhf"),       (fsLit "atanhl"),
        (fsLit "cbrt"),         (fsLit "cbrtf"),        (fsLit "cbrtl"),
        (fsLit "ceil"),         (fsLit "ceilf"),        (fsLit "ceill"),
        (fsLit "copysign"),     (fsLit "copysignf"),    (fsLit "copysignl"),
        (fsLit "cos"),          (fsLit "cosf"),         (fsLit "cosl"),
        (fsLit "cosh"),         (fsLit "coshf"),        (fsLit "coshl"),
        (fsLit "erf"),          (fsLit "erff"),         (fsLit "erfl"),
        (fsLit "erfc"),         (fsLit "erfcf"),        (fsLit "erfcl"),
        (fsLit "exp"),          (fsLit "expf"),         (fsLit "expl"),
        (fsLit "exp2"),         (fsLit "exp2f"),        (fsLit "exp2l"),
        (fsLit "expm1"),        (fsLit "expm1f"),       (fsLit "expm1l"),
        (fsLit "fabs"),         (fsLit "fabsf"),        (fsLit "fabsl"),
        (fsLit "fdim"),         (fsLit "fdimf"),        (fsLit "fdiml"),
        (fsLit "floor"),        (fsLit "floorf"),       (fsLit "floorl"),
        (fsLit "fma"),          (fsLit "fmaf"),         (fsLit "fmal"),
        (fsLit "fmax"),         (fsLit "fmaxf"),        (fsLit "fmaxl"),
        (fsLit "fmin"),         (fsLit "fminf"),        (fsLit "fminl"),
        (fsLit "fmod"),         (fsLit "fmodf"),        (fsLit "fmodl"),
        (fsLit "frexp"),        (fsLit "frexpf"),       (fsLit "frexpl"),
        (fsLit "hypot"),        (fsLit "hypotf"),       (fsLit "hypotl"),
        (fsLit "ilogb"),        (fsLit "ilogbf"),       (fsLit "ilogbl"),
        (fsLit "ldexp"),        (fsLit "ldexpf"),       (fsLit "ldexpl"),
        (fsLit "lgamma"),       (fsLit "lgammaf"),      (fsLit "lgammal"),
        (fsLit "llrint"),       (fsLit "llrintf"),      (fsLit "llrintl"),
        (fsLit "llround"),      (fsLit "llroundf"),     (fsLit "llroundl"),
        (fsLit "log"),          (fsLit "logf"),         (fsLit "logl"),
        (fsLit "log10l"),       (fsLit "log10"),        (fsLit "log10f"),
        (fsLit "log1pl"),       (fsLit "log1p"),        (fsLit "log1pf"),
        (fsLit "log2"),         (fsLit "log2f"),        (fsLit "log2l"),
        (fsLit "logb"),         (fsLit "logbf"),        (fsLit "logbl"),
        (fsLit "lrint"),        (fsLit "lrintf"),       (fsLit "lrintl"),
        (fsLit "lround"),       (fsLit "lroundf"),      (fsLit "lroundl"),
        (fsLit "modf"),         (fsLit "modff"),        (fsLit "modfl"),
        (fsLit "nan"),          (fsLit "nanf"),         (fsLit "nanl"),
        (fsLit "nearbyint"),    (fsLit "nearbyintf"),   (fsLit "nearbyintl"),
        (fsLit "nextafter"),    (fsLit "nextafterf"),   (fsLit "nextafterl"),
        (fsLit "nexttoward"),   (fsLit "nexttowardf"),  (fsLit "nexttowardl"),
        (fsLit "pow"),          (fsLit "powf"),         (fsLit "powl"),
        (fsLit "remainder"),    (fsLit "remainderf"),   (fsLit "remainderl"),
        (fsLit "remquo"),       (fsLit "remquof"),      (fsLit "remquol"),
        (fsLit "rint"),         (fsLit "rintf"),        (fsLit "rintl"),
        (fsLit "round"),        (fsLit "roundf"),       (fsLit "roundl"),
        (fsLit "scalbln"),      (fsLit "scalblnf"),     (fsLit "scalblnl"),
        (fsLit "scalbn"),       (fsLit "scalbnf"),      (fsLit "scalbnl"),
        (fsLit "sin"),          (fsLit "sinf"),         (fsLit "sinl"),
        (fsLit "sinh"),         (fsLit "sinhf"),        (fsLit "sinhl"),
        (fsLit "sqrt"),         (fsLit "sqrtf"),        (fsLit "sqrtl"),
        (fsLit "tan"),          (fsLit "tanf"),         (fsLit "tanl"),
        (fsLit "tanh"),         (fsLit "tanhf"),        (fsLit "tanhl"),
        (fsLit "tgamma"),       (fsLit "tgammaf"),      (fsLit "tgammal"),
        (fsLit "trunc"),        (fsLit "truncf"),       (fsLit "truncl"),
        -- ISO C 99 also defines these function-like macros in math.h:
        -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
        -- isgreaterequal, isless, islessequal, islessgreater, isunordered

        -- additional symbols from _BSD_SOURCE
        (fsLit "drem"),         (fsLit "dremf"),        (fsLit "dreml"),
        (fsLit "finite"),       (fsLit "finitef"),      (fsLit "finitel"),
        (fsLit "gamma"),        (fsLit "gammaf"),       (fsLit "gammal"),
        (fsLit "isinf"),        (fsLit "isinff"),       (fsLit "isinfl"),
        (fsLit "isnan"),        (fsLit "isnanf"),       (fsLit "isnanl"),
        (fsLit "j0"),           (fsLit "j0f"),          (fsLit "j0l"),
        (fsLit "j1"),           (fsLit "j1f"),          (fsLit "j1l"),
        (fsLit "jn"),           (fsLit "jnf"),          (fsLit "jnl"),
        (fsLit "lgamma_r"),     (fsLit "lgammaf_r"),    (fsLit "lgammal_r"),
        (fsLit "scalb"),        (fsLit "scalbf"),       (fsLit "scalbl"),
        (fsLit "significand"),  (fsLit "significandf"), (fsLit "significandl"),
        (fsLit "y0"),           (fsLit "y0f"),          (fsLit "y0l"),
        (fsLit "y1"),           (fsLit "y1f"),          (fsLit "y1l"),
848 849 850 851 852 853
        (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl"),

        -- These functions are described in IEEE Std 754-2008 -
        -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
        (fsLit "nextup"),       (fsLit "nextupf"),      (fsLit "nextupl"),
        (fsLit "nextdown"),     (fsLit "nextdownf"),    (fsLit "nextdownl")
854
    ]
855

856
-- -----------------------------------------------------------------------------
857
-- | Is a CLabel visible outside this object file or not?
Ian Lynagh's avatar
Ian Lynagh committed
858 859 860
--      From the point of view of the code generator, a name is
--      externally visible if it has to be declared as exported
--      in the .o file's symbol table; that is, made non-static.
861
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
Ian Lynagh's avatar
Ian Lynagh committed
862 863 864
externallyVisibleCLabel (CaseLabel _ _)         = False
externallyVisibleCLabel (StringLitLabel _)      = False
externallyVisibleCLabel (AsmTempLabel _)        = False
Peter Wortmann's avatar
Peter Wortmann committed
865
externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
866
externallyVisibleCLabel (RtsLabel _)            = True
Ian Lynagh's avatar
Ian Lynagh committed
867 868 869 870 871
externallyVisibleCLabel (CmmLabel _ _ _)        = True
externallyVisibleCLabel (ForeignLabel{})        = True
externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
externallyVisibleCLabel (CC_Label _)            = True
externallyVisibleCLabel (CCS_Label _)           = True
872
externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
Ian Lynagh's avatar
Ian Lynagh committed
873
externallyVisibleCLabel (HpcTicksLabel _)       = True
874
externallyVisibleCLabel (LargeBitmapLabel _)    = False
875
externallyVisibleCLabel (SRTLabel _)            = False
Ian Lynagh's avatar
Ian Lynagh committed
876
externallyVisibleCLabel (LargeSRTLabel _)       = False
Ian Lynagh's avatar
Ian Lynagh committed
877 878
externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
879

batterseapower's avatar
batterseapower committed
880
externallyVisibleIdLabel :: IdLabelInfo -> Bool
881
externallyVisibleIdLabel SRT             = False
882 883
externallyVisibleIdLabel LocalInfoTable  = False
externallyVisibleIdLabel LocalEntry      = False
884
externallyVisibleIdLabel BlockInfoTable  = False
885
externallyVisibleIdLabel _               = True
batterseapower's avatar
batterseapower committed
886

887
-- -----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
888
-- Finding the "type" of a CLabel
889 890 891 892

-- For generating correct types in label declarations:

data CLabelType
Ian Lynagh's avatar
Ian Lynagh committed
893 894 895
  = CodeLabel   -- Address of some executable instructions
  | DataLabel   -- Address of data, not a GC ptr
  | GcPtrLabel  -- Address of a (presumably static) GC object
896 897 898

isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel lbl = case labelType lbl of
Ian Lynagh's avatar
Ian Lynagh committed
899 900
                        CodeLabel -> True
                        _other    -> False
901 902 903

isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel lbl = case labelType lbl of
Ian Lynagh's avatar
Ian Lynagh committed
904 905
                        GcPtrLabel -> True
                        _other     -> False
906

907 908 909

-- | Work out the general type of data at the address of this label
--    whether it be code, data, or static GC object.
910
labelType :: CLabel -> CLabelType
Ian Lynagh's avatar
Ian Lynagh committed
911
labelType (CmmLabel _ _ CmmData)                = DataLabel
912
labelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel
Ian Lynagh's avatar
Ian Lynagh committed
913 914 915
labelType (CmmLabel _ _ CmmCode)                = CodeLabel
labelType (CmmLabel _ _ CmmInfo)                = DataLabel
labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
916
labelType (CmmLabel _ _ CmmPrimCall)            = CodeLabel
Ian Lynagh's avatar
Ian Lynagh committed
917 918
labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
919 920
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
921 922
labelType (RtsLabel (RtsApFast _))              = CodeLabel
labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
Ian Lynagh's avatar
Ian Lynagh committed
923
labelType (CaseLabel _ _)                       = CodeLabel
924
labelType (SRTLabel _)                          = DataLabel
925 926
labelType (LargeSRTLabel _)                     = DataLabel