a5d559e9ff486fa9ddd528f8d1ca5243d3b211ed
[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 mkCmmGcPtrLabel,
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 | CmmGcPtr -- ^ GcPtrs 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, mkCmmGcPtrLabel
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 mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
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 l = pprPanic "toClosureLbl" (ppr l)
547
548 toSlowEntryLbl :: CLabel -> CLabel
549 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
550 toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
551
552 toRednCountsLbl :: CLabel -> CLabel
553 toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
554 toRednCountsLbl l = pprPanic "toRednCountsLbl" (ppr l)
555
556 toEntryLbl :: CLabel -> CLabel
557 toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
558 toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
559 toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
560 toEntryLbl (IdLabel n c _) = IdLabel n c Entry
561 toEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
562 toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
563 toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
564 toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
565
566 toInfoLbl :: CLabel -> CLabel
567 toInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
568 toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
569 toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
570 toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
571 toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable
572 toInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
573 toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
574 toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
575 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
576
577 -- -----------------------------------------------------------------------------
578 -- Does a CLabel refer to a CAF?
579 hasCAF :: CLabel -> Bool
580 hasCAF (IdLabel _ MayHaveCafRefs _) = True
581 hasCAF _ = False
582
583
584 -- -----------------------------------------------------------------------------
585 -- Does a CLabel need declaring before use or not?
586 --
587 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
588
589 needsCDecl :: CLabel -> Bool
590 -- False <=> it's pre-declared; don't bother
591 -- don't bother declaring Bitmap labels, we always make sure
592 -- they are defined before use.
593 needsCDecl (SRTLabel _) = True
594 needsCDecl (LargeSRTLabel _) = False
595 needsCDecl (LargeBitmapLabel _) = False
596 needsCDecl (IdLabel _ _ _) = True
597 needsCDecl (CaseLabel _ _) = True
598 needsCDecl (PlainModuleInitLabel _) = True
599
600 needsCDecl (StringLitLabel _) = False
601 needsCDecl (AsmTempLabel _) = False
602 needsCDecl (RtsLabel _) = False
603
604 needsCDecl (CmmLabel pkgId _ _)
605 -- Prototypes for labels defined in the runtime system are imported
606 -- into HC files via includes/Stg.h.
607 | pkgId == rtsPackageId = False
608
609 -- For other labels we inline one into the HC file directly.
610 | otherwise = True
611
612 needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
613 needsCDecl (CC_Label _) = True
614 needsCDecl (CCS_Label _) = True
615 needsCDecl (HpcTicksLabel _) = True
616 needsCDecl (DynamicLinkerLabel {}) = panic "needsCDecl DynamicLinkerLabel"
617 needsCDecl PicBaseLabel = panic "needsCDecl PicBaseLabel"
618 needsCDecl (DeadStripPreventer {}) = panic "needsCDecl DeadStripPreventer"
619
620 -- | Check whether a label is a local temporary for native code generation
621 isAsmTemp :: CLabel -> Bool
622 isAsmTemp (AsmTempLabel _) = True
623 isAsmTemp _ = False
624
625
626 -- | If a label is a local temporary used for native code generation
627 -- then return just its unique, otherwise nothing.
628 maybeAsmTemp :: CLabel -> Maybe Unique
629 maybeAsmTemp (AsmTempLabel uq) = Just uq
630 maybeAsmTemp _ = Nothing
631
632
633 -- | Check whether a label corresponds to a C function that has
634 -- a prototype in a system header somehere, or is built-in
635 -- to the C compiler. For these labels we avoid generating our
636 -- own C prototypes.
637 isMathFun :: CLabel -> Bool
638 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
639 isMathFun _ = False
640
641 math_funs :: UniqSet FastString
642 math_funs = mkUniqSet [
643 -- _ISOC99_SOURCE
644 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
645 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
646 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
647 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
648 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
649 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
650 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
651 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
652 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
653 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
654 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
655 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
656 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
657 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
658 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
659 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
660 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
661 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
662 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
663 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
664 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
665 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
666 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
667 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
668 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
669 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
670 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
671 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
672 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
673 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
674 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
675 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
676 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
677 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
678 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
679 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
680 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
681 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
682 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
683 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
684 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
685 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
686 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
687 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
688 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
689 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
690 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
691 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
692 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
693 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
694 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
695 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
696 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
697 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
698 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
699 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
700 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
701 -- ISO C 99 also defines these function-like macros in math.h:
702 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
703 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
704
705 -- additional symbols from _BSD_SOURCE
706 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
707 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
708 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
709 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
710 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
711 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
712 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
713 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
714 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
715 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
716 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
717 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
718 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
719 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl")
720 ]
721
722 -- -----------------------------------------------------------------------------
723 -- | Is a CLabel visible outside this object file or not?
724 -- From the point of view of the code generator, a name is
725 -- externally visible if it has to be declared as exported
726 -- in the .o file's symbol table; that is, made non-static.
727 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
728 externallyVisibleCLabel (CaseLabel _ _) = False
729 externallyVisibleCLabel (StringLitLabel _) = False
730 externallyVisibleCLabel (AsmTempLabel _) = False
731 externallyVisibleCLabel (PlainModuleInitLabel _)= True
732 externallyVisibleCLabel (RtsLabel _) = True
733 externallyVisibleCLabel (CmmLabel _ _ _) = True
734 externallyVisibleCLabel (ForeignLabel{}) = True
735 externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
736 externallyVisibleCLabel (CC_Label _) = True
737 externallyVisibleCLabel (CCS_Label _) = True
738 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
739 externallyVisibleCLabel (HpcTicksLabel _) = True
740 externallyVisibleCLabel (LargeBitmapLabel _) = False
741 externallyVisibleCLabel (SRTLabel _) = False
742 externallyVisibleCLabel (LargeSRTLabel _) = False
743 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
744 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
745
746 externallyVisibleIdLabel :: IdLabelInfo -> Bool
747 externallyVisibleIdLabel SRT = False
748 externallyVisibleIdLabel LocalInfoTable = False
749 externallyVisibleIdLabel LocalEntry = False
750 externallyVisibleIdLabel _ = True
751
752 -- -----------------------------------------------------------------------------
753 -- Finding the "type" of a CLabel
754
755 -- For generating correct types in label declarations:
756
757 data CLabelType
758 = CodeLabel -- Address of some executable instructions
759 | DataLabel -- Address of data, not a GC ptr
760 | GcPtrLabel -- Address of a (presumably static) GC object
761
762 isCFunctionLabel :: CLabel -> Bool
763 isCFunctionLabel lbl = case labelType lbl of
764 CodeLabel -> True
765 _other -> False
766
767 isGcPtrLabel :: CLabel -> Bool
768 isGcPtrLabel lbl = case labelType lbl of
769 GcPtrLabel -> True
770 _other -> False
771
772
773 -- | Work out the general type of data at the address of this label
774 -- whether it be code, data, or static GC object.
775 labelType :: CLabel -> CLabelType
776 labelType (CmmLabel _ _ CmmData) = DataLabel
777 labelType (CmmLabel _ _ CmmGcPtr) = GcPtrLabel
778 labelType (CmmLabel _ _ CmmCode) = CodeLabel
779 labelType (CmmLabel _ _ CmmInfo) = DataLabel
780 labelType (CmmLabel _ _ CmmEntry) = CodeLabel
781 labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
782 labelType (CmmLabel _ _ CmmRet) = CodeLabel
783 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
784 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
785 labelType (RtsLabel (RtsApFast _)) = CodeLabel
786 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
787 labelType (CaseLabel _ _) = CodeLabel
788 labelType (PlainModuleInitLabel _) = CodeLabel
789 labelType (SRTLabel _) = DataLabel
790 labelType (LargeSRTLabel _) = DataLabel
791 labelType (LargeBitmapLabel _) = DataLabel
792 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
793 labelType (IdLabel _ _ info) = idInfoLabelType info
794 labelType _ = DataLabel
795
796 idInfoLabelType :: IdLabelInfo -> CLabelType
797 idInfoLabelType info =
798 case info of
799 InfoTable -> DataLabel
800 LocalInfoTable -> DataLabel
801 Closure -> GcPtrLabel
802 ConInfoTable -> DataLabel
803 StaticInfoTable -> DataLabel
804 ClosureTable -> DataLabel
805 RednCounts -> DataLabel
806 _ -> CodeLabel
807
808
809 -- -----------------------------------------------------------------------------
810 -- Does a CLabel need dynamic linkage?
811
812 -- When referring to data in code, we need to know whether
813 -- that data resides in a DLL or not. [Win32 only.]
814 -- @labelDynamic@ returns @True@ if the label is located
815 -- in a DLL, be it a data reference or not.
816
817 labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
818 labelDynamic dflags this_pkg lbl =
819 case lbl of
820 -- is the RTS in a DLL or not?
821 RtsLabel _ -> not (dopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
822
823 IdLabel n _ _ -> isDllName dflags this_pkg n
824
825 -- When compiling in the "dyn" way, each package is to be linked into
826 -- its own shared library.
827 CmmLabel pkg _ _
828 | os == OSMinGW32 ->
829 not (dopt Opt_Static dflags) && (this_pkg /= pkg)
830 | otherwise ->
831 True
832
833 ForeignLabel _ _ source _ ->
834 if os == OSMinGW32
835 then case source of
836 -- Foreign label is in some un-named foreign package (or DLL).
837 ForeignLabelInExternalPackage -> True
838
839 -- Foreign label is linked into the same package as the
840 -- source file currently being compiled.
841 ForeignLabelInThisPackage -> False
842
843 -- Foreign label is in some named package.
844 -- When compiling in the "dyn" way, each package is to be
845 -- linked into its own DLL.
846 ForeignLabelInPackage pkgId ->
847 (not (dopt Opt_Static dflags)) && (this_pkg /= pkgId)
848
849 else -- On Mac OS X and on ELF platforms, false positives are OK,
850 -- so we claim that all foreign imports come from dynamic
851 -- libraries
852 True
853
854 PlainModuleInitLabel m -> not (dopt Opt_Static dflags) && this_pkg /= (modulePackageId m)
855
856 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
857 _ -> False
858 where os = platformOS (targetPlatform dflags)
859
860 {-
861 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
862 right places. It is used to detect when the abstractC statement of an
863 CCodeBlock actually contains the code for a slow entry point. -- HWL
864
865 We need at least @Eq@ for @CLabels@, because we want to avoid
866 duplicate declarations in generating C (see @labelSeenTE@ in
867 @PprAbsC@).
868 -}
869
870 -----------------------------------------------------------------------------
871 -- Printing out CLabels.
872
873 {-
874 Convention:
875
876 <name>_<type>
877
878 where <name> is <Module>_<name> for external names and <unique> for
879 internal names. <type> is one of the following:
880
881 info Info table
882 srt Static reference table
883 srtd Static reference table descriptor
884 entry Entry code (function, closure)
885 slow Slow entry code (if any)
886 ret Direct return address
887 vtbl Vector table
888 <n>_alt Case alternative (tag n)
889 dflt Default case alternative
890 btm Large bitmap vector
891 closure Static closure
892 con_entry Dynamic Constructor entry code
893 con_info Dynamic Constructor info table
894 static_entry Static Constructor entry code
895 static_info Static Constructor info table
896 sel_info Selector info table
897 sel_entry Selector entry code
898 cc Cost centre
899 ccs Cost centre stack
900
901 Many of these distinctions are only for documentation reasons. For
902 example, _ret is only distinguished from _entry to make it easy to
903 tell whether a code fragment is a return point or a closure/function
904 entry.
905
906 Note [Closure and info labels]
907 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
908 For a function 'foo, we have:
909 foo_info : Points to the info table describing foo's closure
910 (and entry code for foo with tables next to code)
911 foo_closure : Static (no-free-var) closure only:
912 points to the statically-allocated closure
913
914 For a data constructor (such as Just or Nothing), we have:
915 Just_con_info: Info table for the data constructor itself
916 the first word of a heap-allocated Just
917 Just_info: Info table for the *worker function*, an
918 ordinary Haskell function of arity 1 that
919 allocates a (Just x) box:
920 Just = \x -> Just x
921 Just_closure: The closure for this worker
922
923 Nothing_closure: a statically allocated closure for Nothing
924 Nothing_static_info: info table for Nothing_closure
925
926 All these must be exported symbol, EXCEPT Just_info. We don't need to
927 export this because in other modules we either have
928 * A reference to 'Just'; use Just_closure
929 * A saturated call 'Just x'; allocate using Just_con_info
930 Not exporting these Just_info labels reduces the number of symbols
931 somewhat.
932 -}
933
934 instance Outputable CLabel where
935 ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
936
937 pprCLabel :: Platform -> CLabel -> SDoc
938
939 pprCLabel platform (AsmTempLabel u)
940 | cGhcWithNativeCodeGen == "YES"
941 = getPprStyle $ \ sty ->
942 if asmStyle sty then
943 ptext (asmTempLabelPrefix platform) <> pprUnique u
944 else
945 char '_' <> pprUnique u
946
947 pprCLabel platform (DynamicLinkerLabel info lbl)
948 | cGhcWithNativeCodeGen == "YES"
949 = pprDynamicLinkerAsmLabel platform info lbl
950
951 pprCLabel _ PicBaseLabel
952 | cGhcWithNativeCodeGen == "YES"
953 = ptext (sLit "1b")
954
955 pprCLabel platform (DeadStripPreventer lbl)
956 | cGhcWithNativeCodeGen == "YES"
957 = pprCLabel platform lbl <> ptext (sLit "_dsp")
958
959 pprCLabel platform lbl
960 = getPprStyle $ \ sty ->
961 if cGhcWithNativeCodeGen == "YES" && asmStyle sty
962 then maybe_underscore (pprAsmCLbl platform lbl)
963 else pprCLbl lbl
964
965 maybe_underscore :: SDoc -> SDoc
966 maybe_underscore doc
967 | underscorePrefix = pp_cSEP <> doc
968 | otherwise = doc
969
970 pprAsmCLbl :: Platform -> CLabel -> SDoc
971 pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
972 | platformOS platform == OSMinGW32
973 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
974 -- (The C compiler does this itself).
975 = ftext fs <> char '@' <> int sz
976 pprAsmCLbl _ lbl
977 = pprCLbl lbl
978
979 pprCLbl :: CLabel -> SDoc
980 pprCLbl (StringLitLabel u)
981 = pprUnique u <> ptext (sLit "_str")
982
983 pprCLbl (CaseLabel u CaseReturnPt)
984 = hcat [pprUnique u, ptext (sLit "_ret")]
985 pprCLbl (CaseLabel u CaseReturnInfo)
986 = hcat [pprUnique u, ptext (sLit "_info")]
987 pprCLbl (CaseLabel u (CaseAlt tag))
988 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
989 pprCLbl (CaseLabel u CaseDefault)
990 = hcat [pprUnique u, ptext (sLit "_dflt")]
991
992 pprCLbl (SRTLabel u)
993 = pprUnique u <> pp_cSEP <> ptext (sLit "srt")
994
995 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
996 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
997 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
998 -- until that gets resolved we'll just force them to start
999 -- with a letter so the label will be legal assmbly code.
1000
1001
1002 pprCLbl (CmmLabel _ str CmmCode) = ftext str
1003 pprCLbl (CmmLabel _ str CmmData) = ftext str
1004 pprCLbl (CmmLabel _ str CmmGcPtr) = 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 (RtsLabel (RtsPrimOp primop))
1050 = ptext (sLit "stg_") <> ppr primop
1051
1052 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
1053 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
1054
1055 pprCLbl (ForeignLabel str _ _ _)
1056 = ftext str
1057
1058 pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
1059
1060 pprCLbl (CC_Label cc) = ppr cc
1061 pprCLbl (CCS_Label ccs) = ppr ccs
1062
1063 pprCLbl (PlainModuleInitLabel mod)
1064 = ptext (sLit "__stginit_") <> ppr mod
1065
1066 pprCLbl (HpcTicksLabel mod)
1067 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
1068
1069 pprCLbl (AsmTempLabel {}) = panic "pprCLbl AsmTempLabel"
1070 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
1071 pprCLbl (PicBaseLabel {}) = panic "pprCLbl PicBaseLabel"
1072 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
1073
1074 ppIdFlavor :: IdLabelInfo -> SDoc
1075 ppIdFlavor x = pp_cSEP <>
1076 (case x of
1077 Closure -> ptext (sLit "closure")
1078 SRT -> ptext (sLit "srt")
1079 InfoTable -> ptext (sLit "info")
1080 LocalInfoTable -> ptext (sLit "info")
1081 Entry -> ptext (sLit "entry")
1082 LocalEntry -> ptext (sLit "entry")
1083 Slow -> ptext (sLit "slow")
1084 RednCounts -> ptext (sLit "ct")
1085 ConEntry -> ptext (sLit "con_entry")
1086 ConInfoTable -> ptext (sLit "con_info")
1087 StaticConEntry -> ptext (sLit "static_entry")
1088 StaticInfoTable -> ptext (sLit "static_info")
1089 ClosureTable -> ptext (sLit "closure_tbl")
1090 )
1091
1092
1093 pp_cSEP :: SDoc
1094 pp_cSEP = char '_'
1095
1096
1097 instance Outputable ForeignLabelSource where
1098 ppr fs
1099 = case fs of
1100 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
1101 ForeignLabelInThisPackage -> parens $ text "this package"
1102 ForeignLabelInExternalPackage -> parens $ text "external package"
1103
1104 -- -----------------------------------------------------------------------------
1105 -- Machine-dependent knowledge about labels.
1106
1107 underscorePrefix :: Bool -- leading underscore on assembler labels?
1108 underscorePrefix = (cLeadingUnderscore == "YES")
1109
1110 asmTempLabelPrefix :: Platform -> LitString -- for formatting labels
1111 asmTempLabelPrefix platform =
1112 if platformOS platform == OSDarwin
1113 then sLit "L"
1114 else sLit ".L"
1115
1116 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
1117 pprDynamicLinkerAsmLabel platform dllInfo lbl
1118 = if platformOS platform == OSDarwin
1119 then if platformArch platform == ArchX86_64
1120 then case dllInfo of
1121 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1122 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1123 GotSymbolPtr -> ppr lbl <> text "@GOTPCREL"
1124 GotSymbolOffset -> ppr lbl
1125 else case dllInfo of
1126 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1127 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1128 _ -> panic "pprDynamicLinkerAsmLabel"
1129
1130 else if osElfTarget (platformOS platform)
1131 then if platformArch platform == ArchPPC
1132 then case dllInfo of
1133 CodeStub -> ppr lbl <> text "@plt"
1134 SymbolPtr -> text ".LC_" <> ppr lbl
1135 _ -> panic "pprDynamicLinkerAsmLabel"
1136 else if platformArch platform == ArchX86_64
1137 then case dllInfo of
1138 CodeStub -> ppr lbl <> text "@plt"
1139 GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
1140 GotSymbolOffset -> ppr lbl
1141 SymbolPtr -> text ".LC_" <> ppr lbl
1142 else case dllInfo of
1143 CodeStub -> ppr lbl <> text "@plt"
1144 SymbolPtr -> text ".LC_" <> ppr lbl
1145 GotSymbolPtr -> ppr lbl <> text "@got"
1146 GotSymbolOffset -> ppr lbl <> text "@gotoff"
1147 else if platformOS platform == OSMinGW32
1148 then case dllInfo of
1149 SymbolPtr -> text "__imp_" <> ppr lbl
1150 _ -> panic "pprDynamicLinkerAsmLabel"
1151 else panic "pprDynamicLinkerAsmLabel"
1152