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