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