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