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