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