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