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