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