CLabel.hs 46.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
--
-----------------------------------------------------------------------------

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

        mkClosureLabel,
        mkSRTLabel,
16
        mkTopSRTLabel,
Ian Lynagh's avatar
Ian Lynagh committed
17 18
        mkInfoTableLabel,
        mkEntryLabel,
19
        mkSlowEntryLabel,
Ian Lynagh's avatar
Ian Lynagh committed
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
        mkConEntryLabel,
        mkStaticConEntryLabel,
        mkRednCountsLabel,
        mkConInfoTableLabel,
        mkStaticInfoTableLabel,
        mkLargeSRTLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
        mkClosureTableLabel,

        mkLocalClosureLabel,
        mkLocalInfoTableLabel,
        mkLocalEntryLabel,
        mkLocalConEntryLabel,
        mkLocalStaticConEntryLabel,
        mkLocalConInfoTableLabel,
        mkLocalStaticInfoTableLabel,
        mkLocalClosureTableLabel,

        mkReturnPtLabel,
        mkReturnInfoLabel,
        mkAltLabel,
        mkDefaultLabel,
        mkBitmapLabel,
        mkStringLitLabel,

        mkAsmTempLabel,
47

48
        mkPlainModuleInitLabel,
49

Ian Lynagh's avatar
Ian Lynagh committed
50 51 52 53 54
        mkSplitMarkerLabel,
        mkDirty_MUT_VAR_Label,
        mkUpdInfoLabel,
        mkBHUpdInfoLabel,
        mkIndStaticInfoLabel,
55
        mkMainCapabilityLabel,
Ian Lynagh's avatar
Ian Lynagh committed
56
        mkMAP_FROZEN_infoLabel,
57
        mkMAP_FROZEN0_infoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
58
        mkMAP_DIRTY_infoLabel,
59 60 61
        mkSMAP_FROZEN_infoLabel,
        mkSMAP_FROZEN0_infoLabel,
        mkSMAP_DIRTY_infoLabel,
62
        mkEMPTY_MVAR_infoLabel,
63
        mkArrWords_infoLabel,
64

Ian Lynagh's avatar
Ian Lynagh committed
65
        mkTopTickyCtrLabel,
66
        mkCAFBlackHoleInfoTableLabel,
batterseapower's avatar
batterseapower committed
67
        mkCAFBlackHoleEntryLabel,
Ian Lynagh's avatar
Ian Lynagh committed
68
        mkRtsPrimOpLabel,
nfrisby's avatar
nfrisby committed
69
        mkRtsSlowFastTickyCtrLabel,
70

71
        mkSelectorInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
72
        mkSelectorEntryLabel,
73

Ian Lynagh's avatar
Ian Lynagh committed
74 75 76 77 78 79
        mkCmmInfoLabel,
        mkCmmEntryLabel,
        mkCmmRetInfoLabel,
        mkCmmRetLabel,
        mkCmmCodeLabel,
        mkCmmDataLabel,
80
        mkCmmClosureLabel,
81

Ian Lynagh's avatar
Ian Lynagh committed
82
        mkRtsApFastLabel,
83

84 85
        mkPrimCallLabel,

Ian Lynagh's avatar
Ian Lynagh committed
86
        mkForeignLabel,
87
        addLabelSize,
88
        foreignLabelStdcallInfo,
89

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
        hasCAF,
102
        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
103
        isMathFun,
Ian Lynagh's avatar
Ian Lynagh committed
104
        isCFunctionLabel, isGcPtrLabel, labelDynamic,
105 106

        -- * Conversions
nfrisby's avatar
nfrisby committed
107
        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName,
108

109
        pprCLabel
110 111
    ) where

112
import IdInfo
113
import BasicTypes
Simon Marlow's avatar
Simon Marlow committed
114 115 116 117 118 119 120
import Packages
import Module
import Name
import Unique
import PrimOp
import Config
import CostCentre
121 122
import Outputable
import FastString
123
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
124
import Platform
125
import UniqSet
126 127 128 129 130

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

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

  - 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
153
  = -- | A label related to the definition of a particular Id or Con in a .hs file.
