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")
507 -- -----------------------------------------------------------------------------
508 -- Is a CLabel visible outside this object file or not?
510 -- From the point of view of the code generator, a name is
511 -- externally visible if it has to be declared as exported
512 -- in the .o file's symbol table; that is, made non-static.
514 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
515 externallyVisibleCLabel (CaseLabel _ _) = False
516 externallyVisibleCLabel (StringLitLabel _) = False
517 externallyVisibleCLabel (AsmTempLabel _) = False
518 externallyVisibleCLabel (ModuleInitLabel _ _) = True
519 externallyVisibleCLabel (PlainModuleInitLabel _)= True
520 externallyVisibleCLabel ModuleRegdLabel = False
521 externallyVisibleCLabel (RtsLabel _) = True
522 externallyVisibleCLabel (ForeignLabel _ _ _) = True
523 externallyVisibleCLabel (IdLabel name _) = isExternalName name
524 externallyVisibleCLabel (CC_Label _) = True
525 externallyVisibleCLabel (CCS_Label _) = True
526 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
527 externallyVisibleCLabel (HpcTicksLabel _) = True
528 externallyVisibleCLabel HpcModuleNameLabel = False
529 externallyVisibleCLabel (LargeBitmapLabel _) = False
530 externallyVisibleCLabel (LargeSRTLabel _) = False
532 -- -----------------------------------------------------------------------------
533 -- Finding the "type" of a CLabel
535 -- For generating correct types in label declarations:
541 labelType :: CLabel -> CLabelType
542 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
543 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
544 labelType (RtsLabel (RtsData _)) = DataLabel
545 labelType (RtsLabel (RtsCode _)) = CodeLabel
546 labelType (RtsLabel (RtsInfo _)) = DataLabel
547 labelType (RtsLabel (RtsEntry _)) = CodeLabel
548 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
549 labelType (RtsLabel (RtsRet _)) = CodeLabel
550 labelType (RtsLabel (RtsDataFS _)) = DataLabel
551 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
552 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
553 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
554 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
555 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
556 labelType (RtsLabel (RtsApFast _)) = CodeLabel
557 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
558 labelType (CaseLabel _ _) = CodeLabel
559 labelType (ModuleInitLabel _ _) = CodeLabel
560 labelType (PlainModuleInitLabel _) = CodeLabel
561 labelType (LargeSRTLabel _) = DataLabel
562 labelType (LargeBitmapLabel _) = DataLabel
564 labelType (IdLabel _ info) = idInfoLabelType info
565 labelType _ = DataLabel
567 idInfoLabelType info =
569 InfoTable -> DataLabel
571 ConInfoTable -> DataLabel
572 StaticInfoTable -> DataLabel
573 ClosureTable -> DataLabel
574 -- krc: aie! a ticky counter label is data
575 RednCounts -> DataLabel
579 -- -----------------------------------------------------------------------------
580 -- Does a CLabel need dynamic linkage?
582 -- When referring to data in code, we need to know whether
583 -- that data resides in a DLL or not. [Win32 only.]
584 -- @labelDynamic@ returns @True@ if the label is located
585 -- in a DLL, be it a data reference or not.
587 labelDynamic :: PackageId -> CLabel -> Bool
588 labelDynamic this_pkg lbl =
590 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
591 IdLabel n k -> isDllName this_pkg n
592 #if mingw32_TARGET_OS
593 ForeignLabel _ _ d -> d
595 -- On Mac OS X and on ELF platforms, false positives are OK,
596 -- so we claim that all foreign imports come from dynamic libraries
597 ForeignLabel _ _ _ -> True
599 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
600 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
602 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
606 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
607 right places. It is used to detect when the abstractC statement of an
608 CCodeBlock actually contains the code for a slow entry point. -- HWL
610 We need at least @Eq@ for @CLabels@, because we want to avoid
611 duplicate declarations in generating C (see @labelSeenTE@ in
615 -----------------------------------------------------------------------------
616 -- Printing out CLabels.
623 where <name> is <Module>_<name> for external names and <unique> for
624 internal names. <type> is one of the following:
627 srt Static reference table
628 srtd Static reference table descriptor
629 entry Entry code (function, closure)
630 slow Slow entry code (if any)
631 ret Direct return address
633 <n>_alt Case alternative (tag n)
634 dflt Default case alternative
635 btm Large bitmap vector
636 closure Static closure
637 con_entry Dynamic Constructor entry code
638 con_info Dynamic Constructor info table
639 static_entry Static Constructor entry code
640 static_info Static Constructor info table
641 sel_info Selector info table
642 sel_entry Selector entry code
644 ccs Cost centre stack
646 Many of these distinctions are only for documentation reasons. For
647 example, _ret is only distinguished from _entry to make it easy to
648 tell whether a code fragment is a return point or a closure/function
652 instance Outputable CLabel where
655 pprCLabel :: CLabel -> SDoc
657 #if ! OMIT_NATIVE_CODEGEN
658 pprCLabel (AsmTempLabel u)
659 = getPprStyle $ \ sty ->
661 ptext asmTempLabelPrefix <> pprUnique u
663 char '_' <> pprUnique u
665 pprCLabel (DynamicLinkerLabel info lbl)
666 = pprDynamicLinkerAsmLabel info lbl
668 pprCLabel PicBaseLabel
671 pprCLabel (DeadStripPreventer lbl)
672 = pprCLabel lbl <> ptext (sLit "_dsp")
676 #if ! OMIT_NATIVE_CODEGEN
677 getPprStyle $ \ sty ->
679 maybe_underscore (pprAsmCLbl lbl)
685 | underscorePrefix = pp_cSEP <> doc
688 #ifdef mingw32_TARGET_OS
689 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
690 -- (The C compiler does this itself).
691 pprAsmCLbl (ForeignLabel fs (Just sz) _)
692 = ftext fs <> char '@' <> int sz
697 pprCLbl (StringLitLabel u)
698 = pprUnique u <> ptext (sLit "_str")
700 pprCLbl (CaseLabel u CaseReturnPt)
701 = hcat [pprUnique u, ptext (sLit "_ret")]
702 pprCLbl (CaseLabel u CaseReturnInfo)
703 = hcat [pprUnique u, ptext (sLit "_info")]
704 pprCLbl (CaseLabel u (CaseAlt tag))
705 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
706 pprCLbl (CaseLabel u CaseDefault)
707 = hcat [pprUnique u, ptext (sLit "_dflt")]
709 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
710 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
711 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
712 -- until that gets resolved we'll just force them to start
713 -- with a letter so the label will be legal assmbly code.
716 pprCLbl (RtsLabel (RtsCode str)) = ptext str
717 pprCLbl (RtsLabel (RtsData str)) = ptext str
718 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
719 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
721 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
723 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
724 = hcat [ptext (sLit "stg_sel_"), text (show offset),
726 then (sLit "_upd_info")
727 else (sLit "_noupd_info"))
730 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
731 = hcat [ptext (sLit "stg_sel_"), text (show offset),
733 then (sLit "_upd_entry")
734 else (sLit "_noupd_entry"))
737 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
738 = hcat [ptext (sLit "stg_ap_"), text (show arity),
740 then (sLit "_upd_info")
741 else (sLit "_noupd_info"))
744 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
745 = hcat [ptext (sLit "stg_ap_"), text (show arity),
747 then (sLit "_upd_entry")
748 else (sLit "_noupd_entry"))
751 pprCLbl (RtsLabel (RtsInfo fs))
752 = ptext fs <> ptext (sLit "_info")
754 pprCLbl (RtsLabel (RtsEntry fs))
755 = ptext fs <> ptext (sLit "_entry")
757 pprCLbl (RtsLabel (RtsRetInfo fs))
758 = ptext fs <> ptext (sLit "_info")
760 pprCLbl (RtsLabel (RtsRet fs))
761 = ptext fs <> ptext (sLit "_ret")
763 pprCLbl (RtsLabel (RtsInfoFS fs))
764 = ftext fs <> ptext (sLit "_info")
766 pprCLbl (RtsLabel (RtsEntryFS fs))
767 = ftext fs <> ptext (sLit "_entry")
769 pprCLbl (RtsLabel (RtsRetInfoFS fs))
770 = ftext fs <> ptext (sLit "_info")
772 pprCLbl (RtsLabel (RtsRetFS fs))
773 = ftext fs <> ptext (sLit "_ret")
775 pprCLbl (RtsLabel (RtsPrimOp primop))
776 = ppr primop <> ptext (sLit "_fast")
778 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
779 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
781 pprCLbl ModuleRegdLabel
782 = ptext (sLit "_module_registered")
784 pprCLbl (ForeignLabel str _ _)
787 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
789 pprCLbl (CC_Label cc) = ppr cc
790 pprCLbl (CCS_Label ccs) = ppr ccs
792 pprCLbl (ModuleInitLabel mod way)
793 = ptext (sLit "__stginit_") <> ppr mod
794 <> char '_' <> text way
795 pprCLbl (PlainModuleInitLabel mod)
796 = ptext (sLit "__stginit_") <> ppr mod
798 pprCLbl (HpcTicksLabel mod)
799 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
801 pprCLbl HpcModuleNameLabel
802 = ptext (sLit "_hpc_module_name_str")
804 ppIdFlavor :: IdLabelInfo -> SDoc
805 ppIdFlavor x = pp_cSEP <>
807 Closure -> ptext (sLit "closure")
808 SRT -> ptext (sLit "srt")
809 InfoTable -> ptext (sLit "info")
810 Entry -> ptext (sLit "entry")
811 Slow -> ptext (sLit "slow")
812 RednCounts -> ptext (sLit "ct")
813 ConEntry -> ptext (sLit "con_entry")
814 ConInfoTable -> ptext (sLit "con_info")
815 StaticConEntry -> ptext (sLit "static_entry")
816 StaticInfoTable -> ptext (sLit "static_info")
817 ClosureTable -> ptext (sLit "closure_tbl")
823 -- -----------------------------------------------------------------------------
824 -- Machine-dependent knowledge about labels.
826 underscorePrefix :: Bool -- leading underscore on assembler labels?
827 underscorePrefix = (cLeadingUnderscore == "YES")
829 asmTempLabelPrefix :: LitString -- for formatting labels
832 {- The alpha assembler likes temporary labels to look like $L123
833 instead of L123. (Don't toss the L, because then Lf28
837 #elif darwin_TARGET_OS
843 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
845 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
846 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
847 = pprCLabel lbl <> text "@GOTPCREL"
848 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
850 pprDynamicLinkerAsmLabel _ _
851 = panic "pprDynamicLinkerAsmLabel"
852 #elif darwin_TARGET_OS
853 pprDynamicLinkerAsmLabel CodeStub lbl
854 = char 'L' <> pprCLabel lbl <> text "$stub"
855 pprDynamicLinkerAsmLabel SymbolPtr lbl
856 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
857 pprDynamicLinkerAsmLabel _ _
858 = panic "pprDynamicLinkerAsmLabel"
859 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
860 pprDynamicLinkerAsmLabel CodeStub lbl
861 = pprCLabel lbl <> text "@plt"
862 pprDynamicLinkerAsmLabel SymbolPtr lbl
863 = text ".LC_" <> pprCLabel lbl
864 pprDynamicLinkerAsmLabel _ _
865 = panic "pprDynamicLinkerAsmLabel"
866 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
867 pprDynamicLinkerAsmLabel CodeStub lbl
868 = pprCLabel lbl <> text "@plt"
869 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
870 = pprCLabel lbl <> text "@gotpcrel"
871 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
873 pprDynamicLinkerAsmLabel SymbolPtr lbl
874 = text ".LC_" <> pprCLabel lbl
875 #elif linux_TARGET_OS
876 pprDynamicLinkerAsmLabel CodeStub lbl
877 = pprCLabel lbl <> text "@plt"
878 pprDynamicLinkerAsmLabel SymbolPtr lbl
879 = text ".LC_" <> pprCLabel lbl
880 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
881 = pprCLabel lbl <> text "@got"
882 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
883 = pprCLabel lbl <> text "@gotoff"
884 #elif mingw32_TARGET_OS
885 pprDynamicLinkerAsmLabel SymbolPtr lbl
886 = text "__imp_" <> pprCLabel lbl
887 pprDynamicLinkerAsmLabel _ _
888 = panic "pprDynamicLinkerAsmLabel"
890 pprDynamicLinkerAsmLabel _ _
891 = panic "pprDynamicLinkerAsmLabel"