689ebd08f2be1d613a1d9d343946a3a97ad91809
[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 -- static reference tables defined in haskell (.hs)
582 isSomeRODataLabel (IdLabel _ _ SRT) = True
583 isSomeRODataLabel (SRTLabel _) = True
584 -- info table defined in cmm (.cmm)
585 isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
586 isSomeRODataLabel _lbl = False
587
588 -- | Get the label size field from a ForeignLabel
589 foreignLabelStdcallInfo :: CLabel -> Maybe Int
590 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
591 foreignLabelStdcallInfo _lbl = Nothing
592
593
594 -- Constructing Large*Labels
595 mkLargeSRTLabel :: Unique -> CLabel
596 mkBitmapLabel :: Unique -> CLabel
597 mkLargeSRTLabel uniq = LargeSRTLabel uniq
598 mkBitmapLabel uniq = LargeBitmapLabel uniq
599
600 -- Constructing Cost Center Labels
601 mkCCLabel :: CostCentre -> CLabel
602 mkCCSLabel :: CostCentreStack -> CLabel
603 mkCCLabel cc = CC_Label cc
604 mkCCSLabel ccs = CCS_Label ccs
605
606 mkRtsApFastLabel :: FastString -> CLabel
607 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
608
609 mkRtsSlowFastTickyCtrLabel :: String -> CLabel
610 mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
611
612
613 -- Constructing Code Coverage Labels
614 mkHpcTicksLabel :: Module -> CLabel
615 mkHpcTicksLabel = HpcTicksLabel
616
617
618 -- Constructing labels used for dynamic linking
619 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
620 mkDynamicLinkerLabel = DynamicLinkerLabel
621
622 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
623 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
624 dynamicLinkerLabelInfo _ = Nothing
625
626 mkPicBaseLabel :: CLabel
627 mkPicBaseLabel = PicBaseLabel
628
629
630 -- Constructing miscellaneous other labels
631 mkDeadStripPreventer :: CLabel -> CLabel
632 mkDeadStripPreventer lbl = DeadStripPreventer lbl
633
634 mkStringLitLabel :: Unique -> CLabel
635 mkStringLitLabel = StringLitLabel
636
637 mkAsmTempLabel :: Uniquable a => a -> CLabel
638 mkAsmTempLabel a = AsmTempLabel (getUnique a)
639
640 mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
641 mkAsmTempDerivedLabel = AsmTempDerivedLabel
642
643 mkAsmTempEndLabel :: CLabel -> CLabel
644 mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
645
646 -- | Construct a label for a DWARF Debug Information Entity (DIE)
647 -- describing another symbol.
648 mkAsmTempDieLabel :: CLabel -> CLabel
649 mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
650
651 -- -----------------------------------------------------------------------------
652 -- Convert between different kinds of label
653
654 toClosureLbl :: CLabel -> CLabel
655 toClosureLbl (IdLabel n _ BlockInfoTable)
656 = pprPanic "toClosureLbl: BlockInfoTable" (ppr n)
657 toClosureLbl (IdLabel n c _) = IdLabel n c Closure
658 toClosureLbl (CmmLabel m str _) = CmmLabel m str CmmClosure
659 toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
660
661 toSlowEntryLbl :: CLabel -> CLabel
662 toSlowEntryLbl (IdLabel n _ BlockInfoTable)
663 = pprPanic "toSlowEntryLbl" (ppr n)
664 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
665 toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
666
667 toEntryLbl :: CLabel -> CLabel
668 toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
669 toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
670 toEntryLbl (IdLabel n _ BlockInfoTable) = mkLocalBlockLabel (nameUnique n)
671 -- See Note [Proc-point local block entry-point].
672 toEntryLbl (IdLabel n c _) = IdLabel n c Entry
673 toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
674 toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
675 toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
676
677 toInfoLbl :: CLabel -> CLabel
678 toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
679 toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
680 toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable
681 toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
682 toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
683 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
684
685 hasHaskellName :: CLabel -> Maybe Name
686 hasHaskellName (IdLabel n _ _) = Just n
687 hasHaskellName _ = Nothing
688
689 -- -----------------------------------------------------------------------------
690 -- Does a CLabel's referent itself refer to a CAF?
691 hasCAF :: CLabel -> Bool
692 hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
693 hasCAF (IdLabel _ MayHaveCafRefs _) = True
694 hasCAF _ = False
695
696 -- Note [ticky for LNE]
697 -- ~~~~~~~~~~~~~~~~~~~~~
698
699 -- Until 14 Feb 2013, every ticky counter was associated with a
700 -- closure. Thus, ticky labels used IdLabel. It is odd that
701 -- CmmBuildInfoTables.cafTransfers would consider such a ticky label
702 -- reason to add the name to the CAFEnv (and thus eventually the SRT),
703 -- but it was harmless because the ticky was only used if the closure
704 -- was also.
705 --
706 -- Since we now have ticky counters for LNEs, it is no longer the case
707 -- that every ticky counter has an actual closure. So I changed the
708 -- generation of ticky counters' CLabels to not result in their
709 -- associated id ending up in the SRT.
710 --
711 -- NB IdLabel is still appropriate for ticky ids (as opposed to
712 -- CmmLabel) because the LNE's counter is still related to an .hs Id,
713 -- that Id just isn't for a proper closure.
714
715 -- -----------------------------------------------------------------------------
716 -- Does a CLabel need declaring before use or not?
717 --
718 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
719
720 needsCDecl :: CLabel -> Bool
721 -- False <=> it's pre-declared; don't bother
722 -- don't bother declaring Bitmap labels, we always make sure
723 -- they are defined before use.
724 needsCDecl (SRTLabel _) = True
725 needsCDecl (LargeSRTLabel _) = False
726 needsCDecl (LargeBitmapLabel _) = False
727 needsCDecl (IdLabel _ _ _) = True
728 needsCDecl (LocalBlockLabel _) = True
729
730 needsCDecl (StringLitLabel _) = False
731 needsCDecl (AsmTempLabel _) = False
732 needsCDecl (AsmTempDerivedLabel _ _) = False
733 needsCDecl (RtsLabel _) = False
734
735 needsCDecl (CmmLabel pkgId _ _)
736 -- Prototypes for labels defined in the runtime system are imported
737 -- into HC files via includes/Stg.h.
738 | pkgId == rtsUnitId = False
739
740 -- For other labels we inline one into the HC file directly.
741 | otherwise = True
742
743 needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
744 needsCDecl (CC_Label _) = True
745 needsCDecl (CCS_Label _) = True
746 needsCDecl (HpcTicksLabel _) = True
747 needsCDecl (DynamicLinkerLabel {}) = panic "needsCDecl DynamicLinkerLabel"
748 needsCDecl PicBaseLabel = panic "needsCDecl PicBaseLabel"
749 needsCDecl (DeadStripPreventer {}) = panic "needsCDecl DeadStripPreventer"
750
751 -- | If a label is a local block label then return just its 'BlockId', otherwise
752 -- 'Nothing'.
753 maybeLocalBlockLabel :: CLabel -> Maybe BlockId
754 maybeLocalBlockLabel (LocalBlockLabel uq) = Just $ mkBlockId uq
755 maybeLocalBlockLabel _ = Nothing
756
757
758 -- | Check whether a label corresponds to a C function that has
759 -- a prototype in a system header somehere, or is built-in
760 -- to the C compiler. For these labels we avoid generating our
761 -- own C prototypes.
762 isMathFun :: CLabel -> Bool
763 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
764 isMathFun _ = False
765
766 math_funs :: UniqSet FastString
767 math_funs = mkUniqSet [
768 -- _ISOC99_SOURCE
769 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
770 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
771 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
772 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
773 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
774 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
775 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
776 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
777 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
778 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
779 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
780 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
781 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
782 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
783 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
784 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
785 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
786 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
787 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
788 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
789 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
790 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
791 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
792 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
793 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
794 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
795 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
796 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
797 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
798 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
799 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
800 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
801 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
802 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
803 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
804 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
805 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
806 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
807 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
808 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
809 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
810 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
811 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
812 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
813 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
814 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
815 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
816 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
817 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
818 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
819 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
820 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
821 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
822 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
823 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
824 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
825 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
826 -- ISO C 99 also defines these function-like macros in math.h:
827 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
828 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
829
830 -- additional symbols from _BSD_SOURCE
831 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
832 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
833 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
834 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
835 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
836 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
837 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
838 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
839 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
840 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
841 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
842 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
843 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
844 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl"),
845
846 -- These functions are described in IEEE Std 754-2008 -
847 -- Standard for Floating-Point Arithmetic and ISO/IEC TS 18661
848 (fsLit "nextup"), (fsLit "nextupf"), (fsLit "nextupl"),
849 (fsLit "nextdown"), (fsLit "nextdownf"), (fsLit "nextdownl")
850 ]
851
852 -- -----------------------------------------------------------------------------
853 -- | Is a CLabel visible outside this object file or not?
854 -- From the point of view of the code generator, a name is
855 -- externally visible if it has to be declared as exported
856 -- in the .o file's symbol table; that is, made non-static.
857 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
858 externallyVisibleCLabel (StringLitLabel _) = False
859 externallyVisibleCLabel (AsmTempLabel _) = False
860 externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
861 externallyVisibleCLabel (RtsLabel _) = True
862 externallyVisibleCLabel (LocalBlockLabel _) = False
863 externallyVisibleCLabel (CmmLabel _ _ _) = True
864 externallyVisibleCLabel (ForeignLabel{}) = True
865 externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
866 externallyVisibleCLabel (CC_Label _) = True
867 externallyVisibleCLabel (CCS_Label _) = True
868 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
869 externallyVisibleCLabel (HpcTicksLabel _) = True
870 externallyVisibleCLabel (LargeBitmapLabel _) = False
871 externallyVisibleCLabel (SRTLabel _) = False
872 externallyVisibleCLabel (LargeSRTLabel _) = False
873 externallyVisibleCLabel (PicBaseLabel {}) = panic "externallyVisibleCLabel PicBaseLabel"
874 externallyVisibleCLabel (DeadStripPreventer {}) = panic "externallyVisibleCLabel DeadStripPreventer"
875
876 externallyVisibleIdLabel :: IdLabelInfo -> Bool
877 externallyVisibleIdLabel SRT = False
878 externallyVisibleIdLabel LocalInfoTable = False
879 externallyVisibleIdLabel LocalEntry = False
880 externallyVisibleIdLabel BlockInfoTable = False
881 externallyVisibleIdLabel _ = True
882
883 -- -----------------------------------------------------------------------------
884 -- Finding the "type" of a CLabel
885
886 -- For generating correct types in label declarations:
887
888 data CLabelType
889 = CodeLabel -- Address of some executable instructions
890 | DataLabel -- Address of data, not a GC ptr
891 | GcPtrLabel -- Address of a (presumably static) GC object
892
893 isCFunctionLabel :: CLabel -> Bool
894 isCFunctionLabel lbl = case labelType lbl of
895 CodeLabel -> True
896 _other -> False
897
898 isGcPtrLabel :: CLabel -> Bool
899 isGcPtrLabel lbl = case labelType lbl of
900 GcPtrLabel -> True
901 _other -> False
902
903
904 -- | Work out the general type of data at the address of this label
905 -- whether it be code, data, or static GC object.
906 labelType :: CLabel -> CLabelType
907 labelType (IdLabel _ _ info) = idInfoLabelType info
908 labelType (CmmLabel _ _ CmmData) = DataLabel
909 labelType (CmmLabel _ _ CmmClosure) = GcPtrLabel
910 labelType (CmmLabel _ _ CmmCode) = CodeLabel
911 labelType (CmmLabel _ _ CmmInfo) = DataLabel
912 labelType (CmmLabel _ _ CmmEntry) = CodeLabel
913 labelType (CmmLabel _ _ CmmPrimCall) = CodeLabel
914 labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
915 labelType (CmmLabel _ _ CmmRet) = CodeLabel
916 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
917 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
918 labelType (RtsLabel (RtsApFast _)) = CodeLabel
919 labelType (RtsLabel _) = DataLabel
920 labelType (LocalBlockLabel _) = CodeLabel
921 labelType (SRTLabel _) = DataLabel
922 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
923 labelType (ForeignLabel _ _ _ IsData) = DataLabel
924 labelType (AsmTempLabel _) = panic "labelType(AsmTempLabel)"
925 labelType (AsmTempDerivedLabel _ _) = panic "labelType(AsmTempDerivedLabel)"
926 labelType (StringLitLabel _) = DataLabel
927 labelType (CC_Label _) = DataLabel
928 labelType (CCS_Label _) = DataLabel
929 labelType (DynamicLinkerLabel _ _) = DataLabel -- Is this right?
930 labelType PicBaseLabel = DataLabel
931 labelType (DeadStripPreventer _) = DataLabel
932 labelType (HpcTicksLabel _) = DataLabel
933 labelType (LargeSRTLabel _) = DataLabel
934 labelType (LargeBitmapLabel _) = DataLabel
935
936 idInfoLabelType :: IdLabelInfo -> CLabelType
937 idInfoLabelType info =
938 case info of
939 InfoTable -> DataLabel
940 LocalInfoTable -> DataLabel
941 Closure -> GcPtrLabel
942 ConInfoTable -> DataLabel
943 ClosureTable -> DataLabel
944 RednCounts -> DataLabel
945 Bytes -> DataLabel
946 _ -> CodeLabel
947
948
949 -- -----------------------------------------------------------------------------
950 -- Does a CLabel need dynamic linkage?
951
952 -- When referring to data in code, we need to know whether
953 -- that data resides in a DLL or not. [Win32 only.]
954 -- @labelDynamic@ returns @True@ if the label is located
955 -- in a DLL, be it a data reference or not.
956
957 labelDynamic :: DynFlags -> Module -> CLabel -> Bool
958 labelDynamic dflags this_mod lbl =
959 case lbl of
960 -- is the RTS in a DLL or not?
961 RtsLabel _ -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId)
962
963 IdLabel n _ _ -> isDllName dflags this_mod n
964
965 -- When compiling in the "dyn" way, each package is to be linked into
966 -- its own shared library.
967 CmmLabel pkg _ _
968 | os == OSMinGW32 ->
969 (WayDyn `elem` ways dflags) && (this_pkg /= pkg)
970 | otherwise ->
971 True
972
973 LocalBlockLabel _ -> False
974
975 ForeignLabel _ _ source _ ->
976 if os == OSMinGW32
977 then case source of
978 -- Foreign label is in some un-named foreign package (or DLL).
979 ForeignLabelInExternalPackage -> True
980
981 -- Foreign label is linked into the same package as the
982 -- source file currently being compiled.
983 ForeignLabelInThisPackage -> False
984
985 -- Foreign label is in some named package.
986 -- When compiling in the "dyn" way, each package is to be
987 -- linked into its own DLL.
988 ForeignLabelInPackage pkgId ->
989 (WayDyn `elem` ways dflags) && (this_pkg /= pkgId)
990
991 else -- On Mac OS X and on ELF platforms, false positives are OK,
992 -- so we claim that all foreign imports come from dynamic
993 -- libraries
994 True
995
996 HpcTicksLabel m -> (WayDyn `elem` ways dflags) && this_mod /= m
997
998 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
999 _ -> False
1000 where
1001 os = platformOS (targetPlatform dflags)
1002 this_pkg = moduleUnitId this_mod
1003
1004
1005 -----------------------------------------------------------------------------
1006 -- Printing out CLabels.
1007
1008 {-
1009 Convention:
1010
1011 <name>_<type>
1012
1013 where <name> is <Module>_<name> for external names and <unique> for
1014 internal names. <type> is one of the following:
1015
1016 info Info table
1017 srt Static reference table
1018 srtd Static reference table descriptor
1019 entry Entry code (function, closure)
1020 slow Slow entry code (if any)
1021 ret Direct return address
1022 vtbl Vector table
1023 <n>_alt Case alternative (tag n)
1024 dflt Default case alternative
1025 btm Large bitmap vector
1026 closure Static closure
1027 con_entry Dynamic Constructor entry code
1028 con_info Dynamic Constructor info table
1029 static_entry Static Constructor entry code
1030 static_info Static Constructor info table
1031 sel_info Selector info table
1032 sel_entry Selector entry code
1033 cc Cost centre
1034 ccs Cost centre stack
1035
1036 Many of these distinctions are only for documentation reasons. For
1037 example, _ret is only distinguished from _entry to make it easy to
1038 tell whether a code fragment is a return point or a closure/function
1039 entry.
1040
1041 Note [Closure and info labels]
1042 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1043 For a function 'foo, we have:
1044 foo_info : Points to the info table describing foo's closure
1045 (and entry code for foo with tables next to code)
1046 foo_closure : Static (no-free-var) closure only:
1047 points to the statically-allocated closure
1048
1049 For a data constructor (such as Just or Nothing), we have:
1050 Just_con_info: Info table for the data constructor itself
1051 the first word of a heap-allocated Just
1052 Just_info: Info table for the *worker function*, an
1053 ordinary Haskell function of arity 1 that
1054 allocates a (Just x) box:
1055 Just = \x -> Just x
1056 Just_closure: The closure for this worker
1057
1058 Nothing_closure: a statically allocated closure for Nothing
1059 Nothing_static_info: info table for Nothing_closure
1060
1061 All these must be exported symbol, EXCEPT Just_info. We don't need to
1062 export this because in other modules we either have
1063 * A reference to 'Just'; use Just_closure
1064 * A saturated call 'Just x'; allocate using Just_con_info
1065 Not exporting these Just_info labels reduces the number of symbols
1066 somewhat.
1067
1068 Note [Bytes label]
1069 ~~~~~~~~~~~~~~~~~~
1070 For a top-level string literal 'foo', we have just one symbol 'foo_bytes', which
1071 points to a static data block containing the content of the literal.
1072
1073 Note [Proc-point local block entry-points]
1074 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1075 A label for a proc-point local block entry-point has no "_entry" suffix. With
1076 `infoTblLbl` we derive an info table label from a proc-point block ID. If
1077 we convert such an info table label into an entry label we must produce
1078 the label without an "_entry" suffix. So an info table label records
1079 the fact that it was derived from a block ID in `IdLabelInfo` as
1080 `BlockInfoTable`.
1081
1082 The info table label and the local block label are both local labels
1083 and are not externally visible.
1084 -}
1085
1086 instance Outputable CLabel where
1087 ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
1088
1089 pprCLabel :: Platform -> CLabel -> SDoc
1090
1091 pprCLabel platform (LocalBlockLabel u)
1092 = getPprStyle $ \ sty ->
1093 if asmStyle sty then
1094 ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
1095 else
1096 char '_' <> pprUniqueAlways u
1097
1098 pprCLabel platform (AsmTempLabel u)
1099 | not (platformUnregisterised platform)
1100 = getPprStyle $ \ sty ->
1101 if asmStyle sty then
1102 ptext (asmTempLabelPrefix platform) <> pprUniqueAlways u
1103 else
1104 char '_' <> pprUniqueAlways u
1105
1106 pprCLabel platform (AsmTempDerivedLabel l suf)
1107 | cGhcWithNativeCodeGen == "YES"
1108 = ptext (asmTempLabelPrefix platform)
1109 <> case l of AsmTempLabel u -> pprUniqueAlways u
1110 LocalBlockLabel u -> pprUniqueAlways u
1111 _other -> pprCLabel platform l
1112 <> ftext suf
1113
1114 pprCLabel platform (DynamicLinkerLabel info lbl)
1115 | cGhcWithNativeCodeGen == "YES"
1116 = pprDynamicLinkerAsmLabel platform info lbl
1117
1118 pprCLabel _ PicBaseLabel
1119 | cGhcWithNativeCodeGen == "YES"
1120 = text "1b"
1121
1122 pprCLabel platform (DeadStripPreventer lbl)
1123 | cGhcWithNativeCodeGen == "YES"
1124 = pprCLabel platform lbl <> text "_dsp"
1125
1126 pprCLabel _ (StringLitLabel u)
1127 | cGhcWithNativeCodeGen == "YES"
1128 = pprUniqueAlways u <> ptext (sLit "_str")
1129
1130 pprCLabel platform lbl
1131 = getPprStyle $ \ sty ->
1132 if cGhcWithNativeCodeGen == "YES" && asmStyle sty
1133 then maybe_underscore (pprAsmCLbl platform lbl)
1134 else pprCLbl lbl
1135
1136 maybe_underscore :: SDoc -> SDoc
1137 maybe_underscore doc
1138 | underscorePrefix = pp_cSEP <> doc
1139 | otherwise = doc
1140
1141 pprAsmCLbl :: Platform -> CLabel -> SDoc
1142 pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
1143 | platformOS platform == OSMinGW32
1144 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
1145 -- (The C compiler does this itself).
1146 = ftext fs <> char '@' <> int sz
1147 pprAsmCLbl _ lbl
1148 = pprCLbl lbl
1149
1150 pprCLbl :: CLabel -> SDoc
1151 pprCLbl (StringLitLabel u)
1152 = pprUniqueAlways u <> text "_str"
1153
1154 pprCLbl (SRTLabel u)
1155 = pprUniqueAlways u <> pp_cSEP <> text "srt"
1156
1157 pprCLbl (LargeSRTLabel u) = pprUniqueAlways u <> pp_cSEP <> text "srtd"
1158 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUniqueAlways u <> pp_cSEP <> text "btm"
1159 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
1160 -- until that gets resolved we'll just force them to start
1161 -- with a letter so the label will be legal assmbly code.
1162
1163
1164 pprCLbl (CmmLabel _ str CmmCode) = ftext str
1165 pprCLbl (CmmLabel _ str CmmData) = ftext str
1166 pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
1167
1168 pprCLbl (LocalBlockLabel u) = text "blk_" <> pprUniqueAlways u
1169
1170 pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> text "_fast"
1171
1172 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
1173 = sdocWithDynFlags $ \dflags ->
1174 ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
1175 hcat [text "stg_sel_", text (show offset),
1176 ptext (if upd_reqd
1177 then (sLit "_upd_info")
1178 else (sLit "_noupd_info"))
1179 ]
1180
1181 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
1182 = sdocWithDynFlags $ \dflags ->
1183 ASSERT(offset >= 0 && offset <= mAX_SPEC_SELECTEE_SIZE dflags)
1184 hcat [text "stg_sel_", text (show offset),
1185 ptext (if upd_reqd
1186 then (sLit "_upd_entry")
1187 else (sLit "_noupd_entry"))
1188 ]
1189
1190 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
1191 = sdocWithDynFlags $ \dflags ->
1192 ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
1193 hcat [text "stg_ap_", text (show arity),
1194 ptext (if upd_reqd
1195 then (sLit "_upd_info")
1196 else (sLit "_noupd_info"))
1197 ]
1198
1199 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
1200 = sdocWithDynFlags $ \dflags ->
1201 ASSERT(arity > 0 && arity <= mAX_SPEC_AP_SIZE dflags)
1202 hcat [text "stg_ap_", text (show arity),
1203 ptext (if upd_reqd
1204 then (sLit "_upd_entry")
1205 else (sLit "_noupd_entry"))
1206 ]
1207
1208 pprCLbl (CmmLabel _ fs CmmInfo)
1209 = ftext fs <> text "_info"
1210
1211 pprCLbl (CmmLabel _ fs CmmEntry)
1212 = ftext fs <> text "_entry"
1213
1214 pprCLbl (CmmLabel _ fs CmmRetInfo)
1215 = ftext fs <> text "_info"
1216
1217 pprCLbl (CmmLabel _ fs CmmRet)
1218 = ftext fs <> text "_ret"
1219
1220 pprCLbl (CmmLabel _ fs CmmClosure)
1221 = ftext fs <> text "_closure"
1222
1223 pprCLbl (RtsLabel (RtsPrimOp primop))
1224 = text "stg_" <> ppr primop
1225
1226 pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
1227 = text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr")
1228
1229 pprCLbl (ForeignLabel str _ _ _)
1230 = ftext str
1231
1232 pprCLbl (IdLabel name _cafs flavor) = ppr name <> ppIdFlavor flavor
1233
1234 pprCLbl (CC_Label cc) = ppr cc
1235 pprCLbl (CCS_Label ccs) = ppr ccs
1236
1237 pprCLbl (HpcTicksLabel mod)
1238 = text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc")
1239
1240 pprCLbl (AsmTempLabel {}) = panic "pprCLbl AsmTempLabel"
1241 pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
1242 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
1243 pprCLbl (PicBaseLabel {}) = panic "pprCLbl PicBaseLabel"
1244 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
1245
1246 ppIdFlavor :: IdLabelInfo -> SDoc
1247 ppIdFlavor x = pp_cSEP <>
1248 (case x of
1249 Closure -> text "closure"
1250 SRT -> text "srt"
1251 InfoTable -> text "info"
1252 LocalInfoTable -> text "info"
1253 Entry -> text "entry"
1254 LocalEntry -> text "entry"
1255 Slow -> text "slow"
1256 RednCounts -> text "ct"
1257 ConEntry -> text "con_entry"
1258 ConInfoTable -> text "con_info"
1259 ClosureTable -> text "closure_tbl"
1260 Bytes -> text "bytes"
1261 BlockInfoTable -> text "info"
1262 )
1263
1264
1265 pp_cSEP :: SDoc
1266 pp_cSEP = char '_'
1267
1268
1269 instance Outputable ForeignLabelSource where
1270 ppr fs
1271 = case fs of
1272 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
1273 ForeignLabelInThisPackage -> parens $ text "this package"
1274 ForeignLabelInExternalPackage -> parens $ text "external package"
1275
1276 -- -----------------------------------------------------------------------------
1277 -- Machine-dependent knowledge about labels.
1278
1279 underscorePrefix :: Bool -- leading underscore on assembler labels?
1280 underscorePrefix = (cLeadingUnderscore == "YES")
1281
1282 asmTempLabelPrefix :: Platform -> LitString -- for formatting labels
1283 asmTempLabelPrefix platform = case platformOS platform of
1284 OSDarwin -> sLit "L"
1285 OSAIX -> sLit "__L" -- follow IBM XL C's convention
1286 _ -> sLit ".L"
1287
1288 pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
1289 pprDynamicLinkerAsmLabel platform dllInfo lbl =
1290 case platformOS platform of
1291 OSDarwin
1292 | platformArch platform == ArchX86_64 ->
1293 case dllInfo of
1294 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1295 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1296 GotSymbolPtr -> ppr lbl <> text "@GOTPCREL"
1297 GotSymbolOffset -> ppr lbl
1298 | otherwise ->
1299 case dllInfo of
1300 CodeStub -> char 'L' <> ppr lbl <> text "$stub"
1301 SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
1302 _ -> panic "pprDynamicLinkerAsmLabel"
1303
1304 OSAIX ->
1305 case dllInfo of
1306 SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
1307 _ -> panic "pprDynamicLinkerAsmLabel"
1308
1309 _ | osElfTarget (platformOS platform) -> elfLabel
1310
1311 OSMinGW32 ->
1312 case dllInfo of
1313 SymbolPtr -> text "__imp_" <> ppr lbl
1314 _ -> panic "pprDynamicLinkerAsmLabel"
1315
1316 _ -> panic "pprDynamicLinkerAsmLabel"
1317 where
1318 elfLabel
1319 | platformArch platform == ArchPPC
1320 = case dllInfo of
1321 CodeStub -> -- See Note [.LCTOC1 in PPC PIC code]
1322 ppr lbl <> text "+32768@plt"
1323 SymbolPtr -> text ".LC_" <> ppr lbl
1324 _ -> panic "pprDynamicLinkerAsmLabel"
1325
1326 | platformArch platform == ArchX86_64
1327 = case dllInfo of
1328 CodeStub -> ppr lbl <> text "@plt"
1329 GotSymbolPtr -> ppr lbl <> text "@gotpcrel"
1330 GotSymbolOffset -> ppr lbl
1331 SymbolPtr -> text ".LC_" <> ppr lbl
1332
1333 | platformArch platform == ArchPPC_64 ELF_V1
1334 || platformArch platform == ArchPPC_64 ELF_V2
1335 = case dllInfo of
1336 GotSymbolPtr -> text ".LC_" <> ppr lbl
1337 <> text "@toc"
1338 GotSymbolOffset -> ppr lbl
1339 SymbolPtr -> text ".LC_" <> ppr lbl
1340 _ -> panic "pprDynamicLinkerAsmLabel"
1341
1342 | otherwise
1343 = case dllInfo of
1344 CodeStub -> ppr lbl <> text "@plt"
1345 SymbolPtr -> text ".LC_" <> ppr lbl
1346 GotSymbolPtr -> ppr lbl <> text "@got"
1347 GotSymbolOffset -> ppr lbl <> text "@gotoff"
1348