Ian Lynagh's avatar
Ian Lynagh committed
154 155
    IdLabel
        Name
156
        CafInfo
Ian Lynagh's avatar
Ian Lynagh committed
157 158
        IdLabelInfo             -- encodes the suffix of the label

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

  -- | 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
167
  --    If it doesn't have an algorithmically generated name then use a CmmLabel
Ben.Lippmeier@anu.edu.au's avatar
Ben.Lippmeier@anu.edu.au committed
168
  --    instead and give it an appropriate PackageId argument.
Ian Lynagh's avatar
Ian Lynagh committed
169 170
  | RtsLabel
        RtsLabelInfo
171

172 173
  -- | A 'C' (or otherwise foreign) label.
  --
Ian Lynagh's avatar
Ian Lynagh committed
174 175 176 177 178 179
  | 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.
180

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

183 184 185
        FunctionOrData

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

Ian Lynagh's avatar
Ian Lynagh committed
190 191
  | AsmTempLabel
        {-# UNPACK #-} !Unique
192

193
  | StringLitLabel
Ian Lynagh's avatar
Ian Lynagh committed
194
        {-# UNPACK #-} !Unique
195

196
  | PlainModuleInitLabel        -- without the version & way info
Ian Lynagh's avatar
Ian Lynagh committed
197
        Module
198

199 200 201
  | CC_Label  CostCentre
  | CCS_Label CostCentreStack

Ian Lynagh's avatar
Ian Lynagh committed
202 203 204

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

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

215 216
  -- | A label before an info table to prevent excessive dead-stripping on darwin
  | DeadStripPreventer CLabel
217

218

219 220
  -- | Per-module table of tick locations
  | HpcTicksLabel Module
221

222
  -- | Static reference table
223
  | SRTLabel !Unique
224

225 226
  -- | Label of an StgLargeSRT
  | LargeSRTLabel
227 228
        {-# UNPACK #-} !Unique

229 230
  -- | A bitmap (function or case return)
  | LargeBitmapLabel
231 232
        {-# UNPACK #-} !Unique

233 234
  deriving (Eq, Ord)

235 236 237 238 239

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

   -- | Label is in a named package
Ian Lynagh's avatar
Ian Lynagh committed
240 241
   = ForeignLabelInPackage      PackageId

242
   -- | Label is in some external, system package that doesn't also
Ian Lynagh's avatar
Ian Lynagh committed
243 244 245 246
   --   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
247 248

   -- | Label is in the package currenly being compiled.
Ian Lynagh's avatar
Ian Lynagh committed
249 250 251 252
   --   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.
253
   | ForeignLabelInThisPackage
Ian Lynagh's avatar
Ian Lynagh committed
254 255

   deriving (Eq, Ord)
256 257 258


-- | For debugging problems with the CLabel representation.
Ian Lynagh's avatar
Ian Lynagh committed
259 260
--      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.
261
--
262 263
pprDebugCLabel :: CLabel -> SDoc
pprDebugCLabel lbl
264
 = case lbl of
Ian Lynagh's avatar
Ian Lynagh committed
265
        IdLabel{}       -> ppr lbl <> (parens $ text "IdLabel")
Ian Lynagh's avatar
Ian Lynagh committed
266
        CmmLabel pkg _name _info
Ian Lynagh's avatar
Ian Lynagh committed
267
         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
268

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

Ian Lynagh's avatar
Ian Lynagh committed
271
        ForeignLabel _name mSuffix src funOrData
Ian Lynagh's avatar
Ian Lynagh committed
272
            -> ppr lbl <> (parens $ text "ForeignLabel"
Ian Lynagh's avatar
Ian Lynagh committed
273 274 275
                                <+> ppr mSuffix
                                <+> ppr src
                                <+> ppr funOrData)
276

Ian Lynagh's avatar
Ian Lynagh committed
277
        _               -> ppr lbl <> (parens $ text "other CLabel)")
278 279


280
data IdLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
281
  = Closure             -- ^ Label for closure
282 283 284
  | SRT                 -- ^ Static reference table (TODO: could be removed
                        -- with the old code generator, but might be needed
                        -- when we implement the New SRT Plan)
285
  | InfoTable           -- ^ Info tables for closures; always read-only
Ian Lynagh's avatar
Ian Lynagh committed
286
  | Entry               -- ^ Entry point
287
  | Slow                -- ^ Slow entry point
288

289 290 291 292
  | 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
293

Ian Lynagh's avatar
Ian Lynagh committed
294 295 296 297
  | ConEntry            -- ^ Constructor entry point
  | ConInfoTable        -- ^ Corresponding info table
  | StaticConEntry      -- ^ Static constructor entry point
  | StaticInfoTable     -- ^ Corresponding info table
298

Ian Lynagh's avatar
Ian Lynagh committed
299
  | ClosureTable        -- ^ Table of closures for Enum tycons
300 301 302 303 304 305 306 307 308 309 310 311 312

  deriving (Eq, Ord)


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


data RtsLabelInfo
313 314
  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}  -- ^ Selector thunks
  | RtsSelectorEntry     Bool{-updatable-} Int{-offset-}
315

316 317
  | RtsApInfoTable       Bool{-updatable-} Int{-arity-}    -- ^ AP thunks
  | RtsApEntry           Bool{-updatable-} Int{-arity-}
318 319

  | RtsPrimOp PrimOp
Ian Lynagh's avatar
Ian Lynagh committed
320
  | RtsApFast     FastString    -- ^ _fast versions of generic apply
nfrisby's avatar
nfrisby committed
321
  | RtsSlowFastTickyCtr String
322 323

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

327 328

-- | What type of Cmm label we're dealing with.
Ian Lynagh's avatar
Ian Lynagh committed
329 330
--      Determines the suffix appended to the name when a CLabel.CmmLabel
--      is pretty printed.
331
data CmmLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
332 333 334 335 336 337
  = CmmInfo                     -- ^ misc rts info tabless,     suffix _info
  | CmmEntry                    -- ^ misc rts entry points,     suffix _entry
  | CmmRetInfo                  -- ^ misc rts ret info tables,  suffix _info
  | CmmRet                      -- ^ misc rts return points,    suffix _ret
  | CmmData                     -- ^ misc rts data bits, eg CHARLIKE_closure
  | CmmCode                     -- ^ misc rts code
338
  | CmmClosure                  -- ^ closures eg CHARLIKE_closure
Ian Lynagh's avatar
Ian Lynagh committed
339
  | CmmPrimCall                 -- ^ a prim call to some hand written Cmm code
340 341
  deriving (Eq, Ord)

342
data DynamicLinkerLabelInfo
Ian Lynagh's avatar
Ian Lynagh committed
343 344 345 346 347
  = CodeStub                    -- MachO: Lfoo$stub, ELF: foo@plt
  | SymbolPtr                   -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
  | GotSymbolPtr                -- ELF: foo@got
  | GotSymbolOffset             -- ELF: foo@gotoff

348
  deriving (Eq, Ord)
Ian Lynagh's avatar
Ian Lynagh committed
349

350

351 352
-- -----------------------------------------------------------------------------
-- Constructing CLabels
353
-- -----------------------------------------------------------------------------
354

Ian Lynagh's avatar
Ian Lynagh committed
355
-- Constructing IdLabels
356
-- These are always local:
Ian Lynagh's avatar
Ian Lynagh committed
357
mkSlowEntryLabel :: Name -> CafInfo -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
358
mkSlowEntryLabel        name c         = IdLabel name  c Slow
359

360 361
mkTopSRTLabel     :: Unique -> CLabel
mkTopSRTLabel u = SRTLabel u
362

Ian Lynagh's avatar
Ian Lynagh committed
363
mkSRTLabel        :: Name -> CafInfo -> CLabel
nfrisby's avatar
nfrisby committed
364
mkRednCountsLabel :: Name -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
365
mkSRTLabel              name c  = IdLabel name  c SRT
nfrisby's avatar
nfrisby committed
366 367
mkRednCountsLabel       name    =
  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
368 369

-- These have local & (possibly) external variants:
Ian Lynagh's avatar
Ian Lynagh committed
370 371 372 373
mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel    :: Name -> CafInfo -> CLabel
mkLocalEntryLabel        :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
374
mkLocalClosureLabel     name c  = IdLabel name  c Closure
375 376
mkLocalInfoTableLabel   name c  = IdLabel name  c LocalInfoTable
mkLocalEntryLabel       name c  = IdLabel name  c LocalEntry
377 378
mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable

Ian Lynagh's avatar
Ian Lynagh committed
379 380 381 382 383 384 385 386 387 388
mkClosureLabel              :: Name -> CafInfo -> CLabel
mkInfoTableLabel            :: Name -> CafInfo -> CLabel
mkEntryLabel                :: Name -> CafInfo -> CLabel
mkClosureTableLabel         :: Name -> CafInfo -> CLabel
mkLocalConInfoTableLabel    :: CafInfo -> Name -> CLabel
mkLocalConEntryLabel        :: CafInfo -> Name -> CLabel
mkLocalStaticInfoTableLabel :: CafInfo -> Name -> CLabel
mkLocalStaticConEntryLabel  :: CafInfo -> Name -> CLabel
mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
mkStaticInfoTableLabel      :: Name -> CafInfo -> CLabel
389
mkClosureLabel name         c     = IdLabel name c Closure
390
mkInfoTableLabel name       c     = IdLabel name c InfoTable
391
mkEntryLabel name           c     = IdLabel name c Entry
392 393
mkClosureTableLabel name    c     = IdLabel name c ClosureTable
mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
Ian Lynagh's avatar
Ian Lynagh committed
394
mkLocalConEntryLabel        c con = IdLabel con c ConEntry
395 396
mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
397 398
mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
399

Ian Lynagh's avatar
Ian Lynagh committed
400 401
mkConEntryLabel       :: Name -> CafInfo -> CLabel
mkStaticConEntryLabel :: Name -> CafInfo -> CLabel
402 403
mkConEntryLabel name        c     = IdLabel name c ConEntry
mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
404

405
-- Constructing Cmm Labels
406
mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
407
    mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
408
    mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
Ian Lynagh's avatar
Ian Lynagh committed
409
    mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
410
    mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
411 412
    mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
    mkSMAP_DIRTY_infoLabel :: CLabel
413
mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
Ian Lynagh's avatar
Ian Lynagh committed
414 415 416 417 418
mkSplitMarkerLabel              = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
mkUpdInfoLabel                  = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
mkBHUpdInfoLabel                = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
mkIndStaticInfoLabel            = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
mkMainCapabilityLabel           = CmmLabel rtsPackageId (fsLit "MainCapability")        CmmData
419 420
mkMAP_FROZEN_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
mkMAP_FROZEN0_infoLabel         = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
Ian Lynagh's avatar
Ian Lynagh committed
421 422 423 424 425
mkMAP_DIRTY_infoLabel           = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkEMPTY_MVAR_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")        CmmInfo
mkTopTickyCtrLabel              = CmmLabel rtsPackageId (fsLit "top_ct")                CmmData
mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
mkCAFBlackHoleEntryLabel        = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
426
mkArrWords_infoLabel            = CmmLabel rtsPackageId (fsLit "stg_ARR_WORDS")         CmmInfo
427 428 429
mkSMAP_FROZEN_infoLabel         = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel        = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
430 431

-----
432
mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
433
  mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel
Ian Lynagh's avatar
Ian Lynagh committed
434
        :: PackageId -> FastString -> CLabel
435

Ian Lynagh's avatar
Ian Lynagh committed
436 437 438 439 440 441
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
442
mkCmmClosureLabel   pkg str     = CmmLabel pkg str CmmClosure
443 444 445


-- Constructing RtsLabels
Ian Lynagh's avatar
Ian Lynagh committed
446
mkRtsPrimOpLabel :: PrimOp -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
447
mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
448

Ian Lynagh's avatar
Ian Lynagh committed
449 450
mkSelectorInfoLabel  :: Bool -> Int -> CLabel
mkSelectorEntryLabel :: Bool -> Int -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
451 452
mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry     upd off)
453

Ian Lynagh's avatar
Ian Lynagh committed
454 455
mkApInfoTableLabel :: Bool -> Int -> CLabel
mkApEntryLabel     :: Bool -> Int -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
456 457
mkApInfoTableLabel   upd off    = RtsLabel (RtsApInfoTable       upd off)
mkApEntryLabel       upd off    = RtsLabel (RtsApEntry           upd off)
458

459

460
-- A call to some primitive hand written Cmm code
461
mkPrimCallLabel :: PrimCall -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
462 463
mkPrimCallLabel (PrimCall str pkg)
        = CmmLabel pkg str CmmPrimCall
464

465

466
-- Constructing ForeignLabels
467

468
-- | Make a foreign label
Ian Lynagh's avatar
Ian Lynagh committed
469 470 471 472 473 474
mkForeignLabel
        :: FastString           -- name
        -> Maybe Int            -- size prefix
        -> ForeignLabelSource   -- what package it's in
        -> FunctionOrData
        -> CLabel
475 476 477 478 479 480

mkForeignLabel str mb_sz src fod
    = ForeignLabel str mb_sz src  fod


-- | Update the label size field in a ForeignLabel
481
addLabelSize :: CLabel -> Int -> CLabel
482 483
addLabelSize (ForeignLabel str _ src  fod) sz
    = ForeignLabel str (Just sz) src fod
484
addLabelSize label _
485
    = label
486

487
-- | Get the label size field from a ForeignLabel
488
foreignLabelStdcallInfo :: CLabel -> Maybe Int
489
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
490 491
foreignLabelStdcallInfo _lbl = Nothing

492

493
-- Constructing Large*Labels
Ian Lynagh's avatar
Ian Lynagh committed
494 495
mkLargeSRTLabel :: Unique -> CLabel
mkBitmapLabel   :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
496 497
mkLargeSRTLabel uniq            = LargeSRTLabel uniq
mkBitmapLabel   uniq            = LargeBitmapLabel uniq
498 499 500


-- Constructin CaseLabels
Ian Lynagh's avatar
Ian Lynagh committed
501 502 503 504
mkReturnPtLabel   :: Unique -> CLabel
mkReturnInfoLabel :: Unique -> CLabel
mkAltLabel        :: Unique -> ConTag -> CLabel
mkDefaultLabel    :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
505 506 507 508
mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
509

510
-- Constructing Cost Center Labels
Ian Lynagh's avatar
Ian Lynagh committed
511 512
mkCCLabel  :: CostCentre      -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
513 514
mkCCLabel           cc          = CC_Label cc
mkCCSLabel          ccs         = CCS_Label ccs
515

Ian Lynagh's avatar
Ian Lynagh committed
516
mkRtsApFastLabel :: FastString -> CLabel
517 518
mkRtsApFastLabel str = RtsLabel (RtsApFast str)

nfrisby's avatar
nfrisby committed
519 520
mkRtsSlowFastTickyCtrLabel :: String -> CLabel
mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
521

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

523
-- Constructing Code Coverage Labels
Ian Lynagh's avatar
Ian Lynagh committed
524
mkHpcTicksLabel :: Module -> CLabel
andy@galois.com's avatar
andy@galois.com committed
525 526
mkHpcTicksLabel                = HpcTicksLabel

527 528

-- Constructing labels used for dynamic linking
529
mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
530
mkDynamicLinkerLabel            = DynamicLinkerLabel
531 532 533

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

536
mkPicBaseLabel :: CLabel
Ian Lynagh's avatar
Ian Lynagh committed
537
mkPicBaseLabel                  = PicBaseLabel
538

539 540

-- Constructing miscellaneous other labels
541
mkDeadStripPreventer :: CLabel -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
542
mkDeadStripPreventer lbl        = DeadStripPreventer lbl
543 544

mkStringLitLabel :: Unique -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
545
mkStringLitLabel                = StringLitLabel
546 547

mkAsmTempLabel :: Uniquable a => a -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
548
mkAsmTempLabel a                = AsmTempLabel (getUnique a)
549 550

mkPlainModuleInitLabel :: Module -> CLabel
Ian Lynagh's avatar
Ian Lynagh committed
551
mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
552

553
-- -----------------------------------------------------------------------------
554 555
-- Convert between different kinds of label

556 557
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
558
toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584
toClosureLbl l = pprPanic "toClosureLbl" (ppr l)

toSlowEntryLbl :: CLabel -> CLabel
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
toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
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 Entry)          = IdLabel n c InfoTable
toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
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)
585

