Remove last use of entryLblToInfoLbl
[ghc.git] / compiler / cmm / CLabel.hs
1 {-# OPTIONS -w #-}
2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
6 -- for details
7
8 -----------------------------------------------------------------------------
9 --
10 -- Object-file symbols (called CLabel for histerical raisins).
11 --
12 -- (c) The University of Glasgow 2004-2006
13 --
14 -----------------------------------------------------------------------------
15
16 module CLabel (
17 CLabel, -- abstract type
18 ForeignLabelSource(..),
19 pprDebugCLabel,
20
21 mkClosureLabel,
22 mkSRTLabel,
23 mkInfoTableLabel,
24 mkEntryLabel,
25 mkSlowEntryLabel,
26 mkConEntryLabel,
27 mkStaticConEntryLabel,
28 mkRednCountsLabel,
29 mkConInfoTableLabel,
30 mkStaticInfoTableLabel,
31 mkLargeSRTLabel,
32 mkApEntryLabel,
33 mkApInfoTableLabel,
34 mkClosureTableLabel,
35
36 mkLocalClosureLabel,
37 mkLocalInfoTableLabel,
38 mkLocalEntryLabel,
39 mkLocalConEntryLabel,
40 mkLocalStaticConEntryLabel,
41 mkLocalConInfoTableLabel,
42 mkLocalStaticInfoTableLabel,
43 mkLocalClosureTableLabel,
44
45 mkReturnPtLabel,
46 mkReturnInfoLabel,
47 mkAltLabel,
48 mkDefaultLabel,
49 mkBitmapLabel,
50 mkStringLitLabel,
51
52 mkAsmTempLabel,
53
54 mkPlainModuleInitLabel,
55
56 mkSplitMarkerLabel,
57 mkDirty_MUT_VAR_Label,
58 mkUpdInfoLabel,
59 mkBHUpdInfoLabel,
60 mkIndStaticInfoLabel,
61 mkMainCapabilityLabel,
62 mkMAP_FROZEN_infoLabel,
63 mkMAP_DIRTY_infoLabel,
64 mkEMPTY_MVAR_infoLabel,
65
66 mkTopTickyCtrLabel,
67 mkCAFBlackHoleInfoTableLabel,
68 mkCAFBlackHoleEntryLabel,
69 mkRtsPrimOpLabel,
70 mkRtsSlowTickyCtrLabel,
71
72 mkSelectorInfoLabel,
73 mkSelectorEntryLabel,
74
75 mkCmmInfoLabel,
76 mkCmmEntryLabel,
77 mkCmmRetInfoLabel,
78 mkCmmRetLabel,
79 mkCmmCodeLabel,
80 mkCmmDataLabel,
81 mkCmmGcPtrLabel,
82
83 mkRtsApFastLabel,
84
85 mkPrimCallLabel,
86
87 mkForeignLabel,
88 addLabelSize,
89 foreignLabelStdcallInfo,
90
91 mkCCLabel, mkCCSLabel,
92
93 DynamicLinkerLabelInfo(..),
94 mkDynamicLinkerLabel,
95 dynamicLinkerLabelInfo,
96
97 mkPicBaseLabel,
98 mkDeadStripPreventer,
99
100 mkHpcTicksLabel,
101
102 hasCAF,
103 cvtToClosureLbl,
104 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
105 isMathFun,
106 isCFunctionLabel, isGcPtrLabel, labelDynamic,
107
108 pprCLabel
109 ) where
110
111 #include "HsVersions.h"
112
113 import IdInfo
114 import StaticFlags
115 import BasicTypes
116 import Literal
117 import Packages
118 import DataCon
119 import PackageConfig
120 import Module
121 import Name
122 import Unique
123 import PrimOp
124 import Config
125 import CostCentre
126 import Outputable
127 import FastString
128 import DynFlags
129 import UniqSet
130
131 -- -----------------------------------------------------------------------------
132 -- The CLabel type
133
134 {-
135 | CLabel is an abstract type that supports the following operations:
136
137 - Pretty printing
138
139 - In a C file, does it need to be declared before use? (i.e. is it
140 guaranteed to be already in scope in the places we need to refer to it?)
141
142 - If it needs to be declared, what type (code or data) should it be
143 declared to have?
144
145 - Is it visible outside this object file or not?
146
147 - Is it "dynamic" (see details below)
148
149 - Eq and Ord, so that we can make sets of CLabels (currently only
150 used in outputting C as far as I can tell, to avoid generating
151 more than one declaration for any given label).
152
153 - Converting an info table label into an entry label.
154 -}
155
156 data CLabel
157 = -- | A label related to the definition of a particular Id or Con in a .hs file.
158 IdLabel
159 Name
160 CafInfo
161 IdLabelInfo -- encodes the suffix of the label
162
163 -- | A label from a .cmm file that is not associated with a .hs level Id.
164 | CmmLabel
165 PackageId -- what package the label belongs to.
166 FastString -- identifier giving the prefix of the label
167 CmmLabelInfo -- encodes the suffix of the label
168
169 -- | A label with a baked-in \/ algorithmically generated name that definitely
170 -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
171 -- If it doesn't have an algorithmically generated name then use a CmmLabel
172 -- instead and give it an appropriate PackageId argument.
173 | RtsLabel
174 RtsLabelInfo
175
176 -- | A 'C' (or otherwise foreign) label.
177 --
178 | ForeignLabel
179 FastString -- name of the imported label.
180
181 (Maybe Int) -- possible '@n' suffix for stdcall functions
182 -- When generating C, the '@n' suffix is omitted, but when
183 -- generating assembler we must add it to the label.
184
185 ForeignLabelSource -- what package the foreign label is in.
186
187 FunctionOrData
188
189 -- | A family of labels related to a particular case expression.
190 | CaseLabel
191 {-# UNPACK #-} !Unique -- Unique says which case expression
192 CaseLabelInfo
193
194 | AsmTempLabel
195 {-# UNPACK #-} !Unique
196
197 | StringLitLabel
198 {-# UNPACK #-} !Unique
199
200 | PlainModuleInitLabel -- without the version & way info
201 Module
202
203 | CC_Label CostCentre
204 | CCS_Label CostCentreStack
205
206
207 -- | These labels are generated and used inside the NCG only.
208 -- They are special variants of a label used for dynamic linking
209 -- see module PositionIndependentCode for details.
210 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
211
212 -- | This label is generated and used inside the NCG only.
213 -- It is used as a base for PIC calculations on some platforms.
214 -- It takes the form of a local numeric assembler label '1'; and
215 -- is pretty-printed as 1b, referring to the previous definition
216 -- of 1: in the assembler source file.
217 | PicBaseLabel
218
219 -- | A label before an info table to prevent excessive dead-stripping on darwin
220 | DeadStripPreventer CLabel
221
222
223 -- | Per-module table of tick locations
224 | HpcTicksLabel Module
225
226 -- | Label of an StgLargeSRT
227 | LargeSRTLabel
228 {-# UNPACK #-} !Unique
229
230 -- | A bitmap (function or case return)
231 | LargeBitmapLabel
232 {-# UNPACK #-} !Unique
233
234 deriving (Eq, Ord)
235
236
237 -- | Record where a foreign label is stored.
238 data ForeignLabelSource
239
240 -- | Label is in a named package
241 = ForeignLabelInPackage PackageId
242
243 -- | Label is in some external, system package that doesn't also
244 -- contain compiled Haskell code, and is not associated with any .hi files.
245 -- We don't have to worry about Haskell code being inlined from
246 -- external packages. It is safe to treat the RTS package as "external".
247 | ForeignLabelInExternalPackage
248
249 -- | Label is in the package currenly being compiled.
250 -- This is only used for creating hacky tmp labels during code generation.
251 -- Don't use it in any code that might be inlined across a package boundary
252 -- (ie, core code) else the information will be wrong relative to the
253 -- destination module.
254 | ForeignLabelInThisPackage
255
256 deriving (Eq, Ord)
257
258
259 -- | For debugging problems with the CLabel representation.
260 -- We can't make a Show instance for CLabel because lots of its components don't have instances.
261 -- The regular Outputable instance only shows the label name, and not its other info.
262 --
263 pprDebugCLabel :: CLabel -> SDoc
264 pprDebugCLabel lbl
265 = case lbl of
266 IdLabel{} -> ppr lbl <> (parens $ text "IdLabel")
267 CmmLabel pkg name _info
268 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
269
270 RtsLabel{} -> ppr lbl <> (parens $ text "RtsLabel")
271
272 ForeignLabel name mSuffix src funOrData
273 -> ppr lbl <> (parens
274 $ text "ForeignLabel"
275 <+> ppr mSuffix
276 <+> ppr src
277 <+> ppr funOrData)
278
279 _ -> ppr lbl <> (parens $ text "other CLabel)")
280
281
282 -- True if a local IdLabel that we won't mark as exported
283 type IsLocal = Bool
284
285 data IdLabelInfo
286 = Closure -- ^ Label for closure
287 | SRT -- ^ Static reference table
288 | InfoTable IsLocal -- ^ Info tables for closures; always read-only
289 | Entry IsLocal -- ^ Entry point
290 | Slow -- ^ Slow entry point
291
292 | RednCounts -- ^ Label of place to keep Ticky-ticky info for this Id
293
294 | ConEntry -- ^ Constructor entry point
295 | ConInfoTable -- ^ Corresponding info table
296 | StaticConEntry -- ^ Static constructor entry point
297 | StaticInfoTable -- ^ Corresponding info table
298
299 | ClosureTable -- ^ Table of closures for Enum tycons
300
301 deriving (Eq, Ord)
302
303
304 data CaseLabelInfo
305 = CaseReturnPt
306 | CaseReturnInfo
307 | CaseAlt ConTag
308 | CaseDefault
309 deriving (Eq, Ord)
310
311
312 data RtsLabelInfo
313 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- ^ Selector thunks
314 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
315
316 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks
317 | RtsApEntry Bool{-updatable-} Int{-arity-}
318
319 | RtsPrimOp PrimOp
320 | RtsApFast FastString -- ^ _fast versions of generic apply
321 | RtsSlowTickyCtr String
322
323 deriving (Eq, Ord)
324 -- NOTE: Eq on LitString compares the pointer only, so this isn't
325 -- a real equality.
326
327
328 -- | What type of Cmm label we're dealing with.
329 -- Determines the suffix appended to the name when a CLabel.CmmLabel
330 -- is pretty printed.
331 data CmmLabelInfo
332 = CmmInfo -- ^ misc rts info tabless, suffix _info
333 | CmmEntry -- ^ misc rts entry points, suffix _entry
334 | CmmRetInfo -- ^ misc rts ret info tables, suffix _info
335 | CmmRet -- ^ misc rts return points, suffix _ret
336 | CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
337 | CmmCode -- ^ misc rts code
338 | CmmGcPtr -- ^ GcPtrs eg CHARLIKE_closure
339 | CmmPrimCall -- ^ a prim call to some hand written Cmm code
340 deriving (Eq, Ord)
341
342 data DynamicLinkerLabelInfo
343 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
344 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
345 | GotSymbolPtr -- ELF: foo@got
346 | GotSymbolOffset -- ELF: foo@gotoff
347
348 deriving (Eq, Ord)
349
350
351 -- -----------------------------------------------------------------------------
352 -- Constructing CLabels
353 -- -----------------------------------------------------------------------------
354
355 -- Constructing IdLabels
356 -- These are always local:
357 mkSRTLabel name c = IdLabel name c SRT
358 mkSlowEntryLabel name c = IdLabel name c Slow
359 mkRednCountsLabel name c = IdLabel name c RednCounts
360
361 -- These have local & (possibly) external variants:
362 mkLocalClosureLabel name c = IdLabel name c Closure
363 mkLocalInfoTableLabel name c = IdLabel name c (InfoTable True)
364 mkLocalEntryLabel name c = IdLabel name c (Entry True)
365 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
366
367 mkClosureLabel name c = IdLabel name c Closure
368 mkInfoTableLabel name c = IdLabel name c (InfoTable False)
369 mkEntryLabel name c = IdLabel name c (Entry False)
370 mkClosureTableLabel name c = IdLabel name c ClosureTable
371 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
372 mkLocalConEntryLabel c con = IdLabel con c ConEntry
373 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
374 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
375 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
376 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
377
378 mkConEntryLabel name c = IdLabel name c ConEntry
379 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
380
381 -- Constructing Cmm Labels
382 mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode
383 mkDirty_MUT_VAR_Label = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR") CmmCode
384 mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo
385 mkBHUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" ) CmmInfo
386 mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo
387 mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData
388 mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
389 mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
390 mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
391 mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
392 mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
393 mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmEntry
394
395 -----
396 mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
397 mkCmmCodeLabel, mkCmmDataLabel, mkCmmGcPtrLabel
398 :: PackageId -> FastString -> CLabel
399
400 mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
401 mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
402 mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo
403 mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet
404 mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode
405 mkCmmDataLabel pkg str = CmmLabel pkg str CmmData
406 mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
407
408
409 -- Constructing RtsLabels
410 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
411
412 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
413 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
414
415 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
416 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
417
418
419 -- A call to some primitive hand written Cmm code
420 mkPrimCallLabel :: PrimCall -> CLabel
421 mkPrimCallLabel (PrimCall str pkg)
422 = CmmLabel pkg str CmmPrimCall
423
424
425 -- Constructing ForeignLabels
426
427 -- | Make a foreign label
428 mkForeignLabel
429 :: FastString -- name
430 -> Maybe Int -- size prefix
431 -> ForeignLabelSource -- what package it's in
432 -> FunctionOrData
433 -> CLabel
434
435 mkForeignLabel str mb_sz src fod
436 = ForeignLabel str mb_sz src fod
437
438
439 -- | Update the label size field in a ForeignLabel
440 addLabelSize :: CLabel -> Int -> CLabel
441 addLabelSize (ForeignLabel str _ src fod) sz
442 = ForeignLabel str (Just sz) src fod
443 addLabelSize label _
444 = label
445
446 -- | Get the label size field from a ForeignLabel
447 foreignLabelStdcallInfo :: CLabel -> Maybe Int
448 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
449 foreignLabelStdcallInfo _lbl = Nothing
450
451
452 -- Constructing Large*Labels
453 mkLargeSRTLabel uniq = LargeSRTLabel uniq
454 mkBitmapLabel uniq = LargeBitmapLabel uniq
455
456
457 -- Constructin CaseLabels
458 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
459 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
460 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
461 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
462
463 -- Constructing Cost Center Labels
464 mkCCLabel cc = CC_Label cc
465 mkCCSLabel ccs = CCS_Label ccs
466
467 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
468
469 mkRtsSlowTickyCtrLabel :: String -> CLabel
470 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
471
472
473 -- Constructing Code Coverage Labels
474 mkHpcTicksLabel = HpcTicksLabel
475
476
477 -- Constructing labels used for dynamic linking
478 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
479 mkDynamicLinkerLabel = DynamicLinkerLabel
480
481 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
482 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
483 dynamicLinkerLabelInfo _ = Nothing
484
485 mkPicBaseLabel :: CLabel
486 mkPicBaseLabel = PicBaseLabel
487
488
489 -- Constructing miscellaneous other labels
490 mkDeadStripPreventer :: CLabel -> CLabel
491 mkDeadStripPreventer lbl = DeadStripPreventer lbl
492
493 mkStringLitLabel :: Unique -> CLabel
494 mkStringLitLabel = StringLitLabel
495
496 mkAsmTempLabel :: Uniquable a => a -> CLabel
497 mkAsmTempLabel a = AsmTempLabel (getUnique a)
498
499 mkPlainModuleInitLabel :: Module -> CLabel
500 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
501
502 -- -----------------------------------------------------------------------------
503 -- Brutal method of obtaining a closure label
504
505 cvtToClosureLbl (IdLabel n c (InfoTable _)) = IdLabel n c Closure
506 cvtToClosureLbl (IdLabel n c (Entry _)) = IdLabel n c Closure
507 cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
508 cvtToClosureLbl (IdLabel n c RednCounts) = IdLabel n c Closure
509 cvtToClosureLbl l@(IdLabel n c Closure) = l
510 cvtToClosureLbl l
511 = pprPanic "cvtToClosureLbl" (pprCLabel l)
512
513
514 -- -----------------------------------------------------------------------------
515 -- Does a CLabel refer to a CAF?
516 hasCAF :: CLabel -> Bool
517 hasCAF (IdLabel _ MayHaveCafRefs _) = True
518 hasCAF _ = False
519
520
521 -- -----------------------------------------------------------------------------
522 -- Does a CLabel need declaring before use or not?
523 --
524 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
525
526 needsCDecl :: CLabel -> Bool
527 -- False <=> it's pre-declared; don't bother
528 -- don't bother declaring SRT & Bitmap labels, we always make sure
529 -- they are defined before use.
530 needsCDecl (IdLabel _ _ SRT) = False
531 needsCDecl (LargeSRTLabel _) = False
532 needsCDecl (LargeBitmapLabel _) = False
533 needsCDecl (IdLabel _ _ _) = True
534 needsCDecl (CaseLabel _ _) = True
535 needsCDecl (PlainModuleInitLabel _) = True
536
537 needsCDecl (StringLitLabel _) = False
538 needsCDecl (AsmTempLabel _) = False
539 needsCDecl (RtsLabel _) = False
540
541 needsCDecl (CmmLabel pkgId _ _)
542 -- Prototypes for labels defined in the runtime system are imported
543 -- into HC files via includes/Stg.h.
544 | pkgId == rtsPackageId = False
545
546 -- For other labels we inline one into the HC file directly.
547 | otherwise = True
548
549 needsCDecl l@(ForeignLabel{}) = not (isMathFun l)
550 needsCDecl (CC_Label _) = True
551 needsCDecl (CCS_Label _) = True
552 needsCDecl (HpcTicksLabel _) = True
553
554
555 -- | Check whether a label is a local temporary for native code generation
556 isAsmTemp :: CLabel -> Bool
557 isAsmTemp (AsmTempLabel _) = True
558 isAsmTemp _ = False
559
560
561 -- | If a label is a local temporary used for native code generation
562 -- then return just its unique, otherwise nothing.
563 maybeAsmTemp :: CLabel -> Maybe Unique
564 maybeAsmTemp (AsmTempLabel uq) = Just uq
565 maybeAsmTemp _ = Nothing
566
567
568 -- | Check whether a label corresponds to a C function that has
569 -- a prototype in a system header somehere, or is built-in
570 -- to the C compiler. For these labels we avoid generating our
571 -- own C prototypes.
572 isMathFun :: CLabel -> Bool
573 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
574 isMathFun _ = False
575
576 math_funs = mkUniqSet [
577 -- _ISOC99_SOURCE
578 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
579 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
580 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
581 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
582 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
583 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
584 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
585 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
586 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
587 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
588 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
589 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
590 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
591 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
592 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
593 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
594 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
595 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
596 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
597 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
598 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
599 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
600 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
601 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
602 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
603 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
604 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
605 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
606 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
607 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
608 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
609 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
610 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
611 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
612 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
613 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
614 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
615 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
616 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
617 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
618 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
619 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
620 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
621 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
622 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
623 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
624 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
625 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
626 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
627 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
628 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
629 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
630 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
631 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
632 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
633 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
634 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
635 -- ISO C 99 also defines these function-like macros in math.h:
636 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
637 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
638
639 -- additional symbols from _BSD_SOURCE
640 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
641 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
642 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
643 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
644 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
645 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
646 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
647 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
648 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
649 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
650 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
651 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
652 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
653 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl")
654 ]
655
656 -- -----------------------------------------------------------------------------
657 -- | Is a CLabel visible outside this object file or not?
658 -- From the point of view of the code generator, a name is
659 -- externally visible if it has to be declared as exported
660 -- in the .o file's symbol table; that is, made non-static.
661 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
662 externallyVisibleCLabel (CaseLabel _ _) = False
663 externallyVisibleCLabel (StringLitLabel _) = False
664 externallyVisibleCLabel (AsmTempLabel _) = False
665 externallyVisibleCLabel (PlainModuleInitLabel _)= True
666 externallyVisibleCLabel (RtsLabel _) = True
667 externallyVisibleCLabel (CmmLabel _ _ _) = True
668 externallyVisibleCLabel (ForeignLabel{}) = True
669 externallyVisibleCLabel (IdLabel name _ info) = isExternalName name && externallyVisibleIdLabel info
670 externallyVisibleCLabel (CC_Label _) = True
671 externallyVisibleCLabel (CCS_Label _) = True
672 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
673 externallyVisibleCLabel (HpcTicksLabel _) = True
674 externallyVisibleCLabel (LargeBitmapLabel _) = False
675 externallyVisibleCLabel (LargeSRTLabel _) = False
676
677 externallyVisibleIdLabel :: IdLabelInfo -> Bool
678 externallyVisibleIdLabel SRT = False
679 externallyVisibleIdLabel (Entry lcl) = not lcl
680 externallyVisibleIdLabel (InfoTable lcl) = not lcl
681 externallyVisibleIdLabel _ = True
682
683 -- -----------------------------------------------------------------------------
684 -- Finding the "type" of a CLabel
685
686 -- For generating correct types in label declarations:
687
688 data CLabelType
689 = CodeLabel -- Address of some executable instructions
690 | DataLabel -- Address of data, not a GC ptr
691 | GcPtrLabel -- Address of a (presumably static) GC object
692
693 isCFunctionLabel :: CLabel -> Bool
694 isCFunctionLabel lbl = case labelType lbl of
695 CodeLabel -> True
696 _other -> False
697
698 isGcPtrLabel :: CLabel -> Bool
699 isGcPtrLabel lbl = case labelType lbl of
700 GcPtrLabel -> True
701 _other -> False
702
703
704 -- | Work out the general type of data at the address of this label
705 -- whether it be code, data, or static GC object.
706 labelType :: CLabel -> CLabelType
707 labelType (CmmLabel _ _ CmmData) = DataLabel
708 labelType (CmmLabel _ _ CmmGcPtr) = GcPtrLabel
709 labelType (CmmLabel _ _ CmmCode) = CodeLabel
710 labelType (CmmLabel _ _ CmmInfo) = DataLabel
711 labelType (CmmLabel _ _ CmmEntry) = CodeLabel
712 labelType (CmmLabel _ _ CmmRetInfo) = DataLabel
713 labelType (CmmLabel _ _ CmmRet) = CodeLabel
714 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
715 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
716 labelType (RtsLabel (RtsApFast _)) = CodeLabel
717 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
718 labelType (CaseLabel _ _) = CodeLabel
719 labelType (PlainModuleInitLabel _) = CodeLabel
720 labelType (LargeSRTLabel _) = DataLabel
721 labelType (LargeBitmapLabel _) = DataLabel
722 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
723 labelType (IdLabel _ _ info) = idInfoLabelType info
724 labelType _ = DataLabel
725
726 idInfoLabelType info =
727 case info of
728 InfoTable _ -> DataLabel
729 Closure -> GcPtrLabel
730 ConInfoTable -> DataLabel
731 StaticInfoTable -> DataLabel
732 ClosureTable -> DataLabel
733 RednCounts -> DataLabel
734 _ -> CodeLabel
735
736
737 -- -----------------------------------------------------------------------------
738 -- Does a CLabel need dynamic linkage?
739
740 -- When referring to data in code, we need to know whether
741 -- that data resides in a DLL or not. [Win32 only.]
742 -- @labelDynamic@ returns @True@ if the label is located
743 -- in a DLL, be it a data reference or not.
744
745 labelDynamic :: PackageId -> CLabel -> Bool
746 labelDynamic this_pkg lbl =
747 case lbl of
748 -- is the RTS in a DLL or not?
749 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId)
750
751 IdLabel n _ k -> isDllName this_pkg n
752
753 #if mingw32_TARGET_OS
754 -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
755 CmmLabel pkg _ _
756 -> not opt_Static && (this_pkg /= pkg)
757
758 -- Foreign label is in some un-named foreign package (or DLL)
759 ForeignLabel _ _ ForeignLabelInExternalPackage _ -> True
760
761 -- Foreign label is linked into the same package as the source file currently being compiled.
762 ForeignLabel _ _ ForeignLabelInThisPackage _ -> False
763
764 -- Foreign label is in some named package.
765 -- When compiling in the "dyn" way, each package is to be linked into its own DLL.
766 ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
767 -> (not opt_Static) && (this_pkg /= pkgId)
768
769 #else
770 -- On Mac OS X and on ELF platforms, false positives are OK,
771 -- so we claim that all foreign imports come from dynamic libraries
772 ForeignLabel _ _ _ _ -> True
773
774 CmmLabel pkg _ _ -> True
775
776 #endif
777 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
778
779 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
780 _ -> False
781
782 {-
783 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
784 right places. It is used to detect when the abstractC statement of an
785 CCodeBlock actually contains the code for a slow entry point. -- HWL
786
787 We need at least @Eq@ for @CLabels@, because we want to avoid
788 duplicate declarations in generating C (see @labelSeenTE@ in
789 @PprAbsC@).
790 -}
791
792 -----------------------------------------------------------------------------
793 -- Printing out CLabels.
794
795 {-
796 Convention:
797
798 <name>_<type>
799
800 where <name> is <Module>_<name> for external names and <unique> for
801 internal names. <type> is one of the following:
802
803 info Info table
804 srt Static reference table
805 srtd Static reference table descriptor
806 entry Entry code (function, closure)
807 slow Slow entry code (if any)
808 ret Direct return address
809 vtbl Vector table
810 <n>_alt Case alternative (tag n)
811 dflt Default case alternative
812 btm Large bitmap vector
813 closure Static closure
814 con_entry Dynamic Constructor entry code
815 con_info Dynamic Constructor info table
816 static_entry Static Constructor entry code
817 static_info Static Constructor info table
818 sel_info Selector info table
819 sel_entry Selector entry code
820 cc Cost centre
821 ccs Cost centre stack
822
823 Many of these distinctions are only for documentation reasons. For
824 example, _ret is only distinguished from _entry to make it easy to
825 tell whether a code fragment is a return point or a closure/function
826 entry.
827 -}
828
829 instance Outputable CLabel where
830 ppr = pprCLabel
831 instance PlatformOutputable CLabel where
832 pprPlatform _ = pprCLabel
833
834 pprCLabel :: CLabel -> SDoc
835
836 pprCLabel (AsmTempLabel u)
837 | cGhcWithNativeCodeGen == "YES"
838 = getPprStyle $ \ sty ->
839 if asmStyle sty then
840 ptext asmTempLabelPrefix <> pprUnique u
841 else
842 char '_' <> pprUnique u
843
844 pprCLabel (DynamicLinkerLabel info lbl)
845 | cGhcWithNativeCodeGen == "YES"
846 = pprDynamicLinkerAsmLabel info lbl
847
848 pprCLabel PicBaseLabel
849 | cGhcWithNativeCodeGen == "YES"
850 = ptext (sLit "1b")
851
852 pprCLabel (DeadStripPreventer lbl)
853 | cGhcWithNativeCodeGen == "YES"
854 = pprCLabel lbl <> ptext (sLit "_dsp")
855
856 pprCLabel lbl
857 = getPprStyle $ \ sty ->
858 if cGhcWithNativeCodeGen == "YES" && asmStyle sty
859 then maybe_underscore (pprAsmCLbl lbl)
860 else pprCLbl lbl
861
862 maybe_underscore doc
863 | underscorePrefix = pp_cSEP <> doc
864 | otherwise = doc
865
866 #ifdef mingw32_TARGET_OS
867 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
868 -- (The C compiler does this itself).
869 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
870 = ftext fs <> char '@' <> int sz
871 #endif
872 pprAsmCLbl lbl
873 = pprCLbl lbl
874
875 pprCLbl (StringLitLabel u)
876 = pprUnique u <> ptext (sLit "_str")
877
878 pprCLbl (CaseLabel u CaseReturnPt)
879 = hcat [pprUnique u, ptext (sLit "_ret")]
880 pprCLbl (CaseLabel u CaseReturnInfo)
881 = hcat [pprUnique u, ptext (sLit "_info")]
882 pprCLbl (CaseLabel u (CaseAlt tag))
883 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
884 pprCLbl (CaseLabel u CaseDefault)
885 = hcat [pprUnique u, ptext (sLit "_dflt")]
886
887 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
888 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
889 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
890 -- until that gets resolved we'll just force them to start
891 -- with a letter so the label will be legal assmbly code.
892
893
894 pprCLbl (CmmLabel _ str CmmCode) = ftext str
895 pprCLbl (CmmLabel _ str CmmData) = ftext str
896 pprCLbl (CmmLabel _ str CmmGcPtr) = ftext str
897 pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str
898
899 pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> ptext (sLit "_fast")
900
901 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
902 = hcat [ptext (sLit "stg_sel_"), text (show offset),
903 ptext (if upd_reqd
904 then (sLit "_upd_info")
905 else (sLit "_noupd_info"))
906 ]
907
908 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
909 = hcat [ptext (sLit "stg_sel_"), text (show offset),
910 ptext (if upd_reqd
911 then (sLit "_upd_entry")
912 else (sLit "_noupd_entry"))
913 ]
914
915 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
916 = hcat [ptext (sLit "stg_ap_"), text (show arity),
917 ptext (if upd_reqd
918 then (sLit "_upd_info")
919 else (sLit "_noupd_info"))
920 ]
921
922 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
923 = hcat [ptext (sLit "stg_ap_"), text (show arity),
924 ptext (if upd_reqd
925 then (sLit "_upd_entry")
926 else (sLit "_noupd_entry"))
927 ]
928
929 pprCLbl (CmmLabel _ fs CmmInfo)
930 = ftext fs <> ptext (sLit "_info")
931
932 pprCLbl (CmmLabel _ fs CmmEntry)
933 = ftext fs <> ptext (sLit "_entry")
934
935 pprCLbl (CmmLabel _ fs CmmRetInfo)
936 = ftext fs <> ptext (sLit "_info")
937
938 pprCLbl (CmmLabel _ fs CmmRet)
939 = ftext fs <> ptext (sLit "_ret")
940
941 pprCLbl (RtsLabel (RtsPrimOp primop))
942 = ptext (sLit "stg_") <> ppr primop
943
944 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
945 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
946
947 pprCLbl (ForeignLabel str _ _ _)
948 = ftext str
949
950 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
951
952 pprCLbl (CC_Label cc) = ppr cc
953 pprCLbl (CCS_Label ccs) = ppr ccs
954
955 pprCLbl (PlainModuleInitLabel mod)
956 = ptext (sLit "__stginit_") <> ppr mod
957
958 pprCLbl (HpcTicksLabel mod)
959 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
960
961 ppIdFlavor :: IdLabelInfo -> SDoc
962 ppIdFlavor x = pp_cSEP <>
963 (case x of
964 Closure -> ptext (sLit "closure")
965 SRT -> ptext (sLit "srt")
966 InfoTable _ -> ptext (sLit "info")
967 Entry _ -> ptext (sLit "entry")
968 Slow -> ptext (sLit "slow")
969 RednCounts -> ptext (sLit "ct")
970 ConEntry -> ptext (sLit "con_entry")
971 ConInfoTable -> ptext (sLit "con_info")
972 StaticConEntry -> ptext (sLit "static_entry")
973 StaticInfoTable -> ptext (sLit "static_info")
974 ClosureTable -> ptext (sLit "closure_tbl")
975 )
976
977
978 pp_cSEP = char '_'
979
980
981 instance Outputable ForeignLabelSource where
982 ppr fs
983 = case fs of
984 ForeignLabelInPackage pkgId -> parens $ text "package: " <> ppr pkgId
985 ForeignLabelInThisPackage -> parens $ text "this package"
986 ForeignLabelInExternalPackage -> parens $ text "external package"
987
988 -- -----------------------------------------------------------------------------
989 -- Machine-dependent knowledge about labels.
990
991 underscorePrefix :: Bool -- leading underscore on assembler labels?
992 underscorePrefix = (cLeadingUnderscore == "YES")
993
994 asmTempLabelPrefix :: LitString -- for formatting labels
995 asmTempLabelPrefix =
996 #if alpha_TARGET_OS
997 {- The alpha assembler likes temporary labels to look like $L123
998 instead of L123. (Don't toss the L, because then Lf28
999 turns into $f28.)
1000 -}
1001 (sLit "$")
1002 #elif darwin_TARGET_OS
1003 (sLit "L")
1004 #else
1005 (sLit ".L")
1006 #endif
1007
1008 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
1009
1010 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
1011 pprDynamicLinkerAsmLabel CodeStub lbl
1012 = char 'L' <> pprCLabel lbl <> text "$stub"
1013 pprDynamicLinkerAsmLabel SymbolPtr lbl
1014 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1015 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1016 = pprCLabel lbl <> text "@GOTPCREL"
1017 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1018 = pprCLabel lbl
1019 pprDynamicLinkerAsmLabel _ _
1020 = panic "pprDynamicLinkerAsmLabel"
1021
1022 #elif darwin_TARGET_OS
1023 pprDynamicLinkerAsmLabel CodeStub lbl
1024 = char 'L' <> pprCLabel lbl <> text "$stub"
1025 pprDynamicLinkerAsmLabel SymbolPtr lbl
1026 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
1027 pprDynamicLinkerAsmLabel _ _
1028 = panic "pprDynamicLinkerAsmLabel"
1029
1030 #elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
1031 pprDynamicLinkerAsmLabel CodeStub lbl
1032 = pprCLabel lbl <> text "@plt"
1033 pprDynamicLinkerAsmLabel SymbolPtr lbl
1034 = text ".LC_" <> pprCLabel lbl
1035 pprDynamicLinkerAsmLabel _ _
1036 = panic "pprDynamicLinkerAsmLabel"
1037
1038 #elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
1039 pprDynamicLinkerAsmLabel CodeStub lbl
1040 = pprCLabel lbl <> text "@plt"
1041 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1042 = pprCLabel lbl <> text "@gotpcrel"
1043 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1044 = pprCLabel lbl
1045 pprDynamicLinkerAsmLabel SymbolPtr lbl
1046 = text ".LC_" <> pprCLabel lbl
1047
1048 #elif elf_OBJ_FORMAT
1049 pprDynamicLinkerAsmLabel CodeStub lbl
1050 = pprCLabel lbl <> text "@plt"
1051 pprDynamicLinkerAsmLabel SymbolPtr lbl
1052 = text ".LC_" <> pprCLabel lbl
1053 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1054 = pprCLabel lbl <> text "@got"
1055 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1056 = pprCLabel lbl <> text "@gotoff"
1057
1058 #elif mingw32_TARGET_OS
1059 pprDynamicLinkerAsmLabel SymbolPtr lbl
1060 = text "__imp_" <> pprCLabel lbl
1061 pprDynamicLinkerAsmLabel _ _
1062 = panic "pprDynamicLinkerAsmLabel"
1063
1064 #else
1065 pprDynamicLinkerAsmLabel _ _
1066 = panic "pprDynamicLinkerAsmLabel"
1067 #endif