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"
135 -- -----------------------------------------------------------------------------
139 CLabel is an abstract type that supports the following operations:
143 - In a C file, does it need to be declared before use? (i.e. is it
144 guaranteed to be already in scope in the places we need to refer to it?)
146 - If it needs to be declared, what type (code or data) should it be
149 - Is it visible outside this object file or not?
151 - Is it "dynamic" (see details below)
153 - Eq and Ord, so that we can make sets of CLabels (currently only
154 used in outputting C as far as I can tell, to avoid generating
155 more than one declaration for any given label).
157 - Converting an info table label into an entry label.
161 = IdLabel -- A family of labels related to the
162 Name -- definition of a particular Id or Con
166 | CaseLabel -- A family of labels related to a particular
168 {-# UNPACK #-} !Unique -- Unique says which case expression
172 {-# UNPACK #-} !Unique
175 {-# UNPACK #-} !Unique
178 Module -- the module name
180 -- at some point we might want some kind of version number in
181 -- the module init label, to guard against compiling modules in
182 -- the wrong order. We can't use the interface file version however,
183 -- because we don't always recompile modules which depend on a module
184 -- whose version has changed.
186 | PlainModuleInitLabel -- without the version & way info
189 | ModuleInitTableLabel -- table of imported modules to init
194 | RtsLabel RtsLabelInfo
196 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
197 (Maybe Int) -- possible '@n' suffix for stdcall functions
198 -- When generating C, the '@n' suffix is omitted, but when
199 -- generating assembler we must add it to the label.
200 Bool -- True <=> is dynamic
202 | CC_Label CostCentre
203 | CCS_Label CostCentreStack
205 -- Dynamic Linking in the NCG:
206 -- generated and used inside the NCG only,
207 -- see module PositionIndependentCode for details.
209 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
210 -- special variants of a label used for dynamic linking
212 | PicBaseLabel -- a label used as a base for PIC calculations
213 -- on some platforms.
214 -- It takes the form of a local numeric
215 -- assembler label '1'; it is pretty-printed
216 -- as 1b, referring to the previous definition
217 -- of 1: in the assembler source file.
219 | DeadStripPreventer CLabel
220 -- label before an info table to prevent excessive dead-stripping on darwin
222 | HpcTicksLabel Module -- Per-module table of tick locations
223 | HpcModuleNameLabel -- Per-module name of the module for Hpc
225 | LargeSRTLabel -- Label of an StgLargeSRT
226 {-# UNPACK #-} !Unique
228 | LargeBitmapLabel -- A bitmap (function or case return)
229 {-# UNPACK #-} !Unique
234 = Closure -- Label for closure
235 | SRT -- Static reference table
236 | InfoTable -- Info tables for closures; always read-only
237 | Entry -- entry point
238 | Slow -- slow entry point
240 | RednCounts -- Label of place to keep Ticky-ticky info for
243 | ConEntry -- constructor entry point
244 | ConInfoTable -- corresponding info table
245 | StaticConEntry -- static constructor entry point
246 | StaticInfoTable -- corresponding info table
248 | ClosureTable -- table of closures for Enum tycons
262 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
263 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
265 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
266 | RtsApEntry Bool{-updatable-} Int{-arity-}
270 | RtsInfo LitString -- misc rts info tables
271 | RtsEntry LitString -- misc rts entry points
272 | RtsRetInfo LitString -- misc rts ret info tables
273 | RtsRet LitString -- misc rts return points
274 | RtsData LitString -- misc rts data bits
275 | RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure
276 | RtsCode LitString -- misc rts code
278 | RtsInfoFS FastString -- misc rts info tables
279 | RtsEntryFS FastString -- misc rts entry points
280 | RtsRetInfoFS FastString -- misc rts ret info tables
281 | RtsRetFS FastString -- misc rts return points
282 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
283 | RtsCodeFS FastString -- misc rts code
285 | RtsApFast LitString -- _fast versions of generic apply
287 | RtsSlowTickyCtr String
290 -- NOTE: Eq on LitString compares the pointer only, so this isn't
293 data DynamicLinkerLabelInfo
294 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
295 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
296 | GotSymbolPtr -- ELF: foo@got
297 | GotSymbolOffset -- ELF: foo@gotoff
301 -- -----------------------------------------------------------------------------
302 -- Constructing CLabels
304 -- These are always local:
305 mkSRTLabel name c = IdLabel name c SRT
306 mkSlowEntryLabel name c = IdLabel name c Slow
307 mkRednCountsLabel name c = IdLabel name c RednCounts
309 -- These have local & (possibly) external variants:
310 mkLocalClosureLabel name c = IdLabel name c Closure
311 mkLocalInfoTableLabel name c = IdLabel name c InfoTable
312 mkLocalEntryLabel name c = IdLabel name c Entry
313 mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
315 mkClosureLabel name c = IdLabel name c Closure
316 mkInfoTableLabel name c = IdLabel name c InfoTable
317 mkEntryLabel name c = IdLabel name c Entry
318 mkClosureTableLabel name c = IdLabel name c ClosureTable
319 mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
320 mkLocalConEntryLabel c con = IdLabel con c ConEntry
321 mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
322 mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
323 mkConInfoTableLabel name c = IdLabel name c ConInfoTable
324 mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
326 mkConEntryLabel name c = IdLabel name c ConEntry
327 mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
329 mkLargeSRTLabel uniq = LargeSRTLabel uniq
330 mkBitmapLabel uniq = LargeBitmapLabel uniq
332 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
333 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
334 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
335 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
337 mkStringLitLabel = StringLitLabel
338 mkAsmTempLabel :: Uniquable a => a -> CLabel
339 mkAsmTempLabel a = AsmTempLabel (getUnique a)
341 mkModuleInitLabel :: Module -> String -> CLabel
342 mkModuleInitLabel mod way = ModuleInitLabel mod way
344 mkPlainModuleInitLabel :: Module -> CLabel
345 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
347 mkModuleInitTableLabel :: Module -> CLabel
348 mkModuleInitTableLabel mod = ModuleInitTableLabel mod
350 -- Some fixed runtime system labels
352 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
353 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
354 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
355 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
356 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
357 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
358 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
359 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
361 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
362 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
363 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
365 moduleRegdLabel = ModuleRegdLabel
366 moduleRegTableLabel = ModuleInitTableLabel
368 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
369 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
371 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
372 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
376 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
377 mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
379 addLabelSize :: CLabel -> Int -> CLabel
380 addLabelSize (ForeignLabel str _ is_dynamic) sz
381 = ForeignLabel str (Just sz) is_dynamic
385 foreignLabelStdcallInfo :: CLabel -> Maybe Int
386 foreignLabelStdcallInfo (ForeignLabel _ info _) = info
387 foreignLabelStdcallInfo _lbl = Nothing
391 mkCCLabel cc = CC_Label cc
392 mkCCSLabel ccs = CCS_Label ccs
394 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
395 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
396 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
397 mkRtsRetLabel str = RtsLabel (RtsRet str)
398 mkRtsCodeLabel str = RtsLabel (RtsCode str)
399 mkRtsDataLabel str = RtsLabel (RtsData str)
400 mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
402 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
403 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
404 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
405 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
406 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
407 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
409 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
411 mkRtsSlowTickyCtrLabel :: String -> CLabel
412 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
416 mkHpcTicksLabel = HpcTicksLabel
417 mkHpcModuleNameLabel = HpcModuleNameLabel
421 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
422 mkDynamicLinkerLabel = DynamicLinkerLabel
424 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
425 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
426 dynamicLinkerLabelInfo _ = Nothing
428 -- Position independent code
430 mkPicBaseLabel :: CLabel
431 mkPicBaseLabel = PicBaseLabel
433 mkDeadStripPreventer :: CLabel -> CLabel
434 mkDeadStripPreventer lbl = DeadStripPreventer lbl
436 -- -----------------------------------------------------------------------------
437 -- Converting between info labels and entry/ret labels.
439 infoLblToEntryLbl :: CLabel -> CLabel
440 infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
441 infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
442 infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
443 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
444 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
445 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
446 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
447 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
448 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
450 entryLblToInfoLbl :: CLabel -> CLabel
451 entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
452 entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
453 entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
454 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
455 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
456 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
457 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
458 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
459 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
461 cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
462 cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
463 cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
464 cvtToClosureLbl l@(IdLabel n c Closure) = l
465 cvtToClosureLbl l = pprPanic "cvtToClosureLbl" (pprCLabel l)
467 cvtToSRTLbl (IdLabel n c InfoTable) = mkSRTLabel n c
468 cvtToSRTLbl (IdLabel n c Entry) = mkSRTLabel n c
469 cvtToSRTLbl (IdLabel n c ConEntry) = mkSRTLabel n c
470 cvtToSRTLbl l@(IdLabel n c Closure) = mkSRTLabel n c
471 cvtToSRTLbl l = pprPanic "cvtToSRTLbl" (pprCLabel l)
473 -- -----------------------------------------------------------------------------
474 -- Does a CLabel refer to a CAF?
475 hasCAF :: CLabel -> Bool
476 hasCAF (IdLabel _ MayHaveCafRefs _) = True
479 -- -----------------------------------------------------------------------------
480 -- Does a CLabel need declaring before use or not?
482 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
484 needsCDecl :: CLabel -> Bool
485 -- False <=> it's pre-declared; don't bother
486 -- don't bother declaring SRT & Bitmap labels, we always make sure
487 -- they are defined before use.
488 needsCDecl (IdLabel _ _ SRT) = False
489 needsCDecl (LargeSRTLabel _) = False
490 needsCDecl (LargeBitmapLabel _) = False
491 needsCDecl (IdLabel _ _ _) = True
492 needsCDecl (CaseLabel _ _) = True
493 needsCDecl (ModuleInitLabel _ _) = True
494 needsCDecl (PlainModuleInitLabel _) = True
495 needsCDecl (ModuleInitTableLabel _) = True
496 needsCDecl ModuleRegdLabel = False
498 needsCDecl (StringLitLabel _) = False
499 needsCDecl (AsmTempLabel _) = False
500 needsCDecl (RtsLabel _) = False
501 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
502 needsCDecl (CC_Label _) = True
503 needsCDecl (CCS_Label _) = True
504 needsCDecl (HpcTicksLabel _) = True
505 needsCDecl HpcModuleNameLabel = False
507 -- Whether the label is an assembler temporary:
509 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
510 isAsmTemp (AsmTempLabel _) = True
513 maybeAsmTemp :: CLabel -> Maybe Unique
514 maybeAsmTemp (AsmTempLabel uq) = Just uq
515 maybeAsmTemp _ = Nothing
517 -- some labels have C prototypes in scope when compiling via C, because
518 -- they are builtin to the C compiler. For these labels we avoid
519 -- generating our own C prototypes.
520 isMathFun :: CLabel -> Bool
521 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
524 (fsLit "pow"), (fsLit "sin"), (fsLit "cos"),
525 (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"),
526 (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"),
527 (fsLit "atan"), (fsLit "log"), (fsLit "exp"),
528 (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"),
529 (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"),
530 (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"),
531 (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"),
532 (fsLit "expf"), (fsLit "sqrtf"), (fsLit "frexp"),
533 (fsLit "modf"), (fsLit "ilogb"), (fsLit "copysign"),
534 (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
535 (fsLit "cbrt"), (fsLit "atanh"), (fsLit "asinh"),
536 (fsLit "acosh"), (fsLit "lgamma"),(fsLit "hypot"),
537 (fsLit "erfc"), (fsLit "erf"), (fsLit "trunc"),
538 (fsLit "round"), (fsLit "fmod"), (fsLit "floor"),
539 (fsLit "fabs"), (fsLit "ceil"), (fsLit "log10"),
540 (fsLit "ldexp"), (fsLit "atan2"), (fsLit "rint")
544 -- -----------------------------------------------------------------------------
545 -- Is a CLabel visible outside this object file or not?
547 -- From the point of view of the code generator, a name is
548 -- externally visible if it has to be declared as exported
549 -- in the .o file's symbol table; that is, made non-static.
551 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
552 externallyVisibleCLabel (CaseLabel _ _) = False
553 externallyVisibleCLabel (StringLitLabel _) = False
554 externallyVisibleCLabel (AsmTempLabel _) = False
555 externallyVisibleCLabel (ModuleInitLabel _ _) = True
556 externallyVisibleCLabel (PlainModuleInitLabel _)= True
557 externallyVisibleCLabel (ModuleInitTableLabel _)= False
558 externallyVisibleCLabel ModuleRegdLabel = False
559 externallyVisibleCLabel (RtsLabel _) = True
560 externallyVisibleCLabel (ForeignLabel _ _ _) = True
561 externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
562 externallyVisibleCLabel (CC_Label _) = True
563 externallyVisibleCLabel (CCS_Label _) = True
564 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
565 externallyVisibleCLabel (HpcTicksLabel _) = True
566 externallyVisibleCLabel HpcModuleNameLabel = False
567 externallyVisibleCLabel (LargeBitmapLabel _) = False
568 externallyVisibleCLabel (LargeSRTLabel _) = False
570 -- -----------------------------------------------------------------------------
571 -- Finding the "type" of a CLabel
573 -- For generating correct types in label declarations:
576 = CodeLabel -- Address of some executable instructions
577 | DataLabel -- Address of data, not a GC ptr
578 | GcPtrLabel -- Address of a (presumably static) GC object
580 isCFunctionLabel :: CLabel -> Bool
581 isCFunctionLabel lbl = case labelType lbl of
585 isGcPtrLabel :: CLabel -> Bool
586 isGcPtrLabel lbl = case labelType lbl of
590 labelType :: CLabel -> CLabelType
591 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
592 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
593 labelType (RtsLabel (RtsData _)) = DataLabel
594 labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
595 labelType (RtsLabel (RtsCode _)) = CodeLabel
596 labelType (RtsLabel (RtsInfo _)) = DataLabel
597 labelType (RtsLabel (RtsEntry _)) = CodeLabel
598 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
599 labelType (RtsLabel (RtsRet _)) = CodeLabel
600 labelType (RtsLabel (RtsDataFS _)) = DataLabel
601 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
602 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
603 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
604 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
605 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
606 labelType (RtsLabel (RtsApFast _)) = CodeLabel
607 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
608 labelType (CaseLabel _ _) = CodeLabel
609 labelType (ModuleInitLabel _ _) = CodeLabel
610 labelType (PlainModuleInitLabel _) = CodeLabel
611 labelType (ModuleInitTableLabel _) = DataLabel
612 labelType (LargeSRTLabel _) = DataLabel
613 labelType (LargeBitmapLabel _) = DataLabel
614 labelType (IdLabel _ _ info) = idInfoLabelType info
615 labelType _ = DataLabel
617 idInfoLabelType info =
619 InfoTable -> DataLabel
620 Closure -> GcPtrLabel
621 ConInfoTable -> DataLabel
622 StaticInfoTable -> DataLabel
623 ClosureTable -> DataLabel
624 RednCounts -> DataLabel
628 -- -----------------------------------------------------------------------------
629 -- Does a CLabel need dynamic linkage?
631 -- When referring to data in code, we need to know whether
632 -- that data resides in a DLL or not. [Win32 only.]
633 -- @labelDynamic@ returns @True@ if the label is located
634 -- in a DLL, be it a data reference or not.
636 labelDynamic :: PackageId -> CLabel -> Bool
637 labelDynamic this_pkg lbl =
639 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
640 IdLabel n _ k -> isDllName this_pkg n
641 #if mingw32_TARGET_OS
642 ForeignLabel _ _ d -> d
644 -- On Mac OS X and on ELF platforms, false positives are OK,
645 -- so we claim that all foreign imports come from dynamic libraries
646 ForeignLabel _ _ _ -> True
648 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
649 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
650 ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
652 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
656 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
657 right places. It is used to detect when the abstractC statement of an
658 CCodeBlock actually contains the code for a slow entry point. -- HWL
660 We need at least @Eq@ for @CLabels@, because we want to avoid
661 duplicate declarations in generating C (see @labelSeenTE@ in
665 -----------------------------------------------------------------------------
666 -- Printing out CLabels.
673 where <name> is <Module>_<name> for external names and <unique> for
674 internal names. <type> is one of the following:
677 srt Static reference table
678 srtd Static reference table descriptor
679 entry Entry code (function, closure)
680 slow Slow entry code (if any)
681 ret Direct return address
683 <n>_alt Case alternative (tag n)
684 dflt Default case alternative
685 btm Large bitmap vector
686 closure Static closure
687 con_entry Dynamic Constructor entry code
688 con_info Dynamic Constructor info table
689 static_entry Static Constructor entry code
690 static_info Static Constructor info table
691 sel_info Selector info table
692 sel_entry Selector entry code
694 ccs Cost centre stack
696 Many of these distinctions are only for documentation reasons. For
697 example, _ret is only distinguished from _entry to make it easy to
698 tell whether a code fragment is a return point or a closure/function
702 instance Outputable CLabel where
705 pprCLabel :: CLabel -> SDoc
707 #if ! OMIT_NATIVE_CODEGEN
708 pprCLabel (AsmTempLabel u)
709 = getPprStyle $ \ sty ->
711 ptext asmTempLabelPrefix <> pprUnique u
713 char '_' <> pprUnique u
715 pprCLabel (DynamicLinkerLabel info lbl)
716 = pprDynamicLinkerAsmLabel info lbl
718 pprCLabel PicBaseLabel
721 pprCLabel (DeadStripPreventer lbl)
722 = pprCLabel lbl <> ptext (sLit "_dsp")
726 #if ! OMIT_NATIVE_CODEGEN
727 getPprStyle $ \ sty ->
729 maybe_underscore (pprAsmCLbl lbl)
735 | underscorePrefix = pp_cSEP <> doc
738 #ifdef mingw32_TARGET_OS
739 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
740 -- (The C compiler does this itself).
741 pprAsmCLbl (ForeignLabel fs (Just sz) _)
742 = ftext fs <> char '@' <> int sz
747 pprCLbl (StringLitLabel u)
748 = pprUnique u <> ptext (sLit "_str")
750 pprCLbl (CaseLabel u CaseReturnPt)
751 = hcat [pprUnique u, ptext (sLit "_ret")]
752 pprCLbl (CaseLabel u CaseReturnInfo)
753 = hcat [pprUnique u, ptext (sLit "_info")]
754 pprCLbl (CaseLabel u (CaseAlt tag))
755 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
756 pprCLbl (CaseLabel u CaseDefault)
757 = hcat [pprUnique u, ptext (sLit "_dflt")]
759 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
760 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
761 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
762 -- until that gets resolved we'll just force them to start
763 -- with a letter so the label will be legal assmbly code.
766 pprCLbl (RtsLabel (RtsCode str)) = ptext str
767 pprCLbl (RtsLabel (RtsData str)) = ptext str
768 pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str
769 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
770 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
772 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
774 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
775 = hcat [ptext (sLit "stg_sel_"), text (show offset),
777 then (sLit "_upd_info")
778 else (sLit "_noupd_info"))
781 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
782 = hcat [ptext (sLit "stg_sel_"), text (show offset),
784 then (sLit "_upd_entry")
785 else (sLit "_noupd_entry"))
788 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
789 = hcat [ptext (sLit "stg_ap_"), text (show arity),
791 then (sLit "_upd_info")
792 else (sLit "_noupd_info"))
795 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
796 = hcat [ptext (sLit "stg_ap_"), text (show arity),
798 then (sLit "_upd_entry")
799 else (sLit "_noupd_entry"))
802 pprCLbl (RtsLabel (RtsInfo fs))
803 = ptext fs <> ptext (sLit "_info")
805 pprCLbl (RtsLabel (RtsEntry fs))
806 = ptext fs <> ptext (sLit "_entry")
808 pprCLbl (RtsLabel (RtsRetInfo fs))
809 = ptext fs <> ptext (sLit "_info")
811 pprCLbl (RtsLabel (RtsRet fs))
812 = ptext fs <> ptext (sLit "_ret")
814 pprCLbl (RtsLabel (RtsInfoFS fs))
815 = ftext fs <> ptext (sLit "_info")
817 pprCLbl (RtsLabel (RtsEntryFS fs))
818 = ftext fs <> ptext (sLit "_entry")
820 pprCLbl (RtsLabel (RtsRetInfoFS fs))
821 = ftext fs <> ptext (sLit "_info")
823 pprCLbl (RtsLabel (RtsRetFS fs))
824 = ftext fs <> ptext (sLit "_ret")
826 pprCLbl (RtsLabel (RtsPrimOp primop))
827 = ppr primop <> ptext (sLit "_fast")
829 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
830 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
832 pprCLbl ModuleRegdLabel
833 = ptext (sLit "_module_registered")
835 pprCLbl (ForeignLabel str _ _)
838 pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
840 pprCLbl (CC_Label cc) = ppr cc
841 pprCLbl (CCS_Label ccs) = ppr ccs
843 pprCLbl (ModuleInitLabel mod way)
844 = ptext (sLit "__stginit_") <> ppr mod
845 <> char '_' <> text way
846 pprCLbl (PlainModuleInitLabel mod)
847 = ptext (sLit "__stginit_") <> ppr mod
848 pprCLbl (ModuleInitTableLabel mod)
849 = ptext (sLit "__stginittable_") <> ppr mod
851 pprCLbl (HpcTicksLabel mod)
852 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
854 pprCLbl HpcModuleNameLabel
855 = ptext (sLit "_hpc_module_name_str")
857 ppIdFlavor :: IdLabelInfo -> SDoc
858 ppIdFlavor x = pp_cSEP <>
860 Closure -> ptext (sLit "closure")
861 SRT -> ptext (sLit "srt")
862 InfoTable -> ptext (sLit "info")
863 Entry -> ptext (sLit "entry")
864 Slow -> ptext (sLit "slow")
865 RednCounts -> ptext (sLit "ct")
866 ConEntry -> ptext (sLit "con_entry")
867 ConInfoTable -> ptext (sLit "con_info")
868 StaticConEntry -> ptext (sLit "static_entry")
869 StaticInfoTable -> ptext (sLit "static_info")
870 ClosureTable -> ptext (sLit "closure_tbl")
876 -- -----------------------------------------------------------------------------
877 -- Machine-dependent knowledge about labels.
879 underscorePrefix :: Bool -- leading underscore on assembler labels?
880 underscorePrefix = (cLeadingUnderscore == "YES")
882 asmTempLabelPrefix :: LitString -- for formatting labels
885 {- The alpha assembler likes temporary labels to look like $L123
886 instead of L123. (Don't toss the L, because then Lf28
890 #elif darwin_TARGET_OS
896 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
898 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
899 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
900 = pprCLabel lbl <> text "@GOTPCREL"
901 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
903 pprDynamicLinkerAsmLabel _ _
904 = panic "pprDynamicLinkerAsmLabel"
905 #elif darwin_TARGET_OS
906 pprDynamicLinkerAsmLabel CodeStub lbl
907 = char 'L' <> pprCLabel lbl <> text "$stub"
908 pprDynamicLinkerAsmLabel SymbolPtr lbl
909 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
910 pprDynamicLinkerAsmLabel _ _
911 = panic "pprDynamicLinkerAsmLabel"
912 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
913 pprDynamicLinkerAsmLabel CodeStub lbl
914 = pprCLabel lbl <> text "@plt"
915 pprDynamicLinkerAsmLabel SymbolPtr lbl
916 = text ".LC_" <> pprCLabel lbl
917 pprDynamicLinkerAsmLabel _ _
918 = panic "pprDynamicLinkerAsmLabel"
919 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
920 pprDynamicLinkerAsmLabel CodeStub lbl
921 = pprCLabel lbl <> text "@plt"
922 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
923 = pprCLabel lbl <> text "@gotpcrel"
924 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
926 pprDynamicLinkerAsmLabel SymbolPtr lbl
927 = text ".LC_" <> pprCLabel lbl
928 #elif linux_TARGET_OS
929 pprDynamicLinkerAsmLabel CodeStub lbl
930 = pprCLabel lbl <> text "@plt"
931 pprDynamicLinkerAsmLabel SymbolPtr lbl
932 = text ".LC_" <> pprCLabel lbl
933 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
934 = pprCLabel lbl <> text "@got"
935 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
936 = pprCLabel lbl <> text "@gotoff"
937 #elif mingw32_TARGET_OS
938 pprDynamicLinkerAsmLabel SymbolPtr lbl
939 = text "__imp_" <> pprCLabel lbl
940 pprDynamicLinkerAsmLabel _ _
941 = panic "pprDynamicLinkerAsmLabel"
943 pprDynamicLinkerAsmLabel _ _
944 = panic "pprDynamicLinkerAsmLabel"