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,
56 mkDirty_MUT_VAR_Label,
59 mkMainCapabilityLabel,
60 mkMAP_FROZEN_infoLabel,
61 mkMAP_DIRTY_infoLabel,
62 mkEMPTY_MVAR_infoLabel,
65 mkCAFBlackHoleInfoTableLabel,
66 mkSECAFBlackHoleInfoTableLabel,
68 mkRtsSlowTickyCtrLabel,
93 foreignLabelStdcallInfo,
95 mkCCLabel, mkCCSLabel,
97 DynamicLinkerLabelInfo(..),
99 dynamicLinkerLabelInfo,
102 mkDeadStripPreventer,
105 mkHpcModuleNameLabel,
107 infoLblToEntryLbl, entryLblToInfoLbl,
108 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
110 CLabelType(..), labelType, labelDynamic,
115 #include "HsVersions.h"
131 -- -----------------------------------------------------------------------------
135 CLabel is an abstract type that supports the following operations:
139 - In a C file, does it need to be declared before use? (i.e. is it
140 guaranteed to be already in scope in the places we need to refer to it?)
142 - If it needs to be declared, what type (code or data) should it be
145 - Is it visible outside this object file or not?
147 - Is it "dynamic" (see details below)
149 - Eq and Ord, so that we can make sets of CLabels (currently only
150 used in outputting C as far as I can tell, to avoid generating
151 more than one declaration for any given label).
153 - Converting an info table label into an entry label.
157 = IdLabel -- A family of labels related to the
158 Name -- definition of a particular Id or Con
161 | CaseLabel -- A family of labels related to a particular
163 {-# UNPACK #-} !Unique -- Unique says which case expression
167 {-# UNPACK #-} !Unique
170 {-# UNPACK #-} !Unique
173 Module -- the module name
175 -- at some point we might want some kind of version number in
176 -- the module init label, to guard against compiling modules in
177 -- the wrong order. We can't use the interface file version however,
178 -- because we don't always recompile modules which depend on a module
179 -- whose version has changed.
181 | PlainModuleInitLabel -- without the vesrion & way info
186 | RtsLabel RtsLabelInfo
188 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
189 (Maybe Int) -- possible '@n' suffix for stdcall functions
190 -- When generating C, the '@n' suffix is omitted, but when
191 -- generating assembler we must add it to the label.
192 Bool -- True <=> is dynamic
194 | CC_Label CostCentre
195 | CCS_Label CostCentreStack
197 -- Dynamic Linking in the NCG:
198 -- generated and used inside the NCG only,
199 -- see module PositionIndependentCode for details.
201 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
202 -- special variants of a label used for dynamic linking
204 | PicBaseLabel -- a label used as a base for PIC calculations
205 -- on some platforms.
206 -- It takes the form of a local numeric
207 -- assembler label '1'; it is pretty-printed
208 -- as 1b, referring to the previous definition
209 -- of 1: in the assembler source file.
211 | DeadStripPreventer CLabel
212 -- label before an info table to prevent excessive dead-stripping on darwin
214 | HpcTicksLabel Module -- Per-module table of tick locations
215 | HpcModuleNameLabel -- Per-module name of the module for Hpc
217 | LargeSRTLabel -- Label of an StgLargeSRT
218 {-# UNPACK #-} !Unique
220 | LargeBitmapLabel -- A bitmap (function or case return)
221 {-# UNPACK #-} !Unique
226 = Closure -- Label for closure
227 | SRT -- Static reference table
228 | InfoTable -- Info tables for closures; always read-only
229 | Entry -- entry point
230 | Slow -- slow entry point
232 | RednCounts -- Label of place to keep Ticky-ticky info for
235 | ConEntry -- constructor entry point
236 | ConInfoTable -- corresponding info table
237 | StaticConEntry -- static constructor entry point
238 | StaticInfoTable -- corresponding info table
240 | ClosureTable -- table of closures for Enum tycons
254 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
255 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
257 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
258 | RtsApEntry Bool{-updatable-} Int{-arity-}
262 | RtsInfo LitString -- misc rts info tables
263 | RtsEntry LitString -- misc rts entry points
264 | RtsRetInfo LitString -- misc rts ret info tables
265 | RtsRet LitString -- misc rts return points
266 | RtsData LitString -- misc rts data bits, eg CHARLIKE_closure
267 | RtsCode LitString -- misc rts code
269 | RtsInfoFS FastString -- misc rts info tables
270 | RtsEntryFS FastString -- misc rts entry points
271 | RtsRetInfoFS FastString -- misc rts ret info tables
272 | RtsRetFS FastString -- misc rts return points
273 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
274 | RtsCodeFS FastString -- misc rts code
276 | RtsApFast LitString -- _fast versions of generic apply
278 | RtsSlowTickyCtr String
281 -- NOTE: Eq on LitString compares the pointer only, so this isn't
284 data DynamicLinkerLabelInfo
285 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
286 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
287 | GotSymbolPtr -- ELF: foo@got
288 | GotSymbolOffset -- ELF: foo@gotoff
292 -- -----------------------------------------------------------------------------
293 -- Constructing CLabels
295 -- These are always local:
296 mkSRTLabel name = IdLabel name SRT
297 mkSlowEntryLabel name = IdLabel name Slow
298 mkRednCountsLabel name = IdLabel name RednCounts
300 -- These have local & (possibly) external variants:
301 mkLocalClosureLabel name = IdLabel name Closure
302 mkLocalInfoTableLabel name = IdLabel name InfoTable
303 mkLocalEntryLabel name = IdLabel name Entry
304 mkLocalClosureTableLabel name = IdLabel name ClosureTable
306 mkClosureLabel name = IdLabel name Closure
307 mkInfoTableLabel name = IdLabel name InfoTable
308 mkEntryLabel name = IdLabel name Entry
309 mkClosureTableLabel name = IdLabel name ClosureTable
310 mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
311 mkLocalConEntryLabel con = IdLabel con ConEntry
312 mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
313 mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
314 mkConInfoTableLabel name = IdLabel name ConInfoTable
315 mkStaticInfoTableLabel name = IdLabel name StaticInfoTable
317 mkConEntryLabel name = IdLabel name ConEntry
318 mkStaticConEntryLabel name = IdLabel name StaticConEntry
320 mkLargeSRTLabel uniq = LargeSRTLabel uniq
321 mkBitmapLabel uniq = LargeBitmapLabel uniq
323 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
324 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
325 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
326 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
328 mkStringLitLabel = StringLitLabel
329 mkAsmTempLabel :: Uniquable a => a -> CLabel
330 mkAsmTempLabel a = AsmTempLabel (getUnique a)
332 mkModuleInitLabel :: Module -> String -> CLabel
333 mkModuleInitLabel mod way = ModuleInitLabel mod way
335 mkPlainModuleInitLabel :: Module -> CLabel
336 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
338 -- Some fixed runtime system labels
340 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
341 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
342 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
343 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
344 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
345 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
346 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
347 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
349 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
350 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
351 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
352 RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
353 else -- RTS won't have info table unless -ticky is on
354 panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
355 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
357 moduleRegdLabel = ModuleRegdLabel
359 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
360 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
362 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
363 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
367 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
368 mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
370 addLabelSize :: CLabel -> Int -> CLabel
371 addLabelSize (ForeignLabel str _ is_dynamic) sz
372 = ForeignLabel str (Just sz) is_dynamic
376 foreignLabelStdcallInfo :: CLabel -> Maybe Int
377 foreignLabelStdcallInfo (ForeignLabel _ info _) = info
378 foreignLabelStdcallInfo _lbl = Nothing
382 mkCCLabel cc = CC_Label cc
383 mkCCSLabel ccs = CCS_Label ccs
385 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
386 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
387 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
388 mkRtsRetLabel str = RtsLabel (RtsRet str)
389 mkRtsCodeLabel str = RtsLabel (RtsCode str)
390 mkRtsDataLabel str = RtsLabel (RtsData str)
392 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
393 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
394 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
395 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
396 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
397 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
399 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
401 mkRtsSlowTickyCtrLabel :: String -> CLabel
402 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
406 mkHpcTicksLabel = HpcTicksLabel
407 mkHpcModuleNameLabel = HpcModuleNameLabel
411 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
412 mkDynamicLinkerLabel = DynamicLinkerLabel
414 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
415 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
416 dynamicLinkerLabelInfo _ = Nothing
418 -- Position independent code
420 mkPicBaseLabel :: CLabel
421 mkPicBaseLabel = PicBaseLabel
423 mkDeadStripPreventer :: CLabel -> CLabel
424 mkDeadStripPreventer lbl = DeadStripPreventer lbl
426 -- -----------------------------------------------------------------------------
427 -- Converting between info labels and entry/ret labels.
429 infoLblToEntryLbl :: CLabel -> CLabel
430 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
431 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
432 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
433 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
434 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
435 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
436 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
437 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
438 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
440 entryLblToInfoLbl :: CLabel -> CLabel
441 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
442 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
443 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
444 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
445 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
446 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
447 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
448 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
449 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
451 -- -----------------------------------------------------------------------------
452 -- Does a CLabel need declaring before use or not?
454 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
456 needsCDecl :: CLabel -> Bool
457 -- False <=> it's pre-declared; don't bother
458 -- don't bother declaring SRT & Bitmap labels, we always make sure
459 -- they are defined before use.
460 needsCDecl (IdLabel _ SRT) = False
461 needsCDecl (LargeSRTLabel _) = False
462 needsCDecl (LargeBitmapLabel _) = False
463 needsCDecl (IdLabel _ _) = True
464 needsCDecl (CaseLabel _ _) = True
465 needsCDecl (ModuleInitLabel _ _) = True
466 needsCDecl (PlainModuleInitLabel _) = True
467 needsCDecl ModuleRegdLabel = False
469 needsCDecl (StringLitLabel _) = False
470 needsCDecl (AsmTempLabel _) = False
471 needsCDecl (RtsLabel _) = False
472 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
473 needsCDecl (CC_Label _) = True
474 needsCDecl (CCS_Label _) = True
475 needsCDecl (HpcTicksLabel _) = True
476 needsCDecl HpcModuleNameLabel = False
478 -- Whether the label is an assembler temporary:
480 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
481 isAsmTemp (AsmTempLabel _) = True
484 maybeAsmTemp :: CLabel -> Maybe Unique
485 maybeAsmTemp (AsmTempLabel uq) = Just uq
486 maybeAsmTemp _ = Nothing
488 -- some labels have C prototypes in scope when compiling via C, because
489 -- they are builtin to the C compiler. For these labels we avoid
490 -- generating our own C prototypes.
491 isMathFun :: CLabel -> Bool
492 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
495 (fsLit "pow"), (fsLit "sin"), (fsLit "cos"),
496 (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"),
497 (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"),
498 (fsLit "atan"), (fsLit "log"), (fsLit "exp"),
499 (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"),
500 (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"),
501 (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"),
502 (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"),
503 (fsLit "expf"), (fsLit "sqrtf"), (fsLit "frexp"),
504 (fsLit "modf"), (fsLit "ilogb"), (fsLit "copysign"),
505 (fsLit "remainder"), (fsLit "nextafter"), (fsLit "logb"),
506 (fsLit "cbrt"), (fsLit "atanh"), (fsLit "asinh"),
507 (fsLit "acosh"), (fsLit "lgamma"),(fsLit "hypot"),
508 (fsLit "erfc"), (fsLit "erf"), (fsLit "trunc"),
509 (fsLit "round"), (fsLit "fmod"), (fsLit "floor"),
510 (fsLit "fabs"), (fsLit "ceil"), (fsLit "log10"),
511 (fsLit "ldexp"), (fsLit "atan2"), (fsLit "rint")
515 -- -----------------------------------------------------------------------------
516 -- Is a CLabel visible outside this object file or not?
518 -- From the point of view of the code generator, a name is
519 -- externally visible if it has to be declared as exported
520 -- in the .o file's symbol table; that is, made non-static.
522 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
523 externallyVisibleCLabel (CaseLabel _ _) = False
524 externallyVisibleCLabel (StringLitLabel _) = False
525 externallyVisibleCLabel (AsmTempLabel _) = False
526 externallyVisibleCLabel (ModuleInitLabel _ _) = True
527 externallyVisibleCLabel (PlainModuleInitLabel _)= True
528 externallyVisibleCLabel ModuleRegdLabel = False
529 externallyVisibleCLabel (RtsLabel _) = True
530 externallyVisibleCLabel (ForeignLabel _ _ _) = True
531 externallyVisibleCLabel (IdLabel name _) = isExternalName name
532 externallyVisibleCLabel (CC_Label _) = True
533 externallyVisibleCLabel (CCS_Label _) = True
534 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
535 externallyVisibleCLabel (HpcTicksLabel _) = True
536 externallyVisibleCLabel HpcModuleNameLabel = False
537 externallyVisibleCLabel (LargeBitmapLabel _) = False
538 externallyVisibleCLabel (LargeSRTLabel _) = False
540 -- -----------------------------------------------------------------------------
541 -- Finding the "type" of a CLabel
543 -- For generating correct types in label declarations:
549 labelType :: CLabel -> CLabelType
550 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
551 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
552 labelType (RtsLabel (RtsData _)) = DataLabel
553 labelType (RtsLabel (RtsCode _)) = CodeLabel
554 labelType (RtsLabel (RtsInfo _)) = DataLabel
555 labelType (RtsLabel (RtsEntry _)) = CodeLabel
556 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
557 labelType (RtsLabel (RtsRet _)) = CodeLabel
558 labelType (RtsLabel (RtsDataFS _)) = DataLabel
559 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
560 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
561 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
562 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
563 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
564 labelType (RtsLabel (RtsApFast _)) = CodeLabel
565 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
566 labelType (CaseLabel _ _) = CodeLabel
567 labelType (ModuleInitLabel _ _) = CodeLabel
568 labelType (PlainModuleInitLabel _) = CodeLabel
569 labelType (LargeSRTLabel _) = DataLabel
570 labelType (LargeBitmapLabel _) = DataLabel
572 labelType (IdLabel _ info) = idInfoLabelType info
573 labelType _ = DataLabel
575 idInfoLabelType info =
577 InfoTable -> DataLabel
579 ConInfoTable -> DataLabel
580 StaticInfoTable -> DataLabel
581 ClosureTable -> DataLabel
582 -- krc: aie! a ticky counter label is data
583 RednCounts -> DataLabel
587 -- -----------------------------------------------------------------------------
588 -- Does a CLabel need dynamic linkage?
590 -- When referring to data in code, we need to know whether
591 -- that data resides in a DLL or not. [Win32 only.]
592 -- @labelDynamic@ returns @True@ if the label is located
593 -- in a DLL, be it a data reference or not.
595 labelDynamic :: PackageId -> CLabel -> Bool
596 labelDynamic this_pkg lbl =
598 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
599 IdLabel n k -> isDllName this_pkg n
600 #if mingw32_TARGET_OS
601 ForeignLabel _ _ d -> d
603 -- On Mac OS X and on ELF platforms, false positives are OK,
604 -- so we claim that all foreign imports come from dynamic libraries
605 ForeignLabel _ _ _ -> True
607 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
608 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
610 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
614 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
615 right places. It is used to detect when the abstractC statement of an
616 CCodeBlock actually contains the code for a slow entry point. -- HWL
618 We need at least @Eq@ for @CLabels@, because we want to avoid
619 duplicate declarations in generating C (see @labelSeenTE@ in
623 -----------------------------------------------------------------------------
624 -- Printing out CLabels.
631 where <name> is <Module>_<name> for external names and <unique> for
632 internal names. <type> is one of the following:
635 srt Static reference table
636 srtd Static reference table descriptor
637 entry Entry code (function, closure)
638 slow Slow entry code (if any)
639 ret Direct return address
641 <n>_alt Case alternative (tag n)
642 dflt Default case alternative
643 btm Large bitmap vector
644 closure Static closure
645 con_entry Dynamic Constructor entry code
646 con_info Dynamic Constructor info table
647 static_entry Static Constructor entry code
648 static_info Static Constructor info table
649 sel_info Selector info table
650 sel_entry Selector entry code
652 ccs Cost centre stack
654 Many of these distinctions are only for documentation reasons. For
655 example, _ret is only distinguished from _entry to make it easy to
656 tell whether a code fragment is a return point or a closure/function
660 instance Outputable CLabel where
663 pprCLabel :: CLabel -> SDoc
665 #if ! OMIT_NATIVE_CODEGEN
666 pprCLabel (AsmTempLabel u)
667 = getPprStyle $ \ sty ->
669 ptext asmTempLabelPrefix <> pprUnique u
671 char '_' <> pprUnique u
673 pprCLabel (DynamicLinkerLabel info lbl)
674 = pprDynamicLinkerAsmLabel info lbl
676 pprCLabel PicBaseLabel
679 pprCLabel (DeadStripPreventer lbl)
680 = pprCLabel lbl <> ptext (sLit "_dsp")
684 #if ! OMIT_NATIVE_CODEGEN
685 getPprStyle $ \ sty ->
687 maybe_underscore (pprAsmCLbl lbl)
693 | underscorePrefix = pp_cSEP <> doc
696 #ifdef mingw32_TARGET_OS
697 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
698 -- (The C compiler does this itself).
699 pprAsmCLbl (ForeignLabel fs (Just sz) _)
700 = ftext fs <> char '@' <> int sz
705 pprCLbl (StringLitLabel u)
706 = pprUnique u <> ptext (sLit "_str")
708 pprCLbl (CaseLabel u CaseReturnPt)
709 = hcat [pprUnique u, ptext (sLit "_ret")]
710 pprCLbl (CaseLabel u CaseReturnInfo)
711 = hcat [pprUnique u, ptext (sLit "_info")]
712 pprCLbl (CaseLabel u (CaseAlt tag))
713 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
714 pprCLbl (CaseLabel u CaseDefault)
715 = hcat [pprUnique u, ptext (sLit "_dflt")]
717 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
718 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
719 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
720 -- until that gets resolved we'll just force them to start
721 -- with a letter so the label will be legal assmbly code.
724 pprCLbl (RtsLabel (RtsCode str)) = ptext str
725 pprCLbl (RtsLabel (RtsData str)) = ptext str
726 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
727 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
729 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
731 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
732 = hcat [ptext (sLit "stg_sel_"), text (show offset),
734 then (sLit "_upd_info")
735 else (sLit "_noupd_info"))
738 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
739 = hcat [ptext (sLit "stg_sel_"), text (show offset),
741 then (sLit "_upd_entry")
742 else (sLit "_noupd_entry"))
745 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
746 = hcat [ptext (sLit "stg_ap_"), text (show arity),
748 then (sLit "_upd_info")
749 else (sLit "_noupd_info"))
752 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
753 = hcat [ptext (sLit "stg_ap_"), text (show arity),
755 then (sLit "_upd_entry")
756 else (sLit "_noupd_entry"))
759 pprCLbl (RtsLabel (RtsInfo fs))
760 = ptext fs <> ptext (sLit "_info")
762 pprCLbl (RtsLabel (RtsEntry fs))
763 = ptext fs <> ptext (sLit "_entry")
765 pprCLbl (RtsLabel (RtsRetInfo fs))
766 = ptext fs <> ptext (sLit "_info")
768 pprCLbl (RtsLabel (RtsRet fs))
769 = ptext fs <> ptext (sLit "_ret")
771 pprCLbl (RtsLabel (RtsInfoFS fs))
772 = ftext fs <> ptext (sLit "_info")
774 pprCLbl (RtsLabel (RtsEntryFS fs))
775 = ftext fs <> ptext (sLit "_entry")
777 pprCLbl (RtsLabel (RtsRetInfoFS fs))
778 = ftext fs <> ptext (sLit "_info")
780 pprCLbl (RtsLabel (RtsRetFS fs))
781 = ftext fs <> ptext (sLit "_ret")
783 pprCLbl (RtsLabel (RtsPrimOp primop))
784 = ppr primop <> ptext (sLit "_fast")
786 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
787 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
789 pprCLbl ModuleRegdLabel
790 = ptext (sLit "_module_registered")
792 pprCLbl (ForeignLabel str _ _)
795 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
797 pprCLbl (CC_Label cc) = ppr cc
798 pprCLbl (CCS_Label ccs) = ppr ccs
800 pprCLbl (ModuleInitLabel mod way)
801 = ptext (sLit "__stginit_") <> ppr mod
802 <> char '_' <> text way
803 pprCLbl (PlainModuleInitLabel mod)
804 = ptext (sLit "__stginit_") <> ppr mod
806 pprCLbl (HpcTicksLabel mod)
807 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
809 pprCLbl HpcModuleNameLabel
810 = ptext (sLit "_hpc_module_name_str")
812 ppIdFlavor :: IdLabelInfo -> SDoc
813 ppIdFlavor x = pp_cSEP <>
815 Closure -> ptext (sLit "closure")
816 SRT -> ptext (sLit "srt")
817 InfoTable -> ptext (sLit "info")
818 Entry -> ptext (sLit "entry")
819 Slow -> ptext (sLit "slow")
820 RednCounts -> ptext (sLit "ct")
821 ConEntry -> ptext (sLit "con_entry")
822 ConInfoTable -> ptext (sLit "con_info")
823 StaticConEntry -> ptext (sLit "static_entry")
824 StaticInfoTable -> ptext (sLit "static_info")
825 ClosureTable -> ptext (sLit "closure_tbl")
831 -- -----------------------------------------------------------------------------
832 -- Machine-dependent knowledge about labels.
834 underscorePrefix :: Bool -- leading underscore on assembler labels?
835 underscorePrefix = (cLeadingUnderscore == "YES")
837 asmTempLabelPrefix :: LitString -- for formatting labels
840 {- The alpha assembler likes temporary labels to look like $L123
841 instead of L123. (Don't toss the L, because then Lf28
845 #elif darwin_TARGET_OS
851 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
853 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
854 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
855 = pprCLabel lbl <> text "@GOTPCREL"
856 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
858 pprDynamicLinkerAsmLabel _ _
859 = panic "pprDynamicLinkerAsmLabel"
860 #elif darwin_TARGET_OS
861 pprDynamicLinkerAsmLabel CodeStub lbl
862 = char 'L' <> pprCLabel lbl <> text "$stub"
863 pprDynamicLinkerAsmLabel SymbolPtr lbl
864 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
865 pprDynamicLinkerAsmLabel _ _
866 = panic "pprDynamicLinkerAsmLabel"
867 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
868 pprDynamicLinkerAsmLabel CodeStub lbl
869 = pprCLabel lbl <> text "@plt"
870 pprDynamicLinkerAsmLabel SymbolPtr lbl
871 = text ".LC_" <> pprCLabel lbl
872 pprDynamicLinkerAsmLabel _ _
873 = panic "pprDynamicLinkerAsmLabel"
874 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
875 pprDynamicLinkerAsmLabel CodeStub lbl
876 = pprCLabel lbl <> text "@plt"
877 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
878 = pprCLabel lbl <> text "@gotpcrel"
879 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
881 pprDynamicLinkerAsmLabel SymbolPtr lbl
882 = text ".LC_" <> pprCLabel lbl
883 #elif linux_TARGET_OS
884 pprDynamicLinkerAsmLabel CodeStub lbl
885 = pprCLabel lbl <> text "@plt"
886 pprDynamicLinkerAsmLabel SymbolPtr lbl
887 = text ".LC_" <> pprCLabel lbl
888 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
889 = pprCLabel lbl <> text "@got"
890 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
891 = pprCLabel lbl <> text "@gotoff"
892 #elif mingw32_TARGET_OS
893 pprDynamicLinkerAsmLabel SymbolPtr lbl
894 = text "__imp_" <> pprCLabel lbl
895 pprDynamicLinkerAsmLabel _ _
896 = panic "pprDynamicLinkerAsmLabel"
898 pprDynamicLinkerAsmLabel _ _
899 = panic "pprDynamicLinkerAsmLabel"