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
8 -----------------------------------------------------------------------------
10 -- Object-file symbols (called CLabel for histerical raisins).
12 -- (c) The University of Glasgow 2004-2006
14 -----------------------------------------------------------------------------
17 CLabel, -- abstract type
25 mkStaticConEntryLabel,
28 mkStaticInfoTableLabel,
35 mkLocalInfoTableLabel,
38 mkLocalStaticConEntryLabel,
39 mkLocalConInfoTableLabel,
40 mkLocalStaticInfoTableLabel,
41 mkLocalClosureTableLabel,
53 mkPlainModuleInitLabel,
54 mkModuleInitTableLabel,
57 mkDirty_MUT_VAR_Label,
60 mkMainCapabilityLabel,
61 mkMAP_FROZEN_infoLabel,
62 mkMAP_DIRTY_infoLabel,
63 mkEMPTY_MVAR_infoLabel,
66 mkCAFBlackHoleInfoTableLabel,
68 mkRtsSlowTickyCtrLabel,
95 foreignLabelStdcallInfo,
97 mkCCLabel, mkCCSLabel,
99 DynamicLinkerLabelInfo(..),
100 mkDynamicLinkerLabel,
101 dynamicLinkerLabelInfo,
104 mkDeadStripPreventer,
107 mkHpcModuleNameLabel,
110 infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
111 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
113 isCFunctionLabel, isGcPtrLabel, labelDynamic,
118 #include "HsVersions.h"
138 -- -----------------------------------------------------------------------------
142 CLabel is an abstract type that supports the following operations:
146 - In a C file, does it need to be declared before use? (i.e. is it
147 guaranteed to be already in scope in the places we need to refer to it?)
149 - If it needs to be declared, what type (code or data) should it be
152 - Is it visible outside this object file or not?
154 - Is it "dynamic" (see details below)
156 - Eq and Ord, so that we can make sets of CLabels (currently only
157 used in outputting C as far as I can tell, to avoid generating
158 more than one declaration for any given label).
160 - Converting an info table label into an entry label.
164 = IdLabel -- A family of labels related to the
165 Name -- definition of a particular Id or Con
169 | CaseLabel -- A family of labels related to a particular
171 {-# UNPACK #-} !Unique -- Unique says which case expression
175 {-# UNPACK #-} !Unique
178 {-# UNPACK #-} !Unique
181 Module -- the module name
183 -- at some point we might want some kind of version number in
184 -- the module init label, to guard against compiling modules in
185 -- the wrong order. We can't use the interface file version however,
186 -- because we don't always recompile modules which depend on a module
187 -- whose version has changed.
189 | PlainModuleInitLabel -- without the version & way info
192 | ModuleInitTableLabel -- table of imported modules to init
197 | RtsLabel RtsLabelInfo
199 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
200 (Maybe Int) -- possible '@n' suffix for stdcall functions
201 -- When generating C, the '@n' suffix is omitted, but when
202 -- generating assembler we must add it to the label.
203 Bool -- True <=> is dynamic
206 | CC_Label CostCentre
207 | CCS_Label CostCentreStack
209 -- Dynamic Linking in the NCG:
210 -- generated and used inside the NCG only,
211 -- see module PositionIndependentCode for details.
213 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
214 -- special variants of a label used for dynamic linking
216 | PicBaseLabel -- a label used as a base for PIC calculations
217 -- on some platforms.
218 -- It takes the form of a local numeric
219 -- assembler label '1'; it is pretty-printed
220 -- as 1b, referring to the previous definition
221 -- of 1: in the assembler source file.
223 | DeadStripPreventer CLabel
224 -- label before an info table to prevent excessive dead-stripping on darwin
226 | HpcTicksLabel Module -- Per-module table of tick locations
227 | HpcModuleNameLabel -- Per-module name of the module for Hpc
229 | LargeSRTLabel -- Label of an StgLargeSRT
230 {-# UNPACK #-} !Unique
232 | LargeBitmapLabel -- A bitmap (function or case return)
233 {-# UNPACK #-} !Unique
238 = Closure -- Label for closure
239 | SRT -- Static reference table
240 | InfoTable -- Info tables for closures; always read-only
241 | Entry -- entry point
242 | Slow -- slow entry point
244 | RednCounts -- Label of place to keep Ticky-ticky info for
247 | ConEntry -- constructor entry point
248 | ConInfoTable -- corresponding info table
249 | StaticConEntry -- static constructor entry point
250 | StaticInfoTable -- corresponding info table
252 | ClosureTable -- table of closures for Enum tycons
266 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
267 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
269 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
270 | RtsApEntry Bool{-updatable-} Int{-arity-}
274 | RtsInfo LitString -- misc rts info tables
275 | RtsEntry LitString -- misc rts entry points
276 | RtsRetInfo LitString -- misc rts ret info tables
277 | RtsRet LitString -- misc rts return points
278 | RtsData LitString -- misc rts data bits
279 | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure
280 | RtsCode LitString -- misc rts code
282 | RtsInfoFS FastString -- misc rts info tables
283 | RtsEntryFS FastString -- misc rts entry points
284 | RtsRetInfoFS FastString -- misc rts ret info tables
285 | RtsRetFS FastString -- misc rts return points
286 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
287 | RtsCodeFS FastString -- misc rts code
289 | RtsApFast LitString -- _fast versions of generic apply
291 | RtsSlowTickyCtr String
294 -- NOTE: Eq on LitString compares the pointer only, so this isn't
297 data DynamicLinkerLabelInfo
298 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
299 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
300 | GotSymbolPtr -- ELF: foo@got
301 | GotSymbolOffset -- ELF: foo@gotoff
305 -- -----------------------------------------------------------------------------
306 -- Constructing CLabels
308 -- These are always local:
309 mkSRTLabel name c = IdLabel name c SRT
310 mkSlowEntryLabel name c = IdLabel name c Slow
311 mkRednCountsLabel name c = IdLabel name c RednCounts
313 -- These have local & (possibly) external variants:
314 mkLocalClosureLabel name c = IdLabel name c Closure
315 mkLocalInfoTableLabel name c = IdLabel name c InfoTable
316 mkLocalEntryLabel name c = IdLabel name c Entry
317 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
319 mkClosureLabel name c = IdLabel name c Closure
320 mkInfoTableLabel name c = IdLabel name c InfoTable
321 mkEntryLabel name c = IdLabel name c Entry
322 mkClosureTableLabel name c = IdLabel name c ClosureTable
323 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
324 mkLocalConEntryLabel c con = IdLabel con c ConEntry
325 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
326 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
327 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
328 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
330 mkConEntryLabel name c = IdLabel name c ConEntry
331 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
333 mkLargeSRTLabel uniq = LargeSRTLabel uniq
334 mkBitmapLabel uniq = LargeBitmapLabel uniq
336 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
337 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
338 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
339 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
341 mkStringLitLabel = StringLitLabel
342 mkAsmTempLabel :: Uniquable a => a -> CLabel
343 mkAsmTempLabel a = AsmTempLabel (getUnique a)
345 mkModuleInitLabel :: Module -> String -> CLabel
346 mkModuleInitLabel mod way = ModuleInitLabel mod way
348 mkPlainModuleInitLabel :: Module -> CLabel
349 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
351 mkModuleInitTableLabel :: Module -> CLabel
352 mkModuleInitTableLabel mod = ModuleInitTableLabel mod
354 -- Some fixed runtime system labels
356 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
357 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
358 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
359 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
360 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
361 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
362 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
363 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
365 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
366 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
367 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
369 moduleRegdLabel = ModuleRegdLabel
370 moduleRegTableLabel = ModuleInitTableLabel
372 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
373 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
375 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
376 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
380 mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
381 mkForeignLabel str mb_sz is_dynamic fod
382 = ForeignLabel str mb_sz is_dynamic fod
384 addLabelSize :: CLabel -> Int -> CLabel
385 addLabelSize (ForeignLabel str _ is_dynamic fod) sz
386 = ForeignLabel str (Just sz) is_dynamic fod
390 foreignLabelStdcallInfo :: CLabel -> Maybe Int
391 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
392 foreignLabelStdcallInfo _lbl = Nothing
396 mkCCLabel cc = CC_Label cc
397 mkCCSLabel ccs = CCS_Label ccs
399 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
400 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
401 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
402 mkRtsRetLabel str = RtsLabel (RtsRet str)
403 mkRtsCodeLabel str = RtsLabel (RtsCode str)
404 mkRtsDataLabel str = RtsLabel (RtsData str)
405 mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
407 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
408 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
409 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
410 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
411 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
412 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
414 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
416 mkRtsSlowTickyCtrLabel :: String -> CLabel
417 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
421 mkHpcTicksLabel = HpcTicksLabel
422 mkHpcModuleNameLabel = HpcModuleNameLabel
426 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
427 mkDynamicLinkerLabel = DynamicLinkerLabel
429 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
430 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
431 dynamicLinkerLabelInfo _ = Nothing
433 -- Position independent code
435 mkPicBaseLabel :: CLabel
436 mkPicBaseLabel = PicBaseLabel
438 mkDeadStripPreventer :: CLabel -> CLabel
439 mkDeadStripPreventer lbl = DeadStripPreventer lbl
441 -- -----------------------------------------------------------------------------
442 -- Converting between info labels and entry/ret labels.
444 infoLblToEntryLbl :: CLabel -> CLabel
445 infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
446 infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
447 infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
448 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
449 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
450 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
451 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
452 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
453 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
455 entryLblToInfoLbl :: CLabel -> CLabel
456 entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
457 entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
458 entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
459 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
460 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
461 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
462 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
463 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
464 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
466 cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
467 cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
468 cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
469 cvtToClosureLbl l@(IdLabel n c Closure) = l
470 cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
472 cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
473 cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
474 cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
475 cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
476 cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
478 -- -----------------------------------------------------------------------------
479 -- Does a CLabel refer to a CAF?
480 hasCAF :: CLabel -> Bool
481 hasCAF (IdLabel _ MayHaveCafRefs _) = True
484 -- -----------------------------------------------------------------------------
485 -- Does a CLabel need declaring before use or not?
487 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
489 needsCDecl :: CLabel -> Bool
490 -- False <=> it's pre-declared; don't bother
491 -- don't bother declaring SRT & Bitmap labels, we always make sure
492 -- they are defined before use.
493 needsCDecl (IdLabel _ _ SRT) = False
494 needsCDecl (LargeSRTLabel _) = False
495 needsCDecl (LargeBitmapLabel _) = False
496 needsCDecl (IdLabel _ _ _) = True
497 needsCDecl (CaseLabel _ _) = True
498 needsCDecl (ModuleInitLabel _ _) = True
499 needsCDecl (PlainModuleInitLabel _) = True
500 needsCDecl (ModuleInitTableLabel _) = True
501 needsCDecl ModuleRegdLabel = False
503 needsCDecl (StringLitLabel _) = False
504 needsCDecl (AsmTempLabel _) = False
505 needsCDecl (RtsLabel _) = False
506 needsCDecl l@(ForeignLabel _ _ _ _) = not (isMathFun l)
507 needsCDecl (CC_Label _) = True
508 needsCDecl (CCS_Label _) = True
509 needsCDecl (HpcTicksLabel _) = True
510 needsCDecl HpcModuleNameLabel = False
512 -- Whether the label is an assembler temporary:
514 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
515 isAsmTemp (AsmTempLabel _) = True
518 maybeAsmTemp :: CLabel -> Maybe Unique
519 maybeAsmTemp (AsmTempLabel uq) = Just uq
520 maybeAsmTemp _ = Nothing
522 -- some labels have C prototypes in scope when compiling via C, because
523 -- they are builtin to the C compiler. For these labels we avoid
524 -- generating our own C prototypes.
525 isMathFun :: CLabel -> Bool
526 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
529 math_funs = mkUniqSet [
531 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
532 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
533 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
534 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
535 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
536 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
537 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
538 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
539 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
540 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
541 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
542 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
543 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
544 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
545 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
546 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
547 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
548 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
549 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
550 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
551 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
552 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
553 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
554 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
555 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
556 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
557 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
558 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
559 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
560 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
561 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
562 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
563 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
564 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
565 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
566 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
567 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
568 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
569 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
570 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
571 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
572 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
573 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
574 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
575 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
576 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
577 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
578 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
579 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
580 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
581 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
582 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
583 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
584 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
585 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
586 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
587 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
588 -- ISO C 99 also defines these function-like macros in math.h:
589 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
590 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
592 -- additional symbols from _BSD_SOURCE
593 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
594 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
595 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
596 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
597 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
598 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
599 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
600 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
601 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
602 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
603 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
604 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
605 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
606 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl")
609 -- -----------------------------------------------------------------------------
610 -- Is a CLabel visible outside this object file or not?
612 -- From the point of view of the code generator, a name is
613 -- externally visible if it has to be declared as exported
614 -- in the .o file's symbol table; that is, made non-static.
616 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
617 externallyVisibleCLabel (CaseLabel _ _) = False
618 externallyVisibleCLabel (StringLitLabel _) = False
619 externallyVisibleCLabel (AsmTempLabel _) = False
620 externallyVisibleCLabel (ModuleInitLabel _ _) = True
621 externallyVisibleCLabel (PlainModuleInitLabel _)= True
622 externallyVisibleCLabel (ModuleInitTableLabel _)= False
623 externallyVisibleCLabel ModuleRegdLabel = False
624 externallyVisibleCLabel (RtsLabel _) = True
625 externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
626 externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
627 externallyVisibleCLabel (CC_Label _) = True
628 externallyVisibleCLabel (CCS_Label _) = True
629 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
630 externallyVisibleCLabel (HpcTicksLabel _) = True
631 externallyVisibleCLabel HpcModuleNameLabel = False
632 externallyVisibleCLabel (LargeBitmapLabel _) = False
633 externallyVisibleCLabel (LargeSRTLabel _) = False
635 -- -----------------------------------------------------------------------------
636 -- Finding the "type" of a CLabel
638 -- For generating correct types in label declarations:
641 = CodeLabel -- Address of some executable instructions
642 | DataLabel -- Address of data, not a GC ptr
643 | GcPtrLabel -- Address of a (presumably static) GC object
645 isCFunctionLabel :: CLabel -> Bool
646 isCFunctionLabel lbl = case labelType lbl of
650 isGcPtrLabel :: CLabel -> Bool
651 isGcPtrLabel lbl = case labelType lbl of
655 labelType :: CLabel -> CLabelType
656 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
657 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
658 labelType (RtsLabel (RtsData _)) = DataLabel
659 labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
660 labelType (RtsLabel (RtsCode _)) = CodeLabel
661 labelType (RtsLabel (RtsInfo _)) = DataLabel
662 labelType (RtsLabel (RtsEntry _)) = CodeLabel
663 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
664 labelType (RtsLabel (RtsRet _)) = CodeLabel
665 labelType (RtsLabel (RtsDataFS _)) = DataLabel
666 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
667 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
668 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
669 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
670 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
671 labelType (RtsLabel (RtsApFast _)) = CodeLabel
672 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
673 labelType (CaseLabel _ _) = CodeLabel
674 labelType (ModuleInitLabel _ _) = CodeLabel
675 labelType (PlainModuleInitLabel _) = CodeLabel
676 labelType (ModuleInitTableLabel _) = DataLabel
677 labelType (LargeSRTLabel _) = DataLabel
678 labelType (LargeBitmapLabel _) = DataLabel
679 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
680 labelType (IdLabel _ _ info) = idInfoLabelType info
681 labelType _ = DataLabel
683 idInfoLabelType info =
685 InfoTable -> DataLabel
686 Closure -> GcPtrLabel
687 ConInfoTable -> DataLabel
688 StaticInfoTable -> DataLabel
689 ClosureTable -> DataLabel
690 RednCounts -> DataLabel
694 -- -----------------------------------------------------------------------------
695 -- Does a CLabel need dynamic linkage?
697 -- When referring to data in code, we need to know whether
698 -- that data resides in a DLL or not. [Win32 only.]
699 -- @labelDynamic@ returns @True@ if the label is located
700 -- in a DLL, be it a data reference or not.
702 labelDynamic :: PackageId -> CLabel -> Bool
703 labelDynamic this_pkg lbl =
705 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
706 IdLabel n _ k -> isDllName this_pkg n
707 #if mingw32_TARGET_OS
708 ForeignLabel _ _ d _ -> d
710 -- On Mac OS X and on ELF platforms, false positives are OK,
711 -- so we claim that all foreign imports come from dynamic libraries
712 ForeignLabel _ _ _ _ -> True
714 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
715 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
716 ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
718 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
722 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
723 right places. It is used to detect when the abstractC statement of an
724 CCodeBlock actually contains the code for a slow entry point. -- HWL
726 We need at least @Eq@ for @CLabels@, because we want to avoid
727 duplicate declarations in generating C (see @labelSeenTE@ in
731 -----------------------------------------------------------------------------
732 -- Printing out CLabels.
739 where <name> is <Module>_<name> for external names and <unique> for
740 internal names. <type> is one of the following:
743 srt Static reference table
744 srtd Static reference table descriptor
745 entry Entry code (function, closure)
746 slow Slow entry code (if any)
747 ret Direct return address
749 <n>_alt Case alternative (tag n)
750 dflt Default case alternative
751 btm Large bitmap vector
752 closure Static closure
753 con_entry Dynamic Constructor entry code
754 con_info Dynamic Constructor info table
755 static_entry Static Constructor entry code
756 static_info Static Constructor info table
757 sel_info Selector info table
758 sel_entry Selector entry code
760 ccs Cost centre stack
762 Many of these distinctions are only for documentation reasons. For
763 example, _ret is only distinguished from _entry to make it easy to
764 tell whether a code fragment is a return point or a closure/function
768 instance Outputable CLabel where
771 pprCLabel :: CLabel -> SDoc
773 #if ! OMIT_NATIVE_CODEGEN
774 pprCLabel (AsmTempLabel u)
775 = getPprStyle $ \ sty ->
777 ptext asmTempLabelPrefix <> pprUnique u
779 char '_' <> pprUnique u
781 pprCLabel (DynamicLinkerLabel info lbl)
782 = pprDynamicLinkerAsmLabel info lbl
784 pprCLabel PicBaseLabel
787 pprCLabel (DeadStripPreventer lbl)
788 = pprCLabel lbl <> ptext (sLit "_dsp")
792 #if ! OMIT_NATIVE_CODEGEN
793 getPprStyle $ \ sty ->
795 maybe_underscore (pprAsmCLbl lbl)
801 | underscorePrefix = pp_cSEP <> doc
804 #ifdef mingw32_TARGET_OS
805 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
806 -- (The C compiler does this itself).
807 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
808 = ftext fs <> char '@' <> int sz
813 pprCLbl (StringLitLabel u)
814 = pprUnique u <> ptext (sLit "_str")
816 pprCLbl (CaseLabel u CaseReturnPt)
817 = hcat [pprUnique u, ptext (sLit "_ret")]
818 pprCLbl (CaseLabel u CaseReturnInfo)
819 = hcat [pprUnique u, ptext (sLit "_info")]
820 pprCLbl (CaseLabel u (CaseAlt tag))
821 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
822 pprCLbl (CaseLabel u CaseDefault)
823 = hcat [pprUnique u, ptext (sLit "_dflt")]
825 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
826 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
827 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
828 -- until that gets resolved we'll just force them to start
829 -- with a letter so the label will be legal assmbly code.
832 pprCLbl (RtsLabel (RtsCode str)) = ptext str
833 pprCLbl (RtsLabel (RtsData str)) = ptext str
834 pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str
835 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
836 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
838 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
840 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
841 = hcat [ptext (sLit "stg_sel_"), text (show offset),
843 then (sLit "_upd_info")
844 else (sLit "_noupd_info"))
847 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
848 = hcat [ptext (sLit "stg_sel_"), text (show offset),
850 then (sLit "_upd_entry")
851 else (sLit "_noupd_entry"))
854 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
855 = hcat [ptext (sLit "stg_ap_"), text (show arity),
857 then (sLit "_upd_info")
858 else (sLit "_noupd_info"))
861 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
862 = hcat [ptext (sLit "stg_ap_"), text (show arity),
864 then (sLit "_upd_entry")
865 else (sLit "_noupd_entry"))
868 pprCLbl (RtsLabel (RtsInfo fs))
869 = ptext fs <> ptext (sLit "_info")
871 pprCLbl (RtsLabel (RtsEntry fs))
872 = ptext fs <> ptext (sLit "_entry")
874 pprCLbl (RtsLabel (RtsRetInfo fs))
875 = ptext fs <> ptext (sLit "_info")
877 pprCLbl (RtsLabel (RtsRet fs))
878 = ptext fs <> ptext (sLit "_ret")
880 pprCLbl (RtsLabel (RtsInfoFS fs))
881 = ftext fs <> ptext (sLit "_info")
883 pprCLbl (RtsLabel (RtsEntryFS fs))
884 = ftext fs <> ptext (sLit "_entry")
886 pprCLbl (RtsLabel (RtsRetInfoFS fs))
887 = ftext fs <> ptext (sLit "_info")
889 pprCLbl (RtsLabel (RtsRetFS fs))
890 = ftext fs <> ptext (sLit "_ret")
892 pprCLbl (RtsLabel (RtsPrimOp primop))
893 = ppr primop <> ptext (sLit "_fast")
895 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
896 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
898 pprCLbl ModuleRegdLabel
899 = ptext (sLit "_module_registered")
901 pprCLbl (ForeignLabel str _ _ _)
904 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
906 pprCLbl (CC_Label cc) = ppr cc
907 pprCLbl (CCS_Label ccs) = ppr ccs
909 pprCLbl (ModuleInitLabel mod way)
910 = ptext (sLit "__stginit_") <> ppr mod
911 <> char '_' <> text way
912 pprCLbl (PlainModuleInitLabel mod)
913 = ptext (sLit "__stginit_") <> ppr mod
914 pprCLbl (ModuleInitTableLabel mod)
915 = ptext (sLit "__stginittable_") <> ppr mod
917 pprCLbl (HpcTicksLabel mod)
918 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
920 pprCLbl HpcModuleNameLabel
921 = ptext (sLit "_hpc_module_name_str")
923 ppIdFlavor :: IdLabelInfo -> SDoc
924 ppIdFlavor x = pp_cSEP <>
926 Closure -> ptext (sLit "closure")
927 SRT -> ptext (sLit "srt")
928 InfoTable -> ptext (sLit "info")
929 Entry -> ptext (sLit "entry")
930 Slow -> ptext (sLit "slow")
931 RednCounts -> ptext (sLit "ct")
932 ConEntry -> ptext (sLit "con_entry")
933 ConInfoTable -> ptext (sLit "con_info")
934 StaticConEntry -> ptext (sLit "static_entry")
935 StaticInfoTable -> ptext (sLit "static_info")
936 ClosureTable -> ptext (sLit "closure_tbl")
942 -- -----------------------------------------------------------------------------
943 -- Machine-dependent knowledge about labels.
945 underscorePrefix :: Bool -- leading underscore on assembler labels?
946 underscorePrefix = (cLeadingUnderscore == "YES")
948 asmTempLabelPrefix :: LitString -- for formatting labels
951 {- The alpha assembler likes temporary labels to look like $L123
952 instead of L123. (Don't toss the L, because then Lf28
956 #elif darwin_TARGET_OS
962 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
964 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
965 pprDynamicLinkerAsmLabel CodeStub lbl
966 = char 'L' <> pprCLabel lbl <> text "$stub"
967 pprDynamicLinkerAsmLabel SymbolPtr lbl
968 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
969 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
970 = pprCLabel lbl <> text "@GOTPCREL"
971 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
973 pprDynamicLinkerAsmLabel _ _
974 = panic "pprDynamicLinkerAsmLabel"
975 #elif darwin_TARGET_OS
976 pprDynamicLinkerAsmLabel CodeStub lbl
977 = char 'L' <> pprCLabel lbl <> text "$stub"
978 pprDynamicLinkerAsmLabel SymbolPtr lbl
979 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
980 pprDynamicLinkerAsmLabel _ _
981 = panic "pprDynamicLinkerAsmLabel"
982 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
983 pprDynamicLinkerAsmLabel CodeStub lbl
984 = pprCLabel lbl <> text "@plt"
985 pprDynamicLinkerAsmLabel SymbolPtr lbl
986 = text ".LC_" <> pprCLabel lbl
987 pprDynamicLinkerAsmLabel _ _
988 = panic "pprDynamicLinkerAsmLabel"
989 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
990 pprDynamicLinkerAsmLabel CodeStub lbl
991 = pprCLabel lbl <> text "@plt"
992 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
993 = pprCLabel lbl <> text "@gotpcrel"
994 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
996 pprDynamicLinkerAsmLabel SymbolPtr lbl
997 = text ".LC_" <> pprCLabel lbl
998 #elif linux_TARGET_OS
999 pprDynamicLinkerAsmLabel CodeStub lbl
1000 = pprCLabel lbl <> text "@plt"
1001 pprDynamicLinkerAsmLabel SymbolPtr lbl
1002 = text ".LC_" <> pprCLabel lbl
1003 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1004 = pprCLabel lbl <> text "@got"
1005 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1006 = pprCLabel lbl <> text "@gotoff"
1007 #elif mingw32_TARGET_OS
1008 pprDynamicLinkerAsmLabel SymbolPtr lbl
1009 = text "__imp_" <> pprCLabel lbl
1010 pprDynamicLinkerAsmLabel _ _
1011 = panic "pprDynamicLinkerAsmLabel"
1013 pprDynamicLinkerAsmLabel _ _
1014 = panic "pprDynamicLinkerAsmLabel"