nfrisby's avatar
nfrisby committed
586 587 588 589 590 591 592
toRednCountsLbl :: CLabel -> Maybe CLabel
toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName

hasHaskellName :: CLabel -> Maybe Name
hasHaskellName (IdLabel n _ _) = Just n
hasHaskellName _               = Nothing

593
-- -----------------------------------------------------------------------------
nfrisby's avatar
nfrisby committed
594
-- Does a CLabel's referent itself refer to a CAF?
595
hasCAF :: CLabel -> Bool
nfrisby's avatar
nfrisby committed
596
hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
597 598
hasCAF (IdLabel _ MayHaveCafRefs _) = True
hasCAF _                            = False
599

nfrisby's avatar
nfrisby committed
600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617
-- 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.
618

619 620
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
621 622
--
-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
623 624 625

needsCDecl :: CLabel -> Bool
  -- False <=> it's pre-declared; don't bother
626
  -- don't bother declaring Bitmap labels, we always make sure
627
  -- they are defined before use.
628
needsCDecl (SRTLabel _)                 = True
Ian Lynagh's avatar
Ian Lynagh committed
629 630 631 632
needsCDecl (LargeSRTLabel _)            = False
needsCDecl (LargeBitmapLabel _)         = False
needsCDecl (IdLabel _ _ _)              = True
needsCDecl (CaseLabel _ _)              = True
633
needsCDecl (PlainModuleInitLabel _)     = True
634

