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