Cmm: Add missing cases for BlockInfoTable
[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 mkTopSRTLabel,
18 mkInfoTableLabel,
19 mkEntryLabel,
20 mkRednCountsLabel,
21 mkConInfoTableLabel,
22 mkLargeSRTLabel,
23 mkApEntryLabel,
24 mkApInfoTableLabel,
25 mkClosureTableLabel,
26 mkBytesLabel,
27
28 mkLocalBlockLabel,
29 mkLocalClosureLabel,
30 mkLocalInfoTableLabel,
31 mkLocalClosureTableLabel,
32
33 mkBlockInfoTableLabel,
34
35 mkBitmapLabel,
36 mkStringLitLabel,
37
38 mkAsmTempLabel,
39 mkAsmTempDerivedLabel,
40 mkAsmTempEndLabel,
41 mkAsmTempDieLabel,
42
43 mkSplitMarkerLabel,
44 mkDirty_MUT_VAR_Label,
45 mkUpdInfoLabel,
46 mkBHUpdInfoLabel,
47 mkIndStaticInfoLabel,
48 mkMainCapabilityLabel,
49 mkMAP_FROZEN_infoLabel,
50 mkMAP_FROZEN0_infoLabel,
51 mkMAP_DIRTY_infoLabel,
52 mkSMAP_FROZEN_infoLabel,
53 mkSMAP_FROZEN0_infoLabel,
54 mkSMAP_DIRTY_infoLabel,
55 mkBadAlignmentLabel,
56 mkArrWords_infoLabel,
57
58 mkTopTickyCtrLabel,
59 mkCAFBlackHoleInfoTableLabel,
60 mkRtsPrimOpLabel,
61 mkRtsSlowFastTickyCtrLabel,
62
63 mkSelectorInfoLabel,
64 mkSelectorEntryLabel,
65
66 mkCmmInfoLabel,
67 mkCmmEntryLabel,
68 mkCmmRetInfoLabel,
69 mkCmmRetLabel,
70 mkCmmCodeLabel,
71 mkCmmDataLabel,
72 mkCmmClosureLabel,
73
74 mkRtsApFastLabel,
75
76 mkPrimCallLabel,
77
78 mkForeignLabel,
79 addLabelSize,
80
81 foreignLabelStdcallInfo,
82 isBytesLabel,
83 isForeignLabel,
84 isSomeRODataLabel,
85 isStaticClosureLabel,
86 mkCCLabel, mkCCSLabel,
87
88 DynamicLinkerLabelInfo(..),
89 mkDynamicLinkerLabel,
90 dynamicLinkerLabelInfo,
91
92 mkPicBaseLabel,
93 mkDeadStripPreventer,
94
95 mkHpcTicksLabel,
96
97 hasCAF,
98 needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel,
99 isMathFun,
100 isCFunctionLabel, isGcPtrLabel, labelDynamic,
101
102 -- * Conversions
103 toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
104
105 pprCLabel
106 ) where
107
108 #include "HsVersions.h"
109
110 import GhcPrelude
111
112 import IdInfo
113 import BasicTypes
114 import {-# SOURCE #-} BlockId (BlockId, mkBlockId)
115 import Packages
116 import Module
117 import Name
118 import Unique
119 import PrimOp
120 import Config
121 import CostCentre
122 import Outputable
123 import FastString
124 import DynFlags
125 import Platform
126 import UniqSet
127 import Util
128 import PprCore ( {- instances -} )
129
130 -- -----------------------------------------------------------------------------
131 -- The CLabel type
132
133 {-
134 | CLabel is an abstract type that supports the following operations:
135
136 - Pretty printing
137
138 - In a C file, does it need to be declared before use? (i.e. is it
139 guaranteed to be already in scope in the places we need to refer to it?)
140
141 - If it needs to be declared, what type (code or data) should it be
142 declared to have?
143
144 - Is it visible outside this object file or not?
145
146 - Is it "dynamic" (see details below)
147
148 - Eq and Ord, so that we can make sets of CLabels (currently only
149 used in outputting C as far as I can tell, to avoid generating
150 more than one declaration for any given label).
151
152 - Converting an info table label into an entry label.
153 -}
154
155 data CLabel
156 = -- | A label related to the definition of a particular Id or Con in a .hs file.
157 IdLabel
158 Name
159 CafInfo
160 IdLabelInfo -- encodes the suffix of the label
161
162 -- | A label from a .cmm file that is not associated with a .hs level Id.
163 | CmmLabel
164 UnitId -- what package the label belongs to.
165 FastString -- identifier giving the prefix of the label
166 CmmLabelInfo -- encodes the suffix of the label
167
168 -- | A label with a baked-in \/ algorithmically generated name that definitely
169 -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
170 -- If it doesn't have an algorithmically generated name then use a CmmLabel
171 -- instead and give it an appropriate UnitId argument.
172 | RtsLabel
173 RtsLabelInfo
174
175 -- | A label associated with a block. These aren't visible outside of the
176 -- compilation unit in which they are defined. These are generally used to
177 -- name blocks produced by Cmm-to-Cmm passes and the native code generator,
178 -- where we don't have a 'Name' to associate the label to and therefore can't
179 -- use 'IdLabel'.
180 | LocalBlockLabel
181 {-# UNPACK #-} !Unique
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 -- | Local temporary label used for native (or LLVM) code generation
197 | AsmTempLabel
198 {-# UNPACK #-} !Unique
199
200 | AsmTempDerivedLabel
201 CLabel
202 FastString -- suffix
203
204 | StringLitLabel
205 {-# UNPACK #-} !Unique
206
207 | CC_Label CostCentre
208 | CCS_Label CostCentreStack
209
210
211 -- | These labels are generated and used inside the NCG only.
212 -- They are special variants of a label used for dynamic linking
213 -- see module PositionIndependentCode for details.
214 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
215
216 -- | This label is generated and used inside the NCG only.
217 -- It is used as a base for PIC calculations on some platforms.
218 -- It takes the form of a local numeric assembler label '1'; and
219 -- is pretty-printed as 1b, referring to the previous definition
220 -- of 1: in the assembler source file.
221 | PicBaseLabel
222
223 -- | A label before an info table to prevent excessive dead-stripping on darwin
224 | DeadStripPreventer CLabel
225
226
227 -- | Per-module table of tick locations
228 | HpcTicksLabel Module
229
230 -- | Static reference table
231 | SRTLabel !Unique
232
233 -- | Label of an StgLargeSRT
234 | LargeSRTLabel
235 {-# UNPACK #-} !Unique
236
237 -- | A bitmap (function or case return)
238 | LargeBitmapLabel
239 {-# UNPACK #-} !Unique
240
241 deriving Eq
242
243 -- This is laborious, but necessary. We can't derive Ord because
244 -- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
245 -- implementation. See Note [No Ord for Unique]
246 -- This is non-deterministic but we do not currently support deterministic
247 -- code-generation. See Note [Unique Determinism and code generation]
248 instance Ord CLabel where
249 compare (IdLabel a1 b1 c1) (IdLabel a2 b2 c2) =
250 compare a1 a2 `thenCmp`
251 compare b1 b2 `thenCmp`
252 compare c1 c2
253 compare (CmmLabel a1 b1 c1) (CmmLabel a2 b2 c2) =
254 compare a1 a2 `thenCmp`
255 compare b1 b2 `thenCmp`
256 compare c1 c2
257 compare (RtsLabel a1) (RtsLabel a2) = compare a1 a2
258 compare (LocalBlockLabel u1) (LocalBlockLabel u2) = nonDetCmpUnique u1 u2
259 compare (ForeignLabel a1 b1 c1 d1) (ForeignLabel a2 b2 c2 d2) =
260 compare a1 a2 `thenCmp`
261 compare b1 b2 `thenCmp`
262 compare c1 c2 `thenCmp`
263 compare d1 d2
264 compare (AsmTempLabel u1) (AsmTempLabel u2) = nonDetCmpUnique u1 u2
265 compare (AsmTempDerivedLabel a1 b1) (AsmTempDerivedLabel a2 b2) =
266 compare a1 a2 `thenCmp`
267 compare b1 b2
268 compare (StringLitLabel u1) (StringLitLabel u2) =
269 nonDetCmpUnique u1 u2
270 compare (CC_Label a1) (CC_Label a2) =
271 compare a1 a2
272 compare (CCS_Label a1) (CCS_Label a2) =
273 compare a1 a2
274 compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
275 compare a1 a2 `thenCmp`
276 compare b1 b2
277 compare PicBaseLabel PicBaseLabel = EQ
278 compare (DeadStripPreventer a1) (DeadStripPreventer a2) =
279 compare a1 a2
280 compare (HpcTicksLabel a1) (HpcTicksLabel a2) =
281 compare a1 a2
282 compare (SRTLabel u1) (SRTLabel u2) =
283 nonDetCmpUnique u1 u2
284 compare (LargeSRTLabel u1) (LargeSRTLabel u2) =
285 nonDetCmpUnique u1 u2
286 compare (LargeBitmapLabel u1) (LargeBitmapLabel u2) =
287 nonDetCmpUnique u1 u2
288 compare IdLabel{} _ = LT
289 compare _ IdLabel{} = GT
290 compare CmmLabel{} _ = LT
291 compare _ CmmLabel{} = GT
292 compare RtsLabel{} _ = LT
293 compare _ RtsLabel{} = GT
294 compare LocalBlockLabel{} _ = LT
295 compare _ LocalBlockLabel{} = GT
296 compare ForeignLabel{} _ = LT
297 compare _ ForeignLabel{} = GT
298 compare AsmTempLabel{} _ = LT
299 compare _ AsmTempLabel{} = GT
300 compare AsmTempDerivedLabel{} _ = LT
301 compare _ AsmTempDerivedLabel{} = GT
302 compare StringLitLabel{} _ = LT
303 compare _ StringLitLabel{} = GT
304 compare CC_Label{} _ = LT
305 compare _ CC_Label{} = GT
306 compare CCS_Label{} _ = LT
307 compare _ CCS_Label{} = GT
308 compare DynamicLinkerLabel{} _ = LT
309 compare _ DynamicLinkerLabel{} = GT
310 compare PicBaseLabel{} _ = LT
311 compare _ PicBaseLabel{} = GT
312 compare DeadStripPreventer{} _ = LT
313 compare _ DeadStripPreventer{} = GT
314 compare HpcTicksLabel{} _ = LT
315 compare _ HpcTicksLabel{} = GT
316 compare SRTLabel{} _ = LT
317 compare _ SRTLabel{} = GT
318 compare LargeSRTLabel{} _ = LT
319 compare _ LargeSRTLabel{} = GT
320
321 -- | Record where a foreign label is stored.
322 data ForeignLabelSource
323
324 -- | Label is in a named package
325 = ForeignLabelInPackage UnitId
326
327 -- | Label is in some external, system package that doesn't also
328 -- contain compiled Haskell code, and is not associated with any .hi files.
329 -- We don't have to worry about Haskell code being inlined from
330 -- external packages. It is safe to treat the RTS package as "external".
331 | ForeignLabelInExternalPackage
332
333 -- | Label is in the package currenly being compiled.
334 -- This is only used for creating hacky tmp labels during code generation.
335 -- Don't use it in any code that might be inlined across a package boundary
336 -- (ie, core code) else the information will be wrong relative to the
337 -- destination module.
338 | ForeignLabelInThisPackage
339
340 deriving (Eq, Ord)
341
342
343 -- | For debugging problems with the CLabel representation.
344 -- We can't make a Show instance for CLabel because lots of its components don't have instances.
345 -- The regular Outputable instance only shows the label name, and not its other info.
346 --
347 pprDebugCLabel :: CLabel -> SDoc
348 pprDebugCLabel lbl
349 = case lbl of
350 IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
351 <> whenPprDebug (text ":" <> text (show info)))
352 CmmLabel pkg _name _info
353 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
354
355 RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
356
357 ForeignLabel _name mSuffix src funOrData
358 -> ppr lbl <> (parens $ text "ForeignLabel"
359 <+> ppr mSuffix
360 <+> ppr src
361 <+> ppr funOrData)
362
363 _ -> ppr lbl <> (parens $ text "other CLabel")
364
365
366 data IdLabelInfo
367 = Closure -- ^ Label for closure
368 | SRT -- ^ Static reference table (TODO: could be removed
369 -- with the old code generator, but might be needed
370 -- when we implement the New SRT Plan)
371 | InfoTable -- ^ Info tables for closures; always read-only
372 | Entry -- ^ Entry point
373 | Slow -- ^ Slow entry point
374
375 | LocalInfoTable -- ^ Like InfoTable but not externally visible
376 | LocalEntry -- ^ Like Entry but not externally visible
377
378 | RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
379
380 | ConEntry -- ^ Constructor entry point
381 | ConInfoTable -- ^ Corresponding info table
382
383 | ClosureTable -- ^ Table of closures for Enum tycons
384
385 | Bytes -- ^ Content of a string literal. See
386 -- Note [Bytes label].
387 | BlockInfoTable -- ^ Like LocalInfoTable but for a proc-point block
388 -- instead of a closure entry-point.
389 -- See Note [Proc-point local block entry-point].
390
391 deriving (Eq, Ord, Show)
392
393
394 data RtsLabelInfo
395 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- ^ Selector thunks
396 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
397
398 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
399 | RtsApEntry Bool{-updatable-} Int{-arity-}
400
401 | RtsPrimOp PrimOp
402 | RtsApFast FastString -- ^ _fast versions of generic apply
403 | RtsSlowFastTickyCtr String
404
405 deriving (Eq, Ord)
406 -- NOTE: Eq on LitString compares the pointer only, so this isn't
407 -- a real equality.
408
409
410 -- | What type of Cmm label we're dealing with.
411 -- Determines the suffix appended to the name when a CLabel.CmmLabel
412 -- is pretty printed.
413 data CmmLabelInfo
414 = CmmInfo -- ^ misc rts info tables, suffix _info
415 | CmmEntry -- ^ misc rts entry points, suffix _entry
416 | CmmRetInfo -- ^ misc rts ret info tables, suffix _info
417 | CmmRet -- ^ misc rts return points, suffix _ret
418 | CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
419 | CmmCode -- ^ misc rts code
420 | CmmClosure -- ^ closures eg CHARLIKE_closure
421 | CmmPrimCall -- ^ a prim call to some hand written Cmm code
422 deriving (Eq, Ord)
423
424 data DynamicLinkerLabelInfo
425 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
426 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
427 | GotSymbolPtr -- ELF: foo@got
428 | GotSymbolOffset -- ELF: foo@gotoff
429
430 deriving (Eq, Ord)
431
432
433 -- -----------------------------------------------------------------------------
434 -- Constructing CLabels
435 -- -----------------------------------------------------------------------------
436
437 -- Constructing IdLabels
438 -- These are always local:
439
440 mkTopSRTLabel :: Unique -> CLabel
441 mkTopSRTLabel u = SRTLabel u
442
443 mkRednCountsLabel :: Name -> CLabel
444 mkRednCountsLabel name =
445 IdLabel name NoCafRefs RednCounts -- Note [ticky for LNE]
446
447 -- These have local & (possibly) external variants:
448 mkLocalClosureLabel :: Name -> CafInfo -> CLabel
449 mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
450 mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
451 mkLocalClosureLabel name c = IdLabel name c Closure
452 mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
453 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
454
455 mkClosureLabel :: Name -> CafInfo -> CLabel
456 mkInfoTableLabel :: Name -> CafInfo -> CLabel
457 mkEntryLabel :: Name -> CafInfo -> CLabel
458 mkClosureTableLabel :: Name -> CafInfo -> CLabel
459 mkConInfoTableLabel :: Name -> CafInfo -> CLabel
460 mkBytesLabel :: Name -> CLabel
461 mkClosureLabel name c = IdLabel name c Closure
462 mkInfoTableLabel name c = IdLabel name c InfoTable
463 mkEntryLabel name c = IdLabel name c Entry
464 mkClosureTableLabel name c = IdLabel name c ClosureTable
465 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
466 mkBytesLabel name = IdLabel name NoCafRefs Bytes
467
468 mkBlockInfoTableLabel :: Name -> CafInfo -> CLabel
469 mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable
470 -- See Note [Proc-point local block entry-point].
471
472 -- Constructing Cmm Labels
473 mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
474 mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
475 mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
476 mkArrWords_infoLabel,
477 mkTopTickyCtrLabel,
478 mkCAFBlackHoleInfoTableLabel,
479 mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
480 mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
481 mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
482 mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode
483 mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo
484 mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo
485 mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo
486 mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") CmmData
487 mkMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
488 mkMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
489 mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
490 mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData
491 mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
492 mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo
493 mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
494 mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
495 mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
496 mkBadAlignmentLabel = CmmLabel rtsUnitId (fsLit "stg_badAlignment") CmmEntry
497
498 -----
499 mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
500 mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
501 :: UnitId -> FastString -> CLabel
502
503 mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
504 mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
505 mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo
506 mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet
507 mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode
508 mkCmmDataLabel pkg str = CmmLabel pkg str CmmData
509 mkCmmClosureLabel pkg str = CmmLabel pkg str CmmClosure
510
511 mkLocalBlockLabel :: Unique -> CLabel
512 mkLocalBlockLabel u = LocalBlockLabel u
513
514 -- Constructing RtsLabels
515 mkRtsPrimOpLabel :: PrimOp -> CLabel
516 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
517
518 mkSelectorInfoLabel :: Bool -> Int -> CLabel
519 mkSelectorEntryLabel :: Bool -> Int -> CLabel
520 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
521 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
522
523 mkApInfoTableLabel :: Bool -> Int -> CLabel
524 mkApEntryLabel :: Bool -> Int -> CLabel
525 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
526 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
527
528
529 -- A call to some primitive hand written Cmm code
530 mkPrimCallLabel :: PrimCall -> CLabel
531 mkPrimCallLabel (PrimCall str pkg)
532 = CmmLabel pkg str CmmPrimCall
533
534
535 -- Constructing ForeignLabels
536
537 -- | Make a foreign label
538 mkForeignLabel
539 :: FastString -- name
540 -> Maybe Int -- size prefix
541 -> ForeignLabelSource -- what package it's in
542 -> FunctionOrData
543 -> CLabel
544
545 mkForeignLabel str mb_sz src fod
546 = ForeignLabel str mb_sz src fod
547
548
549 -- | Update the label size field in a ForeignLabel
550 addLabelSize :: CLabel -> Int -> CLabel
551 addLabelSize (ForeignLabel str _ src fod) sz
552 = ForeignLabel str (Just sz) src fod
553 addLabelSize label _
554 = label
555
556 -- | Whether label is a top-level string literal
557 isBytesLabel :: CLabel -> Bool
558 isBytesLabel (IdLabel _ _ Bytes) = True
559 isBytesLabel _lbl = False
560
561 -- | Whether label is a non-haskell label (defined in C code)
562 isForeignLabel :: CLabel -> Bool
563 isForeignLabel (ForeignLabel _ _ _ _) = True
564 isForeignLabel _lbl = False
565
566 -- | Whether label is a static closure label (can come from haskell or cmm)
567 isStaticClosureLabel :: CLabel -> Bool
568 -- Closure defined in haskell (.hs)
569 isStaticClosureLabel (IdLabel _ _ Closure) = True
570 -- Closure defined in cmm
571 isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True
572 isStaticClosureLabel _lbl = False
573
574 -- | Whether label is a .rodata label
575 isSomeRODataLabel :: CLabel -> Bool
576 -- info table defined in haskell (.hs)
577 isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
578 isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True
579 isSomeRODataLabel (IdLabel _ _ InfoTable) = True
580 isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
581 isSomeRODataLabel (IdLabel _ _ BlockInfoTable) = True
582 -- static reference tables defined in haskell (.hs)
583 isSomeRODataLabel (IdLabel _ _ SRT) = True
584 isSomeRODataLabel (SRTLabel _) = True
585 -- info table defined in cmm (.cmm)
586 isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
587 isSomeRODataLabel _lbl = False
588
589 -- | Get the label size field from a ForeignLabel
590 foreignLabelStdcallInfo :: CLabel -> Maybe Int
591 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
592 foreignLabelStdcallInfo _lbl = Nothing
593
594
595 -- Constructing Large*Labels
596 mkLargeSRTLabel :: Unique -> CLabel
597 mkBitmapLabel :: Unique -> CLabel
598 mkLargeSRTLabel uniq = LargeSRTLabel uniq
599 mkBitmapLabel uniq = LargeBitmapLabel uniq
600
601 -- Constructing Cost Center Labels
602 mkCCLabel :: CostCentre -> CLabel
603 mkCCSLabel :: CostCentreStack -> CLabel
604 mkCCLabel cc = CC_Label cc
605 mkCCSLabel ccs = CCS_Label ccs
606
607 mkRtsApFastLabel :: FastString -> CLabel
608 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
609
610 mkRtsSlowFastTickyCtrLabel :: String -> CLabel
611 mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
612
613
614 -- Constructing Code Coverage Labels
615 mkHpcTicksLabel :: Module -> CLabel
616 mkHpcTicksLabel = HpcTicksLabel
617
618
619 -- Constructing labels used for dynamic linking
620 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
621 mkDynamicLinkerLabel = DynamicLinkerLabel
622
623 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
624 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
625 dynamicLinkerLabelInfo _ = Nothing
626
627 mkPicBaseLabel :: CLabel
628 mkPicBaseLabel = PicBaseLabel
629
630
631 -- Constructing miscellaneous other labels
632 mkDeadStripPreventer :: CLabel -> CLabel
633 mkDeadStripPreventer lbl = DeadStripPreventer lbl
634
635 mkStringLitLabel :: Unique -> CLabel
636 mkStringLitLabel = StringLitLabel
637
638 mkAsmTempLabel :: Uniquable a => a -> CLabel
639 mkAsmTempLabel a = AsmTempLabel (getUnique a)
640
641 mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
642 mkAsmTempDerivedLabel = AsmTempDerivedLabel
643
644 mkAsmTempEndLabel :: CLabel -> CLabel
645 mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
646
647 -- | Construct a label for a DWARF Debug Information Entity (DIE)
648 -- describing another symbol.
649 mkAsmTempDieLabel :: CLabel -> CLabel
650 mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
651
652 -- -----------------------------------------------------------------------------
653 -- Convert between different kinds of label
654
655 toClosureLbl :: CLabel -> CLabel
656 toClosureLbl (IdLabel n _ BlockInfoTable)
657 = pprPanic "toClosureLbl: BlockInfoTable" (ppr n)
658 toClosureLbl (IdLabel n c _) = IdLabel n c Closure
659 toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
660 toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
661
662 toSlowEntryLbl :: CLabel -> CLabel
663 toSlowEntryLbl (IdLabel n _ BlockInfoTable)
664 = pprPanic "toSlowEntryLbl" (ppr n)
665 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
666 toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
667
668 toEntryLbl :: CLabel -> CLabel
669 toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
670 toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
671 toEntryLbl (IdLabel n _ BlockInfoTable) = mkLocalBlockLabel (nameUnique n)
672 -- See Note [Proc-point local block entry-point].
673 toEntryLbl (IdLabel n c _) = IdLabel n c Entry
674 toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
675 toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
676 toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
677
678 toInfoLbl :: CLabel -> CLabel
679 toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
680 toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
681 toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable
682 toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
683 toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
684 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
685
686 hasHaskellName :: CLabel -> Maybe Name
687 hasHaskellName (IdLabel n _ _) = Just n
688 hasHaskellName _ = Nothing
689
690 -- -----------------------------------------------------------------------------
691 -- Does a CLabel's referent itself refer to a CAF?
692 hasCAF :: CLabel -> Bool
693 hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
694 hasCAF (IdLabel _ MayHaveCafRefs _) = True
695 hasCAF _ = False
696
697 -- Note [ticky for LNE]
698 -- ~~~~~~~~~~~~~~~~~~~~~
699
700 -- Until 14 Feb 2013, every ticky counter was associated with a
701 -- closure. Thus, ticky labels used IdLabel. It is odd that
702 -- CmmBuildInfoTables.cafTransfers would consider such a ticky label
703 -- reason to add the name to the CAFEnv (and thus eventually the SRT),
704 -- but it was harmless because the ticky was only used if the closure
705 -- was also.
706 --
707 -- Since we now have ticky counters for LNEs, it is no longer the case
708 -- that every ticky counter has an actual closure. So I changed the
709 -- generation of ticky counters' CLabels to not result in their
710 -- associated id ending up in the SRT.
711 --
712 -- NB IdLabel is still appropriate for ticky ids (as opposed to
713 -- CmmLabel) because the LNE's counter is still related to an .hs Id,
714 -- that Id just isn't for a proper closure.
715
716 -- -----------------------------------------------------------------------------
717 -- Does a CLabel need declaring before use or not?
718 --
719 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
720
721 needsCDecl :: CLabel -> Bool
722 -- False <=> it's pre-declared; don't bother
723 -- don't bother declaring Bitmap labels, we always make sure
724 -- they are defined before use.
725 needsCDecl (SRTLabel _) = True
726 needsCDecl (LargeSRTLabel _) = False
727 needsCDecl (LargeBitmapLabel _) = False
728 needsCDecl (IdLabel _ _ _) = True
729 needsCDecl (LocalBlockLabel _) = 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 block label then return just its 'BlockId', otherwise
753 -- 'Nothing'.
754 maybeLocalBlockLabel :: CLabel -> Maybe BlockId
755 maybeLocalBlockLabel (LocalBlockLabel uq) = Just $ mkBlockId uq
756 maybeLocalBlockLabel _ = 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 -- These functions are described in IEEE Std 754-2008 -
848 -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
849 (fsLit "nextup"), (fsLit "nextupf"), (fsLit "nextupl"),
850 (fsLit "nextdown"), (fsLit "nextdownf"), (fsLit "nextdownl")
851 ]
852
853 -- -----------------------------------------------------------------------------
854 -- | Is a CLabel visible outside this object file or not?
855 -- From the point of view of the code generator, a name is
856 -- externally visible if it has to be declared as exported
857 -- in the .o file's symbol table; that is, made non-static.
858 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
859 externallyVisibleCLabel (StringLitLabel _) = False
860 externallyVisibleCLabel (AsmTempLabel _) = False
861 externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
862 externallyVisibleCLabel (RtsLabel _) = True
863 externallyVisibleCLabel (LocalBlockLabel _) = False
864 externallyVisibleCLabel (CmmLabel _ _ _) = True
865 externallyVisibleCLabel (ForeignLabel{}) = True
866 externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
867 externallyVisibleCLabel (CC_Label _) = True
868 externallyVisibleCLabel (CCS_Label _) = True
869 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
870 externallyVisibleCLabel (HpcTicksLabel _) = True
871 externallyVisibleCLabel (LargeBitmapLabel _) = False
872 externallyVisibleCLabel (SRTLabel _) = False
873 externallyVisibleCLabel (LargeSRTLabel _) = False
874 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
875 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
876
877 externallyVisibleIdLabel :: IdLabelInfo -> Bool
878 externallyVisibleIdLabel SRT = False
879 externallyVisibleIdLabel LocalInfoTable = False
880 externallyVisibleIdLabel LocalEntry = False
881 externallyVisibleIdLabel BlockInfoTable = False
882 externallyVisibleIdLabel _ = True
883
884 -- -----------------------------------------------------------------------------
885 -- Finding the "type" of a CLabel
886
887 -- For generating correct types in label declarations:
888
889 data CLabelType
890 = CodeLabel -- Address of some executable instructions
891 | DataLabel -- Address of data, not a GC ptr
892 | GcPtrLabel -- Address of a (presumably static) GC object
893
894 isCFunctionLabel :: CLabel -> Bool
895 isCFunctionLabel lbl = case labelType lbl of
896 CodeLabel -> True
897 _other -> False
898
899 isGcPtrLabel :: CLabel -> Bool
900 isGcPtrLabel lbl = case labelType lbl of
901 GcPtrLabel -> True
902 _other -> False
903
904
905 -- | Work out the general type of data at the address of this label
906 -- whether it be code, data, or static GC object.
907 labelType :: CLabel -> CLabelType
908 labelType (IdLabel _ _ info) = idInfoLabelType info
909 labelType (CmmLabel _ _ CmmData) = DataLabel
910 labelType (CmmLabel _ _ CmmClosure) = GcPtrLabel
911 labelType (CmmLabel _ _ CmmCode) = CodeLabel
912 labelType (CmmLabel _ _ CmmInfo) = DataLabel
913 labelType (CmmLabel _ _ CmmEntry) = CodeLabel
914 labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel
915 labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
916 labelType (CmmLabel _ _ CmmRet) = CodeLabel
917 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
918 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
919 labelType (RtsLabel (RtsApFast _)) = CodeLabel
920 labelType (RtsLabel _) = DataLabel
921 labelType (LocalBlockLabel _) = CodeLabel
922 labelType (SRTLabel _) = DataLabel
923 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
924 labelType (ForeignLabel _ _ _ IsData) = DataLabel
925 labelType (AsmTempLabel _) = panic "labelType(AsmTempLabel)"
926 labelType (AsmTempDerivedLabel _ _) = panic "labelType(AsmTempDerivedLabel)"
927 labelType (StringLitLabel _) = DataLabel
928 labelType (CC_Label _) = DataLabel
929 labelType (CCS_Label _) = DataLabel
930 labelType (DynamicLinkerLabel _ _) = DataLabel -- Is this right?
931 labelType PicBaseLabel = DataLabel
932 labelType (DeadStripPreventer _) = DataLabel
933 labelType (HpcTicksLabel _) = DataLabel
934 labelType (LargeSRTLabel _) = DataLabel
935 labelType (LargeBitmapLabel _) = DataLabel
936
937 idInfoLabelType :: IdLabelInfo -> CLabelType
938 idInfoLabelType info =
939 case info of
940 InfoTable -> DataLabel
941 LocalInfoTable -> DataLabel
942 BlockInfoTable -> DataLabel
943 Closure -> GcPtrLabel
944 ConInfoTable -> DataLabel
945 ClosureTable -> DataLabel
946 RednCounts -> DataLabel
947 Bytes -> DataLabel
948 _ -> CodeLabel
949
950
951 -- -----------------------------------------------------------------------------
952 -- Does a CLabel need dynamic linkage?
953
954 -- When referring to data in code, we need to know whether
955 -- that data resides in a DLL or not. [Win32 only.]
956 -- @labelDynamic@ returns @True@ if the label is located
957 -- in a DLL, be it a data reference or not.
958
959 labelDynamic :: DynFlags -> Module -> CLabel -> Bool
960 labelDynamic dflags this_mod lbl =
961 case lbl of
962 -- is the RTS in a DLL or not?
963 RtsLabel _ -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId)
964
965 IdLabel n _ _ -> isDllName dflags this_mod n
966
967 -- When compiling in the "dyn" way, each package is to be linked into
968 -- its own shared library.
969 CmmLabel pkg _ _
970 | os == OSMinGW32 ->
971 (WayDyn `elem` ways dflags) && (this_pkg /= pkg)
972 | otherwise ->
973 True
974
975 LocalBlockLabel _ -> False
976
977 ForeignLabel _ _ source _ ->
978 if os == OSMinGW32
979 then case source of
980 -- Foreign label is in some un-named foreign package (or DLL).
981 ForeignLabelInExternalPackage -> True
982
983 -- Foreign label is linked into the same package as the
984 -- source file currently being compiled.
985 ForeignLabelInThisPackage -> False
986
987 -- Foreign label is in some named package.
988 -- When compiling in the "dyn" way, each package is to be
989 -- linked into its own DLL.
990 ForeignLabelInPackage pkgId ->
991 (WayDyn `elem` ways dflags) && (this_pkg /= pkgId)
992
993 else -- On Mac OS X and on ELF platforms, false positives are OK,
994 -- so we claim that all foreign imports come from dynamic
995 -- libraries
996 True
997
998 HpcTicksLabel m -> (WayDyn `elem` ways dflags) && this_mod /= m
999
1000 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
1001 _ -> False
1002 where
1003 os = platformOS (targetPlatform dflags)
1004 this_pkg = moduleUnitId this_mod
1005
1006
1007 -----------------------------------------------------------------------------
1008 -- Printing out CLabels.
1009
1010 {-
1011 Convention:
1012
1013 <name>_<type>
1014
1015 where <name> is <Module>_<name> for external names and <unique> for
1016 internal names. <type> is one of the following:
1017
1018 info Info table
1019 srt Static reference table
1020 srtd Static reference table descriptor
1021 entry Entry code (function, closure)
1022 slow Slow entry code (if any)
1023 ret Direct return address
1024 vtbl Vector table
1025 <n>_alt Case alternative (tag n)
1026 dflt Default case alternative
1027 btm Large bitmap vector
1028 closure Static closure
1029 con_entry Dynamic Constructor entry code
1030 con_info Dynamic Constructor info table
1031 static_entry Static Constructor entry code
1032 static_info Static Constructor info table
1033 sel_info Selector info table
1034 sel_entry Selector entry code
1035 cc Cost centre
1036 ccs Cost centre stack
1037
1038 Many of these distinctions are only for documentation reasons. For
1039 example, _ret is only distinguished from _entry to make it easy to
1040 tell whether a code fragment is a return point or a closure/function
1041 entry.
1042
1043 Note [Closure and info labels]
1044 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1045 For a function 'foo, we have:
1046 foo_info : Points to the info table describing foo's closure
1047 (and entry code for foo with tables next to code)
1048 foo_closure : Static (no-free-var) closure only:
1049 points to the statically-allocated closure
1050
1051 For a data constructor (such as Just or Nothing), we have:
1052 Just_con_info: Info table for the data constructor itself
1053 the first word of a heap-allocated Just
1054 Just_info: Info table for the *worker function*, an
1055 ordinary Haskell function of arity 1 that
1056 allocates a (Just x) box:
1057 Just = \x -> Just x
1058 Just_closure: The closure for this worker
1059
1060 Nothing_closure: a statically allocated closure for Nothing
1061 Nothing_static_info: info table for Nothing_closure
1062
1063 All these must be exported symbol, EXCEPT Just_info. We don't need to
1064 export this because in other modules we either have
1065 * A reference to 'Just'; use Just_closure
1066 * A saturated call 'Just x'; allocate using Just_con_info
1067 Not exporting these Just_info labels reduces the number of symbols
1068 somewhat.
1069
1070 Note [Bytes label]
1071 ~~~~~~~~~~~~~~~~~~
1072 For a top-level string literal 'foo', we have just one symbol 'foo_bytes', which
1073 points to a static data block containing the content of the literal.
1074
1075 Note [Proc-point local block entry-points]
1076 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1077 A label for a proc-point local block entry-point has no "_entry" suffix. With
1078 `infoTblLbl` we derive an info table label from a proc-point block ID. If
1079 we convert such an info table label into an entry label we must produce
1080 the label without an "_entry" suffix. So an info table label records
1081 the fact that it was derived from a block ID in `IdLabelInfo` as
1082 `BlockInfoTable`.
1083
1084 The info table label and the local block label are both local labels
1085 and are not externally visible.
1086 -}
1087
1088 instance Outputable CLabel where
1089 ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
1090
1091 pprCLabel :: Platform -> CLabel -> SDoc
1092
1093 pprCLabel platform (LocalBlockLabel u)
1094 = getPprStyle $ \ sty ->
1095 if asmStyle sty then
1096 ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
1097 else
1098 char '_' <> pprUniqueAlways u
1099
1100 pprCLabel platform (AsmTempLabel u)
1101 | not (platformUnregisterised platform)
1102 = getPprStyle $ \ sty ->
1103 if asmStyle sty then
1104 ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
1105 else
1106 char '_' <> pprUniqueAlways u
1107
1108 pprCLabel platform (AsmTempDerivedLabel l suf)
1109 | cGhcWithNativeCodeGen == "YES"
1110 = ptext (asmTempLabelPrefix platform)
1111 <> case l of AsmTempLabel u -> pprUniqueAlways u
1112 LocalBlockLabel u -> pprUniqueAlways u
1113 _other -> pprCLabel platform l
1114 <> ftext suf
1115
1116 pprCLabel platform (DynamicLinkerLabel info lbl)
1117 | cGhcWithNativeCodeGen == "YES"
1118 = pprDynamicLinkerAsmLabel platform info lbl
1119
1120 pprCLabel _ PicBaseLabel
1121 | cGhcWithNativeCodeGen == "YES"
1122 = text "1b"
1123
1124 pprCLabel platform (DeadStripPreventer lbl)
1125 | cGhcWithNativeCodeGen == "YES"
1126 = pprCLabel platform lbl <> text "_dsp"
1127
1128 pprCLabel _ (StringLitLabel u)
1129 | cGhcWithNativeCodeGen == "YES"
1130 = pprUniqueAlways u <> ptext (sLit "_str")
1131
1132 pprCLabel platform lbl
1133 = getPprStyle $ \ sty ->
1134 if cGhcWithNativeCodeGen == "YES" && asmStyle sty
1135 then maybe_underscore (pprAsmCLbl platform lbl)
1136 else pprCLbl lbl
1137
1138 maybe_underscore :: SDoc -> SDoc
1139 maybe_underscore doc
1140 | underscorePrefix = pp_cSEP <> doc
1141 | otherwise = doc
1142
1143 pprAsmCLbl :: Platform -> CLabel -> SDoc
1144 pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
1145 | platformOS platform == OSMinGW32
1146 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
1147 -- (The C compiler does this itself).
1148 = ftext fs <> char '@' <> int sz
1149 pprAsmCLbl _ lbl
1150 = pprCLbl lbl
1151
1152 pprCLbl :: CLabel -> SDoc
1153 pprCLbl (StringLitLabel u)
1154 = pprUniqueAlways u <> text "_str"
1155
1156 pprCLbl (SRTLabel u)
1157 = pprUniqueAlways u <> pp_cSEP <> text "srt"
1158
1159 pprCLbl (LargeSRTLabel u) = pprUniqueAlways u <> pp_cSEP <> text "srtd"
1160 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUniqueAlways u <> pp_cSEP <> text "btm"
1161 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
1162 -- until that gets resolved we'll just force them to start
1163 -- with a letter so the label will be legal assmbly code.
1164
1165
1166 pprCLbl (CmmLabel _ str CmmCode) = ftext str
1167 pprCLbl (CmmLabel _ str CmmData) = ftext str
1168 pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
1169
1170 pprCLbl (LocalBlockLabel u) = text "blk_" <> pprUniqueAlways u
1171
1172 pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> text "_fast"
1173
1174 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
1175 = sdocWithDynFlags $ \dflags ->
1176 ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
1177 hcat [text "stg_sel_", text (show offset),
1178 ptext (if upd_reqd
1179 then (sLit "_upd_info")
1180 else (sLit "_noupd_info"))
1181 ]
1182
1183 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
1184 = sdocWithDynFlags $ \dflags ->
1185 ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
1186 hcat [text "stg_sel_", text (show offset),
1187 ptext (if upd_reqd
1188 then (sLit "_upd_entry")
1189 else (sLit "_noupd_entry"))
1190 ]
1191
1192 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
1193 = sdocWithDynFlags $ \dflags ->
1194 ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
1195 hcat [text "stg_ap_", text (show arity),
1196 ptext (if upd_reqd
1197 then (sLit "_upd_info")
1198 else (sLit "_noupd_info"))
1199 ]
1200
1201 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
1202 = sdocWithDynFlags $ \dflags ->
1203 ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
1204 hcat [text "stg_ap_", text (show arity),
1205 ptext (if upd_reqd
1206 then (sLit "_upd_entry")
1207 else (sLit "_noupd_entry"))
1208 ]
1209
1210 pprCLbl (CmmLabel _ fs CmmInfo)
1211 = ftext fs <> text "_info"
1212
1213 pprCLbl (CmmLabel _ fs CmmEntry)
1214 = ftext fs <> text "_entry"
1215
1216 pprCLbl (CmmLabel _ fs CmmRetInfo)
1217 = ftext fs <> text "_info"
1218
1219 pprCLbl (CmmLabel _ fs CmmRet)
1220 = ftext fs <> text "_ret"
1221
1222 pprCLbl (CmmLabel _ fs CmmClosure)
1223 = ftext fs <> text "_closure"
1224
1225 pprCLbl (RtsLabel (RtsPrimOp primop))
1226 = text "stg_" <> ppr primop
1227
1228 pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
1229 = text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr")
1230
1231 pprCLbl (ForeignLabel str _ _ _)
1232 = ftext str
1233
1234 pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
1235
1236 pprCLbl (CC_Label cc) = ppr cc
1237 pprCLbl (CCS_Label ccs) = ppr ccs
1238
1239 pprCLbl (HpcTicksLabel mod)
1240 = text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc")
1241
1242 pprCLbl (AsmTempLabel {}) = panic "pprCLbl AsmTempLabel"
1243 pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
1244 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
1245 pprCLbl (PicBaseLabel {}) = panic "pprCLbl PicBaseLabel"
1246 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
1247
1248 ppIdFlavor :: IdLabelInfo -> SDoc
1249 ppIdFlavor x = pp_cSEP <>
1250 (case x of
1251 Closure -> text "closure"
1252 SRT -> text "srt"
1253 InfoTable -> text "info"
1254 LocalInfoTable -> text "info"
1255 Entry -> text "entry"
1256 LocalEntry -> text "entry"
1257 Slow -> text "slow"
1258 RednCounts -> text "ct"
1259 ConEntry -> text "con_entry"
1260 ConInfoTable -> text "con_info"
1261 ClosureTable -> text "closure_tbl"
1262 Bytes -> text "bytes"
1263 BlockInfoTable -> text "info"
1264 )
1265
1266
1267 pp_cSEP :: SDoc
1268 pp_cSEP = char '_'
1269
1270
1271 instance Outputable ForeignLabelSource where
1272 ppr fs
1273 = case fs of
1274 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
1275 ForeignLabelInThisPackage -> parens $ text "this package"
1276 ForeignLabelInExternalPackage -> parens $ text "external package"
1277
1278 -- -----------------------------------------------------------------------------
1279 -- Machine-dependent knowledge about labels.
1280
1281 underscorePrefix :: Bool -- leading underscore on assembler labels?
1282 underscorePrefix = (cLeadingUnderscore == "YES")
1283
1284 asmTempLabelPrefix :: Platform -> LitString -- for formatting labels
1285 asmTempLabelPrefix platform = case platformOS platform of
1286 OSDarwin -> sLit "L"
1287 OSAIX -> sLit "__L" -- follow IBM XL C's convention
1288 _ -> sLit ".L"
1289
1290 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
1291 pprDynamicLinkerAsmLabel platform dllInfo lbl =
1292 case platformOS platform of
1293 OSDarwin
1294 | platformArch platform == ArchX86_64 ->
1295 case dllInfo of
1296 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1297 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1298 GotSymbolPtr -> ppr lbl <> text "@GOTPCREL"
1299 GotSymbolOffset -> ppr lbl
1300 | otherwise ->
1301 case dllInfo of
1302 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1303 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1304 _ -> panic "pprDynamicLinkerAsmLabel"
1305
1306 OSAIX ->
1307 case dllInfo of
1308 SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
1309 _ -> panic "pprDynamicLinkerAsmLabel"
1310
1311 _ | osElfTarget (platformOS platform) -> elfLabel
1312
1313 OSMinGW32 ->
1314 case dllInfo of
1315 SymbolPtr -> text "__imp_" <> ppr lbl
1316 _ -> panic "pprDynamicLinkerAsmLabel"
1317
1318 _ -> panic "pprDynamicLinkerAsmLabel"
1319 where
1320 elfLabel
1321 | platformArch platform == ArchPPC
1322 = case dllInfo of
1323 CodeStub -> -- See Note [.LCTOC1 in PPC PIC code]
1324 ppr lbl <> text "+32768@plt"
1325 SymbolPtr -> text ".LC_" <> ppr lbl
1326 _ -> panic "pprDynamicLinkerAsmLabel"
1327
1328 | platformArch platform == ArchX86_64
1329 = case dllInfo of
1330 CodeStub -> ppr lbl <> text "@plt"
1331 GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
1332 GotSymbolOffset -> ppr lbl
1333 SymbolPtr -> text ".LC_" <> ppr lbl
1334
1335 | platformArch platform == ArchPPC_64 ELF_V1
1336 || platformArch platform == ArchPPC_64 ELF_V2
1337 = case dllInfo of
1338 GotSymbolPtr -> text ".LC_" <> ppr lbl
1339 <> text "@toc"
1340 GotSymbolOffset -> ppr lbl
1341 SymbolPtr -> text ".LC_" <> ppr lbl
1342 _ -> panic "pprDynamicLinkerAsmLabel"
1343
1344 | otherwise
1345 = case dllInfo of
1346 CodeStub -> ppr lbl <> text "@plt"
1347 SymbolPtr -> text ".LC_" <> ppr lbl
1348 GotSymbolPtr -> ppr lbl <> text "@got"
1349 GotSymbolOffset -> ppr lbl <> text "@gotoff"
1350