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