Ian Lynagh's avatar
Ian Lynagh committed
635 636 637 638 639 640 641 642 643 644 645 646 647 648 649
needsCDecl (StringLitLabel _)           = False
needsCDecl (AsmTempLabel _)             = False
needsCDecl (RtsLabel _)                 = False

needsCDecl (CmmLabel pkgId _ _)
        -- Prototypes for labels defined in the runtime system are imported
        --      into HC files via includes/Stg.h.
        | pkgId == rtsPackageId         = False

        -- 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
650
needsCDecl (HpcTicksLabel _)            = True
Ian Lynagh's avatar
Ian Lynagh committed
651 652 653
needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
654

655
-- | Check whether a label is a local temporary for native code generation
Ian Lynagh's avatar
Ian Lynagh committed
656 657 658
isAsmTemp  :: CLabel -> Bool
isAsmTemp (AsmTempLabel _)              = True
isAsmTemp _                             = False
659

660 661 662

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

667

Ian Lynagh's avatar
Ian Lynagh committed
668
-- | Check whether a label corresponds to a C function that has
669
--      a prototype in a system header somehere, or is built-in
670
--      to the C compiler. For these labels we avoid generating our
671
--      own C prototypes.
672
isMathFun :: CLabel -> Bool
Ian Lynagh's avatar
Ian Lynagh committed
673
isMathFun (ForeignLabel fs _ _ _)       = fs `elementOfUniqSet` math_funs
674 675
isMathFun _ = False

