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