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