Ian Lynagh's avatar
Ian Lynagh committed
676
math_funs :: UniqSet FastString
677
math_funs = mkUniqSet [
678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754
        -- _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"),
        (fsLit "yn"),           (fsLit "ynf"),          (fsLit "ynl")
755
    ]
756

757
-- -----------------------------------------------------------------------------
758
-- | Is a CLabel visible outside this object file or not?
Ian Lynagh's avatar
Ian Lynagh committed
759 760 761
--      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.
762
externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
Ian Lynagh's avatar
Ian Lynagh committed
763 764 765
externallyVisibleCLabel (CaseLabel _ _)         = False
externallyVisibleCLabel (StringLitLabel _)      = False
externallyVisibleCLabel (AsmTempLabel _)        = False
766
externallyVisibleCLabel (PlainModuleInitLabel _)= True
767
externallyVisibleCLabel (RtsLabel _)            = True
Ian Lynagh's avatar
Ian Lynagh committed
768 769 770 771 772
externallyVisibleCLabel (CmmLabel _ _ _)        = True
externallyVisibleCLabel (ForeignLabel{})        = True
externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externallyVisibleIdLabel info
externallyVisibleCLabel (CC_Label _)            = True
externallyVisibleCLabel (CCS_Label _)           = True
773
externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
Ian Lynagh's avatar
Ian Lynagh committed
774
externallyVisibleCLabel (HpcTicksLabel _)       = True
775
externallyVisibleCLabel (LargeBitmapLabel _)    = False
776
externallyVisibleCLabel (SRTLabel _)            = False
Ian Lynagh's avatar
Ian Lynagh committed
777
externallyVisibleCLabel (LargeSRTLabel _)       = False
Ian Lynagh's avatar
Ian Lynagh committed
778 779
externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
780

