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