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