batterseapower's avatar
batterseapower committed
781
externallyVisibleIdLabel :: IdLabelInfo -> Bool
782
externallyVisibleIdLabel SRT             = False
783 784
externallyVisibleIdLabel LocalInfoTable  = False
externallyVisibleIdLabel LocalEntry      = False
785
externallyVisibleIdLabel _               = True
batterseapower's avatar
batterseapower committed
786

787
-- -----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
788
-- Finding the "type" of a CLabel
789 790 791 792

-- For generating correct types in label declarations:

data CLabelType
Ian Lynagh's avatar
Ian Lynagh committed
793 794 795
  = CodeLabel   -- Address of some executable instructions
  | DataLabel   -- Address of data, not a GC ptr
  | GcPtrLabel  -- Address of a (presumably static) GC object
796 797 798

isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel lbl = case labelType lbl of
Ian Lynagh's avatar
Ian Lynagh committed
799 800
                        CodeLabel -> True
                        _other    -> False
801 802 803

isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel lbl = case labelType lbl of
Ian Lynagh's avatar
Ian Lynagh committed
804 805
                        GcPtrLabel -> True
                        _other     -> False
806

807 808 809

-- | Work out the general type of data at the address of this label
--    whether it be code, data, or static GC object.
810
labelType :: CLabel -> CLabelType
Ian Lynagh's avatar
Ian Lynagh committed
811
labelType (CmmLabel _ _ CmmData)                = DataLabel
812
labelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel
Ian Lynagh's avatar
Ian Lynagh committed
813 814 815 816 817
labelType (CmmLabel _ _ CmmCode)                = CodeLabel
labelType (CmmLabel _ _ CmmInfo)                = DataLabel
labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
818 819
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
820 821
labelType (RtsLabel (RtsApFast _))              = CodeLabel
labelType (CaseLabel _ CaseReturnInfo)          = DataLabel
Ian Lynagh's avatar
Ian Lynagh committed
822
labelType (CaseLabel _ _)                       = CodeLabel
823
labelType (PlainModuleInitLabel _)              = CodeLabel
824
labelType (SRTLabel _)                          = DataLabel
825 826
labelType (LargeSRTLabel _)                     = DataLabel
labelType (LargeBitmapLabel _)                  = DataLabel
Ian Lynagh's avatar
Ian Lynagh committed
827
labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
828 829
labelType (IdLabel _ _ info)                    = idInfoLabelType info
labelType _                                     = DataLabel
830

