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