X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCLabel.hs;h=cb07d067dd132b3549ece3125e1b0c31d8365834;hb=869feb6a8105f34092a1ae1e755dffb69a565c85;hp=aacac3e0ddf7c279a02f87bff64977cda530c0b9;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index aacac3e..cb07d06 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -1,8 +1,15 @@ +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Object-file symbols (called CLabel for histerical raisins). -- --- (c) The University of Glasgow 2004 +-- (c) The University of Glasgow 2004-2006 -- ----------------------------------------------------------------------------- @@ -11,7 +18,6 @@ module CLabel ( mkClosureLabel, mkSRTLabel, - mkSRTDescLabel, mkInfoTableLabel, mkEntryLabel, mkSlowEntryLabel, @@ -20,6 +26,7 @@ module CLabel ( mkRednCountsLabel, mkConInfoTableLabel, mkStaticInfoTableLabel, + mkLargeSRTLabel, mkApEntryLabel, mkApInfoTableLabel, mkClosureTableLabel, @@ -48,7 +55,6 @@ module CLabel ( mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, mkUpdInfoLabel, - mkSeqInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_infoLabel, @@ -83,6 +89,7 @@ module CLabel ( mkRtsApFastLabel, mkForeignLabel, + addLabelSize, mkCCLabel, mkCCSLabel, @@ -93,28 +100,32 @@ module CLabel ( mkPicBaseLabel, mkDeadStripPreventer, + mkHpcTicksLabel, + mkHpcModuleNameLabel, + infoLblToEntryLbl, entryLblToInfoLbl, - needsCDecl, isAsmTemp, externallyVisibleCLabel, + needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel, + isMathFun, CLabelType(..), labelType, labelDynamic, pprCLabel ) where - #include "HsVersions.h" -import StaticFlags ( opt_Static, opt_DoTickyProfiling ) -import Packages ( isDllName ) -import DataCon ( ConTag ) -import PackageConfig ( PackageId ) -import Module ( Module, modulePackageId ) -import Name ( Name, isExternalName ) -import Unique ( pprUnique, Unique ) -import PrimOp ( PrimOp ) -import Config ( cLeadingUnderscore ) -import CostCentre ( CostCentre, CostCentreStack ) +import StaticFlags +import Packages +import DataCon +import PackageConfig +import Module +import Name +import Unique +import PrimOp +import Config +import CostCentre import Outputable import FastString +import DynFlags -- ----------------------------------------------------------------------------- -- The CLabel type @@ -146,10 +157,6 @@ data CLabel Name -- definition of a particular Id or Con IdLabelInfo - | DynIdLabel -- like IdLabel, but in a separate package, - Name -- and might therefore need a dynamic - IdLabelInfo -- reference. - | CaseLabel -- A family of labels related to a particular -- case expression. {-# UNPACK #-} !Unique -- Unique says which case expression @@ -164,7 +171,6 @@ data CLabel | ModuleInitLabel Module -- the module name String -- its "way" - Bool -- True <=> is in a different package -- at some point we might want some kind of version number in -- the module init label, to guard against compiling modules in -- the wrong order. We can't use the interface file version however, @@ -173,7 +179,6 @@ data CLabel | PlainModuleInitLabel -- without the vesrion & way info Module - Bool -- True <=> is in a different package | ModuleRegdLabel @@ -205,12 +210,20 @@ data CLabel | DeadStripPreventer CLabel -- label before an info table to prevent excessive dead-stripping on darwin + | HpcTicksLabel Module -- Per-module table of tick locations + | HpcModuleNameLabel -- Per-module name of the module for Hpc + + | LargeSRTLabel -- Label of an StgLargeSRT + {-# UNPACK #-} !Unique + + | LargeBitmapLabel -- A bitmap (function or case return) + {-# UNPACK #-} !Unique + deriving (Eq, Ord) data IdLabelInfo = Closure -- Label for closure | SRT -- Static reference table - | SRTDesc -- Static reference table descriptor | InfoTable -- Info tables for closures; always read-only | Entry -- entry point | Slow -- slow entry point @@ -218,8 +231,6 @@ data IdLabelInfo | RednCounts -- Label of place to keep Ticky-ticky info for -- this Id - | Bitmap -- A bitmap (function or case return) - | ConEntry -- constructor entry point | ConInfoTable -- corresponding info table | StaticConEntry -- static constructor entry point @@ -282,9 +293,7 @@ data DynamicLinkerLabelInfo -- These are always local: mkSRTLabel name = IdLabel name SRT -mkSRTDescLabel name = IdLabel name SRTDesc mkSlowEntryLabel name = IdLabel name Slow -mkBitmapLabel name = IdLabel name Bitmap mkRednCountsLabel name = IdLabel name RednCounts -- These have local & (possibly) external variants: @@ -293,41 +302,22 @@ mkLocalInfoTableLabel name = IdLabel name InfoTable mkLocalEntryLabel name = IdLabel name Entry mkLocalClosureTableLabel name = IdLabel name ClosureTable -mkClosureLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name Closure - | otherwise = IdLabel name Closure - -mkInfoTableLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name InfoTable - | otherwise = IdLabel name InfoTable - -mkEntryLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name Entry - | otherwise = IdLabel name Entry - -mkClosureTableLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name ClosureTable - | otherwise = IdLabel name ClosureTable - -mkLocalConInfoTableLabel con = IdLabel con ConInfoTable -mkLocalConEntryLabel con = IdLabel con ConEntry -mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable -mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry - -mkConInfoTableLabel name False = IdLabel name ConInfoTable -mkConInfoTableLabel name True = DynIdLabel name ConInfoTable +mkClosureLabel name = IdLabel name Closure +mkInfoTableLabel name = IdLabel name InfoTable +mkEntryLabel name = IdLabel name Entry +mkClosureTableLabel name = IdLabel name ClosureTable +mkLocalConInfoTableLabel con = IdLabel con ConInfoTable +mkLocalConEntryLabel con = IdLabel con ConEntry +mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable +mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry +mkConInfoTableLabel name = IdLabel name ConInfoTable +mkStaticInfoTableLabel name = IdLabel name StaticInfoTable -mkStaticInfoTableLabel name False = IdLabel name StaticInfoTable -mkStaticInfoTableLabel name True = DynIdLabel name StaticInfoTable - -mkConEntryLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name ConEntry - | otherwise = IdLabel name ConEntry - -mkStaticConEntryLabel this_pkg name - | isDllName this_pkg name = DynIdLabel name StaticConEntry - | otherwise = IdLabel name StaticConEntry +mkConEntryLabel name = IdLabel name ConEntry +mkStaticConEntryLabel name = IdLabel name StaticConEntry +mkLargeSRTLabel uniq = LargeSRTLabel uniq +mkBitmapLabel uniq = LargeBitmapLabel uniq mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo @@ -335,32 +325,30 @@ mkAltLabel uniq tag = CaseLabel uniq (CaseAlt tag) mkDefaultLabel uniq = CaseLabel uniq CaseDefault mkStringLitLabel = StringLitLabel -mkAsmTempLabel = AsmTempLabel +mkAsmTempLabel :: Uniquable a => a -> CLabel +mkAsmTempLabel a = AsmTempLabel (getUnique a) -mkModuleInitLabel :: PackageId -> Module -> String -> CLabel -mkModuleInitLabel this_pkg mod way - = ModuleInitLabel mod way $! modulePackageId mod /= this_pkg +mkModuleInitLabel :: Module -> String -> CLabel +mkModuleInitLabel mod way = ModuleInitLabel mod way -mkPlainModuleInitLabel :: PackageId -> Module -> CLabel -mkPlainModuleInitLabel this_pkg mod - = PlainModuleInitLabel mod $! modulePackageId mod /= this_pkg +mkPlainModuleInitLabel :: Module -> CLabel +mkPlainModuleInitLabel mod = PlainModuleInitLabel mod -- Some fixed runtime system labels -mkSplitMarkerLabel = RtsLabel (RtsCode SLIT("__stg_split_marker")) -mkDirty_MUT_VAR_Label = RtsLabel (RtsCode SLIT("dirty_MUT_VAR")) -mkUpdInfoLabel = RtsLabel (RtsInfo SLIT("stg_upd_frame")) -mkSeqInfoLabel = RtsLabel (RtsInfo SLIT("stg_seq_frame")) -mkIndStaticInfoLabel = RtsLabel (RtsInfo SLIT("stg_IND_STATIC")) -mkMainCapabilityLabel = RtsLabel (RtsData SLIT("MainCapability")) -mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0")) -mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY")) -mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR")) - -mkTopTickyCtrLabel = RtsLabel (RtsData SLIT("top_ct")) -mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE")) +mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker")) +mkDirty_MUT_VAR_Label = RtsLabel (RtsCode (sLit "dirty_MUT_VAR")) +mkUpdInfoLabel = RtsLabel (RtsInfo (sLit "stg_upd_frame")) +mkIndStaticInfoLabel = RtsLabel (RtsInfo (sLit "stg_IND_STATIC")) +mkMainCapabilityLabel = RtsLabel (RtsData (sLit "MainCapability")) +mkMAP_FROZEN_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_FROZEN0")) +mkMAP_DIRTY_infoLabel = RtsLabel (RtsInfo (sLit "stg_MUT_ARR_PTRS_DIRTY")) +mkEMPTY_MVAR_infoLabel = RtsLabel (RtsInfo (sLit "stg_EMPTY_MVAR")) + +mkTopTickyCtrLabel = RtsLabel (RtsData (sLit "top_ct")) +mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE")) mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then - RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE")) + RtsLabel (RtsInfo (sLit "stg_SE_CAF_BLACKHOLE")) else -- RTS won't have info table unless -ticky is on panic "mkSECAFBlackHoleInfoTableLabel requires -ticky" mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) @@ -378,6 +366,12 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off) mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel mkForeignLabel str mb_sz is_dynamic = ForeignLabel str mb_sz is_dynamic +addLabelSize :: CLabel -> Int -> CLabel +addLabelSize (ForeignLabel str _ is_dynamic) sz + = ForeignLabel str (Just sz) is_dynamic +addLabelSize label _ + = label + -- Cost centres etc. mkCCLabel cc = CC_Label cc @@ -402,6 +396,11 @@ mkRtsApFastLabel str = RtsLabel (RtsApFast str) mkRtsSlowTickyCtrLabel :: String -> CLabel mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat) + -- Coverage + +mkHpcTicksLabel = HpcTicksLabel +mkHpcModuleNameLabel = HpcModuleNameLabel + -- Dynamic linking mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel @@ -420,15 +419,12 @@ mkDeadStripPreventer :: CLabel -> CLabel mkDeadStripPreventer lbl = DeadStripPreventer lbl -- ----------------------------------------------------------------------------- --- Converting info labels to entry labels. +-- Converting between info labels and entry/ret labels. infoLblToEntryLbl :: CLabel -> CLabel infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry -infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry -infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry -infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s) infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s) @@ -440,9 +436,6 @@ entryLblToInfoLbl :: CLabel -> CLabel entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable -entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable -entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable -entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s) entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s) @@ -452,27 +445,30 @@ entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l) -- ----------------------------------------------------------------------------- -- Does a CLabel need declaring before use or not? +-- +-- See wiki:Commentary/Compiler/Backends/PprC#Prototypes needsCDecl :: CLabel -> Bool -- False <=> it's pre-declared; don't bother -- don't bother declaring SRT & Bitmap labels, we always make sure -- they are defined before use. needsCDecl (IdLabel _ SRT) = False -needsCDecl (IdLabel _ SRTDesc) = False -needsCDecl (IdLabel _ Bitmap) = False +needsCDecl (LargeSRTLabel _) = False +needsCDecl (LargeBitmapLabel _) = False needsCDecl (IdLabel _ _) = True -needsCDecl (DynIdLabel _ _) = True needsCDecl (CaseLabel _ _) = True -needsCDecl (ModuleInitLabel _ _ _) = True -needsCDecl (PlainModuleInitLabel _ _) = True +needsCDecl (ModuleInitLabel _ _) = True +needsCDecl (PlainModuleInitLabel _) = True needsCDecl ModuleRegdLabel = False needsCDecl (StringLitLabel _) = False needsCDecl (AsmTempLabel _) = False needsCDecl (RtsLabel _) = False -needsCDecl (ForeignLabel _ _ _) = False +needsCDecl l@(ForeignLabel _ _ _) = not (isMathFun l) needsCDecl (CC_Label _) = True needsCDecl (CCS_Label _) = True +needsCDecl (HpcTicksLabel _) = True +needsCDecl HpcModuleNameLabel = False -- Whether the label is an assembler temporary: @@ -480,6 +476,29 @@ isAsmTemp :: CLabel -> Bool -- is a local temporary for native code generati isAsmTemp (AsmTempLabel _) = True isAsmTemp _ = False +maybeAsmTemp :: CLabel -> Maybe Unique +maybeAsmTemp (AsmTempLabel uq) = Just uq +maybeAsmTemp _ = Nothing + +-- some labels have C prototypes in scope when compiling via C, because +-- they are builtin to the C compiler. For these labels we avoid +-- generating our own C prototypes. +isMathFun :: CLabel -> Bool +isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs + where + math_funs = [ + (fsLit "pow"), (fsLit "sin"), (fsLit "cos"), + (fsLit "tan"), (fsLit "sinh"), (fsLit "cosh"), + (fsLit "tanh"), (fsLit "asin"), (fsLit "acos"), + (fsLit "atan"), (fsLit "log"), (fsLit "exp"), + (fsLit "sqrt"), (fsLit "powf"), (fsLit "sinf"), + (fsLit "cosf"), (fsLit "tanf"), (fsLit "sinhf"), + (fsLit "coshf"), (fsLit "tanhf"), (fsLit "asinf"), + (fsLit "acosf"), (fsLit "atanf"), (fsLit "logf"), + (fsLit "expf"), (fsLit "sqrtf") + ] +isMathFun _ = False + -- ----------------------------------------------------------------------------- -- Is a CLabel visible outside this object file or not? @@ -491,16 +510,19 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static" externallyVisibleCLabel (CaseLabel _ _) = False externallyVisibleCLabel (StringLitLabel _) = False externallyVisibleCLabel (AsmTempLabel _) = False -externallyVisibleCLabel (ModuleInitLabel _ _ _)= True -externallyVisibleCLabel (PlainModuleInitLabel _ _)= True +externallyVisibleCLabel (ModuleInitLabel _ _) = True +externallyVisibleCLabel (PlainModuleInitLabel _)= True externallyVisibleCLabel ModuleRegdLabel = False externallyVisibleCLabel (RtsLabel _) = True externallyVisibleCLabel (ForeignLabel _ _ _) = True externallyVisibleCLabel (IdLabel name _) = isExternalName name -externallyVisibleCLabel (DynIdLabel name _) = isExternalName name externallyVisibleCLabel (CC_Label _) = True externallyVisibleCLabel (CCS_Label _) = True externallyVisibleCLabel (DynamicLinkerLabel _ _) = False +externallyVisibleCLabel (HpcTicksLabel _) = True +externallyVisibleCLabel HpcModuleNameLabel = False +externallyVisibleCLabel (LargeBitmapLabel _) = False +externallyVisibleCLabel (LargeSRTLabel _) = False -- ----------------------------------------------------------------------------- -- Finding the "type" of a CLabel @@ -529,21 +551,23 @@ labelType (RtsLabel (RtsRetFS _)) = CodeLabel labelType (RtsLabel (RtsApFast _)) = CodeLabel labelType (CaseLabel _ CaseReturnInfo) = DataLabel labelType (CaseLabel _ _) = CodeLabel -labelType (ModuleInitLabel _ _ _) = CodeLabel -labelType (PlainModuleInitLabel _ _) = CodeLabel +labelType (ModuleInitLabel _ _) = CodeLabel +labelType (PlainModuleInitLabel _) = CodeLabel +labelType (LargeSRTLabel _) = DataLabel +labelType (LargeBitmapLabel _) = DataLabel labelType (IdLabel _ info) = idInfoLabelType info -labelType (DynIdLabel _ info) = idInfoLabelType info labelType _ = DataLabel idInfoLabelType info = case info of InfoTable -> DataLabel Closure -> DataLabel - Bitmap -> DataLabel ConInfoTable -> DataLabel StaticInfoTable -> DataLabel ClosureTable -> DataLabel +-- krc: aie! a ticky counter label is data + RednCounts -> DataLabel _ -> CodeLabel @@ -555,12 +579,11 @@ idInfoLabelType info = -- @labelDynamic@ returns @True@ if the label is located -- in a DLL, be it a data reference or not. -labelDynamic :: CLabel -> Bool -labelDynamic lbl = +labelDynamic :: PackageId -> CLabel -> Bool +labelDynamic this_pkg lbl = case lbl of - RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not? - IdLabel n k -> False - DynIdLabel n k -> True + RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not? + IdLabel n k -> isDllName this_pkg n #if mingw32_TARGET_OS ForeignLabel _ _ d -> d #else @@ -568,8 +591,8 @@ labelDynamic lbl = -- so we claim that all foreign imports come from dynamic libraries ForeignLabel _ _ _ -> True #endif - ModuleInitLabel m _ dyn -> not opt_Static && dyn - PlainModuleInitLabel m dyn -> not opt_Static && dyn + ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m) + PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m) -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False @@ -638,10 +661,10 @@ pprCLabel (DynamicLinkerLabel info lbl) = pprDynamicLinkerAsmLabel info lbl pprCLabel PicBaseLabel - = ptext SLIT("1b") + = ptext (sLit "1b") pprCLabel (DeadStripPreventer lbl) - = pprCLabel lbl <> ptext SLIT("_dsp") + = pprCLabel lbl <> ptext (sLit "_dsp") #endif pprCLabel lbl = @@ -667,116 +690,126 @@ pprAsmCLbl lbl = pprCLbl lbl pprCLbl (StringLitLabel u) - = pprUnique u <> ptext SLIT("_str") + = pprUnique u <> ptext (sLit "_str") pprCLbl (CaseLabel u CaseReturnPt) - = hcat [pprUnique u, ptext SLIT("_ret")] + = hcat [pprUnique u, ptext (sLit "_ret")] pprCLbl (CaseLabel u CaseReturnInfo) - = hcat [pprUnique u, ptext SLIT("_info")] + = hcat [pprUnique u, ptext (sLit "_info")] pprCLbl (CaseLabel u (CaseAlt tag)) - = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")] + = hcat [pprUnique u, pp_cSEP, int tag, ptext (sLit "_alt")] pprCLbl (CaseLabel u CaseDefault) - = hcat [pprUnique u, ptext SLIT("_dflt")] + = hcat [pprUnique u, ptext (sLit "_dflt")] + +pprCLbl (LargeSRTLabel u) = pprUnique u <> pp_cSEP <> ptext (sLit "srtd") +pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLit "btm") +-- Some bitsmaps for tuple constructors have a numeric tag (e.g. '7') +-- until that gets resolved we'll just force them to start +-- with a letter so the label will be legal assmbly code. + pprCLbl (RtsLabel (RtsCode str)) = ptext str pprCLbl (RtsLabel (RtsData str)) = ptext str pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str pprCLbl (RtsLabel (RtsDataFS str)) = ftext str -pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast") +pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext (sLit "_fast") pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) - = hcat [ptext SLIT("stg_sel_"), text (show offset), + = hcat [ptext (sLit "stg_sel_"), text (show offset), ptext (if upd_reqd - then SLIT("_upd_info") - else SLIT("_noupd_info")) + then (sLit "_upd_info") + else (sLit "_noupd_info")) ] pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset)) - = hcat [ptext SLIT("stg_sel_"), text (show offset), + = hcat [ptext (sLit "stg_sel_"), text (show offset), ptext (if upd_reqd - then SLIT("_upd_entry") - else SLIT("_noupd_entry")) + then (sLit "_upd_entry") + else (sLit "_noupd_entry")) ] pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity)) - = hcat [ptext SLIT("stg_ap_"), text (show arity), + = hcat [ptext (sLit "stg_ap_"), text (show arity), ptext (if upd_reqd - then SLIT("_upd_info") - else SLIT("_noupd_info")) + then (sLit "_upd_info") + else (sLit "_noupd_info")) ] pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) - = hcat [ptext SLIT("stg_ap_"), text (show arity), + = hcat [ptext (sLit "stg_ap_"), text (show arity), ptext (if upd_reqd - then SLIT("_upd_entry") - else SLIT("_noupd_entry")) + then (sLit "_upd_entry") + else (sLit "_noupd_entry")) ] pprCLbl (RtsLabel (RtsInfo fs)) - = ptext fs <> ptext SLIT("_info") + = ptext fs <> ptext (sLit "_info") pprCLbl (RtsLabel (RtsEntry fs)) - = ptext fs <> ptext SLIT("_entry") + = ptext fs <> ptext (sLit "_entry") pprCLbl (RtsLabel (RtsRetInfo fs)) - = ptext fs <> ptext SLIT("_info") + = ptext fs <> ptext (sLit "_info") pprCLbl (RtsLabel (RtsRet fs)) - = ptext fs <> ptext SLIT("_ret") + = ptext fs <> ptext (sLit "_ret") pprCLbl (RtsLabel (RtsInfoFS fs)) - = ftext fs <> ptext SLIT("_info") + = ftext fs <> ptext (sLit "_info") pprCLbl (RtsLabel (RtsEntryFS fs)) - = ftext fs <> ptext SLIT("_entry") + = ftext fs <> ptext (sLit "_entry") pprCLbl (RtsLabel (RtsRetInfoFS fs)) - = ftext fs <> ptext SLIT("_info") + = ftext fs <> ptext (sLit "_info") pprCLbl (RtsLabel (RtsRetFS fs)) - = ftext fs <> ptext SLIT("_ret") + = ftext fs <> ptext (sLit "_ret") pprCLbl (RtsLabel (RtsPrimOp primop)) - = ppr primop <> ptext SLIT("_fast") + = ppr primop <> ptext (sLit "_fast") pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) - = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr") + = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr") pprCLbl ModuleRegdLabel - = ptext SLIT("_module_registered") + = ptext (sLit "_module_registered") pprCLbl (ForeignLabel str _ _) = ftext str pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor -pprCLbl (DynIdLabel name flavor) = ppr name <> ppIdFlavor flavor pprCLbl (CC_Label cc) = ppr cc pprCLbl (CCS_Label ccs) = ppr ccs -pprCLbl (ModuleInitLabel mod way _) - = ptext SLIT("__stginit_") <> ppr mod +pprCLbl (ModuleInitLabel mod way) + = ptext (sLit "__stginit_") <> ppr mod <> char '_' <> text way -pprCLbl (PlainModuleInitLabel mod _) - = ptext SLIT("__stginit_") <> ppr mod +pprCLbl (PlainModuleInitLabel mod) + = ptext (sLit "__stginit_") <> ppr mod + +pprCLbl (HpcTicksLabel mod) + = ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc") + +pprCLbl HpcModuleNameLabel + = ptext (sLit "_hpc_module_name_str") ppIdFlavor :: IdLabelInfo -> SDoc ppIdFlavor x = pp_cSEP <> (case x of - Closure -> ptext SLIT("closure") - SRT -> ptext SLIT("srt") - SRTDesc -> ptext SLIT("srtd") - InfoTable -> ptext SLIT("info") - Entry -> ptext SLIT("entry") - Slow -> ptext SLIT("slow") - RednCounts -> ptext SLIT("ct") - Bitmap -> ptext SLIT("btm") - ConEntry -> ptext SLIT("con_entry") - ConInfoTable -> ptext SLIT("con_info") - StaticConEntry -> ptext SLIT("static_entry") - StaticInfoTable -> ptext SLIT("static_info") - ClosureTable -> ptext SLIT("closure_tbl") + Closure -> ptext (sLit "closure") + SRT -> ptext (sLit "srt") + InfoTable -> ptext (sLit "info") + Entry -> ptext (sLit "entry") + Slow -> ptext (sLit "slow") + RednCounts -> ptext (sLit "ct") + ConEntry -> ptext (sLit "con_entry") + ConInfoTable -> ptext (sLit "con_info") + StaticConEntry -> ptext (sLit "static_entry") + StaticInfoTable -> ptext (sLit "static_info") + ClosureTable -> ptext (sLit "closure_tbl") ) @@ -795,37 +828,60 @@ asmTempLabelPrefix = instead of L123. (Don't toss the L, because then Lf28 turns into $f28.) -} - SLIT("$") + (sLit "$") #elif darwin_TARGET_OS - SLIT("L") + (sLit "L") #else - SLIT(".L") + (sLit ".L") #endif pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc -#if darwin_TARGET_OS -pprDynamicLinkerAsmLabel SymbolPtr lbl - = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr" +#if x86_64_TARGET_ARCH && darwin_TARGET_OS +pprDynamicLinkerAsmLabel GotSymbolPtr lbl + = pprCLabel lbl <> text "@GOTPCREL" +pprDynamicLinkerAsmLabel GotSymbolOffset lbl + = pprCLabel lbl +pprDynamicLinkerAsmLabel _ _ + = panic "pprDynamicLinkerAsmLabel" +#elif darwin_TARGET_OS pprDynamicLinkerAsmLabel CodeStub lbl = char 'L' <> pprCLabel lbl <> text "$stub" +pprDynamicLinkerAsmLabel SymbolPtr lbl + = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr" +pprDynamicLinkerAsmLabel _ _ + = panic "pprDynamicLinkerAsmLabel" #elif powerpc_TARGET_ARCH && linux_TARGET_OS pprDynamicLinkerAsmLabel CodeStub lbl = pprCLabel lbl <> text "@plt" pprDynamicLinkerAsmLabel SymbolPtr lbl = text ".LC_" <> pprCLabel lbl +pprDynamicLinkerAsmLabel _ _ + = panic "pprDynamicLinkerAsmLabel" +#elif x86_64_TARGET_ARCH && linux_TARGET_OS +pprDynamicLinkerAsmLabel CodeStub lbl + = pprCLabel lbl <> text "@plt" +pprDynamicLinkerAsmLabel GotSymbolPtr lbl + = pprCLabel lbl <> text "@gotpcrel" +pprDynamicLinkerAsmLabel GotSymbolOffset lbl + = pprCLabel lbl +pprDynamicLinkerAsmLabel SymbolPtr lbl + = text ".LC_" <> pprCLabel lbl #elif linux_TARGET_OS pprDynamicLinkerAsmLabel CodeStub lbl = pprCLabel lbl <> text "@plt" +pprDynamicLinkerAsmLabel SymbolPtr lbl + = text ".LC_" <> pprCLabel lbl pprDynamicLinkerAsmLabel GotSymbolPtr lbl = pprCLabel lbl <> text "@got" pprDynamicLinkerAsmLabel GotSymbolOffset lbl = pprCLabel lbl <> text "@gotoff" -pprDynamicLinkerAsmLabel SymbolPtr lbl - = text ".LC_" <> pprCLabel lbl #elif mingw32_TARGET_OS pprDynamicLinkerAsmLabel SymbolPtr lbl = text "__imp_" <> pprCLabel lbl -#endif pprDynamicLinkerAsmLabel _ _ = panic "pprDynamicLinkerAsmLabel" +#else +pprDynamicLinkerAsmLabel _ _ + = panic "pprDynamicLinkerAsmLabel" +#endif