X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FCLabel.hs;h=e42b92db5ad7bd7025b76032cac6f604355bd824;hb=04db0e9fa47ce4dfbcb73ec1752d94195f3b394e;hp=a2634daa123c2221ee82a894c8bb0baf8c91de22;hpb=b4d045ae655e5eae25b88917cfe75d7dc7689c21;p=ghc-hetmet.git diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs index a2634da..e42b92d 100644 --- a/ghc/compiler/cmm/CLabel.hs +++ b/ghc/compiler/cmm/CLabel.hs @@ -22,6 +22,16 @@ module CLabel ( mkStaticInfoTableLabel, mkApEntryLabel, mkApInfoTableLabel, + mkClosureTableLabel, + + mkLocalClosureLabel, + mkLocalInfoTableLabel, + mkLocalEntryLabel, + mkLocalConEntryLabel, + mkLocalStaticConEntryLabel, + mkLocalConInfoTableLabel, + mkLocalStaticInfoTableLabel, + mkLocalClosureTableLabel, mkReturnPtLabel, mkReturnInfoLabel, @@ -30,19 +40,19 @@ module CLabel ( mkBitmapLabel, mkStringLitLabel, - mkClosureTblLabel, - mkAsmTempLabel, mkModuleInitLabel, mkPlainModuleInitLabel, mkSplitMarkerLabel, + mkDirty_MUT_VAR_Label, mkUpdInfoLabel, mkSeqInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_infoLabel, + mkMAP_DIRTY_infoLabel, mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel, @@ -70,6 +80,8 @@ module CLabel ( mkRtsCodeLabelFS, mkRtsDataLabelFS, + mkRtsApFastLabel, + mkForeignLabel, mkCCLabel, mkCCSLabel, @@ -79,6 +91,7 @@ module CLabel ( dynamicLinkerLabelInfo, mkPicBaseLabel, + mkDeadStripPreventer, infoLblToEntryLbl, entryLblToInfoLbl, needsCDecl, isAsmTemp, externallyVisibleCLabel, @@ -89,13 +102,13 @@ module CLabel ( #include "HsVersions.h" -#include "../includes/ghcconfig.h" -import CmdLineOpts ( opt_Static, opt_DoTickyProfiling ) +import Packages ( HomeModules ) +import StaticFlags ( opt_Static, opt_DoTickyProfiling ) +import Packages ( isHomeModule, isDllName ) import DataCon ( ConTag ) -import Module ( moduleName, moduleNameFS, - Module, isHomeModule ) -import Name ( Name, isDllName, isExternalName ) +import Module ( moduleFS, Module ) +import Name ( Name, isExternalName ) import Unique ( pprUnique, Unique ) import PrimOp ( PrimOp ) import Config ( cLeadingUnderscore ) @@ -133,6 +146,10 @@ 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 @@ -147,13 +164,16 @@ 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, -- because we don't always recompile modules which depend on a module -- whose version has changed. - | PlainModuleInitLabel Module -- without the vesrion & way info + | PlainModuleInitLabel -- without the vesrion & way info + Module + Bool -- True <=> is in a different package | ModuleRegdLabel @@ -181,13 +201,17 @@ data CLabel -- assembler label '1'; it is pretty-printed -- as 1b, referring to the previous definition -- of 1: in the assembler source file. + + | DeadStripPreventer CLabel + -- label before an info table to prevent excessive dead-stripping on darwin + deriving (Eq, Ord) data IdLabelInfo = Closure -- Label for closure | SRT -- Static reference table | SRTDesc -- Static reference table descriptor - | InfoTbl -- Info tables for closures; always read-only + | InfoTable -- Info tables for closures; always read-only | Entry -- entry point | Slow -- slow entry point @@ -197,9 +221,9 @@ data IdLabelInfo | Bitmap -- A bitmap (function or case return) | ConEntry -- constructor entry point - | ConInfoTbl -- corresponding info table + | ConInfoTable -- corresponding info table | StaticConEntry -- static constructor entry point - | StaticInfoTbl -- corresponding info table + | StaticInfoTable -- corresponding info table | ClosureTable -- table of closures for Enum tycons @@ -215,10 +239,10 @@ data CaseLabelInfo data RtsLabelInfo - = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks + = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-} -- Selector thunks | RtsSelectorEntry Bool{-updatable-} Int{-offset-} - | RtsApInfoTbl Bool{-updatable-} Int{-arity-} -- AP thunks + | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- AP thunks | RtsApEntry Bool{-updatable-} Int{-arity-} | RtsPrimOp PrimOp @@ -237,6 +261,8 @@ data RtsLabelInfo | RtsDataFS FastString -- misc rts data bits, eg CHARLIKE_closure | RtsCodeFS FastString -- misc rts code + | RtsApFast LitString -- _fast versions of generic apply + | RtsSlowTickyCtr String deriving (Eq, Ord) @@ -254,21 +280,54 @@ data DynamicLinkerLabelInfo -- ----------------------------------------------------------------------------- -- Constructing CLabels -mkClosureLabel id = IdLabel id Closure -mkSRTLabel id = IdLabel id SRT -mkSRTDescLabel id = IdLabel id SRTDesc -mkInfoTableLabel id = IdLabel id InfoTbl -mkEntryLabel id = IdLabel id Entry -mkSlowEntryLabel id = IdLabel id Slow -mkBitmapLabel id = IdLabel id Bitmap -mkRednCountsLabel id = IdLabel id RednCounts +-- 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: +mkLocalClosureLabel name = IdLabel name Closure +mkLocalInfoTableLabel name = IdLabel name InfoTable +mkLocalEntryLabel name = IdLabel name Entry +mkLocalClosureTableLabel name = IdLabel name ClosureTable + +mkClosureLabel hmods name + | isDllName hmods name = DynIdLabel name Closure + | otherwise = IdLabel name Closure + +mkInfoTableLabel hmods name + | isDllName hmods name = DynIdLabel name InfoTable + | otherwise = IdLabel name InfoTable + +mkEntryLabel hmods name + | isDllName hmods name = DynIdLabel name Entry + | otherwise = IdLabel name Entry + +mkClosureTableLabel hmods name + | isDllName hmods 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 + +mkStaticInfoTableLabel name False = IdLabel name StaticInfoTable +mkStaticInfoTableLabel name True = DynIdLabel name StaticInfoTable -mkConInfoTableLabel con = IdLabel con ConInfoTbl -mkConEntryLabel con = IdLabel con ConEntry -mkStaticInfoTableLabel con = IdLabel con StaticInfoTbl -mkStaticConEntryLabel con = IdLabel con StaticConEntry +mkConEntryLabel hmods name + | isDllName hmods name = DynIdLabel name ConEntry + | otherwise = IdLabel name ConEntry + +mkStaticConEntryLabel hmods name + | isDllName hmods name = DynIdLabel name StaticConEntry + | otherwise = IdLabel name StaticConEntry -mkClosureTblLabel id = IdLabel id ClosureTable mkReturnPtLabel uniq = CaseLabel uniq CaseReturnPt mkReturnInfoLabel uniq = CaseLabel uniq CaseReturnInfo @@ -278,17 +337,24 @@ mkDefaultLabel uniq = CaseLabel uniq CaseDefault mkStringLitLabel = StringLitLabel mkAsmTempLabel = AsmTempLabel -mkModuleInitLabel = ModuleInitLabel -mkPlainModuleInitLabel = PlainModuleInitLabel +mkModuleInitLabel :: HomeModules -> Module -> String -> CLabel +mkModuleInitLabel hmods mod way + = ModuleInitLabel mod way $! (not (isHomeModule hmods mod)) + +mkPlainModuleInitLabel :: HomeModules -> Module -> CLabel +mkPlainModuleInitLabel hmods mod + = PlainModuleInitLabel mod $! (not (isHomeModule hmods 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_FROZEN")) +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")) @@ -301,10 +367,10 @@ mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop) moduleRegdLabel = ModuleRegdLabel -mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTbl upd off) +mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off) mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off) -mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTbl upd off) +mkApInfoTableLabel upd off = RtsLabel (RtsApInfoTable upd off) mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off) -- Foreign labels @@ -331,6 +397,8 @@ mkRtsRetLabelFS str = RtsLabel (RtsRetFS str) mkRtsCodeLabelFS str = RtsLabel (RtsCodeFS str) mkRtsDataLabelFS str = RtsLabel (RtsDataFS str) +mkRtsApFastLabel str = RtsLabel (RtsApFast str) + mkRtsSlowTickyCtrLabel :: String -> CLabel mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat) @@ -348,13 +416,19 @@ dynamicLinkerLabelInfo _ = Nothing mkPicBaseLabel :: CLabel mkPicBaseLabel = PicBaseLabel +mkDeadStripPreventer :: CLabel -> CLabel +mkDeadStripPreventer lbl = DeadStripPreventer lbl + -- ----------------------------------------------------------------------------- -- Converting info labels to entry labels. infoLblToEntryLbl :: CLabel -> CLabel -infoLblToEntryLbl (IdLabel n InfoTbl) = IdLabel n Entry -infoLblToEntryLbl (IdLabel n ConInfoTbl) = IdLabel n ConEntry -infoLblToEntryLbl (IdLabel n StaticInfoTbl) = IdLabel n StaticConEntry +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) @@ -363,9 +437,12 @@ infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s) infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl" entryLblToInfoLbl :: CLabel -> CLabel -entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTbl -entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTbl -entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTbl +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) @@ -384,12 +461,12 @@ needsCDecl (IdLabel _ SRT) = False needsCDecl (IdLabel _ SRTDesc) = False needsCDecl (IdLabel _ Bitmap) = 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 (CaseLabel _ _) = False needsCDecl (StringLitLabel _) = False needsCDecl (AsmTempLabel _) = False needsCDecl (RtsLabel _) = False @@ -414,12 +491,13 @@ 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 id _) = isExternalName id +externallyVisibleCLabel (IdLabel name _) = isExternalName name +externallyVisibleCLabel (DynIdLabel name _) = isExternalName name externallyVisibleCLabel (CC_Label _) = True externallyVisibleCLabel (CCS_Label _) = True externallyVisibleCLabel (DynamicLinkerLabel _ _) = False @@ -434,8 +512,8 @@ data CLabelType | DataLabel labelType :: CLabel -> CLabelType -labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = DataLabel -labelType (RtsLabel (RtsApInfoTbl _ _)) = DataLabel +labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel +labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsData _)) = DataLabel labelType (RtsLabel (RtsCode _)) = CodeLabel labelType (RtsLabel (RtsInfo _)) = DataLabel @@ -448,23 +526,26 @@ labelType (RtsLabel (RtsInfoFS _)) = DataLabel labelType (RtsLabel (RtsEntryFS _)) = CodeLabel labelType (RtsLabel (RtsRetInfoFS _)) = DataLabel 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 (IdLabel _ info) = +labelType (IdLabel _ info) = idInfoLabelType info +labelType (DynIdLabel _ info) = idInfoLabelType info +labelType _ = DataLabel + +idInfoLabelType info = case info of - InfoTbl -> DataLabel + InfoTable -> DataLabel Closure -> DataLabel Bitmap -> DataLabel - ConInfoTbl -> DataLabel - StaticInfoTbl -> DataLabel + ConInfoTable -> DataLabel + StaticInfoTable -> DataLabel ClosureTable -> DataLabel _ -> CodeLabel -labelType _ = DataLabel - -- ----------------------------------------------------------------------------- -- Does a CLabel need dynamic linkage? @@ -478,7 +559,8 @@ labelDynamic :: CLabel -> Bool labelDynamic lbl = case lbl of RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not? - IdLabel n k -> isDllName n + IdLabel n k -> False + DynIdLabel n k -> True #if mingw32_TARGET_OS ForeignLabel _ _ d -> d #else @@ -486,8 +568,8 @@ labelDynamic lbl = -- so we claim that all foreign imports come from dynamic libraries ForeignLabel _ _ _ -> True #endif - ModuleInitLabel m _ -> (not opt_Static) && (not (isHomeModule m)) - PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m)) + ModuleInitLabel m _ dyn -> not opt_Static && dyn + PlainModuleInitLabel m dyn -> not opt_Static && dyn -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False @@ -539,6 +621,9 @@ tell whether a code fragment is a return point or a closure/function entry. -} +instance Outputable CLabel where + ppr = pprCLabel + pprCLabel :: CLabel -> SDoc #if ! OMIT_NATIVE_CODEGEN @@ -554,6 +639,9 @@ pprCLabel (DynamicLinkerLabel info lbl) pprCLabel PicBaseLabel = ptext SLIT("1b") + +pprCLabel (DeadStripPreventer lbl) + = pprCLabel lbl <> ptext SLIT("_dsp") #endif pprCLabel lbl = @@ -569,10 +657,12 @@ maybe_underscore doc | underscorePrefix = pp_cSEP <> doc | otherwise = doc +#ifdef mingw32_TARGET_OS -- In asm mode, we need to put the suffix on a stdcall ForeignLabel. -- (The C compiler does this itself). pprAsmCLbl (ForeignLabel fs (Just sz) _) = ftext fs <> char '@' <> int sz +#endif pprAsmCLbl lbl = pprCLbl lbl @@ -593,7 +683,9 @@ pprCLbl (RtsLabel (RtsData str)) = ptext str pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str pprCLbl (RtsLabel (RtsDataFS str)) = ftext str -pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset)) +pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast") + +pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) = hcat [ptext SLIT("stg_sel_"), text (show offset), ptext (if upd_reqd then SLIT("_upd_info") @@ -607,7 +699,7 @@ pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset)) else SLIT("_noupd_entry")) ] -pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity)) +pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity)) = hcat [ptext SLIT("stg_ap_"), text (show arity), ptext (if upd_reqd then SLIT("_upd_info") @@ -657,16 +749,17 @@ pprCLbl ModuleRegdLabel pprCLbl (ForeignLabel str _ _) = ftext str -pprCLbl (IdLabel id flavor) = ppr id <> ppIdFlavor flavor +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_") <> ftext (moduleNameFS (moduleName mod)) +pprCLbl (ModuleInitLabel mod way _) + = ptext SLIT("__stginit_") <> ppr mod <> char '_' <> text way -pprCLbl (PlainModuleInitLabel mod) - = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod)) +pprCLbl (PlainModuleInitLabel mod _) + = ptext SLIT("__stginit_") <> ppr mod ppIdFlavor :: IdLabelInfo -> SDoc ppIdFlavor x = pp_cSEP <> @@ -674,15 +767,15 @@ ppIdFlavor x = pp_cSEP <> Closure -> ptext SLIT("closure") SRT -> ptext SLIT("srt") SRTDesc -> ptext SLIT("srtd") - InfoTbl -> ptext SLIT("info") + 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") - ConInfoTbl -> ptext SLIT("con_info") + ConInfoTable -> ptext SLIT("con_info") StaticConEntry -> ptext SLIT("static_entry") - StaticInfoTbl -> ptext SLIT("static_info") + StaticInfoTable -> ptext SLIT("static_info") ClosureTable -> ptext SLIT("closure_tbl") ) @@ -728,6 +821,8 @@ 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