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