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