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,
128 -- -----------------------------------------------------------------------------
132 CLabel is an abstract type that supports the following operations:
136 - In a C file, does it need to be declared before use? (i.e. is it
137 guaranteed to be already in scope in the places we need to refer to it?)
139 - If it needs to be declared, what type (code or data) should it be
142 - Is it visible outside this object file or not?
144 - Is it "dynamic" (see details below)
146 - Eq and Ord, so that we can make sets of CLabels (currently only
147 used in outputting C as far as I can tell, to avoid generating
148 more than one declaration for any given label).
150 - Converting an info table label into an entry label.
154 = IdLabel -- A family of labels related to the
155 Name -- definition of a particular Id or Con
158 | CaseLabel -- A family of labels related to a particular
160 {-# UNPACK #-} !Unique -- Unique says which case expression
164 {-# UNPACK #-} !Unique
167 {-# UNPACK #-} !Unique
170 Module -- the module name
172 -- at some point we might want some kind of version number in
173 -- the module init label, to guard against compiling modules in
174 -- the wrong order. We can't use the interface file version however,
175 -- because we don't always recompile modules which depend on a module
176 -- whose version has changed.
178 | PlainModuleInitLabel -- without the vesrion & way info
183 | RtsLabel RtsLabelInfo
185 | ForeignLabel FastString -- a 'C' (or otherwise foreign) label
186 (Maybe Int) -- possible '@n' suffix for stdcall functions
187 -- When generating C, the '@n' suffix is omitted, but when
188 -- generating assembler we must add it to the label.
189 Bool -- True <=> is dynamic
191 | CC_Label CostCentre
192 | CCS_Label CostCentreStack
194 -- Dynamic Linking in the NCG:
195 -- generated and used inside the NCG only,
196 -- see module PositionIndependentCode for details.
198 | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
199 -- special variants of a label used for dynamic linking
201 | PicBaseLabel -- a label used as a base for PIC calculations
202 -- on some platforms.
203 -- It takes the form of a local numeric
204 -- assembler label '1'; it is pretty-printed
205 -- as 1b, referring to the previous definition
206 -- of 1: in the assembler source file.
208 | DeadStripPreventer CLabel
209 -- label before an info table to prevent excessive dead-stripping on darwin
211 | HpcTicksLabel Module -- Per-module table of tick locations
212 | HpcModuleNameLabel -- Per-module name of the module for Hpc
214 | LargeSRTLabel -- Label of an StgLargeSRT
215 {-# UNPACK #-} !Unique
217 | LargeBitmapLabel -- A bitmap (function or case return)
218 {-# UNPACK #-} !Unique
223 = Closure -- Label for closure
224 | SRT -- Static reference table
225 | InfoTable -- Info tables for closures; always read-only
226 | Entry -- entry point
227 | Slow -- slow entry point
229 | RednCounts -- Label of place to keep Ticky-ticky info for
232 | ConEntry -- constructor entry point
233 | ConInfoTable -- corresponding info table
234 | StaticConEntry -- static constructor entry point
235 | StaticInfoTable -- corresponding info table
237 | ClosureTable -- table of closures for Enum tycons
251 = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks
252 | RtsSelectorEntry Bool{-updatable-} Int{-offset-}
254 | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks
255 | RtsApEntry Bool{-updatable-} Int{-arity-}
259 | RtsInfo LitString -- misc rts info tables
260 | RtsEntry LitString -- misc rts entry points
261 | RtsRetInfo LitString -- misc rts ret info tables
262 | RtsRet LitString -- misc rts return points
263 | RtsData LitString -- misc rts data bits, eg CHARLIKE_closure
264 | RtsCode LitString -- misc rts code
266 | RtsInfoFS FastString -- misc rts info tables
267 | RtsEntryFS FastString -- misc rts entry points
268 | RtsRetInfoFS FastString -- misc rts ret info tables
269 | RtsRetFS FastString -- misc rts return points
270 | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure
271 | RtsCodeFS FastString -- misc rts code
273 | RtsApFast LitString -- _fast versions of generic apply
275 | RtsSlowTickyCtr String
278 -- NOTE: Eq on LitString compares the pointer only, so this isn't
281 data DynamicLinkerLabelInfo
282 = CodeStub -- MachO: Lfoo$stub, ELF: foo@plt
283 | SymbolPtr -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
284 | GotSymbolPtr -- ELF: foo@got
285 | GotSymbolOffset -- ELF: foo@gotoff
289 -- -----------------------------------------------------------------------------
290 -- Constructing CLabels
292 -- These are always local:
293 mkSRTLabel name = IdLabel name SRT
294 mkSlowEntryLabel name = IdLabel name Slow
295 mkRednCountsLabel name = IdLabel name RednCounts
297 -- These have local & (possibly) external variants:
298 mkLocalClosureLabel name = IdLabel name Closure
299 mkLocalInfoTableLabel name = IdLabel name InfoTable
300 mkLocalEntryLabel name = IdLabel name Entry
301 mkLocalClosureTableLabel name = IdLabel name ClosureTable
303 mkClosureLabel name = IdLabel name Closure
304 mkInfoTableLabel name = IdLabel name InfoTable
305 mkEntryLabel name = IdLabel name Entry
306 mkClosureTableLabel name = IdLabel name ClosureTable
307 mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
308 mkLocalConEntryLabel con = IdLabel con ConEntry
309 mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
310 mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
311 mkConInfoTableLabel name = IdLabel name ConInfoTable
312 mkStaticInfoTableLabel name = IdLabel name StaticInfoTable
314 mkConEntryLabel name = IdLabel name ConEntry
315 mkStaticConEntryLabel name = IdLabel name StaticConEntry
317 mkLargeSRTLabel uniq = LargeSRTLabel uniq
318 mkBitmapLabel uniq = LargeBitmapLabel uniq
320 mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt
321 mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo
322 mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag)
323 mkDefaultLabel uniq = CaseLabel uniq CaseDefault
325 mkStringLitLabel = StringLitLabel
326 mkAsmTempLabel :: Uniquable a => a -> CLabel
327 mkAsmTempLabel a = AsmTempLabel (getUnique a)
329 mkModuleInitLabel :: Module -> String -> CLabel
330 mkModuleInitLabel mod way = ModuleInitLabel mod way
332 mkPlainModuleInitLabel :: Module -> CLabel
333 mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
335 -- Some fixed runtime system labels
337 mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
338 mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR"))
339 mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame"))
340 mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC"))
341 mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability"))
342 mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0"))
343 mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY"))
344 mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR"))
346 mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct"))
347 mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
348 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
349 RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE"))
350 else -- RTS won't have info table unless -ticky is on
351 panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
352 mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
354 moduleRegdLabel = ModuleRegdLabel
356 mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
357 mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
359 mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off)
360 mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
364 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
365 mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic
367 addLabelSize :: CLabel -> Int -> CLabel
368 addLabelSize (ForeignLabel str _ is_dynamic) sz
369 = ForeignLabel str (Just sz) is_dynamic
375 mkCCLabel cc = CC_Label cc
376 mkCCSLabel ccs = CCS_Label ccs
378 mkRtsInfoLabel str = RtsLabel (RtsInfo str)
379 mkRtsEntryLabel str = RtsLabel (RtsEntry str)
380 mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
381 mkRtsRetLabel str = RtsLabel (RtsRet str)
382 mkRtsCodeLabel str = RtsLabel (RtsCode str)
383 mkRtsDataLabel str = RtsLabel (RtsData str)
385 mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
386 mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
387 mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
388 mkRtsRetLabelFS str = RtsLabel (RtsRetFS str)
389 mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str)
390 mkRtsDataLabelFS str = RtsLabel (RtsDataFS str)
392 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
394 mkRtsSlowTickyCtrLabel :: String -> CLabel
395 mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
399 mkHpcTicksLabel = HpcTicksLabel
400 mkHpcModuleNameLabel = HpcModuleNameLabel
404 mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
405 mkDynamicLinkerLabel = DynamicLinkerLabel
407 dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
408 dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
409 dynamicLinkerLabelInfo _ = Nothing
411 -- Position independent code
413 mkPicBaseLabel :: CLabel
414 mkPicBaseLabel = PicBaseLabel
416 mkDeadStripPreventer :: CLabel -> CLabel
417 mkDeadStripPreventer lbl = DeadStripPreventer lbl
419 -- -----------------------------------------------------------------------------
420 -- Converting between info labels and entry/ret labels.
422 infoLblToEntryLbl :: CLabel -> CLabel
423 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
424 infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
425 infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
426 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
427 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
428 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
429 infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
430 infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
431 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
433 entryLblToInfoLbl :: CLabel -> CLabel
434 entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
435 entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
436 entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
437 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
438 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
439 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
440 entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
441 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
442 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
444 -- -----------------------------------------------------------------------------
445 -- Does a CLabel need declaring before use or not?
447 -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
449 needsCDecl :: CLabel -> Bool
450 -- False <=> it's pre-declared; don't bother
451 -- don't bother declaring SRT & Bitmap labels, we always make sure
452 -- they are defined before use.
453 needsCDecl (IdLabel _ SRT) = False
454 needsCDecl (LargeSRTLabel _) = False
455 needsCDecl (LargeBitmapLabel _) = False
456 needsCDecl (IdLabel _ _) = True
457 needsCDecl (CaseLabel _ _) = True
458 needsCDecl (ModuleInitLabel _ _) = True
459 needsCDecl (PlainModuleInitLabel _) = True
460 needsCDecl ModuleRegdLabel = False
462 needsCDecl (StringLitLabel _) = False
463 needsCDecl (AsmTempLabel _) = False
464 needsCDecl (RtsLabel _) = False
465 needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l)
466 needsCDecl (CC_Label _) = True
467 needsCDecl (CCS_Label _) = True
468 needsCDecl (HpcTicksLabel _) = True
469 needsCDecl HpcModuleNameLabel = False
471 -- Whether the label is an assembler temporary:
473 isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generation
474 isAsmTemp (AsmTempLabel _) = True
477 maybeAsmTemp :: CLabel -> Maybe Unique
478 maybeAsmTemp (AsmTempLabel uq) = Just uq
479 maybeAsmTemp _ = Nothing
481 -- some labels have C prototypes in scope when compiling via C, because
482 -- they are builtin to the C compiler. For these labels we avoid
483 -- generating our own C prototypes.
484 isMathFun :: CLabel -> Bool
485 isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
488 (fsLit "pow"), (fsLit "sin"), (fsLit "cos"),
489 (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"),
490 (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"),
491 (fsLit "atan"), (fsLit "log"), (fsLit "exp"),
492 (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"),
493 (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"),
494 (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"),
495 (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"),
496 (fsLit "expf"), (fsLit "sqrtf")
500 -- -----------------------------------------------------------------------------
501 -- Is a CLabel visible outside this object file or not?
503 -- From the point of view of the code generator, a name is
504 -- externally visible if it has to be declared as exported
505 -- in the .o file's symbol table; that is, made non-static.
507 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
508 externallyVisibleCLabel (CaseLabel _ _) = False
509 externallyVisibleCLabel (StringLitLabel _) = False
510 externallyVisibleCLabel (AsmTempLabel _) = False
511 externallyVisibleCLabel (ModuleInitLabel _ _) = True
512 externallyVisibleCLabel (PlainModuleInitLabel _)= True
513 externallyVisibleCLabel ModuleRegdLabel = False
514 externallyVisibleCLabel (RtsLabel _) = True
515 externallyVisibleCLabel (ForeignLabel _ _ _) = True
516 externallyVisibleCLabel (IdLabel name _) = isExternalName name
517 externallyVisibleCLabel (CC_Label _) = True
518 externallyVisibleCLabel (CCS_Label _) = True
519 externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
520 externallyVisibleCLabel (HpcTicksLabel _) = True
521 externallyVisibleCLabel HpcModuleNameLabel = False
522 externallyVisibleCLabel (LargeBitmapLabel _) = False
523 externallyVisibleCLabel (LargeSRTLabel _) = False
525 -- -----------------------------------------------------------------------------
526 -- Finding the "type" of a CLabel
528 -- For generating correct types in label declarations:
534 labelType :: CLabel -> CLabelType
535 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
536 labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
537 labelType (RtsLabel (RtsData _)) = DataLabel
538 labelType (RtsLabel (RtsCode _)) = CodeLabel
539 labelType (RtsLabel (RtsInfo _)) = DataLabel
540 labelType (RtsLabel (RtsEntry _)) = CodeLabel
541 labelType (RtsLabel (RtsRetInfo _)) = DataLabel
542 labelType (RtsLabel (RtsRet _)) = CodeLabel
543 labelType (RtsLabel (RtsDataFS _)) = DataLabel
544 labelType (RtsLabel (RtsCodeFS _)) = CodeLabel
545 labelType (RtsLabel (RtsInfoFS _)) = DataLabel
546 labelType (RtsLabel (RtsEntryFS _)) = CodeLabel
547 labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel
548 labelType (RtsLabel (RtsRetFS _)) = CodeLabel
549 labelType (RtsLabel (RtsApFast _)) = CodeLabel
550 labelType (CaseLabel _ CaseReturnInfo) = DataLabel
551 labelType (CaseLabel _ _) = CodeLabel
552 labelType (ModuleInitLabel _ _) = CodeLabel
553 labelType (PlainModuleInitLabel _) = CodeLabel
554 labelType (LargeSRTLabel _) = DataLabel
555 labelType (LargeBitmapLabel _) = DataLabel
557 labelType (IdLabel _ info) = idInfoLabelType info
558 labelType _ = DataLabel
560 idInfoLabelType info =
562 InfoTable -> DataLabel
564 ConInfoTable -> DataLabel
565 StaticInfoTable -> DataLabel
566 ClosureTable -> DataLabel
567 -- krc: aie! a ticky counter label is data
568 RednCounts -> DataLabel
572 -- -----------------------------------------------------------------------------
573 -- Does a CLabel need dynamic linkage?
575 -- When referring to data in code, we need to know whether
576 -- that data resides in a DLL or not. [Win32 only.]
577 -- @labelDynamic@ returns @True@ if the label is located
578 -- in a DLL, be it a data reference or not.
580 labelDynamic :: PackageId -> CLabel -> Bool
581 labelDynamic this_pkg lbl =
583 RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
584 IdLabel n k -> isDllName this_pkg n
585 #if mingw32_TARGET_OS
586 ForeignLabel _ _ d -> d
588 -- On Mac OS X and on ELF platforms, false positives are OK,
589 -- so we claim that all foreign imports come from dynamic libraries
590 ForeignLabel _ _ _ -> True
592 ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
593 PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
595 -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
599 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
600 right places. It is used to detect when the abstractC statement of an
601 CCodeBlock actually contains the code for a slow entry point. -- HWL
603 We need at least @Eq@ for @CLabels@, because we want to avoid
604 duplicate declarations in generating C (see @labelSeenTE@ in
608 -----------------------------------------------------------------------------
609 -- Printing out CLabels.
616 where <name> is <Module>_<name> for external names and <unique> for
617 internal names. <type> is one of the following:
620 srt Static reference table
621 srtd Static reference table descriptor
622 entry Entry code (function, closure)
623 slow Slow entry code (if any)
624 ret Direct return address
626 <n>_alt Case alternative (tag n)
627 dflt Default case alternative
628 btm Large bitmap vector
629 closure Static closure
630 con_entry Dynamic Constructor entry code
631 con_info Dynamic Constructor info table
632 static_entry Static Constructor entry code
633 static_info Static Constructor info table
634 sel_info Selector info table
635 sel_entry Selector entry code
637 ccs Cost centre stack
639 Many of these distinctions are only for documentation reasons. For
640 example, _ret is only distinguished from _entry to make it easy to
641 tell whether a code fragment is a return point or a closure/function
645 instance Outputable CLabel where
648 pprCLabel :: CLabel -> SDoc
650 #if ! OMIT_NATIVE_CODEGEN
651 pprCLabel (AsmTempLabel u)
652 = getPprStyle $ \ sty ->
654 ptext asmTempLabelPrefix <> pprUnique u
656 char '_' <> pprUnique u
658 pprCLabel (DynamicLinkerLabel info lbl)
659 = pprDynamicLinkerAsmLabel info lbl
661 pprCLabel PicBaseLabel
664 pprCLabel (DeadStripPreventer lbl)
665 = pprCLabel lbl <> ptext (sLit "_dsp")
669 #if ! OMIT_NATIVE_CODEGEN
670 getPprStyle $ \ sty ->
672 maybe_underscore (pprAsmCLbl lbl)
678 | underscorePrefix = pp_cSEP <> doc
681 #ifdef mingw32_TARGET_OS
682 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
683 -- (The C compiler does this itself).
684 pprAsmCLbl (ForeignLabel fs (Just sz) _)
685 = ftext fs <> char '@' <> int sz
690 pprCLbl (StringLitLabel u)
691 = pprUnique u <> ptext (sLit "_str")
693 pprCLbl (CaseLabel u CaseReturnPt)
694 = hcat [pprUnique u, ptext (sLit "_ret")]
695 pprCLbl (CaseLabel u CaseReturnInfo)
696 = hcat [pprUnique u, ptext (sLit "_info")]
697 pprCLbl (CaseLabel u (CaseAlt tag))
698 = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")]
699 pprCLbl (CaseLabel u CaseDefault)
700 = hcat [pprUnique u, ptext (sLit "_dflt")]
702 pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd")
703 pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm")
704 -- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7')
705 -- until that gets resolved we'll just force them to start
706 -- with a letter so the label will be legal assmbly code.
709 pprCLbl (RtsLabel (RtsCode str)) = ptext str
710 pprCLbl (RtsLabel (RtsData str)) = ptext str
711 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
712 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
714 pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast")
716 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
717 = hcat [ptext (sLit "stg_sel_"), text (show offset),
719 then (sLit "_upd_info")
720 else (sLit "_noupd_info"))
723 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
724 = hcat [ptext (sLit "stg_sel_"), text (show offset),
726 then (sLit "_upd_entry")
727 else (sLit "_noupd_entry"))
730 pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
731 = hcat [ptext (sLit "stg_ap_"), text (show arity),
733 then (sLit "_upd_info")
734 else (sLit "_noupd_info"))
737 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
738 = hcat [ptext (sLit "stg_ap_"), text (show arity),
740 then (sLit "_upd_entry")
741 else (sLit "_noupd_entry"))
744 pprCLbl (RtsLabel (RtsInfo fs))
745 = ptext fs <> ptext (sLit "_info")
747 pprCLbl (RtsLabel (RtsEntry fs))
748 = ptext fs <> ptext (sLit "_entry")
750 pprCLbl (RtsLabel (RtsRetInfo fs))
751 = ptext fs <> ptext (sLit "_info")
753 pprCLbl (RtsLabel (RtsRet fs))
754 = ptext fs <> ptext (sLit "_ret")
756 pprCLbl (RtsLabel (RtsInfoFS fs))
757 = ftext fs <> ptext (sLit "_info")
759 pprCLbl (RtsLabel (RtsEntryFS fs))
760 = ftext fs <> ptext (sLit "_entry")
762 pprCLbl (RtsLabel (RtsRetInfoFS fs))
763 = ftext fs <> ptext (sLit "_info")
765 pprCLbl (RtsLabel (RtsRetFS fs))
766 = ftext fs <> ptext (sLit "_ret")
768 pprCLbl (RtsLabel (RtsPrimOp primop))
769 = ppr primop <> ptext (sLit "_fast")
771 pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
772 = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
774 pprCLbl ModuleRegdLabel
775 = ptext (sLit "_module_registered")
777 pprCLbl (ForeignLabel str _ _)
780 pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
782 pprCLbl (CC_Label cc) = ppr cc
783 pprCLbl (CCS_Label ccs) = ppr ccs
785 pprCLbl (ModuleInitLabel mod way)
786 = ptext (sLit "__stginit_") <> ppr mod
787 <> char '_' <> text way
788 pprCLbl (PlainModuleInitLabel mod)
789 = ptext (sLit "__stginit_") <> ppr mod
791 pprCLbl (HpcTicksLabel mod)
792 = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
794 pprCLbl HpcModuleNameLabel
795 = ptext (sLit "_hpc_module_name_str")
797 ppIdFlavor :: IdLabelInfo -> SDoc
798 ppIdFlavor x = pp_cSEP <>
800 Closure -> ptext (sLit "closure")
801 SRT -> ptext (sLit "srt")
802 InfoTable -> ptext (sLit "info")
803 Entry -> ptext (sLit "entry")
804 Slow -> ptext (sLit "slow")
805 RednCounts -> ptext (sLit "ct")
806 ConEntry -> ptext (sLit "con_entry")
807 ConInfoTable -> ptext (sLit "con_info")
808 StaticConEntry -> ptext (sLit "static_entry")
809 StaticInfoTable -> ptext (sLit "static_info")
810 ClosureTable -> ptext (sLit "closure_tbl")
816 -- -----------------------------------------------------------------------------
817 -- Machine-dependent knowledge about labels.
819 underscorePrefix :: Bool -- leading underscore on assembler labels?
820 underscorePrefix = (cLeadingUnderscore == "YES")
822 asmTempLabelPrefix :: LitString -- for formatting labels
825 {- The alpha assembler likes temporary labels to look like $L123
826 instead of L123. (Don't toss the L, because then Lf28
830 #elif darwin_TARGET_OS
836 pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
838 #if x86_64_TARGET_ARCH && darwin_TARGET_OS
839 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
840 = pprCLabel lbl <> text "@GOTPCREL"
841 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
843 pprDynamicLinkerAsmLabel _ _
844 = panic "pprDynamicLinkerAsmLabel"
845 #elif darwin_TARGET_OS
846 pprDynamicLinkerAsmLabel CodeStub lbl
847 = char 'L' <> pprCLabel lbl <> text "$stub"
848 pprDynamicLinkerAsmLabel SymbolPtr lbl
849 = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
850 pprDynamicLinkerAsmLabel _ _
851 = panic "pprDynamicLinkerAsmLabel"
852 #elif powerpc_TARGET_ARCH && linux_TARGET_OS
853 pprDynamicLinkerAsmLabel CodeStub lbl
854 = pprCLabel lbl <> text "@plt"
855 pprDynamicLinkerAsmLabel SymbolPtr lbl
856 = text ".LC_" <> pprCLabel lbl
857 pprDynamicLinkerAsmLabel _ _
858 = panic "pprDynamicLinkerAsmLabel"
859 #elif x86_64_TARGET_ARCH && linux_TARGET_OS
860 pprDynamicLinkerAsmLabel CodeStub lbl
861 = pprCLabel lbl <> text "@plt"
862 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
863 = pprCLabel lbl <> text "@gotpcrel"
864 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
866 pprDynamicLinkerAsmLabel SymbolPtr lbl
867 = text ".LC_" <> pprCLabel lbl
868 #elif linux_TARGET_OS
869 pprDynamicLinkerAsmLabel CodeStub lbl
870 = pprCLabel lbl <> text "@plt"
871 pprDynamicLinkerAsmLabel SymbolPtr lbl
872 = text ".LC_" <> pprCLabel lbl
873 pprDynamicLinkerAsmLabel GotSymbolPtr lbl
874 = pprCLabel lbl <> text "@got"
875 pprDynamicLinkerAsmLabel GotSymbolOffset lbl
876 = pprCLabel lbl <> text "@gotoff"
877 #elif mingw32_TARGET_OS
878 pprDynamicLinkerAsmLabel SymbolPtr lbl
879 = text "__imp_" <> pprCLabel lbl
880 pprDynamicLinkerAsmLabel _ _
881 = panic "pprDynamicLinkerAsmLabel"
883 pprDynamicLinkerAsmLabel _ _
884 = panic "pprDynamicLinkerAsmLabel"