Ian Lynagh's avatar
Ian Lynagh committed
831
idInfoLabelType :: IdLabelInfo -> CLabelType
832
idInfoLabelType info =
833
  case info of
834 835 836
    InfoTable     -> DataLabel
    LocalInfoTable -> DataLabel
    Closure       -> GcPtrLabel
837 838
    ConInfoTable  -> DataLabel
    StaticInfoTable -> DataLabel
839
    ClosureTable  -> DataLabel
840
    RednCounts    -> DataLabel
Ian Lynagh's avatar
Ian Lynagh committed
841
    _             -> CodeLabel
842 843 844 845 846 847 848 849 850 851


-- -----------------------------------------------------------------------------
-- Does a CLabel need dynamic linkage?

-- When referring to data in code, we need to know whether
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.

852
labelDynamic :: DynFlags -> PackageId -> Module -> CLabel -> Bool
853
labelDynamic dflags this_pkg this_mod lbl =
854
  case lbl of
855
   -- is the RTS in a DLL or not?
ian@well-typed.com's avatar
ian@well-typed.com committed
856
   RtsLabel _           -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
857

858
   IdLabel n _ _        -> isDllName dflags this_pkg this_mod n
859

daniel.is.fischer's avatar
daniel.is.fischer committed
860
   -- When compiling in the "dyn" way, each package is to be linked into
