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