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,
94 mkCCLabel, mkCCSLabel,
96 DynamicLinkerLabelInfo(..),
98 dynamicLinkerLabelInfo,
101 mkDeadStripPreventer,
104 mkHpcModuleNameLabel,
106 infoLblToEntryLbl, entryLblToInfoLbl,
107 needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
109 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
378 mkCCLabel cc = CC_Label cc
379 mkCCSLabel ccs = CCS_Label ccs
381 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
382 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
383 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
384 mkRtsRetLabel str = RtsLabel (RtsRet str)
385 mkRtsCodeLabel str = RtsLabel (RtsCode str)
386 mkRtsDataLabel str = RtsLabel (RtsData str)
388 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
389 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
390 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
391 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
392 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
393 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
395 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
397 mkRtsSlowTickyCtrLabel :: String -> CLabel
398 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
402 mkHpcTicksLabel = HpcTicksLabel
403 mkHpcModuleNameLabel = HpcModuleNameLabel
407 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
408 mkDynamicLinkerLabel = DynamicLinkerLabel
410 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
411 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
412 dynamicLinkerLabelInfo _ = Nothing
414 -- Position independent code
416 mkPicBaseLabel :: CLabel
417 mkPicBaseLabel = PicBaseLabel
419 mkDeadStripPreventer :: CLabel -> CLabel
420 mkDeadStripPreventer lbl = DeadStripPreventer lbl
422 -- -----------------------------------------------------------------------------
423 -- Converting between info labels and entry/ret labels.
425 infoLblToEntryLbl :: CLabel -> CLabel
426 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
427 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
428 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
429 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
430 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
431 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
432 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
433 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
434 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
436 entryLblToInfoLbl :: CLabel -> CLabel
437 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
438 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
439 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
440 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
441 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
442 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
443 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
444 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
445 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
447 -- -----------------------------------------------------------------------------
448 -- Does a CLabel need declaring before use or not?
450 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
452 needsCDecl :: CLabel -> Bool
453 -- False <=> it's pre-declared; don't bother
454 -- don't bother declaring SRT & Bitmap labels, we always make sure
455 -- they are defined before use.
456 needsCDecl (IdLabel _ SRT) = False
457 needsCDecl (LargeSRTLabel _) = False
458 needsCDecl (LargeBitmapLabel _) = False
459 needsCDecl (IdLabel _ _) = True
460 needsCDecl (CaseLabel _ _) = True
461 needsCDecl (ModuleInitLabel _ _) = True
462 needsCDecl (PlainModuleInitLabel _) = True
463 needsCDecl ModuleRegdLabel = False
465 needsCDecl (StringLitLabel _) = False
466 needsCDecl (AsmTempLabel _) = False
467 needsCDecl (RtsLabel _) = False
468 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
469 needsCDecl (CC_Label _) = True
470 needsCDecl (CCS_Label _) = True
471 needsCDecl (HpcTicksLabel _) = True
472 needsCDecl HpcModuleNameLabel = False
474 -- Whether the label is an assembler temporary:
476 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
477 isAsmTemp (AsmTempLabel _) = True
480 maybeAsmTemp :: CLabel -> Maybe Unique
481 maybeAsmTemp (AsmTempLabel uq) = Just uq
482 maybeAsmTemp _ = Nothing
484 -- some labels have C prototypes in scope when compiling via C, because
485 -- they are builtin to the C compiler. For these labels we avoid
486 -- generating our own C prototypes.
487 isMathFun :: CLabel -> Bool
488 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
491 FSLIT("pow"), FSLIT("sin"), FSLIT("cos"),
492 FSLIT("tan"), FSLIT("sinh"), FSLIT("cosh"),
493 FSLIT("tanh"), FSLIT("asin"), FSLIT("acos"),
494 FSLIT("atan"), FSLIT("log"), FSLIT("exp"),
495 FSLIT("sqrt"), FSLIT("powf"), FSLIT("sinf"),
496 FSLIT("cosf"), FSLIT("tanf"), FSLIT("sinhf"),
497 FSLIT("coshf"), FSLIT("tanhf"), FSLIT("asinf"),
498 FSLIT("acosf"), FSLIT("atanf"), FSLIT("logf"),
499 FSLIT("expf"), FSLIT("sqrtf")
503 -- -----------------------------------------------------------------------------
504 -- Is a CLabel visible outside this object file or not?
506 -- From the point of view of the code generator, a name is
507 -- externally visible if it has to be declared as exported
508 -- in the .o file's symbol table; that is, made non-static.
510 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
511 externallyVisibleCLabel (CaseLabel _ _) = False
512 externallyVisibleCLabel (StringLitLabel _) = False
513 externallyVisibleCLabel (AsmTempLabel _) = False
514 externallyVisibleCLabel (ModuleInitLabel _ _) = True
515 externallyVisibleCLabel (PlainModuleInitLabel _)= True
516 externallyVisibleCLabel ModuleRegdLabel = False
517 externallyVisibleCLabel (RtsLabel _) = True
518 externallyVisibleCLabel (ForeignLabel _ _ _) = True
519 externallyVisibleCLabel (IdLabel name _) = isExternalName name
520 externallyVisibleCLabel (CC_Label _) = True
521 externallyVisibleCLabel (CCS_Label _) = True
522 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
523 externallyVisibleCLabel (HpcTicksLabel _) = True
524 externallyVisibleCLabel HpcModuleNameLabel = False
525 externallyVisibleCLabel (LargeBitmapLabel _) = False
526 externallyVisibleCLabel (LargeSRTLabel _) = False
528 -- -----------------------------------------------------------------------------
529 -- Finding the "type" of a CLabel
531 -- For generating correct types in label declarations:
537 labelType :: CLabel -> CLabelType
538 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
539 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
540 labelType (RtsLabel (RtsData _)) = DataLabel
541 labelType (RtsLabel (RtsCode _)) = CodeLabel
542 labelType (RtsLabel (RtsInfo _)) = DataLabel
543 labelType (RtsLabel (RtsEntry _)) = CodeLabel
544 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
545 labelType (RtsLabel (RtsRet _)) = CodeLabel
546 labelType (RtsLabel (RtsDataFS _)) = DataLabel
547 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
548 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
549 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
550 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
551 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
552 labelType (RtsLabel (RtsApFast _)) = CodeLabel
553 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
554 labelType (CaseLabel _ _) = CodeLabel
555 labelType (ModuleInitLabel _ _) = CodeLabel
556 labelType (PlainModuleInitLabel _) = CodeLabel
557 labelType (LargeSRTLabel _) = DataLabel
558 labelType (LargeBitmapLabel _) = DataLabel
560 labelType (IdLabel _ info) = idInfoLabelType info
561 labelType _ = DataLabel
563 idInfoLabelType info =
565 InfoTable -> DataLabel
567 ConInfoTable -> DataLabel
568 StaticInfoTable -> DataLabel
569 ClosureTable -> DataLabel
570 -- krc: aie! a ticky counter label is data
571 RednCounts -> DataLabel
575 -- -----------------------------------------------------------------------------
576 -- Does a CLabel need dynamic linkage?
578 -- When referring to data in code, we need to know whether
579 -- that data resides in a DLL or not. [Win32 only.]
580 -- @labelDynamic@ returns @True@ if the label is located
581 -- in a DLL, be it a data reference or not.
583 labelDynamic :: PackageId -> CLabel -> Bool
584 labelDynamic this_pkg lbl =
586 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
587 IdLabel n k -> isDllName this_pkg n
588 #if mingw32_TARGET_OS
589 ForeignLabel _ _ d -> d
591 -- On Mac OS X and on ELF platforms, false positives are OK,
592 -- so we claim that all foreign imports come from dynamic libraries
593 ForeignLabel _ _ _ -> True
595 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
596 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
598 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
602 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
603 right places. It is used to detect when the abstractC statement of an
604 CCodeBlock actually contains the code for a slow entry point. -- HWL
606 We need at least @Eq@ for @CLabels@, because we want to avoid
607 duplicate declarations in generating C (see @labelSeenTE@ in
611 -----------------------------------------------------------------------------
612 -- Printing out CLabels.
619 where <name> is <Module>_<name> for external names and <unique> for
620 internal names. <type> is one of the following:
623 srt Static reference table
624 srtd Static reference table descriptor
625 entry Entry code (function, closure)
626 slow Slow entry code (if any)
627 ret Direct return address
629 <n>_alt Case alternative (tag n)
630 dflt Default case alternative
631 btm Large bitmap vector
632 closure Static closure
633 con_entry Dynamic Constructor entry code
634 con_info Dynamic Constructor info table
635 static_entry Static Constructor entry code
636 static_info Static Constructor info table
637 sel_info Selector info table
638 sel_entry Selector entry code
640 ccs Cost centre stack
642 Many of these distinctions are only for documentation reasons. For
643 example, _ret is only distinguished from _entry to make it easy to
644 tell whether a code fragment is a return point or a closure/function
648 instance Outputable CLabel where
651 pprCLabel :: CLabel -> SDoc
653 #if ! OMIT_NATIVE_CODEGEN
654 pprCLabel (AsmTempLabel u)
655 = getPprStyle $ \ sty ->
657 ptext asmTempLabelPrefix <> pprUnique u
659 char '_' <> pprUnique u
661 pprCLabel (DynamicLinkerLabel info lbl)
662 = pprDynamicLinkerAsmLabel info lbl
664 pprCLabel PicBaseLabel
667 pprCLabel (DeadStripPreventer lbl)
668 = pprCLabel lbl <> ptext SLIT("_dsp")
672 #if ! OMIT_NATIVE_CODEGEN
673 getPprStyle $ \ sty ->
675 maybe_underscore (pprAsmCLbl lbl)
681 | underscorePrefix = pp_cSEP <> doc
684 #ifdef mingw32_TARGET_OS
685 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
686 -- (The C compiler does this itself).
687 pprAsmCLbl (ForeignLabel fs (Just sz) _)
688 = ftext fs <> char '@' <> int sz
693 pprCLbl (StringLitLabel u)
694 = pprUnique u <> ptext SLIT("_str")
696 pprCLbl (CaseLabel u CaseReturnPt)
697 = hcat [pprUnique u, ptext SLIT("_ret")]
698 pprCLbl (CaseLabel u CaseReturnInfo)
699 = hcat [pprUnique u, ptext SLIT("_info")]
700 pprCLbl (CaseLabel u (CaseAlt tag))
701 = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
702 pprCLbl (CaseLabel u CaseDefault)
703 = hcat [pprUnique u, ptext SLIT("_dflt")]
705 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
706 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
707 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
708 -- until that gets resolved we'll just force them to start
709 -- with a letter so the label will be legal assmbly code.
712 pprCLbl (RtsLabel (RtsCode str)) = ptext str
713 pprCLbl (RtsLabel (RtsData str)) = ptext str
714 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
715 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
717 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
719 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
720 = hcat [ptext SLIT("stg_sel_"), text (show offset),
722 then SLIT("_upd_info")
723 else SLIT("_noupd_info"))
726 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
727 = hcat [ptext SLIT("stg_sel_"), text (show offset),
729 then SLIT("_upd_entry")
730 else SLIT("_noupd_entry"))
733 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
734 = hcat [ptext SLIT("stg_ap_"), text (show arity),
736 then SLIT("_upd_info")
737 else SLIT("_noupd_info"))
740 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
741 = hcat [ptext SLIT("stg_ap_"), text (show arity),
743 then SLIT("_upd_entry")
744 else SLIT("_noupd_entry"))
747 pprCLbl (RtsLabel (RtsInfo fs))
748 = ptext fs <> ptext SLIT("_info")
750 pprCLbl (RtsLabel (RtsEntry fs))
751 = ptext fs <> ptext SLIT("_entry")
753 pprCLbl (RtsLabel (RtsRetInfo fs))
754 = ptext fs <> ptext SLIT("_info")
756 pprCLbl (RtsLabel (RtsRet fs))
757 = ptext fs <> ptext SLIT("_ret")
759 pprCLbl (RtsLabel (RtsInfoFS fs))
760 = ftext fs <> ptext SLIT("_info")
762 pprCLbl (RtsLabel (RtsEntryFS fs))
763 = ftext fs <> ptext SLIT("_entry")
765 pprCLbl (RtsLabel (RtsRetInfoFS fs))
766 = ftext fs <> ptext SLIT("_info")
768 pprCLbl (RtsLabel (RtsRetFS fs))
769 = ftext fs <> ptext SLIT("_ret")
771 pprCLbl (RtsLabel (RtsPrimOp primop))
772 = ppr primop <> ptext SLIT("_fast")
774 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
775 = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
777 pprCLbl ModuleRegdLabel
778 = ptext SLIT("_module_registered")
780 pprCLbl (ForeignLabel str _ _)
783 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
785 pprCLbl (CC_Label cc) = ppr cc
786 pprCLbl (CCS_Label ccs) = ppr ccs
788 pprCLbl (ModuleInitLabel mod way)
789 = ptext SLIT("__stginit_") <> ppr mod
790 <> char '_' <> text way
791 pprCLbl (PlainModuleInitLabel mod)
792 = ptext SLIT("__stginit_") <> ppr mod
794 pprCLbl (HpcTicksLabel mod)
795 = ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
797 pprCLbl HpcModuleNameLabel
798 = ptext SLIT("_hpc_module_name_str")
800 ppIdFlavor :: IdLabelInfo -> SDoc
801 ppIdFlavor x = pp_cSEP <>
803 Closure -> ptext SLIT("closure")
804 SRT -> ptext SLIT("srt")
805 InfoTable -> ptext SLIT("info")
806 Entry -> ptext SLIT("entry")
807 Slow -> ptext SLIT("slow")
808 RednCounts -> ptext SLIT("ct")
809 ConEntry -> ptext SLIT("con_entry")
810 ConInfoTable -> ptext SLIT("con_info")
811 StaticConEntry -> ptext SLIT("static_entry")
812 StaticInfoTable -> ptext SLIT("static_info")
813 ClosureTable -> ptext SLIT("closure_tbl")
819 -- -----------------------------------------------------------------------------
820 -- Machine-dependent knowledge about labels.
822 underscorePrefix :: Bool -- leading underscore on assembler labels?
823 underscorePrefix = (cLeadingUnderscore == "YES")
825 asmTempLabelPrefix :: LitString -- for formatting labels
828 {- The alpha assembler likes temporary labels to look like $L123
829 instead of L123. (Don't toss the L, because then Lf28
833 #elif darwin_TARGET_OS
839 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
841 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
842 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
843 = pprCLabel lbl <> text "@GOTPCREL"
844 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
846 pprDynamicLinkerAsmLabel _ _
847 = panic "pprDynamicLinkerAsmLabel"
848 #elif darwin_TARGET_OS
849 pprDynamicLinkerAsmLabel CodeStub lbl
850 = char 'L' <> pprCLabel lbl <> text "$stub"
851 pprDynamicLinkerAsmLabel SymbolPtr lbl
852 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
853 pprDynamicLinkerAsmLabel _ _
854 = panic "pprDynamicLinkerAsmLabel"
855 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
856 pprDynamicLinkerAsmLabel CodeStub lbl
857 = pprCLabel lbl <> text "@plt"
858 pprDynamicLinkerAsmLabel SymbolPtr lbl
859 = text ".LC_" <> pprCLabel lbl
860 pprDynamicLinkerAsmLabel _ _
861 = panic "pprDynamicLinkerAsmLabel"
862 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
863 pprDynamicLinkerAsmLabel CodeStub lbl
864 = pprCLabel lbl <> text "@plt"
865 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
866 = pprCLabel lbl <> text "@gotpcrel"
867 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
869 pprDynamicLinkerAsmLabel SymbolPtr lbl
870 = text ".LC_" <> pprCLabel lbl
871 #elif linux_TARGET_OS
872 pprDynamicLinkerAsmLabel CodeStub lbl
873 = pprCLabel lbl <> text "@plt"
874 pprDynamicLinkerAsmLabel SymbolPtr lbl
875 = text ".LC_" <> pprCLabel lbl
876 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
877 = pprCLabel lbl <> text "@got"
878 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
879 = pprCLabel lbl <> text "@gotoff"
880 #elif mingw32_TARGET_OS
881 pprDynamicLinkerAsmLabel SymbolPtr lbl
882 = text "__imp_" <> pprCLabel lbl
883 pprDynamicLinkerAsmLabel _ _
884 = panic "pprDynamicLinkerAsmLabel"
886 pprDynamicLinkerAsmLabel _ _
887 = panic "pprDynamicLinkerAsmLabel"