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 needsCDecl :: CLabel -> Bool
451 -- False <=> it's pre-declared; don't bother
452 -- don't bother declaring SRT & Bitmap labels, we always make sure
453 -- they are defined before use.
454 needsCDecl (IdLabel _ SRT) = False
455 needsCDecl (LargeSRTLabel _) = False
456 needsCDecl (LargeBitmapLabel _) = False
457 needsCDecl (IdLabel _ _) = True
458 needsCDecl (CaseLabel _ _) = True
459 needsCDecl (ModuleInitLabel _ _) = True
460 needsCDecl (PlainModuleInitLabel _) = True
461 needsCDecl ModuleRegdLabel = False
463 needsCDecl (StringLitLabel _) = False
464 needsCDecl (AsmTempLabel _) = False
465 needsCDecl (RtsLabel _) = False
466 -- RTS labels are declared in RTS header files. Otherwise we'd need
467 -- to give types for each label reference in the RTS .cmm files
468 -- somehow; when generating .cmm code we know the types of labels (info,
469 -- entry etc.) but for hand-written .cmm code we don't.
470 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
471 needsCDecl (CC_Label _) = True
472 needsCDecl (CCS_Label _) = True
473 needsCDecl (HpcTicksLabel _) = True
474 needsCDecl HpcModuleNameLabel = False
476 -- Whether the label is an assembler temporary:
478 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
479 isAsmTemp (AsmTempLabel _) = True
482 maybeAsmTemp :: CLabel -> Maybe Unique
483 maybeAsmTemp (AsmTempLabel uq) = Just uq
484 maybeAsmTemp _ = Nothing
486 -- some labels have C prototypes in scope when compiling via C, because
487 -- they are builtin to the C compiler. For these labels we avoid
488 -- generating our own C prototypes.
489 isMathFun :: CLabel -> Bool
490 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
493 FSLIT("pow"), FSLIT("sin"), FSLIT("cos"),
494 FSLIT("tan"), FSLIT("sinh"), FSLIT("cosh"),
495 FSLIT("tanh"), FSLIT("asin"), FSLIT("acos"),
496 FSLIT("atan"), FSLIT("log"), FSLIT("exp"),
497 FSLIT("sqrt"), FSLIT("powf"), FSLIT("sinf"),
498 FSLIT("cosf"), FSLIT("tanf"), FSLIT("sinhf"),
499 FSLIT("coshf"), FSLIT("tanhf"), FSLIT("asinf"),
500 FSLIT("acosf"), FSLIT("atanf"), FSLIT("logf"),
501 FSLIT("expf"), FSLIT("sqrtf")
505 -- -----------------------------------------------------------------------------
506 -- Is a CLabel visible outside this object file or not?
508 -- From the point of view of the code generator, a name is
509 -- externally visible if it has to be declared as exported
510 -- in the .o file's symbol table; that is, made non-static.
512 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
513 externallyVisibleCLabel (CaseLabel _ _) = False
514 externallyVisibleCLabel (StringLitLabel _) = False
515 externallyVisibleCLabel (AsmTempLabel _) = False
516 externallyVisibleCLabel (ModuleInitLabel _ _) = True
517 externallyVisibleCLabel (PlainModuleInitLabel _)= True
518 externallyVisibleCLabel ModuleRegdLabel = False
519 externallyVisibleCLabel (RtsLabel _) = True
520 externallyVisibleCLabel (ForeignLabel _ _ _) = True
521 externallyVisibleCLabel (IdLabel name _) = isExternalName name
522 externallyVisibleCLabel (CC_Label _) = True
523 externallyVisibleCLabel (CCS_Label _) = True
524 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
525 externallyVisibleCLabel (HpcTicksLabel _) = True
526 externallyVisibleCLabel HpcModuleNameLabel = False
527 externallyVisibleCLabel (LargeBitmapLabel _) = False
528 externallyVisibleCLabel (LargeSRTLabel _) = False
530 -- -----------------------------------------------------------------------------
531 -- Finding the "type" of a CLabel
533 -- For generating correct types in label declarations:
539 labelType :: CLabel -> CLabelType
540 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
541 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
542 labelType (RtsLabel (RtsData _)) = DataLabel
543 labelType (RtsLabel (RtsCode _)) = CodeLabel
544 labelType (RtsLabel (RtsInfo _)) = DataLabel
545 labelType (RtsLabel (RtsEntry _)) = CodeLabel
546 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
547 labelType (RtsLabel (RtsRet _)) = CodeLabel
548 labelType (RtsLabel (RtsDataFS _)) = DataLabel
549 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
550 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
551 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
552 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
553 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
554 labelType (RtsLabel (RtsApFast _)) = CodeLabel
555 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
556 labelType (CaseLabel _ _) = CodeLabel
557 labelType (ModuleInitLabel _ _) = CodeLabel
558 labelType (PlainModuleInitLabel _) = CodeLabel
559 labelType (LargeSRTLabel _) = DataLabel
560 labelType (LargeBitmapLabel _) = DataLabel
562 labelType (IdLabel _ info) = idInfoLabelType info
563 labelType _ = DataLabel
565 idInfoLabelType info =
567 InfoTable -> DataLabel
569 ConInfoTable -> DataLabel
570 StaticInfoTable -> DataLabel
571 ClosureTable -> DataLabel
572 -- krc: aie! a ticky counter label is data
573 RednCounts -> DataLabel
577 -- -----------------------------------------------------------------------------
578 -- Does a CLabel need dynamic linkage?
580 -- When referring to data in code, we need to know whether
581 -- that data resides in a DLL or not. [Win32 only.]
582 -- @labelDynamic@ returns @True@ if the label is located
583 -- in a DLL, be it a data reference or not.
585 labelDynamic :: PackageId -> CLabel -> Bool
586 labelDynamic this_pkg lbl =
588 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
589 IdLabel n k -> isDllName this_pkg n
590 #if mingw32_TARGET_OS
591 ForeignLabel _ _ d -> d
593 -- On Mac OS X and on ELF platforms, false positives are OK,
594 -- so we claim that all foreign imports come from dynamic libraries
595 ForeignLabel _ _ _ -> True
597 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
598 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
600 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
604 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
605 right places. It is used to detect when the abstractC statement of an
606 CCodeBlock actually contains the code for a slow entry point. -- HWL
608 We need at least @Eq@ for @CLabels@, because we want to avoid
609 duplicate declarations in generating C (see @labelSeenTE@ in
613 -----------------------------------------------------------------------------
614 -- Printing out CLabels.
621 where <name> is <Module>_<name> for external names and <unique> for
622 internal names. <type> is one of the following:
625 srt Static reference table
626 srtd Static reference table descriptor
627 entry Entry code (function, closure)
628 slow Slow entry code (if any)
629 ret Direct return address
631 <n>_alt Case alternative (tag n)
632 dflt Default case alternative
633 btm Large bitmap vector
634 closure Static closure
635 con_entry Dynamic Constructor entry code
636 con_info Dynamic Constructor info table
637 static_entry Static Constructor entry code
638 static_info Static Constructor info table
639 sel_info Selector info table
640 sel_entry Selector entry code
642 ccs Cost centre stack
644 Many of these distinctions are only for documentation reasons. For
645 example, _ret is only distinguished from _entry to make it easy to
646 tell whether a code fragment is a return point or a closure/function
650 instance Outputable CLabel where
653 pprCLabel :: CLabel -> SDoc
655 #if ! OMIT_NATIVE_CODEGEN
656 pprCLabel (AsmTempLabel u)
657 = getPprStyle $ \ sty ->
659 ptext asmTempLabelPrefix <> pprUnique u
661 char '_' <> pprUnique u
663 pprCLabel (DynamicLinkerLabel info lbl)
664 = pprDynamicLinkerAsmLabel info lbl
666 pprCLabel PicBaseLabel
669 pprCLabel (DeadStripPreventer lbl)
670 = pprCLabel lbl <> ptext SLIT("_dsp")
674 #if ! OMIT_NATIVE_CODEGEN
675 getPprStyle $ \ sty ->
677 maybe_underscore (pprAsmCLbl lbl)
683 | underscorePrefix = pp_cSEP <> doc
686 #ifdef mingw32_TARGET_OS
687 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
688 -- (The C compiler does this itself).
689 pprAsmCLbl (ForeignLabel fs (Just sz) _)
690 = ftext fs <> char '@' <> int sz
695 pprCLbl (StringLitLabel u)
696 = pprUnique u <> ptext SLIT("_str")
698 pprCLbl (CaseLabel u CaseReturnPt)
699 = hcat [pprUnique u, ptext SLIT("_ret")]
700 pprCLbl (CaseLabel u CaseReturnInfo)
701 = hcat [pprUnique u, ptext SLIT("_info")]
702 pprCLbl (CaseLabel u (CaseAlt tag))
703 = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
704 pprCLbl (CaseLabel u CaseDefault)
705 = hcat [pprUnique u, ptext SLIT("_dflt")]
707 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext SLIT("srtd")
708 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext SLIT("btm")
709 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
710 -- until that gets resolved we'll just force them to start
711 -- with a letter so the label will be legal assmbly code.
714 pprCLbl (RtsLabel (RtsCode str)) = ptext str
715 pprCLbl (RtsLabel (RtsData str)) = ptext str
716 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
717 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
719 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
721 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
722 = hcat [ptext SLIT("stg_sel_"), text (show offset),
724 then SLIT("_upd_info")
725 else SLIT("_noupd_info"))
728 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
729 = hcat [ptext SLIT("stg_sel_"), text (show offset),
731 then SLIT("_upd_entry")
732 else SLIT("_noupd_entry"))
735 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
736 = hcat [ptext SLIT("stg_ap_"), text (show arity),
738 then SLIT("_upd_info")
739 else SLIT("_noupd_info"))
742 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
743 = hcat [ptext SLIT("stg_ap_"), text (show arity),
745 then SLIT("_upd_entry")
746 else SLIT("_noupd_entry"))
749 pprCLbl (RtsLabel (RtsInfo fs))
750 = ptext fs <> ptext SLIT("_info")
752 pprCLbl (RtsLabel (RtsEntry fs))
753 = ptext fs <> ptext SLIT("_entry")
755 pprCLbl (RtsLabel (RtsRetInfo fs))
756 = ptext fs <> ptext SLIT("_info")
758 pprCLbl (RtsLabel (RtsRet fs))
759 = ptext fs <> ptext SLIT("_ret")
761 pprCLbl (RtsLabel (RtsInfoFS fs))
762 = ftext fs <> ptext SLIT("_info")
764 pprCLbl (RtsLabel (RtsEntryFS fs))
765 = ftext fs <> ptext SLIT("_entry")
767 pprCLbl (RtsLabel (RtsRetInfoFS fs))
768 = ftext fs <> ptext SLIT("_info")
770 pprCLbl (RtsLabel (RtsRetFS fs))
771 = ftext fs <> ptext SLIT("_ret")
773 pprCLbl (RtsLabel (RtsPrimOp primop))
774 = ppr primop <> ptext SLIT("_fast")
776 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
777 = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
779 pprCLbl ModuleRegdLabel
780 = ptext SLIT("_module_registered")
782 pprCLbl (ForeignLabel str _ _)
785 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
787 pprCLbl (CC_Label cc) = ppr cc
788 pprCLbl (CCS_Label ccs) = ppr ccs
790 pprCLbl (ModuleInitLabel mod way)
791 = ptext SLIT("__stginit_") <> ppr mod
792 <> char '_' <> text way
793 pprCLbl (PlainModuleInitLabel mod)
794 = ptext SLIT("__stginit_") <> ppr mod
796 pprCLbl (HpcTicksLabel mod)
797 = ptext SLIT("_hpc_tickboxes_") <> ppr mod <> ptext SLIT("_hpc")
799 pprCLbl HpcModuleNameLabel
800 = ptext SLIT("_hpc_module_name_str")
802 ppIdFlavor :: IdLabelInfo -> SDoc
803 ppIdFlavor x = pp_cSEP <>
805 Closure -> ptext SLIT("closure")
806 SRT -> ptext SLIT("srt")
807 InfoTable -> ptext SLIT("info")
808 Entry -> ptext SLIT("entry")
809 Slow -> ptext SLIT("slow")
810 RednCounts -> ptext SLIT("ct")
811 ConEntry -> ptext SLIT("con_entry")
812 ConInfoTable -> ptext SLIT("con_info")
813 StaticConEntry -> ptext SLIT("static_entry")
814 StaticInfoTable -> ptext SLIT("static_info")
815 ClosureTable -> ptext SLIT("closure_tbl")
821 -- -----------------------------------------------------------------------------
822 -- Machine-dependent knowledge about labels.
824 underscorePrefix :: Bool -- leading underscore on assembler labels?
825 underscorePrefix = (cLeadingUnderscore == "YES")
827 asmTempLabelPrefix :: LitString -- for formatting labels
830 {- The alpha assembler likes temporary labels to look like $L123
831 instead of L123. (Don't toss the L, because then Lf28
835 #elif darwin_TARGET_OS
841 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
843 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
844 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
845 = pprCLabel lbl <> text "@GOTPCREL"
846 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
848 pprDynamicLinkerAsmLabel _ _
849 = panic "pprDynamicLinkerAsmLabel"
850 #elif darwin_TARGET_OS
851 pprDynamicLinkerAsmLabel CodeStub lbl
852 = char 'L' <> pprCLabel lbl <> text "$stub"
853 pprDynamicLinkerAsmLabel SymbolPtr lbl
854 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
855 pprDynamicLinkerAsmLabel _ _
856 = panic "pprDynamicLinkerAsmLabel"
857 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
858 pprDynamicLinkerAsmLabel CodeStub lbl
859 = pprCLabel lbl <> text "@plt"
860 pprDynamicLinkerAsmLabel SymbolPtr lbl
861 = text ".LC_" <> pprCLabel lbl
862 pprDynamicLinkerAsmLabel _ _
863 = panic "pprDynamicLinkerAsmLabel"
864 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
865 pprDynamicLinkerAsmLabel CodeStub lbl
866 = pprCLabel lbl <> text "@plt"
867 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
868 = pprCLabel lbl <> text "@gotpcrel"
869 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
871 pprDynamicLinkerAsmLabel SymbolPtr lbl
872 = text ".LC_" <> pprCLabel lbl
873 #elif linux_TARGET_OS
874 pprDynamicLinkerAsmLabel CodeStub lbl
875 = pprCLabel lbl <> text "@plt"
876 pprDynamicLinkerAsmLabel SymbolPtr lbl
877 = text ".LC_" <> pprCLabel lbl
878 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
879 = pprCLabel lbl <> text "@got"
880 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
881 = pprCLabel lbl <> text "@gotoff"
882 #elif mingw32_TARGET_OS
883 pprDynamicLinkerAsmLabel SymbolPtr lbl
884 = text "__imp_" <> pprCLabel lbl
885 pprDynamicLinkerAsmLabel _ _
886 = panic "pprDynamicLinkerAsmLabel"
888 pprDynamicLinkerAsmLabel _ _
889 = panic "pprDynamicLinkerAsmLabel"