never executed always true always false
1 -----------------------------------------------------------------------------
2 --
3 -- Object-file symbols (called CLabel for histerical raisins).
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 {-# LANGUAGE BangPatterns #-}
10 {-# LANGUAGE MultiParamTypeClasses #-}
11 {-# LANGUAGE FlexibleInstances #-}
12
13
14 module GHC.Cmm.CLabel (
15 CLabel, -- abstract type
16 NeedExternDecl (..),
17 ForeignLabelSource(..),
18 DynamicLinkerLabelInfo(..),
19 ConInfoTableLocation(..),
20 getConInfoTableLocation,
21
22 -- * Constructors
23 mkClosureLabel,
24 mkSRTLabel,
25 mkInfoTableLabel,
26 mkEntryLabel,
27 mkRednCountsLabel,
28 mkConInfoTableLabel,
29 mkApEntryLabel,
30 mkApInfoTableLabel,
31 mkClosureTableLabel,
32 mkBytesLabel,
33
34 mkLocalBlockLabel,
35 mkLocalClosureLabel,
36 mkLocalInfoTableLabel,
37 mkLocalClosureTableLabel,
38
39 mkBlockInfoTableLabel,
40
41 mkBitmapLabel,
42 mkStringLitLabel,
43
44 mkAsmTempLabel,
45 mkAsmTempDerivedLabel,
46 mkAsmTempEndLabel,
47 mkAsmTempProcEndLabel,
48 mkAsmTempDieLabel,
49
50 mkDirty_MUT_VAR_Label,
51 mkNonmovingWriteBarrierEnabledLabel,
52 mkUpdInfoLabel,
53 mkBHUpdInfoLabel,
54 mkIndStaticInfoLabel,
55 mkMainCapabilityLabel,
56 mkMAP_FROZEN_CLEAN_infoLabel,
57 mkMAP_FROZEN_DIRTY_infoLabel,
58 mkMAP_DIRTY_infoLabel,
59 mkSMAP_FROZEN_CLEAN_infoLabel,
60 mkSMAP_FROZEN_DIRTY_infoLabel,
61 mkSMAP_DIRTY_infoLabel,
62 mkBadAlignmentLabel,
63 mkArrWords_infoLabel,
64 mkSRTInfoLabel,
65
66 mkTopTickyCtrLabel,
67 mkCAFBlackHoleInfoTableLabel,
68 mkRtsPrimOpLabel,
69 mkRtsSlowFastTickyCtrLabel,
70
71 mkSelectorInfoLabel,
72 mkSelectorEntryLabel,
73 mkCmmInfoLabel,
74 mkCmmEntryLabel,
75 mkCmmRetInfoLabel,
76 mkCmmRetLabel,
77 mkCmmCodeLabel,
78 mkCmmDataLabel,
79 mkRtsCmmDataLabel,
80 mkCmmClosureLabel,
81 mkRtsApFastLabel,
82 mkPrimCallLabel,
83 mkForeignLabel,
84 mkCCLabel,
85 mkCCSLabel,
86 mkIPELabel,
87 InfoProvEnt(..),
88
89 mkDynamicLinkerLabel,
90 mkPicBaseLabel,
91 mkDeadStripPreventer,
92 mkHpcTicksLabel,
93
94 -- * Predicates
95 hasCAF,
96 needsCDecl,
97 maybeLocalBlockLabel,
98 externallyVisibleCLabel,
99 isMathFun,
100 isCFunctionLabel,
101 isGcPtrLabel,
102 labelDynamic,
103 isLocalCLabel,
104 mayRedirectTo,
105 isInfoTableLabel,
106 isConInfoTableLabel,
107 isIdLabel,
108 isTickyLabel,
109 hasHaskellName,
110 hasIdLabelInfo,
111 isBytesLabel,
112 isForeignLabel,
113 isSomeRODataLabel,
114 isStaticClosureLabel,
115
116 -- * Conversions
117 toClosureLbl,
118 toSlowEntryLbl,
119 toEntryLbl,
120 toInfoLbl,
121
122 -- * Pretty-printing
123 LabelStyle (..),
124 pprDebugCLabel,
125 pprCLabel,
126 ppInternalProcLabel,
127
128 -- * Others
129 dynamicLinkerLabelInfo,
130 addLabelSize,
131 foreignLabelStdcallInfo
132 ) where
133
134 import GHC.Prelude
135
136 import GHC.Types.Id.Info
137 import GHC.Types.Basic
138 import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
139 import GHC.Unit.Types
140 import GHC.Types.Name
141 import GHC.Types.Unique
142 import GHC.Builtin.PrimOps
143 import GHC.Types.CostCentre
144 import GHC.Utils.Outputable
145 import GHC.Utils.Panic
146 import GHC.Utils.Panic.Plain
147 import GHC.Data.FastString
148 import GHC.Driver.Session
149 import GHC.Platform
150 import GHC.Types.Unique.Set
151 import GHC.Utils.Misc
152 import GHC.Core.Ppr ( {- instances -} )
153 import GHC.CmmToAsm.Config
154 import GHC.Types.SrcLoc
155
156 -- -----------------------------------------------------------------------------
157 -- The CLabel type
158
159 {- |
160 'CLabel' is an abstract type that supports the following operations:
161
162 - Pretty printing
163
164 - In a C file, does it need to be declared before use? (i.e. is it
165 guaranteed to be already in scope in the places we need to refer to it?)
166
167 - If it needs to be declared, what type (code or data) should it be
168 declared to have?
169
170 - Is it visible outside this object file or not?
171
172 - Is it "dynamic" (see details below)
173
174 - Eq and Ord, so that we can make sets of CLabels (currently only
175 used in outputting C as far as I can tell, to avoid generating
176 more than one declaration for any given label).
177
178 - Converting an info table label into an entry label.
179
180 CLabel usage is a bit messy in GHC as they are used in a number of different
181 contexts:
182
183 - By the C-- AST to identify labels
184
185 - By the unregisterised C code generator (\"PprC\") for naming functions (hence
186 the name 'CLabel')
187
188 - By the native and LLVM code generators to identify labels
189
190 For extra fun, each of these uses a slightly different subset of constructors
191 (e.g. 'AsmTempLabel' and 'AsmTempDerivedLabel' are used only in the NCG and
192 LLVM backends).
193
194 In general, we use 'IdLabel' to represent Haskell things early in the
195 pipeline. However, later optimization passes will often represent blocks they
196 create with 'LocalBlockLabel' where there is no obvious 'Name' to hang off the
197 label.
198 -}
199
200 data CLabel
201 = -- | A label related to the definition of a particular Id or Con in a .hs file.
202 IdLabel
203 Name
204 CafInfo
205 IdLabelInfo -- ^ encodes the suffix of the label
206
207 -- | A label from a .cmm file that is not associated with a .hs level Id.
208 | CmmLabel
209 UnitId -- ^ what package the label belongs to.
210 NeedExternDecl -- ^ does the label need an "extern .." declaration
211 FastString -- ^ identifier giving the prefix of the label
212 CmmLabelInfo -- ^ encodes the suffix of the label
213
214 -- | A label with a baked-in \/ algorithmically generated name that definitely
215 -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
216 -- If it doesn't have an algorithmically generated name then use a CmmLabel
217 -- instead and give it an appropriate UnitId argument.
218 | RtsLabel
219 RtsLabelInfo
220
221 -- | A label associated with a block. These aren't visible outside of the
222 -- compilation unit in which they are defined. These are generally used to
223 -- name blocks produced by Cmm-to-Cmm passes and the native code generator,
224 -- where we don't have a 'Name' to associate the label to and therefore can't
225 -- use 'IdLabel'.
226 | LocalBlockLabel
227 {-# UNPACK #-} !Unique
228
229 -- | A 'C' (or otherwise foreign) label.
230 --
231 | ForeignLabel
232 FastString -- ^ name of the imported label.
233
234 (Maybe Int) -- ^ possible '@n' suffix for stdcall functions
235 -- When generating C, the '@n' suffix is omitted, but when
236 -- generating assembler we must add it to the label.
237
238 ForeignLabelSource -- ^ what package the foreign label is in.
239
240 FunctionOrData
241
242 -- | Local temporary label used for native (or LLVM) code generation; must not
243 -- appear outside of these contexts. Use primarily for debug information
244 | AsmTempLabel
245 {-# UNPACK #-} !Unique
246
247 -- | A label \"derived\" from another 'CLabel' by the addition of a suffix.
248 -- Must not occur outside of the NCG or LLVM code generators.
249 | AsmTempDerivedLabel
250 CLabel
251 FastString -- ^ suffix
252
253 | StringLitLabel
254 {-# UNPACK #-} !Unique
255
256 | CC_Label CostCentre
257 | CCS_Label CostCentreStack
258 | IPE_Label InfoProvEnt
259
260
261 -- | These labels are generated and used inside the NCG only.
262 -- They are special variants of a label used for dynamic linking
263 -- see module "GHC.CmmToAsm.PIC" for details.
264 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
265
266 -- | This label is generated and used inside the NCG only.
267 -- It is used as a base for PIC calculations on some platforms.
268 -- It takes the form of a local numeric assembler label '1'; and
269 -- is pretty-printed as 1b, referring to the previous definition
270 -- of 1: in the assembler source file.
271 | PicBaseLabel
272
273 -- | A label before an info table to prevent excessive dead-stripping on darwin
274 | DeadStripPreventer CLabel
275
276
277 -- | Per-module table of tick locations
278 | HpcTicksLabel Module
279
280 -- | Static reference table
281 | SRTLabel
282 {-# UNPACK #-} !Unique
283
284 -- | A bitmap (function or case return)
285 | LargeBitmapLabel
286 {-# UNPACK #-} !Unique
287
288 deriving Eq
289
290 instance Show CLabel where
291 show = showPprUnsafe . pprDebugCLabel genericPlatform
292
293 instance Outputable CLabel where
294 ppr = text . show
295
296 isIdLabel :: CLabel -> Bool
297 isIdLabel IdLabel{} = True
298 isIdLabel _ = False
299
300 -- Used in SRT analysis. See Note [Ticky labels in SRT analysis] in
301 -- GHC.Cmm.Info.Build.
302 isTickyLabel :: CLabel -> Bool
303 isTickyLabel (IdLabel _ _ RednCounts) = True
304 isTickyLabel _ = False
305
306 -- | Indicate if "GHC.CmmToC" has to generate an extern declaration for the
307 -- label (e.g. "extern StgWordArray(foo)"). The type is fixed to StgWordArray.
308 --
309 -- Symbols from the RTS don't need "extern" declarations because they are
310 -- exposed via "rts/include/Stg.h" with the appropriate type. See 'needsCDecl'.
311 --
312 -- The fixed StgWordArray type led to "conflicting types" issues with user
313 -- provided Cmm files (not in the RTS) that declare data of another type (#15467
314 -- and test for #17920). Hence the Cmm parser considers that labels in data
315 -- sections don't need the "extern" declaration (just add one explicitly if you
316 -- need it).
317 --
318 -- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes
319 -- for why extern declaration are needed at all.
320 newtype NeedExternDecl
321 = NeedExternDecl Bool
322 deriving (Ord,Eq)
323
324 -- This is laborious, but necessary. We can't derive Ord because
325 -- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
326 -- implementation. See Note [No Ord for Unique]
327 -- This is non-deterministic but we do not currently support deterministic
328 -- code-generation. See Note [Unique Determinism and code generation]
329 instance Ord CLabel where
330 compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
331 compare a1 a2 `thenCmp`
332 compare b1 b2 `thenCmp`
333 compare c1 c2
334 compare (CmmLabel a1 b1 c1 d1) (CmmLabel a2 b2 c2 d2) =
335 compare a1 a2 `thenCmp`
336 compare b1 b2 `thenCmp`
337 -- This non-determinism is "safe" in the sense that it only affects object code,
338 -- which is currently not covered by GHC's determinism guarantees. See #12935.
339 uniqCompareFS c1 c2 `thenCmp`
340 compare d1 d2
341 compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
342 compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
343 compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
344 uniqCompareFS a1 a2 `thenCmp`
345 compare b1 b2 `thenCmp`
346 compare c1 c2 `thenCmp`
347 compare d1 d2
348 compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
349 compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
350 compare a1 a2 `thenCmp`
351 lexicalCompareFS b1 b2
352 compare (StringLitLabel u1) (StringLitLabel u2) =
353 nonDetCmpUnique u1 u2
354 compare (CC_Label a1) (CC_Label a2) =
355 compare a1 a2
356 compare (CCS_Label a1) (CCS_Label a2) =
357 compare a1 a2
358 compare (IPE_Label a1) (IPE_Label a2) =
359 compare a1 a2
360 compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
361 compare a1 a2 `thenCmp`
362 compare b1 b2
363 compare PicBaseLabel PicBaseLabel = EQ
364 compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
365 compare a1 a2
366 compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
367 compare a1 a2
368 compare (SRTLabel u1) (SRTLabel u2) =
369 nonDetCmpUnique u1 u2
370 compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
371 nonDetCmpUnique u1 u2
372 compare IdLabel{} _ = LT
373 compare _ IdLabel{} = GT
374 compare CmmLabel{} _ = LT
375 compare _ CmmLabel{} = GT
376 compare RtsLabel{} _ = LT
377 compare _ RtsLabel{} = GT
378 compare LocalBlockLabel{} _ = LT
379 compare _ LocalBlockLabel{} = GT
380 compare ForeignLabel{} _ = LT
381 compare _ ForeignLabel{} = GT
382 compare AsmTempLabel{} _ = LT
383 compare _ AsmTempLabel{} = GT
384 compare AsmTempDerivedLabel{} _ = LT
385 compare _ AsmTempDerivedLabel{} = GT
386 compare StringLitLabel{} _ = LT
387 compare _ StringLitLabel{} = GT
388 compare CC_Label{} _ = LT
389 compare _ CC_Label{} = GT
390 compare CCS_Label{} _ = LT
391 compare _ CCS_Label{} = GT
392 compare DynamicLinkerLabel{} _ = LT
393 compare _ DynamicLinkerLabel{} = GT
394 compare PicBaseLabel{} _ = LT
395 compare _ PicBaseLabel{} = GT
396 compare DeadStripPreventer{} _ = LT
397 compare _ DeadStripPreventer{} = GT
398 compare HpcTicksLabel{} _ = LT
399 compare _ HpcTicksLabel{} = GT
400 compare SRTLabel{} _ = LT
401 compare _ SRTLabel{} = GT
402 compare (IPE_Label {}) _ = LT
403 compare _ (IPE_Label{}) = GT
404
405 -- | Record where a foreign label is stored.
406 data ForeignLabelSource
407
408 -- | Label is in a named package
409 = ForeignLabelInPackage UnitId
410
411 -- | Label is in some external, system package that doesn't also
412 -- contain compiled Haskell code, and is not associated with any .hi files.
413 -- We don't have to worry about Haskell code being inlined from
414 -- external packages. It is safe to treat the RTS package as "external".
415 | ForeignLabelInExternalPackage
416
417 -- | Label is in the package currently being compiled.
418 -- This is only used for creating hacky tmp labels during code generation.
419 -- Don't use it in any code that might be inlined across a package boundary
420 -- (ie, core code) else the information will be wrong relative to the
421 -- destination module.
422 | ForeignLabelInThisPackage
423
424 deriving (Eq, Ord)
425
426
427 -- | For debugging problems with the CLabel representation.
428 -- We can't make a Show instance for CLabel because lots of its components don't have instances.
429 -- The regular Outputable instance only shows the label name, and not its other info.
430 --
431 pprDebugCLabel :: Platform -> CLabel -> SDoc
432 pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra
433 where
434 extra = case lbl of
435 IdLabel _ _ info
436 -> text "IdLabel" <> whenPprDebug (text ":" <> ppr info)
437
438 CmmLabel pkg _ext _name _info
439 -> text "CmmLabel" <+> ppr pkg
440
441 RtsLabel{}
442 -> text "RtsLabel"
443
444 ForeignLabel _name mSuffix src funOrData
445 -> text "ForeignLabel" <+> ppr mSuffix <+> ppr src <+> ppr funOrData
446
447 _ -> text "other CLabel"
448
449
450 data IdLabelInfo
451 = Closure -- ^ Label for closure
452 | InfoTable -- ^ Info tables for closures; always read-only
453 | Entry -- ^ Entry point
454 | Slow -- ^ Slow entry point
455
456 | LocalInfoTable -- ^ Like InfoTable but not externally visible
457 | LocalEntry -- ^ Like Entry but not externally visible
458
459 | RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
460
461 | ConEntry ConInfoTableLocation
462 -- ^ Constructor entry point, when `-fdistinct-info-tables` is enabled then
463 -- each usage of a constructor will be given a unique number and a fresh info
464 -- table will be created in the module where the constructor is used. The
465 -- argument is used to keep track of which info table a usage of a constructor
466 -- should use. When the argument is 'Nothing' then it uses the info table which
467 -- is defined in the module where the datatype is declared, this is the usual case.
468 -- When it is (Just (m, k)) it will use the kth info table defined in module m. The
469 -- point of this inefficiency is so that you can work out where allocations of data
470 -- constructors are coming from when you are debugging.
471
472 | ConInfoTable ConInfoTableLocation -- ^ Corresponding info table
473
474 | ClosureTable -- ^ Table of closures for Enum tycons
475
476 | Bytes -- ^ Content of a string literal. See
477 -- Note [Bytes label].
478 | BlockInfoTable -- ^ Like LocalInfoTable but for a proc-point block
479 -- instead of a closure entry-point.
480 -- See Note [Proc-point local block entry-point].
481
482 deriving (Eq, Ord)
483
484 -- | Which module is the info table from, and which number was it.
485 data ConInfoTableLocation = UsageSite Module Int
486 | DefinitionSite
487 deriving (Eq, Ord)
488
489 instance Outputable ConInfoTableLocation where
490 ppr (UsageSite m n) = text "Loc(" <> ppr n <> text "):" <+> ppr m
491 ppr DefinitionSite = empty
492
493 getConInfoTableLocation :: IdLabelInfo -> Maybe ConInfoTableLocation
494 getConInfoTableLocation (ConInfoTable ci) = Just ci
495 getConInfoTableLocation _ = Nothing
496
497 instance Outputable IdLabelInfo where
498 ppr Closure = text "Closure"
499 ppr InfoTable = text "InfoTable"
500 ppr Entry = text "Entry"
501 ppr Slow = text "Slow"
502
503 ppr LocalInfoTable = text "LocalInfoTable"
504 ppr LocalEntry = text "LocalEntry"
505
506 ppr RednCounts = text "RednCounts"
507 ppr (ConEntry mn) = text "ConEntry" <+> ppr mn
508 ppr (ConInfoTable mn) = text "ConInfoTable" <+> ppr mn
509 ppr ClosureTable = text "ClosureTable"
510 ppr Bytes = text "Bytes"
511 ppr BlockInfoTable = text "BlockInfoTable"
512
513
514 data RtsLabelInfo
515 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- ^ Selector thunks
516 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
517
518 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
519 | RtsApEntry Bool{-updatable-} Int{-arity-}
520
521 | RtsPrimOp PrimOp
522 | RtsApFast NonDetFastString -- ^ _fast versions of generic apply
523 | RtsSlowFastTickyCtr String
524
525 deriving (Eq,Ord)
526
527
528 -- | What type of Cmm label we're dealing with.
529 -- Determines the suffix appended to the name when a CLabel.CmmLabel
530 -- is pretty printed.
531 data CmmLabelInfo
532 = CmmInfo -- ^ misc rts info tables, suffix _info
533 | CmmEntry -- ^ misc rts entry points, suffix _entry
534 | CmmRetInfo -- ^ misc rts ret info tables, suffix _info
535 | CmmRet -- ^ misc rts return points, suffix _ret
536 | CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
537 | CmmCode -- ^ misc rts code
538 | CmmClosure -- ^ closures eg CHARLIKE_closure
539 | CmmPrimCall -- ^ a prim call to some hand written Cmm code
540 deriving (Eq, Ord)
541
542 data DynamicLinkerLabelInfo
543 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
544 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
545 | GotSymbolPtr -- ELF: foo@got
546 | GotSymbolOffset -- ELF: foo@gotoff
547
548 deriving (Eq, Ord)
549
550
551 -- -----------------------------------------------------------------------------
552 -- Constructing CLabels
553 -- -----------------------------------------------------------------------------
554
555 -- Constructing IdLabels
556 -- These are always local:
557
558 mkSRTLabel :: Unique -> CLabel
559 mkSRTLabel u = SRTLabel u
560
561 mkRednCountsLabel :: Name -> CLabel
562 mkRednCountsLabel name = IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE]
563
564 -- These have local & (possibly) external variants:
565 mkLocalClosureLabel :: Name -> CafInfo -> CLabel
566 mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
567 mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
568 mkLocalClosureLabel !name !c = IdLabel name c Closure
569 mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
570 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
571
572 mkClosureLabel :: Name -> CafInfo -> CLabel
573 mkInfoTableLabel :: Name -> CafInfo -> CLabel
574 mkEntryLabel :: Name -> CafInfo -> CLabel
575 mkClosureTableLabel :: Name -> CafInfo -> CLabel
576 mkConInfoTableLabel :: Name -> ConInfoTableLocation -> CLabel
577 mkBytesLabel :: Name -> CLabel
578 mkClosureLabel name c = IdLabel name c Closure
579 mkInfoTableLabel name c = IdLabel name c InfoTable
580 mkEntryLabel name c = IdLabel name c Entry
581 mkClosureTableLabel name c = IdLabel name c ClosureTable
582 -- Special case for the normal 'DefinitionSite' case so that the 'ConInfoTable' application can be floated to a CAF.
583 mkConInfoTableLabel name DefinitionSite = IdLabel name NoCafRefs (ConInfoTable DefinitionSite)
584 mkConInfoTableLabel name k = IdLabel name NoCafRefs (ConInfoTable k)
585 mkBytesLabel name = IdLabel name NoCafRefs Bytes
586
587 mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
588 mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
589 -- See Note [Proc-point local block entry-point].
590
591 -- Constructing Cmm Labels
592 mkDirty_MUT_VAR_Label,
593 mkNonmovingWriteBarrierEnabledLabel,
594 mkUpdInfoLabel,
595 mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
596 mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel,
597 mkMAP_DIRTY_infoLabel,
598 mkArrWords_infoLabel,
599 mkTopTickyCtrLabel,
600 mkCAFBlackHoleInfoTableLabel,
601 mkSMAP_FROZEN_CLEAN_infoLabel, mkSMAP_FROZEN_DIRTY_infoLabel,
602 mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
603 mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
604 mkNonmovingWriteBarrierEnabledLabel
605 = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData
606 mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo
607 mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo
608 mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo
609 mkMainCapabilityLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "MainCapability") CmmData
610 mkMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
611 mkMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
612 mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
613 mkTopTickyCtrLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "top_ct") CmmData
614 mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_CAF_BLACKHOLE") CmmInfo
615 mkArrWords_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_ARR_WORDS") CmmInfo
616 mkSMAP_FROZEN_CLEAN_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN") CmmInfo
617 mkSMAP_FROZEN_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY") CmmInfo
618 mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
619 mkBadAlignmentLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_badAlignment") CmmEntry
620
621 mkSRTInfoLabel :: Int -> CLabel
622 mkSRTInfoLabel n = CmmLabel rtsUnitId (NeedExternDecl False) lbl CmmInfo
623 where
624 lbl =
625 case n of
626 1 -> fsLit "stg_SRT_1"
627 2 -> fsLit "stg_SRT_2"
628 3 -> fsLit "stg_SRT_3"
629 4 -> fsLit "stg_SRT_4"
630 5 -> fsLit "stg_SRT_5"
631 6 -> fsLit "stg_SRT_6"
632 7 -> fsLit "stg_SRT_7"
633 8 -> fsLit "stg_SRT_8"
634 9 -> fsLit "stg_SRT_9"
635 10 -> fsLit "stg_SRT_10"
636 11 -> fsLit "stg_SRT_11"
637 12 -> fsLit "stg_SRT_12"
638 13 -> fsLit "stg_SRT_13"
639 14 -> fsLit "stg_SRT_14"
640 15 -> fsLit "stg_SRT_15"
641 16 -> fsLit "stg_SRT_16"
642 _ -> panic "mkSRTInfoLabel"
643
644 -----
645 mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
646 mkCmmCodeLabel, mkCmmClosureLabel
647 :: UnitId -> FastString -> CLabel
648
649 mkCmmDataLabel :: UnitId -> NeedExternDecl -> FastString -> CLabel
650 mkRtsCmmDataLabel :: FastString -> CLabel
651
652 mkCmmInfoLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmInfo
653 mkCmmEntryLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmEntry
654 mkCmmRetInfoLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmRetInfo
655 mkCmmRetLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmRet
656 mkCmmCodeLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmCode
657 mkCmmClosureLabel pkg str = CmmLabel pkg (NeedExternDecl True) str CmmClosure
658 mkCmmDataLabel pkg ext str = CmmLabel pkg ext str CmmData
659 mkRtsCmmDataLabel str = CmmLabel rtsUnitId (NeedExternDecl False) str CmmData
660 -- RTS symbols don't need "GHC.CmmToC" to
661 -- generate \"extern\" declaration (they are
662 -- exposed via rts/include/Stg.h)
663
664 mkLocalBlockLabel :: Unique -> CLabel
665 mkLocalBlockLabel u = LocalBlockLabel u
666
667 -- Constructing RtsLabels
668 mkRtsPrimOpLabel :: PrimOp -> CLabel
669 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
670
671 mkSelectorInfoLabel :: Platform -> Bool -> Int -> CLabel
672 mkSelectorInfoLabel platform upd offset =
673 assert (offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform)) $
674 RtsLabel (RtsSelectorInfoTable upd offset)
675
676 mkSelectorEntryLabel :: Platform -> Bool -> Int -> CLabel
677 mkSelectorEntryLabel platform upd offset =
678 assert (offset >= 0 && offset <= pc_MAX_SPEC_SELECTEE_SIZE (platformConstants platform)) $
679 RtsLabel (RtsSelectorEntry upd offset)
680
681 mkApInfoTableLabel :: Platform -> Bool -> Int -> CLabel
682 mkApInfoTableLabel platform upd arity =
683 assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $
684 RtsLabel (RtsApInfoTable upd arity)
685
686 mkApEntryLabel :: Platform -> Bool -> Int -> CLabel
687 mkApEntryLabel platform upd arity =
688 assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $
689 RtsLabel (RtsApEntry upd arity)
690
691
692 -- A call to some primitive hand written Cmm code
693 mkPrimCallLabel :: PrimCall -> CLabel
694 mkPrimCallLabel (PrimCall str pkg)
695 = CmmLabel (toUnitId pkg) (NeedExternDecl True) str CmmPrimCall
696
697
698 -- Constructing ForeignLabels
699
700 -- | Make a foreign label
701 mkForeignLabel
702 :: FastString -- name
703 -> Maybe Int -- size prefix
704 -> ForeignLabelSource -- what package it's in
705 -> FunctionOrData
706 -> CLabel
707
708 mkForeignLabel = ForeignLabel
709
710
711 -- | Update the label size field in a ForeignLabel
712 addLabelSize :: CLabel -> Int -> CLabel
713 addLabelSize (ForeignLabel str _ src fod) sz
714 = ForeignLabel str (Just sz) src fod
715 addLabelSize label _
716 = label
717
718 -- | Whether label is a top-level string literal
719 isBytesLabel :: CLabel -> Bool
720 isBytesLabel (IdLabel _ _ Bytes) = True
721 isBytesLabel _lbl = False
722
723 -- | Whether label is a non-haskell label (defined in C code)
724 isForeignLabel :: CLabel -> Bool
725 isForeignLabel (ForeignLabel _ _ _ _) = True
726 isForeignLabel _lbl = False
727
728 -- | Whether label is a static closure label (can come from haskell or cmm)
729 isStaticClosureLabel :: CLabel -> Bool
730 -- Closure defined in haskell (.hs)
731 isStaticClosureLabel (IdLabel _ _ Closure) = True
732 -- Closure defined in cmm
733 isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True
734 isStaticClosureLabel _lbl = False
735
736 -- | Whether label is a .rodata label
737 isSomeRODataLabel :: CLabel -> Bool
738 -- info table defined in haskell (.hs)
739 isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
740 isSomeRODataLabel (IdLabel _ _ ConInfoTable {}) = True
741 isSomeRODataLabel (IdLabel _ _ InfoTable) = True
742 isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
743 isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
744 -- info table defined in cmm (.cmm)
745 isSomeRODataLabel (CmmLabel _ _ _ CmmInfo) = True
746 isSomeRODataLabel _lbl = False
747
748 -- | Whether label is points to some kind of info table
749 isInfoTableLabel :: CLabel -> Bool
750 isInfoTableLabel (IdLabel _ _ InfoTable) = True
751 isInfoTableLabel (IdLabel _ _ LocalInfoTable) = True
752 isInfoTableLabel (IdLabel _ _ ConInfoTable {}) = True
753 isInfoTableLabel (IdLabel _ _ BlockInfoTable) = True
754 isInfoTableLabel _ = False
755
756 -- | Whether label is points to constructor info table
757 isConInfoTableLabel :: CLabel -> Bool
758 isConInfoTableLabel (IdLabel _ _ ConInfoTable {}) = True
759 isConInfoTableLabel _ = False
760
761 -- | Get the label size field from a ForeignLabel
762 foreignLabelStdcallInfo :: CLabel -> Maybe Int
763 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
764 foreignLabelStdcallInfo _lbl = Nothing
765
766
767 -- Constructing Large*Labels
768 mkBitmapLabel :: Unique -> CLabel
769 mkBitmapLabel uniq = LargeBitmapLabel uniq
770
771 -- | Info Table Provenance Entry
772 -- See Note [Mapping Info Tables to Source Positions]
773 data InfoProvEnt = InfoProvEnt
774 { infoTablePtr :: !CLabel
775 -- Address of the info table
776 , infoProvEntClosureType :: !Int
777 -- The closure type of the info table (from ClosureMacros.h)
778 , infoTableType :: !String
779 -- The rendered Haskell type of the closure the table represents
780 , infoProvModule :: !Module
781 -- Origin module
782 , infoTableProv :: !(Maybe (RealSrcSpan, String)) }
783 -- Position and information about the info table
784 deriving (Eq, Ord)
785
786 -- Constructing Cost Center Labels
787 mkCCLabel :: CostCentre -> CLabel
788 mkCCSLabel :: CostCentreStack -> CLabel
789 mkIPELabel :: InfoProvEnt -> CLabel
790 mkCCLabel cc = CC_Label cc
791 mkCCSLabel ccs = CCS_Label ccs
792 mkIPELabel ipe = IPE_Label ipe
793
794 mkRtsApFastLabel :: FastString -> CLabel
795 mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
796
797 mkRtsSlowFastTickyCtrLabel :: String -> CLabel
798 mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
799
800
801 -- Constructing Code Coverage Labels
802 mkHpcTicksLabel :: Module -> CLabel
803 mkHpcTicksLabel = HpcTicksLabel
804
805
806 -- Constructing labels used for dynamic linking
807 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
808 mkDynamicLinkerLabel = DynamicLinkerLabel
809
810 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
811 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
812 dynamicLinkerLabelInfo _ = Nothing
813
814 mkPicBaseLabel :: CLabel
815 mkPicBaseLabel = PicBaseLabel
816
817
818 -- Constructing miscellaneous other labels
819 mkDeadStripPreventer :: CLabel -> CLabel
820 mkDeadStripPreventer lbl = DeadStripPreventer lbl
821
822 mkStringLitLabel :: Unique -> CLabel
823 mkStringLitLabel = StringLitLabel
824
825 mkAsmTempLabel :: Uniquable a => a -> CLabel
826 mkAsmTempLabel a = AsmTempLabel (getUnique a)
827
828 mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
829 mkAsmTempDerivedLabel = AsmTempDerivedLabel
830
831 mkAsmTempEndLabel :: CLabel -> CLabel
832 mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
833
834 -- | A label indicating the end of a procedure.
835 mkAsmTempProcEndLabel :: CLabel -> CLabel
836 mkAsmTempProcEndLabel l = mkAsmTempDerivedLabel l (fsLit "_proc_end")
837
838 -- | Construct a label for a DWARF Debug Information Entity (DIE)
839 -- describing another symbol.
840 mkAsmTempDieLabel :: CLabel -> CLabel
841 mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
842
843 -- -----------------------------------------------------------------------------
844 -- Convert between different kinds of label
845
846 toClosureLbl :: Platform -> CLabel -> CLabel
847 toClosureLbl platform lbl = case lbl of
848 IdLabel n c _ -> IdLabel n c Closure
849 CmmLabel m ext str _ -> CmmLabel m ext str CmmClosure
850 _ -> pprPanic "toClosureLbl" (pprDebugCLabel platform lbl)
851
852 toSlowEntryLbl :: Platform -> CLabel -> CLabel
853 toSlowEntryLbl platform lbl = case lbl of
854 IdLabel n _ BlockInfoTable -> pprPanic "toSlowEntryLbl" (ppr n)
855 IdLabel n c _ -> IdLabel n c Slow
856 _ -> pprPanic "toSlowEntryLbl" (pprDebugCLabel platform lbl)
857
858 toEntryLbl :: Platform -> CLabel -> CLabel
859 toEntryLbl platform lbl = case lbl of
860 IdLabel n c LocalInfoTable -> IdLabel n c LocalEntry
861 IdLabel n c (ConInfoTable k) -> IdLabel n c (ConEntry k)
862
863 IdLabel n _ BlockInfoTable -> mkLocalBlockLabel (nameUnique n)
864 -- See Note [Proc-point local block entry-point].
865 IdLabel n c _ -> IdLabel n c Entry
866 CmmLabel m ext str CmmInfo -> CmmLabel m ext str CmmEntry
867 CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet
868 _ -> pprPanic "toEntryLbl" (pprDebugCLabel platform lbl)
869
870 toInfoLbl :: Platform -> CLabel -> CLabel
871 toInfoLbl platform lbl = case lbl of
872 IdLabel n c LocalEntry -> IdLabel n c LocalInfoTable
873 IdLabel n c (ConEntry k) -> IdLabel n c (ConInfoTable k)
874
875 IdLabel n c _ -> IdLabel n c InfoTable
876 CmmLabel m ext str CmmEntry -> CmmLabel m ext str CmmInfo
877 CmmLabel m ext str CmmRet -> CmmLabel m ext str CmmRetInfo
878 _ -> pprPanic "CLabel.toInfoLbl" (pprDebugCLabel platform lbl)
879
880 hasHaskellName :: CLabel -> Maybe Name
881 hasHaskellName (IdLabel n _ _) = Just n
882 hasHaskellName _ = Nothing
883
884 hasIdLabelInfo :: CLabel -> Maybe IdLabelInfo
885 hasIdLabelInfo (IdLabel _ _ l) = Just l
886 hasIdLabelInfo _ = Nothing
887
888 -- -----------------------------------------------------------------------------
889 -- Does a CLabel's referent itself refer to a CAF?
890 hasCAF :: CLabel -> Bool
891 hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
892 hasCAF (IdLabel _ MayHaveCafRefs _) = True
893 hasCAF _ = False
894
895 -- Note [ticky for LNE]
896 -- ~~~~~~~~~~~~~~~~~~~~~
897
898 -- Until 14 Feb 2013, every ticky counter was associated with a
899 -- closure. Thus, ticky labels used IdLabel. It is odd that
900 -- GHC.Cmm.Info.Build.cafTransfers would consider such a ticky label
901 -- reason to add the name to the CAFEnv (and thus eventually the SRT),
902 -- but it was harmless because the ticky was only used if the closure
903 -- was also.
904 --
905 -- Since we now have ticky counters for LNEs, it is no longer the case
906 -- that every ticky counter has an actual closure. So I changed the
907 -- generation of ticky counters' CLabels to not result in their
908 -- associated id ending up in the SRT.
909 --
910 -- NB IdLabel is still appropriate for ticky ids (as opposed to
911 -- CmmLabel) because the LNE's counter is still related to an .hs Id,
912 -- that Id just isn't for a proper closure.
913
914 -- -----------------------------------------------------------------------------
915 -- Does a CLabel need declaring before use or not?
916 --
917 -- See wiki:commentary/compiler/backends/ppr-c#prototypes
918
919 needsCDecl :: CLabel -> Bool
920 -- False <=> it's pre-declared; don't bother
921 -- don't bother declaring Bitmap labels, we always make sure
922 -- they are defined before use.
923 needsCDecl (SRTLabel _) = True
924 needsCDecl (LargeBitmapLabel _) = False
925 needsCDecl (IdLabel _ _ _) = True
926 needsCDecl (LocalBlockLabel _) = True
927
928 needsCDecl (StringLitLabel _) = False
929 needsCDecl (AsmTempLabel _) = False
930 needsCDecl (AsmTempDerivedLabel _ _) = False
931 needsCDecl (RtsLabel _) = False
932
933 needsCDecl (CmmLabel pkgId (NeedExternDecl external) _ _)
934 -- local labels mustn't have it
935 | not external = False
936
937 -- Prototypes for labels defined in the runtime system are imported
938 -- into HC files via rts/include/Stg.h.
939 | pkgId == rtsUnitId = False
940
941 -- For other labels we inline one into the HC file directly.
942 | otherwise = True
943
944 needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
945 needsCDecl (CC_Label _) = True
946 needsCDecl (CCS_Label _) = True
947 needsCDecl (IPE_Label {}) = True
948 needsCDecl (HpcTicksLabel _) = True
949 needsCDecl (DynamicLinkerLabel {}) = panic "needsCDecl DynamicLinkerLabel"
950 needsCDecl PicBaseLabel = panic "needsCDecl PicBaseLabel"
951 needsCDecl (DeadStripPreventer {}) = panic "needsCDecl DeadStripPreventer"
952
953 -- | If a label is a local block label then return just its 'BlockId', otherwise
954 -- 'Nothing'.
955 maybeLocalBlockLabel :: CLabel -> Maybe BlockId
956 maybeLocalBlockLabel (LocalBlockLabel uq) = Just $ mkBlockId uq
957 maybeLocalBlockLabel _ = Nothing
958
959
960 -- | Check whether a label corresponds to a C function that has
961 -- a prototype in a system header somewhere, or is built-in
962 -- to the C compiler. For these labels we avoid generating our
963 -- own C prototypes.
964 isMathFun :: CLabel -> Bool
965 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
966 isMathFun _ = False
967
968 math_funs :: UniqSet FastString
969 math_funs = mkUniqSet [
970 -- _ISOC99_SOURCE
971 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
972 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
973 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
974 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
975 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
976 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
977 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
978 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
979 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
980 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
981 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
982 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
983 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
984 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
985 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
986 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
987 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
988 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
989 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
990 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
991 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
992 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
993 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
994 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
995 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
996 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
997 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
998 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
999 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
1000 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
1001 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
1002 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
1003 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
1004 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
1005 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
1006 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
1007 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
1008 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
1009 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
1010 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
1011 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
1012 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
1013 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
1014 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
1015 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
1016 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
1017 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
1018 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
1019 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
1020 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
1021 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
1022 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
1023 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
1024 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
1025 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
1026 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
1027 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
1028 -- ISO C 99 also defines these function-like macros in math.h:
1029 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
1030 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
1031
1032 -- additional symbols from _BSD_SOURCE
1033 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
1034 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
1035 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
1036 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
1037 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
1038 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
1039 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
1040 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
1041 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
1042 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
1043 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
1044 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
1045 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
1046 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl"),
1047
1048 -- These functions are described in IEEE Std 754-2008 -
1049 -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
1050 (fsLit "nextup"), (fsLit "nextupf"), (fsLit "nextupl"),
1051 (fsLit "nextdown"), (fsLit "nextdownf"), (fsLit "nextdownl")
1052 ]
1053
1054 -- -----------------------------------------------------------------------------
1055 -- | Is a CLabel visible outside this object file or not?
1056 -- From the point of view of the code generator, a name is
1057 -- externally visible if it has to be declared as exported
1058 -- in the .o file's symbol table; that is, made non-static.
1059 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
1060 externallyVisibleCLabel (StringLitLabel _) = False
1061 externallyVisibleCLabel (AsmTempLabel _) = False
1062 externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
1063 externallyVisibleCLabel (RtsLabel _) = True
1064 externallyVisibleCLabel (LocalBlockLabel _) = False
1065 externallyVisibleCLabel (CmmLabel _ _ _ _) = True
1066 externallyVisibleCLabel (ForeignLabel{}) = True
1067 externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
1068 externallyVisibleCLabel (CC_Label _) = True
1069 externallyVisibleCLabel (CCS_Label _) = True
1070 externallyVisibleCLabel (IPE_Label {}) = True
1071 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
1072 externallyVisibleCLabel (HpcTicksLabel _) = True
1073 externallyVisibleCLabel (LargeBitmapLabel _) = False
1074 externallyVisibleCLabel (SRTLabel _) = False
1075 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
1076 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
1077
1078 externallyVisibleIdLabel :: IdLabelInfo -> Bool
1079 externallyVisibleIdLabel LocalInfoTable = False
1080 externallyVisibleIdLabel LocalEntry = False
1081 externallyVisibleIdLabel BlockInfoTable = False
1082 externallyVisibleIdLabel _ = True
1083
1084 -- -----------------------------------------------------------------------------
1085 -- Finding the "type" of a CLabel
1086
1087 -- For generating correct types in label declarations:
1088
1089 data CLabelType
1090 = CodeLabel -- Address of some executable instructions
1091 | DataLabel -- Address of data, not a GC ptr
1092 | GcPtrLabel -- Address of a (presumably static) GC object
1093
1094 isCFunctionLabel :: CLabel -> Bool
1095 isCFunctionLabel lbl = case labelType lbl of
1096 CodeLabel -> True
1097 _other -> False
1098
1099 isGcPtrLabel :: CLabel -> Bool
1100 isGcPtrLabel lbl = case labelType lbl of
1101 GcPtrLabel -> True
1102 _other -> False
1103
1104
1105 -- | Work out the general type of data at the address of this label
1106 -- whether it be code, data, or static GC object.
1107 labelType :: CLabel -> CLabelType
1108 labelType (IdLabel _ _ info) = idInfoLabelType info
1109 labelType (CmmLabel _ _ _ CmmData) = DataLabel
1110 labelType (CmmLabel _ _ _ CmmClosure) = GcPtrLabel
1111 labelType (CmmLabel _ _ _ CmmCode) = CodeLabel
1112 labelType (CmmLabel _ _ _ CmmInfo) = DataLabel
1113 labelType (CmmLabel _ _ _ CmmEntry) = CodeLabel
1114 labelType (CmmLabel _ _ _ CmmPrimCall) = CodeLabel
1115 labelType (CmmLabel _ _ _ CmmRetInfo) = DataLabel
1116 labelType (CmmLabel _ _ _ CmmRet) = CodeLabel
1117 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
1118 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
1119 labelType (RtsLabel (RtsApFast _)) = CodeLabel
1120 labelType (RtsLabel _) = DataLabel
1121 labelType (LocalBlockLabel _) = CodeLabel
1122 labelType (SRTLabel _) = DataLabel
1123 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
1124 labelType (ForeignLabel _ _ _ IsData) = DataLabel
1125 labelType (AsmTempLabel _) = panic "labelType(AsmTempLabel)"
1126 labelType (AsmTempDerivedLabel _ _) = panic "labelType(AsmTempDerivedLabel)"
1127 labelType (StringLitLabel _) = DataLabel
1128 labelType (CC_Label _) = DataLabel
1129 labelType (CCS_Label _) = DataLabel
1130 labelType (IPE_Label {}) = DataLabel
1131 labelType (DynamicLinkerLabel _ _) = DataLabel -- Is this right?
1132 labelType PicBaseLabel = DataLabel
1133 labelType (DeadStripPreventer _) = DataLabel
1134 labelType (HpcTicksLabel _) = DataLabel
1135 labelType (LargeBitmapLabel _) = DataLabel
1136
1137 idInfoLabelType :: IdLabelInfo -> CLabelType
1138 idInfoLabelType info =
1139 case info of
1140 InfoTable -> DataLabel
1141 LocalInfoTable -> DataLabel
1142 BlockInfoTable -> DataLabel
1143 Closure -> GcPtrLabel
1144 ConInfoTable {} -> DataLabel
1145 ClosureTable -> DataLabel
1146 RednCounts -> DataLabel
1147 Bytes -> DataLabel
1148 _ -> CodeLabel
1149
1150
1151 -- -----------------------------------------------------------------------------
1152
1153 -- | Is a 'CLabel' defined in the current module being compiled?
1154 --
1155 -- Sometimes we can optimise references within a compilation unit in ways that
1156 -- we couldn't for inter-module references. This provides a conservative
1157 -- estimate of whether a 'CLabel' lives in the current module.
1158 isLocalCLabel :: Module -> CLabel -> Bool
1159 isLocalCLabel this_mod lbl =
1160 case lbl of
1161 IdLabel name _ _
1162 | isInternalName name -> True
1163 | otherwise -> nameModule name == this_mod
1164 LocalBlockLabel _ -> True
1165 _ -> False
1166
1167 -- -----------------------------------------------------------------------------
1168
1169 -- | Does a 'CLabel' need dynamic linkage?
1170 --
1171 -- When referring to data in code, we need to know whether
1172 -- that data resides in a DLL or not. [Win32 only.]
1173 -- @labelDynamic@ returns @True@ if the label is located
1174 -- in a DLL, be it a data reference or not.
1175 labelDynamic :: NCGConfig -> CLabel -> Bool
1176 labelDynamic config lbl =
1177 case lbl of
1178 -- is the RTS in a DLL or not?
1179 RtsLabel _ ->
1180 externalDynamicRefs && (this_unit /= rtsUnitId)
1181
1182 IdLabel n _ _ ->
1183 externalDynamicRefs && isDynLinkName platform this_mod n
1184
1185 -- When compiling in the "dyn" way, each package is to be linked into
1186 -- its own shared library.
1187 CmmLabel lbl_unit _ _ _
1188 | os == OSMinGW32 -> externalDynamicRefs && (this_unit /= lbl_unit)
1189 | otherwise -> externalDynamicRefs
1190
1191 LocalBlockLabel _ -> False
1192
1193 ForeignLabel _ _ source _ ->
1194 if os == OSMinGW32
1195 then case source of
1196 -- Foreign label is in some un-named foreign package (or DLL).
1197 ForeignLabelInExternalPackage -> True
1198
1199 -- Foreign label is linked into the same package as the
1200 -- source file currently being compiled.
1201 ForeignLabelInThisPackage -> False
1202
1203 -- Foreign label is in some named package.
1204 -- When compiling in the "dyn" way, each package is to be
1205 -- linked into its own DLL.
1206 ForeignLabelInPackage pkgId ->
1207 externalDynamicRefs && (this_unit /= pkgId)
1208
1209 else -- On Mac OS X and on ELF platforms, false positives are OK,
1210 -- so we claim that all foreign imports come from dynamic
1211 -- libraries
1212 True
1213
1214 CC_Label cc ->
1215 externalDynamicRefs && not (ccFromThisModule cc this_mod)
1216
1217 -- CCS_Label always contains a CostCentre defined in the current module
1218 CCS_Label _ -> False
1219 IPE_Label {} -> True
1220
1221 HpcTicksLabel m ->
1222 externalDynamicRefs && this_mod /= m
1223
1224 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
1225 _ -> False
1226 where
1227 externalDynamicRefs = ncgExternalDynamicRefs config
1228 platform = ncgPlatform config
1229 os = platformOS platform
1230 this_mod = ncgThisModule config
1231 this_unit = toUnitId (moduleUnit this_mod)
1232
1233
1234 -----------------------------------------------------------------------------
1235 -- Printing out CLabels.
1236
1237 {-
1238 Convention:
1239
1240 <name>_<type>
1241
1242 where <name> is <Module>_<name> for external names and <unique> for
1243 internal names. <type> is one of the following:
1244
1245 info Info table
1246 srt Static reference table
1247 entry Entry code (function, closure)
1248 slow Slow entry code (if any)
1249 ret Direct return address
1250 vtbl Vector table
1251 <n>_alt Case alternative (tag n)
1252 dflt Default case alternative
1253 btm Large bitmap vector
1254 closure Static closure
1255 con_entry Dynamic Constructor entry code
1256 con_info Dynamic Constructor info table
1257 static_entry Static Constructor entry code
1258 static_info Static Constructor info table
1259 sel_info Selector info table
1260 sel_entry Selector entry code
1261 cc Cost centre
1262 ccs Cost centre stack
1263
1264 Many of these distinctions are only for documentation reasons. For
1265 example, _ret is only distinguished from _entry to make it easy to
1266 tell whether a code fragment is a return point or a closure/function
1267 entry.
1268
1269 Note [Closure and info labels]
1270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1271 For a function 'foo, we have:
1272 foo_info : Points to the info table describing foo's closure
1273 (and entry code for foo with tables next to code)
1274 foo_closure : Static (no-free-var) closure only:
1275 points to the statically-allocated closure
1276
1277 For a data constructor (such as Just or Nothing), we have:
1278 Just_con_info: Info table for the data constructor itself
1279 the first word of a heap-allocated Just
1280 Just_info: Info table for the *worker function*, an
1281 ordinary Haskell function of arity 1 that
1282 allocates a (Just x) box:
1283 Just = \x -> Just x
1284 Just_closure: The closure for this worker
1285
1286 Nothing_closure: a statically allocated closure for Nothing
1287 Nothing_static_info: info table for Nothing_closure
1288
1289 All these must be exported symbol, EXCEPT Just_info. We don't need to
1290 export this because in other modules we either have
1291 * A reference to 'Just'; use Just_closure
1292 * A saturated call 'Just x'; allocate using Just_con_info
1293 Not exporting these Just_info labels reduces the number of symbols
1294 somewhat.
1295
1296 Note [Bytes label]
1297 ~~~~~~~~~~~~~~~~~~
1298 For a top-level string literal 'foo', we have just one symbol 'foo_bytes', which
1299 points to a static data block containing the content of the literal.
1300
1301 Note [Proc-point local block entry-points]
1302 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1303 A label for a proc-point local block entry-point has no "_entry" suffix. With
1304 `infoTblLbl` we derive an info table label from a proc-point block ID. If
1305 we convert such an info table label into an entry label we must produce
1306 the label without an "_entry" suffix. So an info table label records
1307 the fact that it was derived from a block ID in `IdLabelInfo` as
1308 `BlockInfoTable`.
1309
1310 The info table label and the local block label are both local labels
1311 and are not externally visible.
1312
1313 Note [Bangs in CLabel]
1314 ~~~~~~~~~~~~~~~~~~~~~~
1315 There are some carefully placed strictness annotations in this module,
1316 which were discovered in !5226 to significantly reduce compile-time
1317 allocation. Take care if you want to remove them!
1318
1319 -}
1320
1321 instance OutputableP Platform CLabel where
1322 {-# INLINE pdoc #-} -- see Note [Bangs in CLabel]
1323 pdoc !platform lbl = getPprStyle $ \pp_sty ->
1324 let !sty = case pp_sty of
1325 PprCode sty -> sty
1326 _ -> CStyle
1327 in pprCLabel platform sty lbl
1328
1329 pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
1330 pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
1331 let
1332 !use_leading_underscores = platformLeadingUnderscore platform
1333
1334 -- some platform (e.g. Darwin) require a leading "_" for exported asm
1335 -- symbols
1336 maybe_underscore :: SDoc -> SDoc
1337 maybe_underscore doc = case sty of
1338 AsmStyle | use_leading_underscores -> pp_cSEP <> doc
1339 _ -> doc
1340
1341 tempLabelPrefixOrUnderscore :: Platform -> SDoc
1342 tempLabelPrefixOrUnderscore platform = case sty of
1343 AsmStyle -> asmTempLabelPrefix platform
1344 CStyle -> char '_'
1345
1346
1347 in case lbl of
1348 LocalBlockLabel u -> case sty of
1349 AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
1350 CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u
1351
1352 AsmTempLabel u
1353 -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
1354
1355 AsmTempDerivedLabel l suf
1356 -> asmTempLabelPrefix platform
1357 <> case l of AsmTempLabel u -> pprUniqueAlways u
1358 LocalBlockLabel u -> pprUniqueAlways u
1359 _other -> pprCLabel platform sty l
1360 <> ftext suf
1361
1362 DynamicLinkerLabel info lbl
1363 -> pprDynamicLinkerAsmLabel platform info (pprCLabel platform AsmStyle lbl)
1364
1365 PicBaseLabel
1366 -> text "1b"
1367
1368 DeadStripPreventer lbl
1369 ->
1370 {-
1371 `lbl` can be temp one but we need to ensure that dsp label will stay
1372 in the final binary so we prepend non-temp prefix ("dsp_") and
1373 optional `_` (underscore) because this is how you mark non-temp symbols
1374 on some platforms (Darwin)
1375 -}
1376 maybe_underscore $ text "dsp_" <> pprCLabel platform sty lbl <> text "_dsp"
1377
1378 StringLitLabel u
1379 -> maybe_underscore $ pprUniqueAlways u <> text "_str"
1380
1381 ForeignLabel fs (Just sz) _ _
1382 | AsmStyle <- sty
1383 , OSMinGW32 <- platformOS platform
1384 -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
1385 -- (The C compiler does this itself).
1386 maybe_underscore $ ftext fs <> char '@' <> int sz
1387
1388 ForeignLabel fs _ _ _
1389 -> maybe_underscore $ ftext fs
1390
1391
1392 IdLabel name _cafs flavor -> case sty of
1393 AsmStyle -> maybe_underscore $ internalNamePrefix <> ppr name <> ppIdFlavor flavor
1394 where
1395 isRandomGenerated = not (isExternalName name)
1396 internalNamePrefix =
1397 if isRandomGenerated
1398 then asmTempLabelPrefix platform
1399 else empty
1400 CStyle -> ppr name <> ppIdFlavor flavor
1401
1402 SRTLabel u
1403 -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
1404
1405 RtsLabel (RtsApFast (NonDetFastString str))
1406 -> maybe_underscore $ ftext str <> text "_fast"
1407
1408 RtsLabel (RtsSelectorInfoTable upd_reqd offset)
1409 -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
1410 , if upd_reqd
1411 then text "_upd_info"
1412 else text "_noupd_info"
1413 ]
1414
1415 RtsLabel (RtsSelectorEntry upd_reqd offset)
1416 -> maybe_underscore $ hcat [ text "stg_sel_", text (show offset)
1417 , if upd_reqd
1418 then text "_upd_entry"
1419 else text "_noupd_entry"
1420 ]
1421
1422 RtsLabel (RtsApInfoTable upd_reqd arity)
1423 -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
1424 , if upd_reqd
1425 then text "_upd_info"
1426 else text "_noupd_info"
1427 ]
1428
1429 RtsLabel (RtsApEntry upd_reqd arity)
1430 -> maybe_underscore $ hcat [ text "stg_ap_", text (show arity)
1431 , if upd_reqd
1432 then text "_upd_entry"
1433 else text "_noupd_entry"
1434 ]
1435
1436 RtsLabel (RtsPrimOp primop)
1437 -> maybe_underscore $ text "stg_" <> ppr primop
1438
1439 RtsLabel (RtsSlowFastTickyCtr pat)
1440 -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
1441
1442 LargeBitmapLabel u
1443 -> maybe_underscore $ tempLabelPrefixOrUnderscore platform
1444 <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm"
1445 -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7')
1446 -- until that gets resolved we'll just force them to start
1447 -- with a letter so the label will be legal assembly code.
1448
1449 HpcTicksLabel mod
1450 -> maybe_underscore $ text "_hpc_tickboxes_" <> ppr mod <> text "_hpc"
1451
1452 CC_Label cc -> maybe_underscore $ ppr cc
1453 CCS_Label ccs -> maybe_underscore $ ppr ccs
1454 IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe")
1455
1456
1457 CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs
1458 CmmLabel _ _ fs CmmData -> maybe_underscore $ ftext fs
1459 CmmLabel _ _ fs CmmPrimCall -> maybe_underscore $ ftext fs
1460 CmmLabel _ _ fs CmmInfo -> maybe_underscore $ ftext fs <> text "_info"
1461 CmmLabel _ _ fs CmmEntry -> maybe_underscore $ ftext fs <> text "_entry"
1462 CmmLabel _ _ fs CmmRetInfo -> maybe_underscore $ ftext fs <> text "_info"
1463 CmmLabel _ _ fs CmmRet -> maybe_underscore $ ftext fs <> text "_ret"
1464 CmmLabel _ _ fs CmmClosure -> maybe_underscore $ ftext fs <> text "_closure"
1465
1466 -- Note [Internal proc labels]
1467 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1468 --
1469 -- Some tools (e.g. the `perf` utility on Linux) rely on the symbol table
1470 -- for resolution of function names. To help these tools we provide the
1471 -- (enabled by default) -fexpose-all-symbols flag which causes GHC to produce
1472 -- symbols even for symbols with are internal to a module (although such
1473 -- symbols will have only local linkage).
1474 --
1475 -- Note that these labels are *not* referred to by code. They are strictly for
1476 -- diagnostics purposes.
1477 --
1478 -- To avoid confusion, it is desirable to add a module-qualifier to the
1479 -- symbol name. However, the Name type's Internal constructor doesn't carry
1480 -- knowledge of the current Module. Consequently, we have to pass this around
1481 -- explicitly.
1482
1483 -- | Generate a label for a procedure internal to a module (if
1484 -- 'Opt_ExposeAllSymbols' is enabled).
1485 -- See Note [Internal proc labels].
1486 ppInternalProcLabel :: Module -- ^ the current module
1487 -> CLabel
1488 -> Maybe SDoc -- ^ the internal proc label
1489 ppInternalProcLabel this_mod (IdLabel nm _ flavour)
1490 | isInternalName nm
1491 = Just
1492 $ text "_" <> ppr this_mod
1493 <> char '_'
1494 <> ztext (zEncodeFS (occNameFS (occName nm)))
1495 <> char '_'
1496 <> pprUniqueAlways (getUnique nm)
1497 <> ppIdFlavor flavour
1498 ppInternalProcLabel _ _ = Nothing
1499
1500 ppIdFlavor :: IdLabelInfo -> SDoc
1501 ppIdFlavor x = pp_cSEP <> case x of
1502 Closure -> text "closure"
1503 InfoTable -> text "info"
1504 LocalInfoTable -> text "info"
1505 Entry -> text "entry"
1506 LocalEntry -> text "entry"
1507 Slow -> text "slow"
1508 RednCounts -> text "ct"
1509 ConEntry loc ->
1510 case loc of
1511 DefinitionSite -> text "con_entry"
1512 UsageSite m n ->
1513 ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_entry"
1514 ConInfoTable k ->
1515 case k of
1516 DefinitionSite -> text "con_info"
1517 UsageSite m n ->
1518 ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_info"
1519 ClosureTable -> text "closure_tbl"
1520 Bytes -> text "bytes"
1521 BlockInfoTable -> text "info"
1522
1523 pp_cSEP :: SDoc
1524 pp_cSEP = char '_'
1525
1526
1527 instance Outputable ForeignLabelSource where
1528 ppr fs
1529 = case fs of
1530 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
1531 ForeignLabelInThisPackage -> parens $ text "this package"
1532 ForeignLabelInExternalPackage -> parens $ text "external package"
1533
1534 -- -----------------------------------------------------------------------------
1535 -- Machine-dependent knowledge about labels.
1536
1537 asmTempLabelPrefix :: Platform -> SDoc -- for formatting labels
1538 asmTempLabelPrefix !platform = case platformOS platform of
1539 OSDarwin -> text "L"
1540 OSAIX -> text "__L" -- follow IBM XL C's convention
1541 _ -> text ".L"
1542
1543 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
1544 pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
1545 case platformOS platform of
1546 OSDarwin
1547 | platformArch platform == ArchX86_64 ->
1548 case dllInfo of
1549 CodeStub -> char 'L' <> ppLbl <> text "$stub"
1550 SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
1551 GotSymbolPtr -> ppLbl <> text "@GOTPCREL"
1552 GotSymbolOffset -> ppLbl
1553 | platformArch platform == ArchAArch64 -> ppLbl
1554 | otherwise ->
1555 case dllInfo of
1556 CodeStub -> char 'L' <> ppLbl <> text "$stub"
1557 SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
1558 _ -> panic "pprDynamicLinkerAsmLabel"
1559
1560 OSAIX ->
1561 case dllInfo of
1562 SymbolPtr -> text "LC.." <> ppLbl -- GCC's naming convention
1563 _ -> panic "pprDynamicLinkerAsmLabel"
1564
1565 _ | osElfTarget (platformOS platform) -> elfLabel
1566
1567 OSMinGW32 ->
1568 case dllInfo of
1569 SymbolPtr -> text "__imp_" <> ppLbl
1570 _ -> panic "pprDynamicLinkerAsmLabel"
1571
1572 _ -> panic "pprDynamicLinkerAsmLabel"
1573 where
1574 elfLabel
1575 | platformArch platform == ArchPPC
1576 = case dllInfo of
1577 CodeStub -> -- See Note [.LCTOC1 in PPC PIC code]
1578 ppLbl <> text "+32768@plt"
1579 SymbolPtr -> text ".LC_" <> ppLbl
1580 _ -> panic "pprDynamicLinkerAsmLabel"
1581
1582 | platformArch platform == ArchAArch64
1583 = ppLbl
1584
1585
1586 | platformArch platform == ArchX86_64
1587 = case dllInfo of
1588 CodeStub -> ppLbl <> text "@plt"
1589 GotSymbolPtr -> ppLbl <> text "@gotpcrel"
1590 GotSymbolOffset -> ppLbl
1591 SymbolPtr -> text ".LC_" <> ppLbl
1592
1593 | platformArch platform == ArchPPC_64 ELF_V1
1594 || platformArch platform == ArchPPC_64 ELF_V2
1595 = case dllInfo of
1596 GotSymbolPtr -> text ".LC_" <> ppLbl <> text "@toc"
1597 GotSymbolOffset -> ppLbl
1598 SymbolPtr -> text ".LC_" <> ppLbl
1599 _ -> panic "pprDynamicLinkerAsmLabel"
1600
1601 | otherwise
1602 = case dllInfo of
1603 CodeStub -> ppLbl <> text "@plt"
1604 SymbolPtr -> text ".LC_" <> ppLbl
1605 GotSymbolPtr -> ppLbl <> text "@got"
1606 GotSymbolOffset -> ppLbl <> text "@gotoff"
1607
1608 -- Figure out whether `symbol` may serve as an alias
1609 -- to `target` within one compilation unit.
1610 --
1611 -- This is true if any of these holds:
1612 -- * `target` is a module-internal haskell name.
1613 -- * `target` is an exported name, but comes from the same
1614 -- module as `symbol`
1615 --
1616 -- These are sufficient conditions for establishing e.g. a
1617 -- GNU assembly alias ('.equiv' directive). Sadly, there is
1618 -- no such thing as an alias to an imported symbol (conf.
1619 -- http://blog.omega-prime.co.uk/2011/07/06/the-sad-state-of-symbol-aliases/)
1620 -- See note [emit-time elimination of static indirections].
1621 --
1622 -- Precondition is that both labels represent the
1623 -- same semantic value.
1624
1625 mayRedirectTo :: CLabel -> CLabel -> Bool
1626 mayRedirectTo symbol target
1627 | Just nam <- haskellName
1628 , staticClosureLabel
1629 , isExternalName nam
1630 , Just mod <- nameModule_maybe nam
1631 , Just anam <- hasHaskellName symbol
1632 , Just amod <- nameModule_maybe anam
1633 = amod == mod
1634
1635 | Just nam <- haskellName
1636 , staticClosureLabel
1637 , isInternalName nam
1638 = True
1639
1640 | otherwise = False
1641 where staticClosureLabel = isStaticClosureLabel target
1642 haskellName = hasHaskellName target
1643
1644
1645 {-
1646 Note [emit-time elimination of static indirections]
1647 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1648 As described in #15155, certain static values are representationally
1649 equivalent, e.g. 'cast'ed values (when created by 'newtype' wrappers).
1650
1651 newtype A = A Int
1652 {-# NOINLINE a #-}
1653 a = A 42
1654
1655 a1_rYB :: Int
1656 [GblId, Caf=NoCafRefs, Unf=OtherCon []]
1657 a1_rYB = GHC.Types.I# 42#
1658
1659 a [InlPrag=NOINLINE] :: A
1660 [GblId, Unf=OtherCon []]
1661 a = a1_rYB `cast` (Sym (T15155.N:A[0]) :: Int ~R# A)
1662
1663 Formerly we created static indirections for these (IND_STATIC), which
1664 consist of a statically allocated forwarding closure that contains
1665 the (possibly tagged) indirectee. (See CMM/assembly below.)
1666 This approach is suboptimal for two reasons:
1667 (a) they occupy extra space,
1668 (b) they need to be entered in order to obtain the indirectee,
1669 thus they cannot be tagged.
1670
1671 Fortunately there is a common case where static indirections can be
1672 eliminated while emitting assembly (native or LLVM), viz. when the
1673 indirectee is in the same module (object file) as the symbol that
1674 points to it. In this case an assembly-level identification can
1675 be created ('.equiv' directive), and as such the same object will
1676 be assigned two names in the symbol table. Any of the identified
1677 symbols can be referenced by a tagged pointer.
1678
1679 Currently the 'mayRedirectTo' predicate will
1680 give a clue whether a label can be equated with another, already
1681 emitted, label (which can in turn be an alias). The general mechanics
1682 is that we identify data (IND_STATIC closures) that are amenable
1683 to aliasing while pretty-printing of assembly output, and emit the
1684 '.equiv' directive instead of static data in such a case.
1685
1686 Here is a sketch how the output is massaged:
1687
1688 Consider
1689 newtype A = A Int
1690 {-# NOINLINE a #-}
1691 a = A 42 -- I# 42# is the indirectee
1692 -- 'a' is exported
1693
1694 results in STG
1695
1696 a1_rXq :: GHC.Types.Int
1697 [GblId, Caf=NoCafRefs, Unf=OtherCon []] =
1698 CCS_DONT_CARE GHC.Types.I#! [42#];
1699
1700 T15155.a [InlPrag=NOINLINE] :: T15155.A
1701 [GblId, Unf=OtherCon []] =
1702 CAF_ccs \ u [] a1_rXq;
1703
1704 and CMM
1705
1706 [section ""data" . a1_rXq_closure" {
1707 a1_rXq_closure:
1708 const GHC.Types.I#_con_info;
1709 const 42;
1710 }]
1711
1712 [section ""data" . T15155.a_closure" {
1713 T15155.a_closure:
1714 const stg_IND_STATIC_info;
1715 const a1_rXq_closure+1;
1716 const 0;
1717 const 0;
1718 }]
1719
1720 The emitted assembly is
1721
1722 ==== INDIRECTEE
1723 a1_rXq_closure: -- module local haskell value
1724 .quad GHC.Types.I#_con_info -- an Int
1725 .quad 42
1726
1727 ==== BEFORE
1728 .globl T15155.a_closure -- exported newtype wrapped value
1729 T15155.a_closure:
1730 .quad stg_IND_STATIC_info -- the closure info
1731 .quad a1_rXq_closure+1 -- indirectee ('+1' being the tag)
1732 .quad 0
1733 .quad 0
1734
1735 ==== AFTER
1736 .globl T15155.a_closure -- exported newtype wrapped value
1737 .equiv a1_rXq_closure,T15155.a_closure -- both are shared
1738
1739 The transformation is performed because
1740 T15155.a_closure `mayRedirectTo` a1_rXq_closure+1
1741 returns True.
1742 -}