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