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