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"
137 -- -----------------------------------------------------------------------------
141 CLabel is an abstract type that supports the following operations:
145 - In a C file, does it need to be declared before use? (i.e. is it
146 guaranteed to be already in scope in the places we need to refer to it?)
148 - If it needs to be declared, what type (code or data) should it be
151 - Is it visible outside this object file or not?
153 - Is it "dynamic" (see details below)
155 - Eq and Ord, so that we can make sets of CLabels (currently only
156 used in outputting C as far as I can tell, to avoid generating
157 more than one declaration for any given label).
159 - Converting an info table label into an entry label.
163 = IdLabel -- A family of labels related to the
164 Name -- definition of a particular Id or Con
168 | CaseLabel -- A family of labels related to a particular
170 {-# UNPACK #-} !Unique -- Unique says which case expression
174 {-# UNPACK #-} !Unique
177 {-# UNPACK #-} !Unique
180 Module -- the module name
182 -- at some point we might want some kind of version number in
183 -- the module init label, to guard against compiling modules in
184 -- the wrong order. We can't use the interface file version however,
185 -- because we don't always recompile modules which depend on a module
186 -- whose version has changed.
188 | PlainModuleInitLabel -- without the version & way info
191 | ModuleInitTableLabel -- table of imported modules to init
196 | RtsLabel RtsLabelInfo
198 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
199 (Maybe Int) -- possible '@n' suffix for stdcall functions
200 -- When generating C, the '@n' suffix is omitted, but when
201 -- generating assembler we must add it to the label.
202 Bool -- True <=> is dynamic
205 | CC_Label CostCentre
206 | CCS_Label CostCentreStack
208 -- Dynamic Linking in the NCG:
209 -- generated and used inside the NCG only,
210 -- see module PositionIndependentCode for details.
212 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
213 -- special variants of a label used for dynamic linking
215 | PicBaseLabel -- a label used as a base for PIC calculations
216 -- on some platforms.
217 -- It takes the form of a local numeric
218 -- assembler label '1'; it is pretty-printed
219 -- as 1b, referring to the previous definition
220 -- of 1: in the assembler source file.
222 | DeadStripPreventer CLabel
223 -- label before an info table to prevent excessive dead-stripping on darwin
225 | HpcTicksLabel Module -- Per-module table of tick locations
226 | HpcModuleNameLabel -- Per-module name of the module for Hpc
228 | LargeSRTLabel -- Label of an StgLargeSRT
229 {-# UNPACK #-} !Unique
231 | LargeBitmapLabel -- A bitmap (function or case return)
232 {-# UNPACK #-} !Unique
237 = Closure -- Label for closure
238 | SRT -- Static reference table
239 | InfoTable -- Info tables for closures; always read-only
240 | Entry -- entry point
241 | Slow -- slow entry point
243 | RednCounts -- Label of place to keep Ticky-ticky info for
246 | ConEntry -- constructor entry point
247 | ConInfoTable -- corresponding info table
248 | StaticConEntry -- static constructor entry point
249 | StaticInfoTable -- corresponding info table
251 | ClosureTable -- table of closures for Enum tycons
265 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
266 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
268 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
269 | RtsApEntry Bool{-updatable-} Int{-arity-}
273 | RtsInfo LitString -- misc rts info tables
274 | RtsEntry LitString -- misc rts entry points
275 | RtsRetInfo LitString -- misc rts ret info tables
276 | RtsRet LitString -- misc rts return points
277 | RtsData LitString -- misc rts data bits
278 | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure
279 | RtsCode LitString -- misc rts code
281 | RtsInfoFS FastString -- misc rts info tables
282 | RtsEntryFS FastString -- misc rts entry points
283 | RtsRetInfoFS FastString -- misc rts ret info tables
284 | RtsRetFS FastString -- misc rts return points
285 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
286 | RtsCodeFS FastString -- misc rts code
288 | RtsApFast LitString -- _fast versions of generic apply
290 | RtsSlowTickyCtr String
293 -- NOTE: Eq on LitString compares the pointer only, so this isn't
296 data DynamicLinkerLabelInfo
297 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
298 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
299 | GotSymbolPtr -- ELF: foo@got
300 | GotSymbolOffset -- ELF: foo@gotoff
304 -- -----------------------------------------------------------------------------
305 -- Constructing CLabels
307 -- These are always local:
308 mkSRTLabel name c = IdLabel name c SRT
309 mkSlowEntryLabel name c = IdLabel name c Slow
310 mkRednCountsLabel name c = IdLabel name c RednCounts
312 -- These have local & (possibly) external variants:
313 mkLocalClosureLabel name c = IdLabel name c Closure
314 mkLocalInfoTableLabel name c = IdLabel name c InfoTable
315 mkLocalEntryLabel name c = IdLabel name c Entry
316 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
318 mkClosureLabel name c = IdLabel name c Closure
319 mkInfoTableLabel name c = IdLabel name c InfoTable
320 mkEntryLabel name c = IdLabel name c Entry
321 mkClosureTableLabel name c = IdLabel name c ClosureTable
322 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
323 mkLocalConEntryLabel c con = IdLabel con c ConEntry
324 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
325 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
326 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
327 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
329 mkConEntryLabel name c = IdLabel name c ConEntry
330 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
332 mkLargeSRTLabel uniq = LargeSRTLabel uniq
333 mkBitmapLabel uniq = LargeBitmapLabel uniq
335 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
336 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
337 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
338 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
340 mkStringLitLabel = StringLitLabel
341 mkAsmTempLabel :: Uniquable a => a -> CLabel
342 mkAsmTempLabel a = AsmTempLabel (getUnique a)
344 mkModuleInitLabel :: Module -> String -> CLabel
345 mkModuleInitLabel mod way = ModuleInitLabel mod way
347 mkPlainModuleInitLabel :: Module -> CLabel
348 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
350 mkModuleInitTableLabel :: Module -> CLabel
351 mkModuleInitTableLabel mod = ModuleInitTableLabel mod
353 -- Some fixed runtime system labels
355 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
356 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
357 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
358 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
359 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
360 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
361 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
362 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
364 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
365 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
366 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
368 moduleRegdLabel = ModuleRegdLabel
369 moduleRegTableLabel = ModuleInitTableLabel
371 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
372 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
374 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
375 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
379 mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
380 mkForeignLabel str mb_sz is_dynamic fod
381 = ForeignLabel str mb_sz is_dynamic fod
383 addLabelSize :: CLabel -> Int -> CLabel
384 addLabelSize (ForeignLabel str _ is_dynamic fod) sz
385 = ForeignLabel str (Just sz) is_dynamic fod
389 foreignLabelStdcallInfo :: CLabel -> Maybe Int
390 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
391 foreignLabelStdcallInfo _lbl = Nothing
395 mkCCLabel cc = CC_Label cc
396 mkCCSLabel ccs = CCS_Label ccs
398 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
399 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
400 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
401 mkRtsRetLabel str = RtsLabel (RtsRet str)
402 mkRtsCodeLabel str = RtsLabel (RtsCode str)
403 mkRtsDataLabel str = RtsLabel (RtsData str)
404 mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
406 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
407 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
408 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
409 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
410 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
411 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
413 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
415 mkRtsSlowTickyCtrLabel :: String -> CLabel
416 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
420 mkHpcTicksLabel = HpcTicksLabel
421 mkHpcModuleNameLabel = HpcModuleNameLabel
425 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
426 mkDynamicLinkerLabel = DynamicLinkerLabel
428 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
429 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
430 dynamicLinkerLabelInfo _ = Nothing
432 -- Position independent code
434 mkPicBaseLabel :: CLabel
435 mkPicBaseLabel = PicBaseLabel
437 mkDeadStripPreventer :: CLabel -> CLabel
438 mkDeadStripPreventer lbl = DeadStripPreventer lbl
440 -- -----------------------------------------------------------------------------
441 -- Converting between info labels and entry/ret labels.
443 infoLblToEntryLbl :: CLabel -> CLabel
444 infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
445 infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
446 infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
447 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
448 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
449 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
450 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
451 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
452 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
454 entryLblToInfoLbl :: CLabel -> CLabel
455 entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
456 entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
457 entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
458 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
459 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
460 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
461 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
462 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
463 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
465 cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
466 cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
467 cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
468 cvtToClosureLbl l@(IdLabel n c Closure) = l
469 cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
471 cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
472 cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
473 cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
474 cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
475 cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
477 -- -----------------------------------------------------------------------------
478 -- Does a CLabel refer to a CAF?
479 hasCAF :: CLabel -> Bool
480 hasCAF (IdLabel _ MayHaveCafRefs _) = True
483 -- -----------------------------------------------------------------------------
484 -- Does a CLabel need declaring before use or not?
486 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
488 needsCDecl :: CLabel -> Bool
489 -- False <=> it's pre-declared; don't bother
490 -- don't bother declaring SRT & Bitmap labels, we always make sure
491 -- they are defined before use.
492 needsCDecl (IdLabel _ _ SRT) = False
493 needsCDecl (LargeSRTLabel _) = False
494 needsCDecl (LargeBitmapLabel _) = False
495 needsCDecl (IdLabel _ _ _) = True
496 needsCDecl (CaseLabel _ _) = True
497 needsCDecl (ModuleInitLabel _ _) = True
498 needsCDecl (PlainModuleInitLabel _) = True
499 needsCDecl (ModuleInitTableLabel _) = True
500 needsCDecl ModuleRegdLabel = False
502 needsCDecl (StringLitLabel _) = False
503 needsCDecl (AsmTempLabel _) = False
504 needsCDecl (RtsLabel _) = False
505 needsCDecl l@(ForeignLabel _ _ _ _) = not (isMathFun l)
506 needsCDecl (CC_Label _) = True
507 needsCDecl (CCS_Label _) = True
508 needsCDecl (HpcTicksLabel _) = True
509 needsCDecl HpcModuleNameLabel = False
511 -- Whether the label is an assembler temporary:
513 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
514 isAsmTemp (AsmTempLabel _) = True
517 maybeAsmTemp :: CLabel -> Maybe Unique
518 maybeAsmTemp (AsmTempLabel uq) = Just uq
519 maybeAsmTemp _ = Nothing
521 -- some labels have C prototypes in scope when compiling via C, because
522 -- they are builtin to the C compiler. For these labels we avoid
523 -- generating our own C prototypes.
524 isMathFun :: CLabel -> Bool
525 isMathFun (ForeignLabel fs _ _ _) = fs `elem` math_funs
528 (fsLit "pow"), (fsLit "sin"), (fsLit "cos"),
529 (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"),
530 (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"),
531 (fsLit "atan"), (fsLit "log"), (fsLit "exp"),
532 (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"),
533 (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"),
534 (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"),
535 (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"),
536 (fsLit "expf"), (fsLit "sqrtf"), (fsLit "frexp"),
537 (fsLit "modf"), (fsLit "ilogb"), (fsLit "copysign"),
538 (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
539 (fsLit "cbrt"), (fsLit "atanh"), (fsLit "asinh"),
540 (fsLit "acosh"), (fsLit "lgamma"),(fsLit "hypot"),
541 (fsLit "erfc"), (fsLit "erf"), (fsLit "trunc"),
542 (fsLit "round"), (fsLit "fmod"), (fsLit "floor"),
543 (fsLit "fabs"), (fsLit "ceil"), (fsLit "log10"),
544 (fsLit "ldexp"), (fsLit "atan2"), (fsLit "rint")
548 -- -----------------------------------------------------------------------------
549 -- Is a CLabel visible outside this object file or not?
551 -- From the point of view of the code generator, a name is
552 -- externally visible if it has to be declared as exported
553 -- in the .o file's symbol table; that is, made non-static.
555 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
556 externallyVisibleCLabel (CaseLabel _ _) = False
557 externallyVisibleCLabel (StringLitLabel _) = False
558 externallyVisibleCLabel (AsmTempLabel _) = False
559 externallyVisibleCLabel (ModuleInitLabel _ _) = True
560 externallyVisibleCLabel (PlainModuleInitLabel _)= True
561 externallyVisibleCLabel (ModuleInitTableLabel _)= False
562 externallyVisibleCLabel ModuleRegdLabel = False
563 externallyVisibleCLabel (RtsLabel _) = True
564 externallyVisibleCLabel (ForeignLabel _ _ _ _) = True
565 externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
566 externallyVisibleCLabel (CC_Label _) = True
567 externallyVisibleCLabel (CCS_Label _) = True
568 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
569 externallyVisibleCLabel (HpcTicksLabel _) = True
570 externallyVisibleCLabel HpcModuleNameLabel = False
571 externallyVisibleCLabel (LargeBitmapLabel _) = False
572 externallyVisibleCLabel (LargeSRTLabel _) = False
574 -- -----------------------------------------------------------------------------
575 -- Finding the "type" of a CLabel
577 -- For generating correct types in label declarations:
580 = CodeLabel -- Address of some executable instructions
581 | DataLabel -- Address of data, not a GC ptr
582 | GcPtrLabel -- Address of a (presumably static) GC object
584 isCFunctionLabel :: CLabel -> Bool
585 isCFunctionLabel lbl = case labelType lbl of
589 isGcPtrLabel :: CLabel -> Bool
590 isGcPtrLabel lbl = case labelType lbl of
594 labelType :: CLabel -> CLabelType
595 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
596 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
597 labelType (RtsLabel (RtsData _)) = DataLabel
598 labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
599 labelType (RtsLabel (RtsCode _)) = CodeLabel
600 labelType (RtsLabel (RtsInfo _)) = DataLabel
601 labelType (RtsLabel (RtsEntry _)) = CodeLabel
602 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
603 labelType (RtsLabel (RtsRet _)) = CodeLabel
604 labelType (RtsLabel (RtsDataFS _)) = DataLabel
605 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
606 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
607 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
608 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
609 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
610 labelType (RtsLabel (RtsApFast _)) = CodeLabel
611 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
612 labelType (CaseLabel _ _) = CodeLabel
613 labelType (ModuleInitLabel _ _) = CodeLabel
614 labelType (PlainModuleInitLabel _) = CodeLabel
615 labelType (ModuleInitTableLabel _) = DataLabel
616 labelType (LargeSRTLabel _) = DataLabel
617 labelType (LargeBitmapLabel _) = DataLabel
618 labelType (ForeignLabel _ _ _ IsFunction) = CodeLabel
619 labelType (IdLabel _ _ info) = idInfoLabelType info
620 labelType _ = DataLabel
622 idInfoLabelType info =
624 InfoTable -> DataLabel
625 Closure -> GcPtrLabel
626 ConInfoTable -> DataLabel
627 StaticInfoTable -> DataLabel
628 ClosureTable -> DataLabel
629 RednCounts -> DataLabel
633 -- -----------------------------------------------------------------------------
634 -- Does a CLabel need dynamic linkage?
636 -- When referring to data in code, we need to know whether
637 -- that data resides in a DLL or not. [Win32 only.]
638 -- @labelDynamic@ returns @True@ if the label is located
639 -- in a DLL, be it a data reference or not.
641 labelDynamic :: PackageId -> CLabel -> Bool
642 labelDynamic this_pkg lbl =
644 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
645 IdLabel n _ k -> isDllName this_pkg n
646 #if mingw32_TARGET_OS
647 ForeignLabel _ _ d _ -> d
649 -- On Mac OS X and on ELF platforms, false positives are OK,
650 -- so we claim that all foreign imports come from dynamic libraries
651 ForeignLabel _ _ _ _ -> True
653 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
654 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
655 ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
657 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
661 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
662 right places. It is used to detect when the abstractC statement of an
663 CCodeBlock actually contains the code for a slow entry point. -- HWL
665 We need at least @Eq@ for @CLabels@, because we want to avoid
666 duplicate declarations in generating C (see @labelSeenTE@ in
670 -----------------------------------------------------------------------------
671 -- Printing out CLabels.
678 where <name> is <Module>_<name> for external names and <unique> for
679 internal names. <type> is one of the following:
682 srt Static reference table
683 srtd Static reference table descriptor
684 entry Entry code (function, closure)
685 slow Slow entry code (if any)
686 ret Direct return address
688 <n>_alt Case alternative (tag n)
689 dflt Default case alternative
690 btm Large bitmap vector
691 closure Static closure
692 con_entry Dynamic Constructor entry code
693 con_info Dynamic Constructor info table
694 static_entry Static Constructor entry code
695 static_info Static Constructor info table
696 sel_info Selector info table
697 sel_entry Selector entry code
699 ccs Cost centre stack
701 Many of these distinctions are only for documentation reasons. For
702 example, _ret is only distinguished from _entry to make it easy to
703 tell whether a code fragment is a return point or a closure/function
707 instance Outputable CLabel where
710 pprCLabel :: CLabel -> SDoc
712 #if ! OMIT_NATIVE_CODEGEN
713 pprCLabel (AsmTempLabel u)
714 = getPprStyle $ \ sty ->
716 ptext asmTempLabelPrefix <> pprUnique u
718 char '_' <> pprUnique u
720 pprCLabel (DynamicLinkerLabel info lbl)
721 = pprDynamicLinkerAsmLabel info lbl
723 pprCLabel PicBaseLabel
726 pprCLabel (DeadStripPreventer lbl)
727 = pprCLabel lbl <> ptext (sLit "_dsp")
731 #if ! OMIT_NATIVE_CODEGEN
732 getPprStyle $ \ sty ->
734 maybe_underscore (pprAsmCLbl lbl)
740 | underscorePrefix = pp_cSEP <> doc
743 #ifdef mingw32_TARGET_OS
744 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
745 -- (The C compiler does this itself).
746 pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
747 = ftext fs <> char '@' <> int sz
752 pprCLbl (StringLitLabel u)
753 = pprUnique u <> ptext (sLit "_str")
755 pprCLbl (CaseLabel u CaseReturnPt)
756 = hcat [pprUnique u, ptext (sLit "_ret")]
757 pprCLbl (CaseLabel u CaseReturnInfo)
758 = hcat [pprUnique u, ptext (sLit "_info")]
759 pprCLbl (CaseLabel u (CaseAlt tag))
760 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
761 pprCLbl (CaseLabel u CaseDefault)
762 = hcat [pprUnique u, ptext (sLit "_dflt")]
764 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
765 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
766 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
767 -- until that gets resolved we'll just force them to start
768 -- with a letter so the label will be legal assmbly code.
771 pprCLbl (RtsLabel (RtsCode str)) = ptext str
772 pprCLbl (RtsLabel (RtsData str)) = ptext str
773 pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str
774 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
775 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
777 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
779 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
780 = hcat [ptext (sLit "stg_sel_"), text (show offset),
782 then (sLit "_upd_info")
783 else (sLit "_noupd_info"))
786 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
787 = hcat [ptext (sLit "stg_sel_"), text (show offset),
789 then (sLit "_upd_entry")
790 else (sLit "_noupd_entry"))
793 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
794 = hcat [ptext (sLit "stg_ap_"), text (show arity),
796 then (sLit "_upd_info")
797 else (sLit "_noupd_info"))
800 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
801 = hcat [ptext (sLit "stg_ap_"), text (show arity),
803 then (sLit "_upd_entry")
804 else (sLit "_noupd_entry"))
807 pprCLbl (RtsLabel (RtsInfo fs))
808 = ptext fs <> ptext (sLit "_info")
810 pprCLbl (RtsLabel (RtsEntry fs))
811 = ptext fs <> ptext (sLit "_entry")
813 pprCLbl (RtsLabel (RtsRetInfo fs))
814 = ptext fs <> ptext (sLit "_info")
816 pprCLbl (RtsLabel (RtsRet fs))
817 = ptext fs <> ptext (sLit "_ret")
819 pprCLbl (RtsLabel (RtsInfoFS fs))
820 = ftext fs <> ptext (sLit "_info")
822 pprCLbl (RtsLabel (RtsEntryFS fs))
823 = ftext fs <> ptext (sLit "_entry")
825 pprCLbl (RtsLabel (RtsRetInfoFS fs))
826 = ftext fs <> ptext (sLit "_info")
828 pprCLbl (RtsLabel (RtsRetFS fs))
829 = ftext fs <> ptext (sLit "_ret")
831 pprCLbl (RtsLabel (RtsPrimOp primop))
832 = ppr primop <> ptext (sLit "_fast")
834 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
835 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
837 pprCLbl ModuleRegdLabel
838 = ptext (sLit "_module_registered")
840 pprCLbl (ForeignLabel str _ _ _)
843 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
845 pprCLbl (CC_Label cc) = ppr cc
846 pprCLbl (CCS_Label ccs) = ppr ccs
848 pprCLbl (ModuleInitLabel mod way)
849 = ptext (sLit "__stginit_") <> ppr mod
850 <> char '_' <> text way
851 pprCLbl (PlainModuleInitLabel mod)
852 = ptext (sLit "__stginit_") <> ppr mod
853 pprCLbl (ModuleInitTableLabel mod)
854 = ptext (sLit "__stginittable_") <> ppr mod
856 pprCLbl (HpcTicksLabel mod)
857 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
859 pprCLbl HpcModuleNameLabel
860 = ptext (sLit "_hpc_module_name_str")
862 ppIdFlavor :: IdLabelInfo -> SDoc
863 ppIdFlavor x = pp_cSEP <>
865 Closure -> ptext (sLit "closure")
866 SRT -> ptext (sLit "srt")
867 InfoTable -> ptext (sLit "info")
868 Entry -> ptext (sLit "entry")
869 Slow -> ptext (sLit "slow")
870 RednCounts -> ptext (sLit "ct")
871 ConEntry -> ptext (sLit "con_entry")
872 ConInfoTable -> ptext (sLit "con_info")
873 StaticConEntry -> ptext (sLit "static_entry")
874 StaticInfoTable -> ptext (sLit "static_info")
875 ClosureTable -> ptext (sLit "closure_tbl")
881 -- -----------------------------------------------------------------------------
882 -- Machine-dependent knowledge about labels.
884 underscorePrefix :: Bool -- leading underscore on assembler labels?
885 underscorePrefix = (cLeadingUnderscore == "YES")
887 asmTempLabelPrefix :: LitString -- for formatting labels
890 {- The alpha assembler likes temporary labels to look like $L123
891 instead of L123. (Don't toss the L, because then Lf28
895 #elif darwin_TARGET_OS
901 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
903 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
904 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
905 = pprCLabel lbl <> text "@GOTPCREL"
906 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
908 pprDynamicLinkerAsmLabel _ _
909 = panic "pprDynamicLinkerAsmLabel"
910 #elif darwin_TARGET_OS
911 pprDynamicLinkerAsmLabel CodeStub lbl
912 = char 'L' <> pprCLabel lbl <> text "$stub"
913 pprDynamicLinkerAsmLabel SymbolPtr lbl
914 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
915 pprDynamicLinkerAsmLabel _ _
916 = panic "pprDynamicLinkerAsmLabel"
917 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
918 pprDynamicLinkerAsmLabel CodeStub lbl
919 = pprCLabel lbl <> text "@plt"
920 pprDynamicLinkerAsmLabel SymbolPtr lbl
921 = text ".LC_" <> pprCLabel lbl
922 pprDynamicLinkerAsmLabel _ _
923 = panic "pprDynamicLinkerAsmLabel"
924 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
925 pprDynamicLinkerAsmLabel CodeStub lbl
926 = pprCLabel lbl <> text "@plt"
927 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
928 = pprCLabel lbl <> text "@gotpcrel"
929 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
931 pprDynamicLinkerAsmLabel SymbolPtr lbl
932 = text ".LC_" <> pprCLabel lbl
933 #elif linux_TARGET_OS
934 pprDynamicLinkerAsmLabel CodeStub lbl
935 = pprCLabel lbl <> text "@plt"
936 pprDynamicLinkerAsmLabel SymbolPtr lbl
937 = text ".LC_" <> pprCLabel lbl
938 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
939 = pprCLabel lbl <> text "@got"
940 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
941 = pprCLabel lbl <> text "@gotoff"
942 #elif mingw32_TARGET_OS
943 pprDynamicLinkerAsmLabel SymbolPtr lbl
944 = text "__imp_" <> pprCLabel lbl
945 pprDynamicLinkerAsmLabel _ _
946 = panic "pprDynamicLinkerAsmLabel"
948 pprDynamicLinkerAsmLabel _ _
949 = panic "pprDynamicLinkerAsmLabel"