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