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