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,
114 #include "HsVersions.h"
130 -- -----------------------------------------------------------------------------
134 CLabel is an abstract type that supports the following operations:
138 - In a C file, does it need to be declared before use? (i.e. is it
139 guaranteed to be already in scope in the places we need to refer to it?)
141 - If it needs to be declared, what type (code or data) should it be
144 - Is it visible outside this object file or not?
146 - Is it "dynamic" (see details below)
148 - Eq and Ord, so that we can make sets of CLabels (currently only
149 used in outputting C as far as I can tell, to avoid generating
150 more than one declaration for any given label).
152 - Converting an info table label into an entry label.
156 = IdLabel -- A family of labels related to the
157 Name -- definition of a particular Id or Con
160 | CaseLabel -- A family of labels related to a particular
162 {-# UNPACK #-} !Unique -- Unique says which case expression
166 {-# UNPACK #-} !Unique
169 {-# UNPACK #-} !Unique
172 Module -- the module name
174 -- at some point we might want some kind of version number in
175 -- the module init label, to guard against compiling modules in
176 -- the wrong order. We can't use the interface file version however,
177 -- because we don't always recompile modules which depend on a module
178 -- whose version has changed.
180 | PlainModuleInitLabel -- without the vesrion & way info
185 | RtsLabel RtsLabelInfo
187 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
188 (Maybe Int) -- possible '@n' suffix for stdcall functions
189 -- When generating C, the '@n' suffix is omitted, but when
190 -- generating assembler we must add it to the label.
191 Bool -- True <=> is dynamic
193 | CC_Label CostCentre
194 | CCS_Label CostCentreStack
196 -- Dynamic Linking in the NCG:
197 -- generated and used inside the NCG only,
198 -- see module PositionIndependentCode for details.
200 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
201 -- special variants of a label used for dynamic linking
203 | PicBaseLabel -- a label used as a base for PIC calculations
204 -- on some platforms.
205 -- It takes the form of a local numeric
206 -- assembler label '1'; it is pretty-printed
207 -- as 1b, referring to the previous definition
208 -- of 1: in the assembler source file.
210 | DeadStripPreventer CLabel
211 -- label before an info table to prevent excessive dead-stripping on darwin
213 | HpcTicksLabel Module -- Per-module table of tick locations
214 | HpcModuleNameLabel -- Per-module name of the module for Hpc
216 | LargeSRTLabel -- Label of an StgLargeSRT
217 {-# UNPACK #-} !Unique
219 | LargeBitmapLabel -- A bitmap (function or case return)
220 {-# UNPACK #-} !Unique
225 = Closure -- Label for closure
226 | SRT -- Static reference table
227 | InfoTable -- Info tables for closures; always read-only
228 | Entry -- entry point
229 | Slow -- slow entry point
231 | RednCounts -- Label of place to keep Ticky-ticky info for
234 | ConEntry -- constructor entry point
235 | ConInfoTable -- corresponding info table
236 | StaticConEntry -- static constructor entry point
237 | StaticInfoTable -- corresponding info table
239 | ClosureTable -- table of closures for Enum tycons
253 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
254 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
256 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
257 | RtsApEntry Bool{-updatable-} Int{-arity-}
261 | RtsInfo LitString -- misc rts info tables
262 | RtsEntry LitString -- misc rts entry points
263 | RtsRetInfo LitString -- misc rts ret info tables
264 | RtsRet LitString -- misc rts return points
265 | RtsData LitString -- misc rts data bits, eg CHARLIKE_closure
266 | RtsCode LitString -- misc rts code
268 | RtsInfoFS FastString -- misc rts info tables
269 | RtsEntryFS FastString -- misc rts entry points
270 | RtsRetInfoFS FastString -- misc rts ret info tables
271 | RtsRetFS FastString -- misc rts return points
272 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
273 | RtsCodeFS FastString -- misc rts code
275 | RtsApFast LitString -- _fast versions of generic apply
277 | RtsSlowTickyCtr String
280 -- NOTE: Eq on LitString compares the pointer only, so this isn't
283 data DynamicLinkerLabelInfo
284 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
285 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
286 | GotSymbolPtr -- ELF: foo@got
287 | GotSymbolOffset -- ELF: foo@gotoff
291 -- -----------------------------------------------------------------------------
292 -- Constructing CLabels
294 -- These are always local:
295 mkSRTLabel name = IdLabel name SRT
296 mkSlowEntryLabel name = IdLabel name Slow
297 mkRednCountsLabel name = IdLabel name RednCounts
299 -- These have local & (possibly) external variants:
300 mkLocalClosureLabel name = IdLabel name Closure
301 mkLocalInfoTableLabel name = IdLabel name InfoTable
302 mkLocalEntryLabel name = IdLabel name Entry
303 mkLocalClosureTableLabel name = IdLabel name ClosureTable
305 mkClosureLabel name = IdLabel name Closure
306 mkInfoTableLabel name = IdLabel name InfoTable
307 mkEntryLabel name = IdLabel name Entry
308 mkClosureTableLabel name = IdLabel name ClosureTable
309 mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
310 mkLocalConEntryLabel con = IdLabel con ConEntry
311 mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
312 mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
313 mkConInfoTableLabel name = IdLabel name ConInfoTable
314 mkStaticInfoTableLabel name = IdLabel name StaticInfoTable
316 mkConEntryLabel name = IdLabel name ConEntry
317 mkStaticConEntryLabel name = IdLabel name StaticConEntry
319 mkLargeSRTLabel uniq = LargeSRTLabel uniq
320 mkBitmapLabel uniq = LargeBitmapLabel uniq
322 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
323 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
324 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
325 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
327 mkStringLitLabel = StringLitLabel
328 mkAsmTempLabel :: Uniquable a => a -> CLabel
329 mkAsmTempLabel a = AsmTempLabel (getUnique a)
331 mkModuleInitLabel :: Module -> String -> CLabel
332 mkModuleInitLabel mod way = ModuleInitLabel mod way
334 mkPlainModuleInitLabel :: Module -> CLabel
335 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
337 -- Some fixed runtime system labels
339 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
340 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
341 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
342 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
343 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
344 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
345 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
346 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
348 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
349 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
350 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
351 RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
352 else -- RTS won't have info table unless -ticky is on
353 panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
354 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
356 moduleRegdLabel = ModuleRegdLabel
358 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
359 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
361 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
362 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
366 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
367 mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
369 addLabelSize :: CLabel -> Int -> CLabel
370 addLabelSize (ForeignLabel str _ is_dynamic) sz
371 = ForeignLabel str (Just sz) is_dynamic
377 mkCCLabel cc = CC_Label cc
378 mkCCSLabel ccs = CCS_Label ccs
380 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
381 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
382 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
383 mkRtsRetLabel str = RtsLabel (RtsRet str)
384 mkRtsCodeLabel str = RtsLabel (RtsCode str)
385 mkRtsDataLabel str = RtsLabel (RtsData str)
387 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
388 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
389 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
390 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
391 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
392 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
394 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
396 mkRtsSlowTickyCtrLabel :: String -> CLabel
397 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
401 mkHpcTicksLabel = HpcTicksLabel
402 mkHpcModuleNameLabel = HpcModuleNameLabel
406 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
407 mkDynamicLinkerLabel = DynamicLinkerLabel
409 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
410 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
411 dynamicLinkerLabelInfo _ = Nothing
413 -- Position independent code
415 mkPicBaseLabel :: CLabel
416 mkPicBaseLabel = PicBaseLabel
418 mkDeadStripPreventer :: CLabel -> CLabel
419 mkDeadStripPreventer lbl = DeadStripPreventer lbl
421 -- -----------------------------------------------------------------------------
422 -- Converting between info labels and entry/ret labels.
424 infoLblToEntryLbl :: CLabel -> CLabel
425 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
426 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
427 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
428 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
429 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
430 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
431 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
432 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
433 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
435 entryLblToInfoLbl :: CLabel -> CLabel
436 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
437 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
438 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
439 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
440 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
441 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
442 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
443 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
444 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
446 -- -----------------------------------------------------------------------------
447 -- Does a CLabel need declaring before use or not?
449 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
451 needsCDecl :: CLabel -> Bool
452 -- False <=> it's pre-declared; don't bother
453 -- don't bother declaring SRT & Bitmap labels, we always make sure
454 -- they are defined before use.
455 needsCDecl (IdLabel _ SRT) = False
456 needsCDecl (LargeSRTLabel _) = False
457 needsCDecl (LargeBitmapLabel _) = False
458 needsCDecl (IdLabel _ _) = True
459 needsCDecl (CaseLabel _ _) = True
460 needsCDecl (ModuleInitLabel _ _) = True
461 needsCDecl (PlainModuleInitLabel _) = True
462 needsCDecl ModuleRegdLabel = False
464 needsCDecl (StringLitLabel _) = False
465 needsCDecl (AsmTempLabel _) = False
466 needsCDecl (RtsLabel _) = False
467 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
468 needsCDecl (CC_Label _) = True
469 needsCDecl (CCS_Label _) = True
470 needsCDecl (HpcTicksLabel _) = True
471 needsCDecl HpcModuleNameLabel = False
473 -- Whether the label is an assembler temporary:
475 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
476 isAsmTemp (AsmTempLabel _) = True
479 maybeAsmTemp :: CLabel -> Maybe Unique
480 maybeAsmTemp (AsmTempLabel uq) = Just uq
481 maybeAsmTemp _ = Nothing
483 -- some labels have C prototypes in scope when compiling via C, because
484 -- they are builtin to the C compiler. For these labels we avoid
485 -- generating our own C prototypes.
486 isMathFun :: CLabel -> Bool
487 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
490 (fsLit "pow"), (fsLit "sin"), (fsLit "cos"),
491 (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"),
492 (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"),
493 (fsLit "atan"), (fsLit "log"), (fsLit "exp"),
494 (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"),
495 (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"),
496 (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"),
497 (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"),
498 (fsLit "expf"), (fsLit "sqrtf")
502 -- -----------------------------------------------------------------------------
503 -- Is a CLabel visible outside this object file or not?
505 -- From the point of view of the code generator, a name is
506 -- externally visible if it has to be declared as exported
507 -- in the .o file's symbol table; that is, made non-static.
509 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
510 externallyVisibleCLabel (CaseLabel _ _) = False
511 externallyVisibleCLabel (StringLitLabel _) = False
512 externallyVisibleCLabel (AsmTempLabel _) = False
513 externallyVisibleCLabel (ModuleInitLabel _ _) = True
514 externallyVisibleCLabel (PlainModuleInitLabel _)= True
515 externallyVisibleCLabel ModuleRegdLabel = False
516 externallyVisibleCLabel (RtsLabel _) = True
517 externallyVisibleCLabel (ForeignLabel _ _ _) = True
518 externallyVisibleCLabel (IdLabel name _) = isExternalName name
519 externallyVisibleCLabel (CC_Label _) = True
520 externallyVisibleCLabel (CCS_Label _) = True
521 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
522 externallyVisibleCLabel (HpcTicksLabel _) = True
523 externallyVisibleCLabel HpcModuleNameLabel = False
524 externallyVisibleCLabel (LargeBitmapLabel _) = False
525 externallyVisibleCLabel (LargeSRTLabel _) = False
527 -- -----------------------------------------------------------------------------
528 -- Finding the "type" of a CLabel
530 -- For generating correct types in label declarations:
536 labelType :: CLabel -> CLabelType
537 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
538 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
539 labelType (RtsLabel (RtsData _)) = DataLabel
540 labelType (RtsLabel (RtsCode _)) = CodeLabel
541 labelType (RtsLabel (RtsInfo _)) = DataLabel
542 labelType (RtsLabel (RtsEntry _)) = CodeLabel
543 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
544 labelType (RtsLabel (RtsRet _)) = CodeLabel
545 labelType (RtsLabel (RtsDataFS _)) = DataLabel
546 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
547 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
548 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
549 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
550 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
551 labelType (RtsLabel (RtsApFast _)) = CodeLabel
552 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
553 labelType (CaseLabel _ _) = CodeLabel
554 labelType (ModuleInitLabel _ _) = CodeLabel
555 labelType (PlainModuleInitLabel _) = CodeLabel
556 labelType (LargeSRTLabel _) = DataLabel
557 labelType (LargeBitmapLabel _) = DataLabel
559 labelType (IdLabel _ info) = idInfoLabelType info
560 labelType _ = DataLabel
562 idInfoLabelType info =
564 InfoTable -> DataLabel
566 ConInfoTable -> DataLabel
567 StaticInfoTable -> DataLabel
568 ClosureTable -> DataLabel
569 -- krc: aie! a ticky counter label is data
570 RednCounts -> DataLabel
574 -- -----------------------------------------------------------------------------
575 -- Does a CLabel need dynamic linkage?
577 -- When referring to data in code, we need to know whether
578 -- that data resides in a DLL or not. [Win32 only.]
579 -- @labelDynamic@ returns @True@ if the label is located
580 -- in a DLL, be it a data reference or not.
582 labelDynamic :: PackageId -> CLabel -> Bool
583 labelDynamic this_pkg lbl =
585 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
586 IdLabel n k -> isDllName this_pkg n
587 #if mingw32_TARGET_OS
588 ForeignLabel _ _ d -> d
590 -- On Mac OS X and on ELF platforms, false positives are OK,
591 -- so we claim that all foreign imports come from dynamic libraries
592 ForeignLabel _ _ _ -> True
594 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
595 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
597 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
601 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
602 right places. It is used to detect when the abstractC statement of an
603 CCodeBlock actually contains the code for a slow entry point. -- HWL
605 We need at least @Eq@ for @CLabels@, because we want to avoid
606 duplicate declarations in generating C (see @labelSeenTE@ in
610 -----------------------------------------------------------------------------
611 -- Printing out CLabels.
618 where <name> is <Module>_<name> for external names and <unique> for
619 internal names. <type> is one of the following:
622 srt Static reference table
623 srtd Static reference table descriptor
624 entry Entry code (function, closure)
625 slow Slow entry code (if any)
626 ret Direct return address
628 <n>_alt Case alternative (tag n)
629 dflt Default case alternative
630 btm Large bitmap vector
631 closure Static closure
632 con_entry Dynamic Constructor entry code
633 con_info Dynamic Constructor info table
634 static_entry Static Constructor entry code
635 static_info Static Constructor info table
636 sel_info Selector info table
637 sel_entry Selector entry code
639 ccs Cost centre stack
641 Many of these distinctions are only for documentation reasons. For
642 example, _ret is only distinguished from _entry to make it easy to
643 tell whether a code fragment is a return point or a closure/function
647 instance Outputable CLabel where
650 pprCLabel :: CLabel -> SDoc
652 #if ! OMIT_NATIVE_CODEGEN
653 pprCLabel (AsmTempLabel u)
654 = getPprStyle $ \ sty ->
656 ptext asmTempLabelPrefix <> pprUnique u
658 char '_' <> pprUnique u
660 pprCLabel (DynamicLinkerLabel info lbl)
661 = pprDynamicLinkerAsmLabel info lbl
663 pprCLabel PicBaseLabel
666 pprCLabel (DeadStripPreventer lbl)
667 = pprCLabel lbl <> ptext (sLit "_dsp")
671 #if ! OMIT_NATIVE_CODEGEN
672 getPprStyle $ \ sty ->
674 maybe_underscore (pprAsmCLbl lbl)
680 | underscorePrefix = pp_cSEP <> doc
683 #ifdef mingw32_TARGET_OS
684 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
685 -- (The C compiler does this itself).
686 pprAsmCLbl (ForeignLabel fs (Just sz) _)
687 = ftext fs <> char '@' <> int sz
692 pprCLbl (StringLitLabel u)
693 = pprUnique u <> ptext (sLit "_str")
695 pprCLbl (CaseLabel u CaseReturnPt)
696 = hcat [pprUnique u, ptext (sLit "_ret")]
697 pprCLbl (CaseLabel u CaseReturnInfo)
698 = hcat [pprUnique u, ptext (sLit "_info")]
699 pprCLbl (CaseLabel u (CaseAlt tag))
700 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
701 pprCLbl (CaseLabel u CaseDefault)
702 = hcat [pprUnique u, ptext (sLit "_dflt")]
704 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
705 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
706 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
707 -- until that gets resolved we'll just force them to start
708 -- with a letter so the label will be legal assmbly code.
711 pprCLbl (RtsLabel (RtsCode str)) = ptext str
712 pprCLbl (RtsLabel (RtsData str)) = ptext str
713 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
714 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
716 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
718 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
719 = hcat [ptext (sLit "stg_sel_"), text (show offset),
721 then (sLit "_upd_info")
722 else (sLit "_noupd_info"))
725 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
726 = hcat [ptext (sLit "stg_sel_"), text (show offset),
728 then (sLit "_upd_entry")
729 else (sLit "_noupd_entry"))
732 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
733 = hcat [ptext (sLit "stg_ap_"), text (show arity),
735 then (sLit "_upd_info")
736 else (sLit "_noupd_info"))
739 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
740 = hcat [ptext (sLit "stg_ap_"), text (show arity),
742 then (sLit "_upd_entry")
743 else (sLit "_noupd_entry"))
746 pprCLbl (RtsLabel (RtsInfo fs))
747 = ptext fs <> ptext (sLit "_info")
749 pprCLbl (RtsLabel (RtsEntry fs))
750 = ptext fs <> ptext (sLit "_entry")
752 pprCLbl (RtsLabel (RtsRetInfo fs))
753 = ptext fs <> ptext (sLit "_info")
755 pprCLbl (RtsLabel (RtsRet fs))
756 = ptext fs <> ptext (sLit "_ret")
758 pprCLbl (RtsLabel (RtsInfoFS fs))
759 = ftext fs <> ptext (sLit "_info")
761 pprCLbl (RtsLabel (RtsEntryFS fs))
762 = ftext fs <> ptext (sLit "_entry")
764 pprCLbl (RtsLabel (RtsRetInfoFS fs))
765 = ftext fs <> ptext (sLit "_info")
767 pprCLbl (RtsLabel (RtsRetFS fs))
768 = ftext fs <> ptext (sLit "_ret")
770 pprCLbl (RtsLabel (RtsPrimOp primop))
771 = ppr primop <> ptext (sLit "_fast")
773 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
774 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
776 pprCLbl ModuleRegdLabel
777 = ptext (sLit "_module_registered")
779 pprCLbl (ForeignLabel str _ _)
782 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
784 pprCLbl (CC_Label cc) = ppr cc
785 pprCLbl (CCS_Label ccs) = ppr ccs
787 pprCLbl (ModuleInitLabel mod way)
788 = ptext (sLit "__stginit_") <> ppr mod
789 <> char '_' <> text way
790 pprCLbl (PlainModuleInitLabel mod)
791 = ptext (sLit "__stginit_") <> ppr mod
793 pprCLbl (HpcTicksLabel mod)
794 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
796 pprCLbl HpcModuleNameLabel
797 = ptext (sLit "_hpc_module_name_str")
799 ppIdFlavor :: IdLabelInfo -> SDoc
800 ppIdFlavor x = pp_cSEP <>
802 Closure -> ptext (sLit "closure")
803 SRT -> ptext (sLit "srt")
804 InfoTable -> ptext (sLit "info")
805 Entry -> ptext (sLit "entry")
806 Slow -> ptext (sLit "slow")
807 RednCounts -> ptext (sLit "ct")
808 ConEntry -> ptext (sLit "con_entry")
809 ConInfoTable -> ptext (sLit "con_info")
810 StaticConEntry -> ptext (sLit "static_entry")
811 StaticInfoTable -> ptext (sLit "static_info")
812 ClosureTable -> ptext (sLit "closure_tbl")
818 -- -----------------------------------------------------------------------------
819 -- Machine-dependent knowledge about labels.
821 underscorePrefix :: Bool -- leading underscore on assembler labels?
822 underscorePrefix = (cLeadingUnderscore == "YES")
824 asmTempLabelPrefix :: LitString -- for formatting labels
827 {- The alpha assembler likes temporary labels to look like $L123
828 instead of L123. (Don't toss the L, because then Lf28
832 #elif darwin_TARGET_OS
838 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
840 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
841 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
842 = pprCLabel lbl <> text "@GOTPCREL"
843 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
845 pprDynamicLinkerAsmLabel _ _
846 = panic "pprDynamicLinkerAsmLabel"
847 #elif darwin_TARGET_OS
848 pprDynamicLinkerAsmLabel CodeStub lbl
849 = char 'L' <> pprCLabel lbl <> text "$stub"
850 pprDynamicLinkerAsmLabel SymbolPtr lbl
851 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
852 pprDynamicLinkerAsmLabel _ _
853 = panic "pprDynamicLinkerAsmLabel"
854 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
855 pprDynamicLinkerAsmLabel CodeStub lbl
856 = pprCLabel lbl <> text "@plt"
857 pprDynamicLinkerAsmLabel SymbolPtr lbl
858 = text ".LC_" <> pprCLabel lbl
859 pprDynamicLinkerAsmLabel _ _
860 = panic "pprDynamicLinkerAsmLabel"
861 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
862 pprDynamicLinkerAsmLabel CodeStub lbl
863 = pprCLabel lbl <> text "@plt"
864 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
865 = pprCLabel lbl <> text "@gotpcrel"
866 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
868 pprDynamicLinkerAsmLabel SymbolPtr lbl
869 = text ".LC_" <> pprCLabel lbl
870 #elif linux_TARGET_OS
871 pprDynamicLinkerAsmLabel CodeStub lbl
872 = pprCLabel lbl <> text "@plt"
873 pprDynamicLinkerAsmLabel SymbolPtr lbl
874 = text ".LC_" <> pprCLabel lbl
875 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
876 = pprCLabel lbl <> text "@got"
877 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
878 = pprCLabel lbl <> text "@gotoff"
879 #elif mingw32_TARGET_OS
880 pprDynamicLinkerAsmLabel SymbolPtr lbl
881 = text "__imp_" <> pprCLabel lbl
882 pprDynamicLinkerAsmLabel _ _
883 = panic "pprDynamicLinkerAsmLabel"
885 pprDynamicLinkerAsmLabel _ _
886 = panic "pprDynamicLinkerAsmLabel"