Merge branch 'master' of darcs.haskell.org:/home/darcs/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 mkTopSRTLabel,
17 mkInfoTableLabel,
18 mkEntryLabel,
19 mkSlowEntryLabel,
20 mkConEntryLabel,
21 mkStaticConEntryLabel,
22 mkRednCountsLabel,
23 mkConInfoTableLabel,
24 mkStaticInfoTableLabel,
25 mkLargeSRTLabel,
26 mkApEntryLabel,
27 mkApInfoTableLabel,
28 mkClosureTableLabel,
29
30 mkLocalClosureLabel,
31 mkLocalInfoTableLabel,
32 mkLocalEntryLabel,
33 mkLocalConEntryLabel,
34 mkLocalStaticConEntryLabel,
35 mkLocalConInfoTableLabel,
36 mkLocalStaticInfoTableLabel,
37 mkLocalClosureTableLabel,
38
39 mkReturnPtLabel,
40 mkReturnInfoLabel,
41 mkAltLabel,
42 mkDefaultLabel,
43 mkBitmapLabel,
44 mkStringLitLabel,
45
46 mkAsmTempLabel,
47
48 mkPlainModuleInitLabel,
49
50 mkSplitMarkerLabel,
51 mkDirty_MUT_VAR_Label,
52 mkUpdInfoLabel,
53 mkBHUpdInfoLabel,
54 mkIndStaticInfoLabel,
55 mkMainCapabilityLabel,
56 mkMAP_FROZEN_infoLabel,
57 mkMAP_DIRTY_infoLabel,
58 mkEMPTY_MVAR_infoLabel,
59
60 mkTopTickyCtrLabel,
61 mkCAFBlackHoleInfoTableLabel,
62 mkCAFBlackHoleEntryLabel,
63 mkRtsPrimOpLabel,
64 mkRtsSlowTickyCtrLabel,
65
66 mkSelectorInfoLabel,
67 mkSelectorEntryLabel,
68
69 mkCmmInfoLabel,
70 mkCmmEntryLabel,
71 mkCmmRetInfoLabel,
72 mkCmmRetLabel,
73 mkCmmCodeLabel,
74 mkCmmDataLabel,
75 mkCmmClosureLabel,
76
77 mkRtsApFastLabel,
78
79 mkPrimCallLabel,
80
81 mkForeignLabel,
82 addLabelSize,
83 foreignLabelStdcallInfo,
84
85 mkCCLabel, mkCCSLabel,
86
87 DynamicLinkerLabelInfo(..),
88 mkDynamicLinkerLabel,
89 dynamicLinkerLabelInfo,
90
91 mkPicBaseLabel,
92 mkDeadStripPreventer,
93
94 mkHpcTicksLabel,
95
96 hasCAF,
97 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
98 isMathFun,
99 isCFunctionLabel, isGcPtrLabel, labelDynamic,
100
101 -- * Conversions
102 toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
103
104 pprCLabel
105 ) where
106
107 import IdInfo
108 import BasicTypes
109 import Packages
110 import Module
111 import Name
112 import Unique
113 import PrimOp
114 import Config
115 import CostCentre
116 import Outputable
117 import FastString
118 import DynFlags
119 import Platform
120 import UniqSet
121
122 -- -----------------------------------------------------------------------------
123 -- The CLabel type
124
125 {-
126 | CLabel is an abstract type that supports the following operations:
127
128 - Pretty printing
129
130 - In a C file, does it need to be declared before use? (i.e. is it
131 guaranteed to be already in scope in the places we need to refer to it?)
132
133 - If it needs to be declared, what type (code or data) should it be
134 declared to have?
135
136 - Is it visible outside this object file or not?
137
138 - Is it "dynamic" (see details below)
139
140 - Eq and Ord, so that we can make sets of CLabels (currently only
141 used in outputting C as far as I can tell, to avoid generating
142 more than one declaration for any given label).
143
144 - Converting an info table label into an entry label.
145 -}
146
147 data CLabel
148 = -- | A label related to the definition of a particular Id or Con in a .hs file.
149 IdLabel
150 Name
151 CafInfo
152 IdLabelInfo -- encodes the suffix of the label
153
154 -- | A label from a .cmm file that is not associated with a .hs level Id.
155 | CmmLabel
156 PackageId -- what package the label belongs to.
157 FastString -- identifier giving the prefix of the label
158 CmmLabelInfo -- encodes the suffix of the label
159
160 -- | A label with a baked-in \/ algorithmically generated name that definitely
161 -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
162 -- If it doesn't have an algorithmically generated name then use a CmmLabel
163 -- instead and give it an appropriate PackageId argument.
164 | RtsLabel
165 RtsLabelInfo
166
167 -- | A 'C' (or otherwise foreign) label.
168 --
169 | ForeignLabel
170 FastString -- name of the imported label.
171
172 (Maybe Int) -- possible '@n' suffix for stdcall functions
173 -- When generating C, the '@n' suffix is omitted, but when
174 -- generating assembler we must add it to the label.
175
176 ForeignLabelSource -- what package the foreign label is in.
177
178 FunctionOrData
179
180 -- | A family of labels related to a particular case expression.
181 | CaseLabel
182 {-# UNPACK #-} !Unique -- Unique says which case expression
183 CaseLabelInfo
184
185 | AsmTempLabel
186 {-# UNPACK #-} !Unique
187
188 | StringLitLabel
189 {-# UNPACK #-} !Unique
190
191 | PlainModuleInitLabel -- without the version & way info
192 Module
193
194 | CC_Label CostCentre
195 | CCS_Label CostCentreStack
196
197
198 -- | These labels are generated and used inside the NCG only.
199 -- They are special variants of a label used for dynamic linking
200 -- see module PositionIndependentCode for details.
201 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
202
203 -- | This label is generated and used inside the NCG only.
204 -- It is used as a base for PIC calculations on some platforms.
205 -- It takes the form of a local numeric assembler label '1'; and
206 -- is pretty-printed as 1b, referring to the previous definition
207 -- of 1: in the assembler source file.
208 | PicBaseLabel
209
210 -- | A label before an info table to prevent excessive dead-stripping on darwin
211 | DeadStripPreventer CLabel
212
213
214 -- | Per-module table of tick locations
215 | HpcTicksLabel Module
216
217 -- | Static reference table
218 | SRTLabel !Unique
219
220 -- | Label of an StgLargeSRT
221 | LargeSRTLabel
222 {-# UNPACK #-} !Unique
223
224 -- | A bitmap (function or case return)
225 | LargeBitmapLabel
226 {-# UNPACK #-} !Unique
227
228 deriving (Eq, Ord)
229
230
231 -- | Record where a foreign label is stored.
232 data ForeignLabelSource
233
234 -- | Label is in a named package
235 = ForeignLabelInPackage PackageId
236
237 -- | Label is in some external, system package that doesn't also
238 -- contain compiled Haskell code, and is not associated with any .hi files.
239 -- We don't have to worry about Haskell code being inlined from
240 -- external packages. It is safe to treat the RTS package as "external".
241 | ForeignLabelInExternalPackage
242
243 -- | Label is in the package currenly being compiled.
244 -- This is only used for creating hacky tmp labels during code generation.
245 -- Don't use it in any code that might be inlined across a package boundary
246 -- (ie, core code) else the information will be wrong relative to the
247 -- destination module.
248 | ForeignLabelInThisPackage
249
250 deriving (Eq, Ord)
251
252
253 -- | For debugging problems with the CLabel representation.
254 -- We can't make a Show instance for CLabel because lots of its components don't have instances.
255 -- The regular Outputable instance only shows the label name, and not its other info.
256 --
257 pprDebugCLabel :: CLabel -> SDoc
258 pprDebugCLabel lbl
259 = case lbl of
260 IdLabel{} -> ppr lbl <> (parens $ text "IdLabel")
261 CmmLabel pkg _name _info
262 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
263
264 RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
265
266 ForeignLabel _name mSuffix src funOrData
267 -> ppr lbl <> (parens $ text "ForeignLabel"
268 <+> ppr mSuffix
269 <+> ppr src
270 <+> ppr funOrData)
271
272 _ -> ppr lbl <> (parens $ text "other CLabel)")
273
274
275 data IdLabelInfo
276 = Closure -- ^ Label for closure
277 | SRT -- ^ Static reference table (TODO: could be removed
278 -- with the old code generator, but might be needed
279 -- when we implement the New SRT Plan)
280 | InfoTable -- ^ Info tables for closures; always read-only
281 | Entry -- ^ Entry point
282 | Slow -- ^ Slow entry point
283
284 | LocalInfoTable -- ^ Like InfoTable but not externally visible
285 | LocalEntry -- ^ Like Entry but not externally visible
286
287 | RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
288
289 | ConEntry -- ^ Constructor entry point
290 | ConInfoTable -- ^ Corresponding info table
291 | StaticConEntry -- ^ Static constructor entry point
292 | StaticInfoTable -- ^ Corresponding info table
293
294 | ClosureTable -- ^ Table of closures for Enum tycons
295
296 deriving (Eq, Ord)
297
298
299 data CaseLabelInfo
300 = CaseReturnPt
301 | CaseReturnInfo
302 | CaseAlt ConTag
303 | CaseDefault
304 deriving (Eq, Ord)
305
306
307 data RtsLabelInfo
308 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- ^ Selector thunks
309 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
310
311 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
312 | RtsApEntry Bool{-updatable-} Int{-arity-}
313
314 | RtsPrimOp PrimOp
315 | RtsApFast FastString -- ^ _fast versions of generic apply
316 | RtsSlowTickyCtr String
317
318 deriving (Eq, Ord)
319 -- NOTE: Eq on LitString compares the pointer only, so this isn't
320 -- a real equality.
321
322
323 -- | What type of Cmm label we're dealing with.
324 -- Determines the suffix appended to the name when a CLabel.CmmLabel
325 -- is pretty printed.
326 data CmmLabelInfo
327 = CmmInfo -- ^ misc rts info tabless, suffix _info
328 | CmmEntry -- ^ misc rts entry points, suffix _entry
329 | CmmRetInfo -- ^ misc rts ret info tables, suffix _info
330 | CmmRet -- ^ misc rts return points, suffix _ret
331 | CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
332 | CmmCode -- ^ misc rts code
333 | CmmClosure -- ^ closures eg CHARLIKE_closure
334 | CmmPrimCall -- ^ a prim call to some hand written Cmm code
335 deriving (Eq, Ord)
336
337 data DynamicLinkerLabelInfo
338 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
339 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
340 | GotSymbolPtr -- ELF: foo@got
341 | GotSymbolOffset -- ELF: foo@gotoff
342
343 deriving (Eq, Ord)
344
345
346 -- -----------------------------------------------------------------------------
347 -- Constructing CLabels
348 -- -----------------------------------------------------------------------------
349
350 -- Constructing IdLabels
351 -- These are always local:
352 mkSlowEntryLabel :: Name -> CafInfo -> CLabel
353 mkSlowEntryLabel name c = IdLabel name c Slow
354
355 mkTopSRTLabel :: Unique -> CLabel
356 mkTopSRTLabel u = SRTLabel u
357
358 mkSRTLabel :: Name -> CafInfo -> CLabel
359 mkRednCountsLabel :: Name -> CafInfo -> CLabel
360 mkSRTLabel name c = IdLabel name c SRT
361 mkRednCountsLabel name c = IdLabel name c RednCounts
362
363 -- These have local & (possibly) external variants:
364 mkLocalClosureLabel :: Name -> CafInfo -> CLabel
365 mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
366 mkLocalEntryLabel :: Name -> CafInfo -> CLabel
367 mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
368 mkLocalClosureLabel name c = IdLabel name c Closure
369 mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
370 mkLocalEntryLabel name c = IdLabel name c LocalEntry
371 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
372
373 mkClosureLabel :: Name -> CafInfo -> CLabel
374 mkInfoTableLabel :: Name -> CafInfo -> CLabel
375 mkEntryLabel :: Name -> CafInfo -> CLabel
376 mkClosureTableLabel :: Name -> CafInfo -> CLabel
377 mkLocalConInfoTableLabel :: CafInfo -> Name -> CLabel
378 mkLocalConEntryLabel :: CafInfo -> Name -> CLabel
379 mkLocalStaticInfoTableLabel :: CafInfo -> Name -> CLabel
380 mkLocalStaticConEntryLabel :: CafInfo -> Name -> CLabel
381 mkConInfoTableLabel :: Name -> CafInfo -> CLabel
382 mkStaticInfoTableLabel :: Name -> CafInfo -> CLabel
383 mkClosureLabel name c = IdLabel name c Closure
384 mkInfoTableLabel name c = IdLabel name c InfoTable
385 mkEntryLabel name c = IdLabel name c Entry
386 mkClosureTableLabel name c = IdLabel name c ClosureTable
387 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
388 mkLocalConEntryLabel c con = IdLabel con c ConEntry
389 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
390 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
391 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
392 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
393
394 mkConEntryLabel :: Name -> CafInfo -> CLabel
395 mkStaticConEntryLabel :: Name -> CafInfo -> CLabel
396 mkConEntryLabel name c = IdLabel name c ConEntry
397 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
398
399 -- Constructing Cmm Labels
400 mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, mkUpdInfoLabel,
401 mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
402 mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
403 mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
404 mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel :: CLabel
405 mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode
406 mkDirty_MUT_VAR_Label = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR") CmmCode
407 mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo
408 mkBHUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" ) CmmInfo
409 mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo
410 mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData
411 mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
412 mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
413 mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
414 mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
415 mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
416 mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmEntry
417
418 -----
419 mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
420 mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
421 :: PackageId -> FastString -> CLabel
422
423 mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
424 mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
425 mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo
426 mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet
427 mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode
428 mkCmmDataLabel pkg str = CmmLabel pkg str CmmData
429 mkCmmClosureLabel pkg str = CmmLabel pkg str CmmClosure
430
431
432 -- Constructing RtsLabels
433 mkRtsPrimOpLabel :: PrimOp -> CLabel
434 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
435
436 mkSelectorInfoLabel :: Bool -> Int -> CLabel
437 mkSelectorEntryLabel :: Bool -> Int -> CLabel
438 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
439 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
440
441 mkApInfoTableLabel :: Bool -> Int -> CLabel
442 mkApEntryLabel :: Bool -> Int -> CLabel
443 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
444 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
445
446
447 -- A call to some primitive hand written Cmm code
448 mkPrimCallLabel :: PrimCall -> CLabel
449 mkPrimCallLabel (PrimCall str pkg)
450 = CmmLabel pkg str CmmPrimCall
451
452
453 -- Constructing ForeignLabels
454
455 -- | Make a foreign label
456 mkForeignLabel
457 :: FastString -- name
458 -> Maybe Int -- size prefix
459 -> ForeignLabelSource -- what package it's in
460 -> FunctionOrData
461 -> CLabel
462
463 mkForeignLabel str mb_sz src fod
464 = ForeignLabel str mb_sz src fod
465
466
467 -- | Update the label size field in a ForeignLabel
468 addLabelSize :: CLabel -> Int -> CLabel
469 addLabelSize (ForeignLabel str _ src fod) sz
470 = ForeignLabel str (Just sz) src fod
471 addLabelSize label _
472 = label
473
474 -- | Get the label size field from a ForeignLabel
475 foreignLabelStdcallInfo :: CLabel -> Maybe Int
476 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
477 foreignLabelStdcallInfo _lbl = Nothing
478
479
480 -- Constructing Large*Labels
481 mkLargeSRTLabel :: Unique -> CLabel
482 mkBitmapLabel :: Unique -> CLabel
483 mkLargeSRTLabel uniq = LargeSRTLabel uniq
484 mkBitmapLabel uniq = LargeBitmapLabel uniq
485
486
487 -- Constructin CaseLabels
488 mkReturnPtLabel :: Unique -> CLabel
489 mkReturnInfoLabel :: Unique -> CLabel
490 mkAltLabel :: Unique -> ConTag -> CLabel
491 mkDefaultLabel :: Unique -> CLabel
492 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
493 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
494 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
495 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
496
497 -- Constructing Cost Center Labels
498 mkCCLabel :: CostCentre -> CLabel
499 mkCCSLabel :: CostCentreStack -> CLabel
500 mkCCLabel cc = CC_Label cc
501 mkCCSLabel ccs = CCS_Label ccs
502
503 mkRtsApFastLabel :: FastString -> CLabel
504 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
505
506 mkRtsSlowTickyCtrLabel :: String -> CLabel
507 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
508
509
510 -- Constructing Code Coverage Labels
511 mkHpcTicksLabel :: Module -> CLabel
512 mkHpcTicksLabel = HpcTicksLabel
513
514
515 -- Constructing labels used for dynamic linking
516 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
517 mkDynamicLinkerLabel = DynamicLinkerLabel
518
519 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
520 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
521 dynamicLinkerLabelInfo _ = Nothing
522
523 mkPicBaseLabel :: CLabel
524 mkPicBaseLabel = PicBaseLabel
525
526
527 -- Constructing miscellaneous other labels
528 mkDeadStripPreventer :: CLabel -> CLabel
529 mkDeadStripPreventer lbl = DeadStripPreventer lbl
530
531 mkStringLitLabel :: Unique -> CLabel
532 mkStringLitLabel = StringLitLabel
533
534 mkAsmTempLabel :: Uniquable a => a -> CLabel
535 mkAsmTempLabel a = AsmTempLabel (getUnique a)
536
537 mkPlainModuleInitLabel :: Module -> CLabel
538 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
539
540 -- -----------------------------------------------------------------------------
541 -- Convert between different kinds of label
542
543 toClosureLbl :: CLabel -> CLabel
544 toClosureLbl (IdLabel n c _) = IdLabel n c Closure
545 toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
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 _ _ CmmClosure) = 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 (gopt 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 (gopt 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 (gopt 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 (gopt 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 CmmPrimCall) = ftext str
1005
1006 pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> ptext (sLit "_fast")
1007
1008 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
1009 = hcat [ptext (sLit "stg_sel_"), text (show offset),
1010 ptext (if upd_reqd
1011 then (sLit "_upd_info")
1012 else (sLit "_noupd_info"))
1013 ]
1014
1015 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
1016 = hcat [ptext (sLit "stg_sel_"), text (show offset),
1017 ptext (if upd_reqd
1018 then (sLit "_upd_entry")
1019 else (sLit "_noupd_entry"))
1020 ]
1021
1022 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
1023 = hcat [ptext (sLit "stg_ap_"), text (show arity),
1024 ptext (if upd_reqd
1025 then (sLit "_upd_info")
1026 else (sLit "_noupd_info"))
1027 ]
1028
1029 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
1030 = hcat [ptext (sLit "stg_ap_"), text (show arity),
1031 ptext (if upd_reqd
1032 then (sLit "_upd_entry")
1033 else (sLit "_noupd_entry"))
1034 ]
1035
1036 pprCLbl (CmmLabel _ fs CmmInfo)
1037 = ftext fs <> ptext (sLit "_info")
1038
1039 pprCLbl (CmmLabel _ fs CmmEntry)
1040 = ftext fs <> ptext (sLit "_entry")
1041
1042 pprCLbl (CmmLabel _ fs CmmRetInfo)
1043 = ftext fs <> ptext (sLit "_info")
1044
1045 pprCLbl (CmmLabel _ fs CmmRet)
1046 = ftext fs <> ptext (sLit "_ret")
1047
1048 pprCLbl (CmmLabel _ fs CmmClosure)
1049 = ftext fs <> ptext (sLit "_closure")
1050
1051 pprCLbl (RtsLabel (RtsPrimOp primop))
1052 = ptext (sLit "stg_") <> ppr primop
1053
1054 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
1055 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
1056
1057 pprCLbl (ForeignLabel str _ _ _)
1058 = ftext str
1059
1060 pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
1061
1062 pprCLbl (CC_Label cc) = ppr cc
1063 pprCLbl (CCS_Label ccs) = ppr ccs
1064
1065 pprCLbl (PlainModuleInitLabel mod)
1066 = ptext (sLit "__stginit_") <> ppr mod
1067
1068 pprCLbl (HpcTicksLabel mod)
1069 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
1070
1071 pprCLbl (AsmTempLabel {}) = panic "pprCLbl AsmTempLabel"
1072 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
1073 pprCLbl (PicBaseLabel {}) = panic "pprCLbl PicBaseLabel"
1074 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
1075
1076 ppIdFlavor :: IdLabelInfo -> SDoc
1077 ppIdFlavor x = pp_cSEP <>
1078 (case x of
1079 Closure -> ptext (sLit "closure")
1080 SRT -> ptext (sLit "srt")
1081 InfoTable -> ptext (sLit "info")
1082 LocalInfoTable -> ptext (sLit "info")
1083 Entry -> ptext (sLit "entry")
1084 LocalEntry -> ptext (sLit "entry")
1085 Slow -> ptext (sLit "slow")
1086 RednCounts -> ptext (sLit "ct")
1087 ConEntry -> ptext (sLit "con_entry")
1088 ConInfoTable -> ptext (sLit "con_info")
1089 StaticConEntry -> ptext (sLit "static_entry")
1090 StaticInfoTable -> ptext (sLit "static_info")
1091 ClosureTable -> ptext (sLit "closure_tbl")
1092 )
1093
1094
1095 pp_cSEP :: SDoc
1096 pp_cSEP = char '_'
1097
1098
1099 instance Outputable ForeignLabelSource where
1100 ppr fs
1101 = case fs of
1102 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
1103 ForeignLabelInThisPackage -> parens $ text "this package"
1104 ForeignLabelInExternalPackage -> parens $ text "external package"
1105
1106 -- -----------------------------------------------------------------------------
1107 -- Machine-dependent knowledge about labels.
1108
1109 underscorePrefix :: Bool -- leading underscore on assembler labels?
1110 underscorePrefix = (cLeadingUnderscore == "YES")
1111
1112 asmTempLabelPrefix :: Platform -> LitString -- for formatting labels
1113 asmTempLabelPrefix platform =
1114 if platformOS platform == OSDarwin
1115 then sLit "L"
1116 else sLit ".L"
1117
1118 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
1119 pprDynamicLinkerAsmLabel platform dllInfo lbl
1120 = if platformOS platform == OSDarwin
1121 then if platformArch platform == ArchX86_64
1122 then case dllInfo of
1123 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1124 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1125 GotSymbolPtr -> ppr lbl <> text "@GOTPCREL"
1126 GotSymbolOffset -> ppr lbl
1127 else case dllInfo of
1128 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1129 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1130 _ -> panic "pprDynamicLinkerAsmLabel"
1131
1132 else if osElfTarget (platformOS platform)
1133 then if platformArch platform == ArchPPC
1134 then case dllInfo of
1135 CodeStub -> ppr lbl <> text "@plt"
1136 SymbolPtr -> text ".LC_" <> ppr lbl
1137 _ -> panic "pprDynamicLinkerAsmLabel"
1138 else if platformArch platform == ArchX86_64
1139 then case dllInfo of
1140 CodeStub -> ppr lbl <> text "@plt"
1141 GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
1142 GotSymbolOffset -> ppr lbl
1143 SymbolPtr -> text ".LC_" <> ppr lbl
1144 else case dllInfo of
1145 CodeStub -> ppr lbl <> text "@plt"
1146 SymbolPtr -> text ".LC_" <> ppr lbl
1147 GotSymbolPtr -> ppr lbl <> text "@got"
1148 GotSymbolOffset -> ppr lbl <> text "@gotoff"
1149 else if platformOS platform == OSMinGW32
1150 then case dllInfo of
1151 SymbolPtr -> text "__imp_" <> ppr lbl
1152 _ -> panic "pprDynamicLinkerAsmLabel"
1153 else panic "pprDynamicLinkerAsmLabel"
1154