Ian Lynagh's avatar
Ian Lynagh committed
861
   -- its own shared library.
862
   CmmLabel pkg _ _
Ian Lynagh's avatar
Ian Lynagh committed
863
    | os == OSMinGW32 ->
ian@well-typed.com's avatar
ian@well-typed.com committed
864
       not (gopt Opt_Static dflags) && (this_pkg /= pkg)
Ian Lynagh's avatar
Ian Lynagh committed
865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881
    | otherwise ->
       True

   ForeignLabel _ _ source _  ->
       if os == OSMinGW32
       then case source of
            -- Foreign label is in some un-named foreign package (or DLL).
            ForeignLabelInExternalPackage -> True

            -- Foreign label is linked into the same package as the
            -- source file currently being compiled.
            ForeignLabelInThisPackage -> False

            -- Foreign label is in some named package.
            -- When compiling in the "dyn" way, each package is to be
            -- linked into its own DLL.
            ForeignLabelInPackage pkgId ->
ian@well-typed.com's avatar
ian@well-typed.com committed
882
                (not (gopt Opt_Static dflags)) && (this_pkg /= pkgId)
Ian Lynagh's avatar
Ian Lynagh committed
883 884 885 886 887

       else -- On Mac OS X and on ELF platforms, false positives are OK,
            -- so we claim that all foreign imports come from dynamic
            -- libraries
            True
888

ian@well-typed.com's avatar
ian@well-typed.com committed
889
   PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m)
890

891
   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
Ian Lynagh's avatar
Ian Lynagh committed
892
   _                 -> False
Ian Lynagh's avatar
Ian Lynagh committed
893
  where os = platformOS (targetPlatform dflags)
894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915

{-
OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
right places. It is used to detect when the abstractC statement of an
CCodeBlock actually contains the code for a slow entry point.  -- HWL

We need at least @Eq@ for @CLabels@, because we want to avoid
duplicate declarations in generating C (see @labelSeenTE@ in
@PprAbsC@).
-}

-----------------------------------------------------------------------------
-- Printing out CLabels.

{-
Convention:

      <name>_<type>

where <name> is <Module>_<name> for external names and <unique> for
internal names. <type> is one of the following:

Ian Lynagh's avatar
Ian Lynagh committed
916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
         info                   Info table
         srt                    Static reference table
         srtd                   Static reference table descriptor
         entry                  Entry code (function, closure)
         slow                   Slow entry code (if any)
         ret                    Direct return address
         vtbl                   Vector table
         <n>_alt                Case alternative (tag n)
         dflt                   Default case alternative
         btm                    Large bitmap vector
         closure                Static closure
         con_entry              Dynamic Constructor entry code
         con_info               Dynamic Constructor info table
         static_entry           Static Constructor entry code
         static_info            Static Constructor info table
         sel_info               Selector info table
         sel_entry              Selector entry code
         cc                     Cost centre
         ccs                    Cost centre stack
935 936 937 938 939

Many of these distinctions are only for documentation reasons.  For
example, _ret is only distinguished from _entry to make it easy to
tell whether a code fragment is a return point or a closure/function
entry.
940 941 942 943 944

Note [Closure and info labels]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For a function 'foo, we have:
   foo_info    : Points to the info table describing foo's closure
Ian Lynagh's avatar
Ian Lynagh committed
945 946
                 (and entry code for foo with tables next to code)
   foo_closure : Static (no-free-var) closure only:
Simon Peyton Jones's avatar