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,
97 foreignLabelStdcallInfo,
99 mkCCLabel, mkCCSLabel,
101 DynamicLinkerLabelInfo(..),
102 mkDynamicLinkerLabel,
103 dynamicLinkerLabelInfo,
106 mkDeadStripPreventer,
109 mkHpcModuleNameLabel,
112 infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
113 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
115 isCFunctionLabel, isGcPtrLabel, labelDynamic,
120 #include "HsVersions.h"
140 -- -----------------------------------------------------------------------------
144 CLabel is an abstract type that supports the following operations:
148 - In a C file, does it need to be declared before use? (i.e. is it
149 guaranteed to be already in scope in the places we need to refer to it?)
151 - If it needs to be declared, what type (code or data) should it be
154 - Is it visible outside this object file or not?
156 - Is it "dynamic" (see details below)
158 - Eq and Ord, so that we can make sets of CLabels (currently only
159 used in outputting C as far as I can tell, to avoid generating
160 more than one declaration for any given label).
162 - Converting an info table label into an entry label.
166 = IdLabel -- A family of labels related to the
167 Name -- definition of a particular Id or Con
171 | CaseLabel -- A family of labels related to a particular
173 {-# UNPACK #-} !Unique -- Unique says which case expression
177 {-# UNPACK #-} !Unique
180 {-# UNPACK #-} !Unique
183 Module -- the module name
185 -- at some point we might want some kind of version number in
186 -- the module init label, to guard against compiling modules in
187 -- the wrong order. We can't use the interface file version however,
188 -- because we don't always recompile modules which depend on a module
189 -- whose version has changed.
191 | PlainModuleInitLabel -- without the version & way info
194 | ModuleInitTableLabel -- table of imported modules to init
199 | RtsLabel RtsLabelInfo
201 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
202 (Maybe Int) -- possible '@n' suffix for stdcall functions
203 -- When generating C, the '@n' suffix is omitted, but when
204 -- generating assembler we must add it to the label.
205 Bool -- True <=> is dynamic
208 | CC_Label CostCentre
209 | CCS_Label CostCentreStack
211 -- Dynamic Linking in the NCG:
212 -- generated and used inside the NCG only,
213 -- see module PositionIndependentCode for details.
215 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
216 -- special variants of a label used for dynamic linking
218 | PicBaseLabel -- a label used as a base for PIC calculations
219 -- on some platforms.
220 -- It takes the form of a local numeric
221 -- assembler label '1'; it is pretty-printed
222 -- as 1b, referring to the previous definition
223 -- of 1: in the assembler source file.
225 | DeadStripPreventer CLabel
226 -- label before an info table to prevent excessive dead-stripping on darwin
228 | HpcTicksLabel Module -- Per-module table of tick locations
229 | HpcModuleNameLabel -- Per-module name of the module for Hpc
231 | LargeSRTLabel -- Label of an StgLargeSRT
232 {-# UNPACK #-} !Unique
234 | LargeBitmapLabel -- A bitmap (function or case return)
235 {-# UNPACK #-} !Unique
240 = Closure -- Label for closure
241 | SRT -- Static reference table
242 | InfoTable -- Info tables for closures; always read-only
243 | Entry -- entry point
244 | Slow -- slow entry point
246 | RednCounts -- Label of place to keep Ticky-ticky info for
249 | ConEntry -- constructor entry point
250 | ConInfoTable -- corresponding info table
251 | StaticConEntry -- static constructor entry point
252 | StaticInfoTable -- corresponding info table
254 | ClosureTable -- table of closures for Enum tycons
268 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
269 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
271 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
272 | RtsApEntry Bool{-updatable-} Int{-arity-}
276 | RtsInfo LitString -- misc rts info tables
277 | RtsEntry LitString -- misc rts entry points
278 | RtsRetInfo LitString -- misc rts ret info tables
279 | RtsRet LitString -- misc rts return points
280 | RtsData LitString -- misc rts data bits
281 | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure
282 | RtsCode LitString -- misc rts code
284 | RtsInfoFS FastString -- misc rts info tables
285 | RtsEntryFS FastString -- misc rts entry points
286 | RtsRetInfoFS FastString -- misc rts ret info tables
287 | RtsRetFS FastString -- misc rts return points
288 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
289 | RtsCodeFS FastString -- misc rts code
291 | RtsApFast LitString -- _fast versions of generic apply
293 | RtsSlowTickyCtr String
296 -- NOTE: Eq on LitString compares the pointer only, so this isn't
299 data DynamicLinkerLabelInfo
300 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
301 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
302 | GotSymbolPtr -- ELF: foo@got
303 | GotSymbolOffset -- ELF: foo@gotoff
307 -- -----------------------------------------------------------------------------
308 -- Constructing CLabels
310 -- These are always local:
311 mkSRTLabel name c = IdLabel name c SRT
312 mkSlowEntryLabel name c = IdLabel name c Slow
313 mkRednCountsLabel name c = IdLabel name c RednCounts
315 -- These have local & (possibly) external variants:
316 mkLocalClosureLabel name c = IdLabel name c Closure
317 mkLocalInfoTableLabel name c = IdLabel name c InfoTable
318 mkLocalEntryLabel name c = IdLabel name c Entry
319 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
321 mkClosureLabel name c = IdLabel name c Closure
322 mkInfoTableLabel name c = IdLabel name c InfoTable
323 mkEntryLabel name c = IdLabel name c Entry
324 mkClosureTableLabel name c = IdLabel name c ClosureTable
325 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
326 mkLocalConEntryLabel c con = IdLabel con c ConEntry
327 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
328 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
329 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
330 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
332 mkConEntryLabel name c = IdLabel name c ConEntry
333 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
335 mkLargeSRTLabel uniq = LargeSRTLabel uniq
336 mkBitmapLabel uniq = LargeBitmapLabel uniq
338 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
339 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
340 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
341 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
343 mkStringLitLabel = StringLitLabel
344 mkAsmTempLabel :: Uniquable a => a -> CLabel
345 mkAsmTempLabel a = AsmTempLabel (getUnique a)
347 mkModuleInitLabel :: Module -> String -> CLabel
348 mkModuleInitLabel mod way = ModuleInitLabel mod way
350 mkPlainModuleInitLabel :: Module -> CLabel
351 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
353 mkModuleInitTableLabel :: Module -> CLabel
354 mkModuleInitTableLabel mod = ModuleInitTableLabel mod
356 -- Some fixed runtime system labels
358 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
359 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
360 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
361 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
362 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
363 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
364 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
365 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
367 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
368 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
369 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
371 moduleRegdLabel = ModuleRegdLabel
372 moduleRegTableLabel = ModuleInitTableLabel
374 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
375 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
377 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
378 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
380 -- Primitive / cmm call labels
382 mkPrimCallLabel :: PrimCall -> CLabel
383 mkPrimCallLabel (PrimCall str) = ForeignLabel str Nothing False IsFunction
387 mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
388 mkForeignLabel str mb_sz is_dynamic fod
389 = ForeignLabel str mb_sz is_dynamic fod
391 addLabelSize :: CLabel -> Int -> CLabel
392 addLabelSize (ForeignLabel str _ is_dynamic fod) sz
393 = ForeignLabel str (Just sz) is_dynamic fod
397 foreignLabelStdcallInfo :: CLabel -> Maybe Int
398 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
399 foreignLabelStdcallInfo _lbl = Nothing
403 mkCCLabel cc = CC_Label cc
404 mkCCSLabel ccs = CCS_Label ccs
406 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
407 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
408 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
409 mkRtsRetLabel str = RtsLabel (RtsRet str)
410 mkRtsCodeLabel str = RtsLabel (RtsCode str)
411 mkRtsDataLabel str = RtsLabel (RtsData str)
412 mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
414 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
415 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
416 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
417 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
418 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
419 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
421 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
423 mkRtsSlowTickyCtrLabel :: String -> CLabel
424 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
428 mkHpcTicksLabel = HpcTicksLabel
429 mkHpcModuleNameLabel = HpcModuleNameLabel
433 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
434 mkDynamicLinkerLabel = DynamicLinkerLabel
436 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
437 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
438 dynamicLinkerLabelInfo _ = Nothing
440 -- Position independent code
442 mkPicBaseLabel :: CLabel
443 mkPicBaseLabel = PicBaseLabel
445 mkDeadStripPreventer :: CLabel -> CLabel
446 mkDeadStripPreventer lbl = DeadStripPreventer lbl
448 -- -----------------------------------------------------------------------------
449 -- Converting between info labels and entry/ret labels.
451 infoLblToEntryLbl :: CLabel -> CLabel
452 infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
453 infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
454 infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
455 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
456 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
457 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
458 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
459 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
460 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
462 entryLblToInfoLbl :: CLabel -> CLabel
463 entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
464 entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
465 entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
466 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
467 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
468 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
469 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
470 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
471 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
473 cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
474 cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
475 cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
476 cvtToClosureLbl l@(IdLabel n c Closure) = l
477 cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
479 cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
480 cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
481 cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
482 cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
483 cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
485 -- -----------------------------------------------------------------------------
486 -- Does a CLabel refer to a CAF?
487 hasCAF :: CLabel -> Bool
488 hasCAF (IdLabel _ MayHaveCafRefs _) = True
491 -- -----------------------------------------------------------------------------
492 -- Does a CLabel need declaring before use or not?
494 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
496 needsCDecl :: CLabel -> Bool
497 -- False <=> it's pre-declared; don't bother
498 -- don't bother declaring SRT & Bitmap labels, we always make sure
499 -- they are defined before use.
500 needsCDecl (IdLabel _ _ SRT) = False
501 needsCDecl (LargeSRTLabel _) = False
502 needsCDecl (LargeBitmapLabel _) = False
503 needsCDecl (IdLabel _ _ _) = True
504 needsCDecl (CaseLabel _ _) = True
505 needsCDecl (ModuleInitLabel _ _) = True
506 needsCDecl (PlainModuleInitLabel _) = True
507 needsCDecl (ModuleInitTableLabel _) = True
508 needsCDecl ModuleRegdLabel = False
510 needsCDecl (StringLitLabel _) = False
511 needsCDecl (AsmTempLabel _) = False
512 needsCDecl (RtsLabel _) = False
513 needsCDecl l@(ForeignLabel _ _ _ _) = not (isMathFun l)
514 needsCDecl (CC_Label _) = True
515 needsCDecl (CCS_Label _) = True
516 needsCDecl (HpcTicksLabel _) = True
517 needsCDecl HpcModuleNameLabel = False
519 -- Whether the label is an assembler temporary:
521 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
522 isAsmTemp (AsmTempLabel _) = True
525 maybeAsmTemp :: CLabel -> Maybe Unique
526 maybeAsmTemp (AsmTempLabel uq) = Just uq
527 maybeAsmTemp _ = Nothing
529 -- some labels have C prototypes in scope when compiling via C, because
530 -- they are builtin to the C compiler. For these labels we avoid
531 -- generating our own C prototypes.
532 isMathFun :: CLabel -> Bool
533 isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
536 math_funs = mkUniqSet [
538 (fsLit "acos"), (fsLit "acosf"), (fsLit "acosh"),
539 (fsLit "acoshf"), (fsLit "acoshl"), (fsLit "acosl"),
540 (fsLit "asin"), (fsLit "asinf"), (fsLit "asinl"),
541 (fsLit "asinh"), (fsLit "asinhf"), (fsLit "asinhl"),
542 (fsLit "atan"), (fsLit "atanf"), (fsLit "atanl"),
543 (fsLit "atan2"), (fsLit "atan2f"), (fsLit "atan2l"),
544 (fsLit "atanh"), (fsLit "atanhf"), (fsLit "atanhl"),
545 (fsLit "cbrt"), (fsLit "cbrtf"), (fsLit "cbrtl"),
546 (fsLit "ceil"), (fsLit "ceilf"), (fsLit "ceill"),
547 (fsLit "copysign"), (fsLit "copysignf"), (fsLit "copysignl"),
548 (fsLit "cos"), (fsLit "cosf"), (fsLit "cosl"),
549 (fsLit "cosh"), (fsLit "coshf"), (fsLit "coshl"),
550 (fsLit "erf"), (fsLit "erff"), (fsLit "erfl"),
551 (fsLit "erfc"), (fsLit "erfcf"), (fsLit "erfcl"),
552 (fsLit "exp"), (fsLit "expf"), (fsLit "expl"),
553 (fsLit "exp2"), (fsLit "exp2f"), (fsLit "exp2l"),
554 (fsLit "expm1"), (fsLit "expm1f"), (fsLit "expm1l"),
555 (fsLit "fabs"), (fsLit "fabsf"), (fsLit "fabsl"),
556 (fsLit "fdim"), (fsLit "fdimf"), (fsLit "fdiml"),
557 (fsLit "floor"), (fsLit "floorf"), (fsLit "floorl"),
558 (fsLit "fma"), (fsLit "fmaf"), (fsLit "fmal"),
559 (fsLit "fmax"), (fsLit "fmaxf"), (fsLit "fmaxl"),
560 (fsLit "fmin"), (fsLit "fminf"), (fsLit "fminl"),
561 (fsLit "fmod"), (fsLit "fmodf"), (fsLit "fmodl"),
562 (fsLit "frexp"), (fsLit "frexpf"), (fsLit "frexpl"),
563 (fsLit "hypot"), (fsLit "hypotf"), (fsLit "hypotl"),
564 (fsLit "ilogb"), (fsLit "ilogbf"), (fsLit "ilogbl"),
565 (fsLit "ldexp"), (fsLit "ldexpf"), (fsLit "ldexpl"),
566 (fsLit "lgamma"), (fsLit "lgammaf"), (fsLit "lgammal"),
567 (fsLit "llrint"), (fsLit "llrintf"), (fsLit "llrintl"),
568 (fsLit "llround"), (fsLit "llroundf"), (fsLit "llroundl"),
569 (fsLit "log"), (fsLit "logf"), (fsLit "logl"),
570 (fsLit "log10l"), (fsLit "log10"), (fsLit "log10f"),
571 (fsLit "log1pl"), (fsLit "log1p"), (fsLit "log1pf"),
572 (fsLit "log2"), (fsLit "log2f"), (fsLit "log2l"),
573 (fsLit "logb"), (fsLit "logbf"), (fsLit "logbl"),
574 (fsLit "lrint"), (fsLit "lrintf"), (fsLit "lrintl"),
575 (fsLit "lround"), (fsLit "lroundf"), (fsLit "lroundl"),
576 (fsLit "modf"), (fsLit "modff"), (fsLit "modfl"),
577 (fsLit "nan"), (fsLit "nanf"), (fsLit "nanl"),
578 (fsLit "nearbyint"), (fsLit "nearbyintf"), (fsLit "nearbyintl"),
579 (fsLit "nextafter"), (fsLit "nextafterf"), (fsLit "nextafterl"),
580 (fsLit "nexttoward"), (fsLit "nexttowardf"), (fsLit "nexttowardl"),
581 (fsLit "pow"), (fsLit "powf"), (fsLit "powl"),
582 (fsLit "remainder"), (fsLit "remainderf"), (fsLit "remainderl"),
583 (fsLit "remquo"), (fsLit "remquof"), (fsLit "remquol"),
584 (fsLit "rint"), (fsLit "rintf"), (fsLit "rintl"),
585 (fsLit "round"), (fsLit "roundf"), (fsLit "roundl"),
586 (fsLit "scalbln"), (fsLit "scalblnf"), (fsLit "scalblnl"),
587 (fsLit "scalbn"), (fsLit "scalbnf"), (fsLit "scalbnl"),
588 (fsLit "sin"), (fsLit "sinf"), (fsLit "sinl"),
589 (fsLit "sinh"), (fsLit "sinhf"), (fsLit "sinhl"),
590 (fsLit "sqrt"), (fsLit "sqrtf"), (fsLit "sqrtl"),
591 (fsLit "tan"), (fsLit "tanf"), (fsLit "tanl"),
592 (fsLit "tanh"), (fsLit "tanhf"), (fsLit "tanhl"),
593 (fsLit "tgamma"), (fsLit "tgammaf"), (fsLit "tgammal"),
594 (fsLit "trunc"), (fsLit "truncf"), (fsLit "truncl"),
595 -- ISO C 99 also defines these function-like macros in math.h:
596 -- fpclassify, isfinite, isinf, isnormal, signbit, isgreater,
597 -- isgreaterequal, isless, islessequal, islessgreater, isunordered
599 -- additional symbols from _BSD_SOURCE
600 (fsLit "drem"), (fsLit "dremf"), (fsLit "dreml"),
601 (fsLit "finite"), (fsLit "finitef"), (fsLit "finitel"),
602 (fsLit "gamma"), (fsLit "gammaf"), (fsLit "gammal"),
603 (fsLit "isinf"), (fsLit "isinff"), (fsLit "isinfl"),
604 (fsLit "isnan"), (fsLit "isnanf"), (fsLit "isnanl"),
605 (fsLit "j0"), (fsLit "j0f"), (fsLit "j0l"),
606 (fsLit "j1"), (fsLit "j1f"), (fsLit "j1l"),
607 (fsLit "jn"), (fsLit "jnf"), (fsLit "jnl"),
608 (fsLit "lgamma_r"), (fsLit "lgammaf_r"), (fsLit "lgammal_r"),
609 (fsLit "scalb"), (fsLit "scalbf"), (fsLit "scalbl"),
610 (fsLit "significand"), (fsLit "significandf"), (fsLit "significandl"),
611 (fsLit "y0"), (fsLit "y0f"), (fsLit "y0l"),
612 (fsLit "y1"), (fsLit "y1f"), (fsLit "y1l"),
613 (fsLit "yn"), (fsLit "ynf"), (fsLit "ynl")
616 -- -----------------------------------------------------------------------------
617 -- Is a CLabel visible outside this object file or not?
619 -- From the point of view of the code generator, a name is
620 -- externally visible if it has to be declared as exported
621 -- in the .o file's symbol table; that is, made non-static.
623 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
624 externallyVisibleCLabel (CaseLabel _ _) = False
625 externallyVisibleCLabel (StringLitLabel _) = False
626 externallyVisibleCLabel (AsmTempLabel _) = False
627 externallyVisibleCLabel (ModuleInitLabel _ _) = True
628 externallyVisibleCLabel (PlainModuleInitLabel _)= True
629 externallyVisibleCLabel (ModuleInitTableLabel _)= False
630 externallyVisibleCLabel ModuleRegdLabel = False
631 externallyVisibleCLabel (RtsLabel _) = True
632 externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
633 externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
634 externallyVisibleCLabel (CC_Label _) = True
635 externallyVisibleCLabel (CCS_Label _) = True
636 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
637 externallyVisibleCLabel (HpcTicksLabel _) = True
638 externallyVisibleCLabel HpcModuleNameLabel = False
639 externallyVisibleCLabel (LargeBitmapLabel _) = False
640 externallyVisibleCLabel (LargeSRTLabel _) = False
642 -- -----------------------------------------------------------------------------
643 -- Finding the "type" of a CLabel
645 -- For generating correct types in label declarations:
648 = CodeLabel -- Address of some executable instructions
649 | DataLabel -- Address of data, not a GC ptr
650 | GcPtrLabel -- Address of a (presumably static) GC object
652 isCFunctionLabel :: CLabel -> Bool
653 isCFunctionLabel lbl = case labelType lbl of
657 isGcPtrLabel :: CLabel -> Bool
658 isGcPtrLabel lbl = case labelType lbl of
662 labelType :: CLabel -> CLabelType
663 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
664 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
665 labelType (RtsLabel (RtsData _)) = DataLabel
666 labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
667 labelType (RtsLabel (RtsCode _)) = CodeLabel
668 labelType (RtsLabel (RtsInfo _)) = DataLabel
669 labelType (RtsLabel (RtsEntry _)) = CodeLabel
670 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
671 labelType (RtsLabel (RtsRet _)) = CodeLabel
672 labelType (RtsLabel (RtsDataFS _)) = DataLabel
673 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
674 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
675 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
676 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
677 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
678 labelType (RtsLabel (RtsApFast _)) = CodeLabel
679 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
680 labelType (CaseLabel _ _) = CodeLabel
681 labelType (ModuleInitLabel _ _) = CodeLabel
682 labelType (PlainModuleInitLabel _) = CodeLabel
683 labelType (ModuleInitTableLabel _) = DataLabel
684 labelType (LargeSRTLabel _) = DataLabel
685 labelType (LargeBitmapLabel _) = DataLabel
686 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
687 labelType (IdLabel _ _ info) = idInfoLabelType info
688 labelType _ = DataLabel
690 idInfoLabelType info =
692 InfoTable -> DataLabel
693 Closure -> GcPtrLabel
694 ConInfoTable -> DataLabel
695 StaticInfoTable -> DataLabel
696 ClosureTable -> DataLabel
697 RednCounts -> DataLabel
701 -- -----------------------------------------------------------------------------
702 -- Does a CLabel need dynamic linkage?
704 -- When referring to data in code, we need to know whether
705 -- that data resides in a DLL or not. [Win32 only.]
706 -- @labelDynamic@ returns @True@ if the label is located
707 -- in a DLL, be it a data reference or not.
709 labelDynamic :: PackageId -> CLabel -> Bool
710 labelDynamic this_pkg lbl =
712 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
713 IdLabel n _ k -> isDllName this_pkg n
714 #if mingw32_TARGET_OS
715 ForeignLabel _ _ d _ -> d
717 -- On Mac OS X and on ELF platforms, false positives are OK,
718 -- so we claim that all foreign imports come from dynamic libraries
719 ForeignLabel _ _ _ _ -> True
721 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
722 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
723 ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
725 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
729 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
730 right places. It is used to detect when the abstractC statement of an
731 CCodeBlock actually contains the code for a slow entry point. -- HWL
733 We need at least @Eq@ for @CLabels@, because we want to avoid
734 duplicate declarations in generating C (see @labelSeenTE@ in
738 -----------------------------------------------------------------------------
739 -- Printing out CLabels.
746 where <name> is <Module>_<name> for external names and <unique> for
747 internal names. <type> is one of the following:
750 srt Static reference table
751 srtd Static reference table descriptor
752 entry Entry code (function, closure)
753 slow Slow entry code (if any)
754 ret Direct return address
756 <n>_alt Case alternative (tag n)
757 dflt Default case alternative
758 btm Large bitmap vector
759 closure Static closure
760 con_entry Dynamic Constructor entry code
761 con_info Dynamic Constructor info table
762 static_entry Static Constructor entry code
763 static_info Static Constructor info table
764 sel_info Selector info table
765 sel_entry Selector entry code
767 ccs Cost centre stack
769 Many of these distinctions are only for documentation reasons. For
770 example, _ret is only distinguished from _entry to make it easy to
771 tell whether a code fragment is a return point or a closure/function
775 instance Outputable CLabel where
778 pprCLabel :: CLabel -> SDoc
780 #if ! OMIT_NATIVE_CODEGEN
781 pprCLabel (AsmTempLabel u)
782 = getPprStyle $ \ sty ->
784 ptext asmTempLabelPrefix <> pprUnique u
786 char '_' <> pprUnique u
788 pprCLabel (DynamicLinkerLabel info lbl)
789 = pprDynamicLinkerAsmLabel info lbl
791 pprCLabel PicBaseLabel
794 pprCLabel (DeadStripPreventer lbl)
795 = pprCLabel lbl <> ptext (sLit "_dsp")
799 #if ! OMIT_NATIVE_CODEGEN
800 getPprStyle $ \ sty ->
802 maybe_underscore (pprAsmCLbl lbl)
808 | underscorePrefix = pp_cSEP <> doc
811 #ifdef mingw32_TARGET_OS
812 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
813 -- (The C compiler does this itself).
814 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
815 = ftext fs <> char '@' <> int sz
820 pprCLbl (StringLitLabel u)
821 = pprUnique u <> ptext (sLit "_str")
823 pprCLbl (CaseLabel u CaseReturnPt)
824 = hcat [pprUnique u, ptext (sLit "_ret")]
825 pprCLbl (CaseLabel u CaseReturnInfo)
826 = hcat [pprUnique u, ptext (sLit "_info")]
827 pprCLbl (CaseLabel u (CaseAlt tag))
828 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
829 pprCLbl (CaseLabel u CaseDefault)
830 = hcat [pprUnique u, ptext (sLit "_dflt")]
832 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
833 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
834 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
835 -- until that gets resolved we'll just force them to start
836 -- with a letter so the label will be legal assmbly code.
839 pprCLbl (RtsLabel (RtsCode str)) = ptext str
840 pprCLbl (RtsLabel (RtsData str)) = ptext str
841 pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str
842 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
843 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
845 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
847 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
848 = hcat [ptext (sLit "stg_sel_"), text (show offset),
850 then (sLit "_upd_info")
851 else (sLit "_noupd_info"))
854 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
855 = hcat [ptext (sLit "stg_sel_"), text (show offset),
857 then (sLit "_upd_entry")
858 else (sLit "_noupd_entry"))
861 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
862 = hcat [ptext (sLit "stg_ap_"), text (show arity),
864 then (sLit "_upd_info")
865 else (sLit "_noupd_info"))
868 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
869 = hcat [ptext (sLit "stg_ap_"), text (show arity),
871 then (sLit "_upd_entry")
872 else (sLit "_noupd_entry"))
875 pprCLbl (RtsLabel (RtsInfo fs))
876 = ptext fs <> ptext (sLit "_info")
878 pprCLbl (RtsLabel (RtsEntry fs))
879 = ptext fs <> ptext (sLit "_entry")
881 pprCLbl (RtsLabel (RtsRetInfo fs))
882 = ptext fs <> ptext (sLit "_info")
884 pprCLbl (RtsLabel (RtsRet fs))
885 = ptext fs <> ptext (sLit "_ret")
887 pprCLbl (RtsLabel (RtsInfoFS fs))
888 = ftext fs <> ptext (sLit "_info")
890 pprCLbl (RtsLabel (RtsEntryFS fs))
891 = ftext fs <> ptext (sLit "_entry")
893 pprCLbl (RtsLabel (RtsRetInfoFS fs))
894 = ftext fs <> ptext (sLit "_info")
896 pprCLbl (RtsLabel (RtsRetFS fs))
897 = ftext fs <> ptext (sLit "_ret")
899 pprCLbl (RtsLabel (RtsPrimOp primop))
900 = ppr primop <> ptext (sLit "_fast")
902 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
903 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
905 pprCLbl ModuleRegdLabel
906 = ptext (sLit "_module_registered")
908 pprCLbl (ForeignLabel str _ _ _)
911 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
913 pprCLbl (CC_Label cc) = ppr cc
914 pprCLbl (CCS_Label ccs) = ppr ccs
916 pprCLbl (ModuleInitLabel mod way)
917 = ptext (sLit "__stginit_") <> ppr mod
918 <> char '_' <> text way
919 pprCLbl (PlainModuleInitLabel mod)
920 = ptext (sLit "__stginit_") <> ppr mod
921 pprCLbl (ModuleInitTableLabel mod)
922 = ptext (sLit "__stginittable_") <> ppr mod
924 pprCLbl (HpcTicksLabel mod)
925 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
927 pprCLbl HpcModuleNameLabel
928 = ptext (sLit "_hpc_module_name_str")
930 ppIdFlavor :: IdLabelInfo -> SDoc
931 ppIdFlavor x = pp_cSEP <>
933 Closure -> ptext (sLit "closure")
934 SRT -> ptext (sLit "srt")
935 InfoTable -> ptext (sLit "info")
936 Entry -> ptext (sLit "entry")
937 Slow -> ptext (sLit "slow")
938 RednCounts -> ptext (sLit "ct")
939 ConEntry -> ptext (sLit "con_entry")
940 ConInfoTable -> ptext (sLit "con_info")
941 StaticConEntry -> ptext (sLit "static_entry")
942 StaticInfoTable -> ptext (sLit "static_info")
943 ClosureTable -> ptext (sLit "closure_tbl")
949 -- -----------------------------------------------------------------------------
950 -- Machine-dependent knowledge about labels.
952 underscorePrefix :: Bool -- leading underscore on assembler labels?
953 underscorePrefix = (cLeadingUnderscore == "YES")
955 asmTempLabelPrefix :: LitString -- for formatting labels
958 {- The alpha assembler likes temporary labels to look like $L123
959 instead of L123. (Don't toss the L, because then Lf28
963 #elif darwin_TARGET_OS
969 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
971 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
972 pprDynamicLinkerAsmLabel CodeStub lbl
973 = char 'L' <> pprCLabel lbl <> text "$stub"
974 pprDynamicLinkerAsmLabel SymbolPtr lbl
975 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
976 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
977 = pprCLabel lbl <> text "@GOTPCREL"
978 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
980 pprDynamicLinkerAsmLabel _ _
981 = panic "pprDynamicLinkerAsmLabel"
982 #elif darwin_TARGET_OS
983 pprDynamicLinkerAsmLabel CodeStub lbl
984 = char 'L' <> pprCLabel lbl <> text "$stub"
985 pprDynamicLinkerAsmLabel SymbolPtr lbl
986 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
987 pprDynamicLinkerAsmLabel _ _
988 = panic "pprDynamicLinkerAsmLabel"
989 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
990 pprDynamicLinkerAsmLabel CodeStub lbl
991 = pprCLabel lbl <> text "@plt"
992 pprDynamicLinkerAsmLabel SymbolPtr lbl
993 = text ".LC_" <> pprCLabel lbl
994 pprDynamicLinkerAsmLabel _ _
995 = panic "pprDynamicLinkerAsmLabel"
996 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
997 pprDynamicLinkerAsmLabel CodeStub lbl
998 = pprCLabel lbl <> text "@plt"
999 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1000 = pprCLabel lbl <> text "@gotpcrel"
1001 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1003 pprDynamicLinkerAsmLabel SymbolPtr lbl
1004 = text ".LC_" <> pprCLabel lbl
1005 #elif linux_TARGET_OS
1006 pprDynamicLinkerAsmLabel CodeStub lbl
1007 = pprCLabel lbl <> text "@plt"
1008 pprDynamicLinkerAsmLabel SymbolPtr lbl
1009 = text ".LC_" <> pprCLabel lbl
1010 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
1011 = pprCLabel lbl <> text "@got"
1012 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
1013 = pprCLabel lbl <> text "@gotoff"
1014 #elif mingw32_TARGET_OS
1015 pprDynamicLinkerAsmLabel SymbolPtr lbl
1016 = text "__imp_" <> pprCLabel lbl
1017 pprDynamicLinkerAsmLabel _ _
1018 = panic "pprDynamicLinkerAsmLabel"
1020 pprDynamicLinkerAsmLabel _ _
1021 = panic "pprDynamicLinkerAsmLabel"