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