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