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