diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-16 16:46:39 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-21 06:39:32 -0400 |
commit | 747093b7c23a1cf92b564eb3d9efe2adc15330df (patch) | |
tree | 06b74ab72984f98036a40fc441d37438a49a26a8 | |
parent | f2a98996e7792f572ab685f29742e3476be81166 (diff) | |
download | haskell-747093b7c23a1cf92b564eb3d9efe2adc15330df.tar.gz |
CmmToAsm DynFlags refactoring (#17957)
* Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used
to test the global `ExternalDynamicRefs` flag. Now we test it outside of
`isDynLinkName`
* Add new fields into `NCGConfig`: current unit id, sse/bmi versions,
externalDynamicRefs, etc.
* Replace many uses of `DynFlags` by `NCGConfig`
* Moved `BMI/SSE` datatypes into `GHC.Platform`
-rw-r--r-- | compiler/GHC/Cmm/CLabel.hs | 18 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Info/Build.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm.hs | 91 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Config.hs | 31 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Monad.hs | 52 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PIC.hs | 63 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/CodeGen.hs | 86 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC/CodeGen.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 101 | ||||
-rw-r--r-- | compiler/GHC/Driver/Packages.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 11 | ||||
-rw-r--r-- | compiler/GHC/Stg/Syntax.hs | 8 | ||||
-rw-r--r-- | libraries/ghc-boot/GHC/Platform.hs | 84 | ||||
-rw-r--r-- | testsuite/tests/regalloc/regalloc_unit_tests.hs | 6 |
14 files changed, 298 insertions, 276 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs index bef9b0f8c7..c6969be7ca 100644 --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -132,6 +132,7 @@ import GHC.Platform import GHC.Types.Unique.Set import Util import GHC.Core.Ppr ( {- instances -} ) +import GHC.CmmToAsm.Config -- ----------------------------------------------------------------------------- -- The CLabel type @@ -1027,23 +1028,21 @@ isLocalCLabel this_mod lbl = -- that data resides in a DLL or not. [Win32 only.] -- @labelDynamic@ returns @True@ if the label is located -- in a DLL, be it a data reference or not. -labelDynamic :: DynFlags -> Module -> CLabel -> Bool -labelDynamic dflags this_mod lbl = +labelDynamic :: NCGConfig -> Module -> CLabel -> Bool +labelDynamic config this_mod lbl = case lbl of -- is the RTS in a DLL or not? RtsLabel _ -> externalDynamicRefs && (this_pkg /= rtsUnitId) IdLabel n _ _ -> - isDynLinkName dflags this_mod n + externalDynamicRefs && isDynLinkName platform this_mod n -- When compiling in the "dyn" way, each package is to be linked into -- its own shared library. CmmLabel pkg _ _ - | os == OSMinGW32 -> - externalDynamicRefs && (this_pkg /= pkg) - | otherwise -> - gopt Opt_ExternalDynamicRefs dflags + | os == OSMinGW32 -> externalDynamicRefs && (this_pkg /= pkg) + | otherwise -> externalDynamicRefs LocalBlockLabel _ -> False @@ -1080,8 +1079,9 @@ labelDynamic dflags this_mod lbl = -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False where - externalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags - os = platformOS (targetPlatform dflags) + externalDynamicRefs = ncgExternalDynamicRefs config + platform = ncgPlatform config + os = platformOS platform this_pkg = moduleUnitId this_mod diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs index 9a7602504e..8ee009f638 100644 --- a/compiler/GHC/Cmm/Info/Build.hs +++ b/compiler/GHC/Cmm/Info/Build.hs @@ -31,6 +31,8 @@ import GHC.Runtime.Heap.Layout import GHC.Types.Unique.Supply import GHC.Types.CostCentre import GHC.StgToCmm.Heap +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config import Control.Monad import Data.Map.Strict (Map) @@ -925,6 +927,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do topSRT <- get let + config = initConfig dflags srtMap = moduleSRTMap topSRT blockids = getBlockLabels lbls @@ -1024,11 +1027,11 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do -- when dynamic linking is used we cannot guarantee that the offset -- between the SRT and the info table will fit in the offset field. -- Consequently we build a singleton SRT in in this case. - not (labelDynamic dflags this_mod lbl) + not (labelDynamic config this_mod lbl) -- MachO relocations can't express offsets between compilation units at -- all, so we are always forced to build a singleton SRT in this case. - && (not (osMachOTarget $ platformOS $ targetPlatform dflags) + && (not (osMachOTarget $ platformOS $ ncgPlatform config) || isLocalCLabel this_mod lbl) -> do -- If we have a static function closure, then it becomes the diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs index 558d422ba1..56ac9ceaf5 100644 --- a/compiler/GHC/CmmToAsm.hs +++ b/compiler/GHC/CmmToAsm.hs @@ -162,35 +162,36 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS -> Stream IO RawCmmGroup a -> IO a nativeCodeGen dflags this_mod modLoc h us cmms - = let platform = targetPlatform dflags + = let config = initConfig dflags + platform = ncgPlatform config nCG' :: ( Outputable statics, Outputable instr , Outputable jumpDest, Instruction instr) => NcgImpl statics instr jumpDest -> IO a nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms in case platformArch platform of - ArchX86 -> nCG' (x86NcgImpl dflags) - ArchX86_64 -> nCG' (x86_64NcgImpl dflags) - ArchPPC -> nCG' (ppcNcgImpl dflags) + ArchX86 -> nCG' (x86NcgImpl config) + ArchX86_64 -> nCG' (x86_64NcgImpl config) + ArchPPC -> nCG' (ppcNcgImpl config) ArchS390X -> panic "nativeCodeGen: No NCG for S390X" - ArchSPARC -> nCG' (sparcNcgImpl dflags) + ArchSPARC -> nCG' (sparcNcgImpl config) ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64" ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" - ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags) + ArchPPC_64 _ -> nCG' (ppcNcgImpl config) ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" -x86NcgImpl :: DynFlags -> NcgImpl (Alignment, RawCmmStatics) +x86NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr.Instr X86.Instr.JumpDest -x86NcgImpl dflags - = (x86_64NcgImpl dflags) +x86NcgImpl config + = (x86_64NcgImpl config) -x86_64NcgImpl :: DynFlags -> NcgImpl (Alignment, RawCmmStatics) +x86_64NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr.Instr X86.Instr.JumpDest -x86_64NcgImpl dflags +x86_64NcgImpl config = NcgImpl { ncgConfig = config ,cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen @@ -209,11 +210,10 @@ x86_64NcgImpl dflags ,invertCondBranches = X86.CodeGen.invertCondBranches } where - config = initConfig dflags platform = ncgPlatform config -ppcNcgImpl :: DynFlags -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest -ppcNcgImpl dflags +ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest +ppcNcgImpl config = NcgImpl { ncgConfig = config ,cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen @@ -232,11 +232,10 @@ ppcNcgImpl dflags ,invertCondBranches = \_ _ -> id } where - config = initConfig dflags platform = ncgPlatform config -sparcNcgImpl :: DynFlags -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest -sparcNcgImpl dflags +sparcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest +sparcNcgImpl config = NcgImpl { ncgConfig = config ,cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen @@ -255,7 +254,6 @@ sparcNcgImpl dflags ,invertCondBranches = \_ _ -> id } where - config = initConfig dflags platform = ncgPlatform config -- @@ -565,7 +563,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count -- cmm to cmm optimisations let (opt_cmm, imports) = {-# SCC "cmmToCmm" #-} - cmmToCmm dflags this_mod fixed_cmm + cmmToCmm config this_mod fixed_cmm dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" FormatCMM @@ -1067,10 +1065,10 @@ Ideas for other things we could do (put these in Hoopl please!): temp assignments, and certain assigns to mem...) -} -cmmToCmm :: DynFlags -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel]) +cmmToCmm :: NCGConfig -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel]) cmmToCmm _ _ top@(CmmData _ _) = (top, []) -cmmToCmm dflags this_mod (CmmProc info lbl live graph) - = runCmmOpt dflags this_mod $ +cmmToCmm config this_mod (CmmProc info lbl live graph) + = runCmmOpt config this_mod $ do blocks' <- mapM cmmBlockConFold (toBlockList graph) return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks') @@ -1087,7 +1085,7 @@ pattern OptMResult x y = (# x, y #) data OptMResult a = OptMResult !a ![CLabel] deriving (Functor) #endif -newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> OptMResult a) +newtype CmmOptM a = CmmOptM (NCGConfig -> Module -> [CLabel] -> OptMResult a) deriving (Functor) instance Applicative CmmOptM where @@ -1096,11 +1094,11 @@ instance Applicative CmmOptM where instance Monad CmmOptM where (CmmOptM f) >>= g = - CmmOptM $ \dflags this_mod imports0 -> - case f dflags this_mod imports0 of + CmmOptM $ \config this_mod imports0 -> + case f config this_mod imports0 of OptMResult x imports1 -> case g x of - CmmOptM g' -> g' dflags this_mod imports1 + CmmOptM g' -> g' config this_mod imports1 instance CmmMakeDynamicReferenceM CmmOptM where addImport = addImportCmmOpt @@ -1109,12 +1107,12 @@ instance CmmMakeDynamicReferenceM CmmOptM where addImportCmmOpt :: CLabel -> CmmOptM () addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports) -instance HasDynFlags CmmOptM where - getDynFlags = CmmOptM $ \dflags _ imports -> OptMResult dflags imports +getCmmOptConfig :: CmmOptM NCGConfig +getCmmOptConfig = CmmOptM $ \config _ imports -> OptMResult config imports -runCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel]) -runCmmOpt dflags this_mod (CmmOptM f) = - case f dflags this_mod [] of +runCmmOpt :: NCGConfig -> Module -> CmmOptM a -> (a, [CLabel]) +runCmmOpt config this_mod (CmmOptM f) = + case f config this_mod [] of OptMResult result imports -> (result, imports) cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock @@ -1178,29 +1176,26 @@ cmmStmtConFold stmt cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr cmmExprConFold referenceKind expr = do - dflags <- getDynFlags + config <- getCmmOptConfig - -- With -O1 and greater, the cmmSink pass does constant-folding, so - -- we don't need to do it again here. - let expr' = if optLevel dflags >= 1 + let expr' = if not (ncgDoConstantFolding config) then expr - else cmmExprCon dflags expr + else cmmExprCon config expr cmmExprNative referenceKind expr' -cmmExprCon :: DynFlags -> CmmExpr -> CmmExpr -cmmExprCon dflags (CmmLoad addr rep) = CmmLoad (cmmExprCon dflags addr) rep -cmmExprCon dflags (CmmMachOp mop args) - = cmmMachOpFold platform mop (map (cmmExprCon dflags) args) - where platform = targetPlatform dflags +cmmExprCon :: NCGConfig -> CmmExpr -> CmmExpr +cmmExprCon config (CmmLoad addr rep) = CmmLoad (cmmExprCon config addr) rep +cmmExprCon config (CmmMachOp mop args) + = cmmMachOpFold (ncgPlatform config) mop (map (cmmExprCon config) args) cmmExprCon _ other = other -- handles both PIC and non-PIC cases... a very strange mixture -- of things to do. cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr cmmExprNative referenceKind expr = do - dflags <- getDynFlags - let platform = targetPlatform dflags + config <- getCmmOptConfig + let platform = ncgPlatform config arch = platformArch platform case expr of CmmLoad addr rep @@ -1219,10 +1214,10 @@ cmmExprNative referenceKind expr = do CmmLit (CmmLabel lbl) -> do - cmmMakeDynamicReference dflags referenceKind lbl + cmmMakeDynamicReference config referenceKind lbl CmmLit (CmmLabelOff lbl off) -> do - dynRef <- cmmMakeDynamicReference dflags referenceKind lbl + dynRef <- cmmMakeDynamicReference config referenceKind lbl -- need to optimize here, since it's late return $ cmmMachOpFold platform (MO_Add (wordWidth platform)) [ dynRef, @@ -1233,15 +1228,15 @@ cmmExprNative referenceKind expr = do -- to use the register table, so we replace these registers -- with the corresponding labels: CmmReg (CmmGlobal EagerBlackholeInfo) - | arch == ArchPPC && not (positionIndependent dflags) + | arch == ArchPPC && not (ncgPIC config) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_EAGER_BLACKHOLE_info"))) CmmReg (CmmGlobal GCEnter1) - | arch == ArchPPC && not (positionIndependent dflags) + | arch == ArchPPC && not (ncgPIC config) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) - | arch == ArchPPC && not (positionIndependent dflags) + | arch == ArchPPC && not (ncgPIC config) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_fun"))) diff --git a/compiler/GHC/CmmToAsm/Config.hs b/compiler/GHC/CmmToAsm/Config.hs index 1ed66f47d3..52c0995bdf 100644 --- a/compiler/GHC/CmmToAsm/Config.hs +++ b/compiler/GHC/CmmToAsm/Config.hs @@ -9,21 +9,28 @@ where import GhcPrelude import GHC.Platform import GHC.Cmm.Type (Width(..)) +import GHC.Types.Module -- | Native code generator configuration data NCGConfig = NCGConfig - { ncgPlatform :: !Platform -- ^ Target platform - , ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment - , ncgDebugLevel :: !Int -- ^ Debug level - , ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries - , ncgPIC :: !Bool -- ^ Enable Position-Independent Code - , ncgSplitSections :: !Bool -- ^ Split sections - , ncgSpillPreallocSize :: !Int -- ^ Size in bytes of the pre-allocated spill space on the C stack - , ncgRegsIterative :: !Bool - , ncgAsmLinting :: !Bool -- ^ Perform ASM linting pass - , ncgDumpRegAllocStages :: !Bool - , ncgDumpAsmStats :: !Bool - , ncgDumpAsmConflicts :: !Bool + { ncgPlatform :: !Platform -- ^ Target platform + , ncgUnitId :: UnitId -- ^ Target unit ID + , ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment + , ncgDebugLevel :: !Int -- ^ Debug level + , ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries + , ncgPIC :: !Bool -- ^ Enable Position-Independent Code + , ncgInlineThresholdMemcpy :: !Word -- ^ If inlining `memcpy` produces less than this threshold (in pseudo-instruction unit), do it + , ncgInlineThresholdMemset :: !Word -- ^ Ditto for `memset` + , ncgSplitSections :: !Bool -- ^ Split sections + , ncgSpillPreallocSize :: !Int -- ^ Size in bytes of the pre-allocated spill space on the C stack + , ncgRegsIterative :: !Bool + , ncgAsmLinting :: !Bool -- ^ Perform ASM linting pass + , ncgDoConstantFolding :: !Bool -- ^ Perform CMM constant folding + , ncgSseVersion :: Maybe SseVersion -- ^ (x86) SSE instructions + , ncgBmiVersion :: Maybe BmiVersion -- ^ (x86) BMI instructions + , ncgDumpRegAllocStages :: !Bool + , ncgDumpAsmStats :: !Bool + , ncgDumpAsmConflicts :: !Bool } -- | Return Word size diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs index f6e5515705..07c3cc809b 100644 --- a/compiler/GHC/CmmToAsm/Monad.hs +++ b/compiler/GHC/CmmToAsm/Monad.hs @@ -148,18 +148,46 @@ mkNatM_State us delta dflags this_mod -- | Initialize the native code generator configuration from the DynFlags initConfig :: DynFlags -> NCGConfig initConfig dflags = NCGConfig - { ncgPlatform = targetPlatform dflags - , ncgProcAlignment = cmmProcAlignment dflags - , ncgDebugLevel = debugLevel dflags - , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags - , ncgPIC = positionIndependent dflags - , ncgSplitSections = gopt Opt_SplitSections dflags - , ncgSpillPreallocSize = rESERVED_C_STACK_BYTES dflags - , ncgRegsIterative = gopt Opt_RegsIterative dflags - , ncgAsmLinting = gopt Opt_DoAsmLinting dflags - , ncgDumpRegAllocStages = dopt Opt_D_dump_asm_regalloc_stages dflags - , ncgDumpAsmStats = dopt Opt_D_dump_asm_stats dflags - , ncgDumpAsmConflicts = dopt Opt_D_dump_asm_conflicts dflags + { ncgPlatform = targetPlatform dflags + , ncgUnitId = thisPackage dflags + , ncgProcAlignment = cmmProcAlignment dflags + , ncgDebugLevel = debugLevel dflags + , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags + , ncgPIC = positionIndependent dflags + , ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags + , ncgInlineThresholdMemset = fromIntegral $ maxInlineMemsetInsns dflags + , ncgSplitSections = gopt Opt_SplitSections dflags + , ncgSpillPreallocSize = rESERVED_C_STACK_BYTES dflags + , ncgRegsIterative = gopt Opt_RegsIterative dflags + , ncgAsmLinting = gopt Opt_DoAsmLinting dflags + + -- With -O1 and greater, the cmmSink pass does constant-folding, so + -- we don't need to do it again in the native code generator. + , ncgDoConstantFolding = optLevel dflags < 1 + + , ncgDumpRegAllocStages = dopt Opt_D_dump_asm_regalloc_stages dflags + , ncgDumpAsmStats = dopt Opt_D_dump_asm_stats dflags + , ncgDumpAsmConflicts = dopt Opt_D_dump_asm_conflicts dflags + , ncgBmiVersion = case platformArch (targetPlatform dflags) of + ArchX86_64 -> bmiVersion dflags + ArchX86 -> bmiVersion dflags + _ -> Nothing + + -- We Assume SSE1 and SSE2 operations are available on both + -- x86 and x86_64. Historically we didn't default to SSE2 and + -- SSE1 on x86, which results in defacto nondeterminism for how + -- rounding behaves in the associated x87 floating point instructions + -- because variations in the spill/fpu stack placement of arguments for + -- operations would change the precision and final result of what + -- would otherwise be the same expressions with respect to single or + -- double precision IEEE floating point computations. + , ncgSseVersion = + let v | sseVersion dflags < Just SSE2 = Just SSE2 + | otherwise = sseVersion dflags + in case platformArch (targetPlatform dflags) of + ArchX86_64 -> v + ArchX86 -> v + _ -> Nothing } diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs index cb7d82a6c5..d60821ee10 100644 --- a/compiler/GHC/CmmToAsm/PIC.hs +++ b/compiler/GHC/CmmToAsm/PIC.hs @@ -109,21 +109,20 @@ instance CmmMakeDynamicReferenceM NatM where cmmMakeDynamicReference :: CmmMakeDynamicReferenceM m - => DynFlags + => NCGConfig -> ReferenceKind -- whether this is the target of a jump -> CLabel -- the label -> m CmmExpr -cmmMakeDynamicReference dflags referenceKind lbl +cmmMakeDynamicReference config referenceKind lbl | Just _ <- dynamicLinkerLabelInfo lbl = return $ CmmLit $ CmmLabel lbl -- already processed it, pass through | otherwise = do this_mod <- getThisModule - let config = initConfig dflags - platform = ncgPlatform config + let platform = ncgPlatform config case howToAccessLabel - dflags + config (platformArch platform) (platformOS platform) this_mod @@ -215,9 +214,7 @@ data LabelAccessStyle | AccessViaSymbolPtr | AccessDirectly -howToAccessLabel - :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle - +howToAccessLabel :: NCGConfig -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle -- Windows -- In Windows speak, a "module" is a set of objects linked into the @@ -240,15 +237,15 @@ howToAccessLabel -- into the same .exe file. In this case we always access symbols directly, -- and never use __imp_SYMBOL. -- -howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl +howToAccessLabel config _ OSMinGW32 this_mod _ lbl -- Assume all symbols will be in the same PE, so just access them directly. - | not (gopt Opt_ExternalDynamicRefs dflags) + | not (ncgExternalDynamicRefs config) = AccessDirectly -- If the target symbol is in another PE we need to access it via the -- appropriate __imp_SYMBOL pointer. - | labelDynamic dflags this_mod lbl + | labelDynamic config this_mod lbl = AccessViaSymbolPtr -- Target symbol is in the same PE as the caller, so just access it directly. @@ -264,9 +261,9 @@ howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl -- It is always possible to access something indirectly, -- even when it's not necessary. -- -howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl +howToAccessLabel config arch OSDarwin this_mod DataReference lbl -- data access to a dynamic library goes via a symbol pointer - | labelDynamic dflags this_mod lbl + | labelDynamic config this_mod lbl = AccessViaSymbolPtr -- when generating PIC code, all cross-module data references must @@ -279,27 +276,27 @@ howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl -- we'd need to pass the current Module all the way in to -- this function. | arch /= ArchX86_64 - , positionIndependent dflags && externallyVisibleCLabel lbl + , ncgPIC config && externallyVisibleCLabel lbl = AccessViaSymbolPtr | otherwise = AccessDirectly -howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl +howToAccessLabel config arch OSDarwin this_mod JumpReference lbl -- dyld code stubs don't work for tailcalls because the -- stack alignment is only right for regular calls. -- Therefore, we have to go via a symbol pointer: | arch == ArchX86 || arch == ArchX86_64 - , labelDynamic dflags this_mod lbl + , labelDynamic config this_mod lbl = AccessViaSymbolPtr -howToAccessLabel dflags arch OSDarwin this_mod _ lbl +howToAccessLabel config arch OSDarwin this_mod _ lbl -- Code stubs are the usual method of choice for imported code; -- not needed on x86_64 because Apple's new linker, ld64, generates -- them automatically. | arch /= ArchX86_64 - , labelDynamic dflags this_mod lbl + , labelDynamic config this_mod lbl = AccessViaStub | otherwise @@ -310,7 +307,7 @@ howToAccessLabel dflags arch OSDarwin this_mod _ lbl -- AIX -- quite simple (for now) -howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl +howToAccessLabel _config _arch OSAIX _this_mod kind _lbl = case kind of DataReference -> AccessViaSymbolPtr CallReference -> AccessDirectly @@ -339,27 +336,27 @@ howToAccessLabel _ (ArchPPC_64 _) os _ kind _ -- regular calls are handled by the runtime linker _ -> AccessDirectly -howToAccessLabel dflags _ os _ _ _ +howToAccessLabel config _ os _ _ _ -- no PIC -> the dynamic linker does everything for us; -- if we don't dynamically link to Haskell code, -- it actually manages to do so without messing things up. | osElfTarget os - , not (positionIndependent dflags) && - not (gopt Opt_ExternalDynamicRefs dflags) + , not (ncgPIC config) && + not (ncgExternalDynamicRefs config) = AccessDirectly -howToAccessLabel dflags arch os this_mod DataReference lbl +howToAccessLabel config arch os this_mod DataReference lbl | osElfTarget os = case () of -- A dynamic label needs to be accessed via a symbol pointer. - _ | labelDynamic dflags this_mod lbl + _ | labelDynamic config this_mod lbl -> AccessViaSymbolPtr -- For PowerPC32 -fPIC, we have to access even static data -- via a symbol pointer (see below for an explanation why -- PowerPC32 Linux is especially broken). | arch == ArchPPC - , positionIndependent dflags + , ncgPIC config -> AccessViaSymbolPtr | otherwise @@ -378,26 +375,26 @@ howToAccessLabel dflags arch os this_mod DataReference lbl -- (AccessDirectly, because we get an implicit symbol stub) -- and calling functions from PIC code on non-i386 platforms (via a symbol stub) -howToAccessLabel dflags arch os this_mod CallReference lbl +howToAccessLabel config arch os this_mod CallReference lbl | osElfTarget os - , labelDynamic dflags this_mod lbl && not (positionIndependent dflags) + , labelDynamic config this_mod lbl && not (ncgPIC config) = AccessDirectly | osElfTarget os , arch /= ArchX86 - , labelDynamic dflags this_mod lbl - , positionIndependent dflags + , labelDynamic config this_mod lbl + , ncgPIC config = AccessViaStub -howToAccessLabel dflags _ os this_mod _ lbl +howToAccessLabel config _ os this_mod _ lbl | osElfTarget os - = if labelDynamic dflags this_mod lbl + = if labelDynamic config this_mod lbl then AccessViaSymbolPtr else AccessDirectly -- all other platforms -howToAccessLabel dflags _ _ _ _ _ - | not (positionIndependent dflags) +howToAccessLabel config _ _ _ _ _ + | not (ncgPIC config) = AccessDirectly | otherwise diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs index 74d8b00c39..90b670c9b0 100644 --- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs @@ -33,7 +33,7 @@ import GHC.CmmToAsm.CPrim import GHC.CmmToAsm.Monad ( NatM, getNewRegNat, getNewLabelNat , getBlockIdNat, getPicBaseNat, getNewRegPairNat - , getPicBaseMaybeNat, getPlatform, initConfig + , getPicBaseMaybeNat, getPlatform, getConfig ) import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC @@ -57,7 +57,6 @@ import GHC.Cmm.Dataflow.Graph -- The rest: import OrdList import Outputable -import GHC.Driver.Session import Control.Monad ( mapAndUnzipM, when ) import Data.Bits @@ -149,7 +148,7 @@ stmtsToInstrs stmts stmtToInstrs :: CmmNode e x -> NatM InstrBlock stmtToInstrs stmt = do - dflags <- getDynFlags + config <- getConfig platform <- getPlatform case stmt of CmmComment s -> return (unitOL (COMMENT s)) @@ -180,7 +179,7 @@ stmtToInstrs stmt = do b1 <- genCondJump true arg prediction b2 <- genBranch false return (b1 `appOL` b2) - CmmSwitch arg ids -> genSwitch dflags arg ids + CmmSwitch arg ids -> genSwitch config arg ids CmmCall { cml_target = arg , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs) _ -> @@ -404,10 +403,10 @@ iselExpr64 expr getRegister :: CmmExpr -> NatM Register -getRegister e = do dflags <- getDynFlags - getRegister' dflags (targetPlatform dflags) e +getRegister e = do config <- getConfig + getRegister' config (ncgPlatform config) e -getRegister' :: DynFlags -> Platform -> CmmExpr -> NatM Register +getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do @@ -424,8 +423,8 @@ getRegister' _ platform (CmmReg reg) = return (Fixed (cmmTypeFormat (cmmRegType platform reg)) (getRegisterReg platform reg) nilOL) -getRegister' dflags platform tree@(CmmRegOff _ _) - = getRegister' dflags platform (mangleIndexTree platform tree) +getRegister' config platform tree@(CmmRegOff _ _) + = getRegister' config platform (mangleIndexTree platform tree) -- for 32-bit architectures, support some 64 -> 32 bit conversions: -- TO_W_(x), TO_W_(x >> 32) @@ -509,7 +508,7 @@ getRegister' _ _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do Amode addr addr_code <- getAmode DS mem return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr)) -getRegister' dflags platform (CmmMachOp mop [x]) -- unary MachOps +getRegister' config platform (CmmMachOp mop [x]) -- unary MachOps = case mop of MO_Not rep -> triv_ucode_int rep NOT @@ -539,7 +538,7 @@ getRegister' dflags platform (CmmMachOp mop [x]) -- unary MachOps triv_ucode_float width instr = trivialUCode (floatFormat width) instr x conversionNop new_format expr - = do e_code <- getRegister' dflags platform expr + = do e_code <- getRegister' config platform expr return (swizzleRegisterRep e_code new_format) clearLeft from to @@ -662,9 +661,9 @@ getRegister' _ _ (CmmLit (CmmInt i rep)) in return (Any (intFormat rep) code) -getRegister' dflags _ (CmmLit (CmmFloat f frep)) = do +getRegister' config _ (CmmLit (CmmFloat f frep)) = do lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl Amode addr addr_code <- getAmode D dynRef let format = floatFormat frep code dst = @@ -673,7 +672,7 @@ getRegister' dflags _ (CmmLit (CmmFloat f frep)) = do `consOL` (addr_code `snocOL` LD format dst addr) return (Any format code) -getRegister' dflags platform (CmmLit lit) +getRegister' config platform (CmmLit lit) | target32Bit platform = let rep = cmmLitType platform lit imm = litToImm lit @@ -684,7 +683,7 @@ getRegister' dflags platform (CmmLit lit) in return (Any (cmmTypeFormat rep) code) | otherwise = do lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl Amode addr addr_code <- getAmode D dynRef let rep = cmmLitType platform lit format = cmmTypeFormat rep @@ -1031,8 +1030,8 @@ assignMem_IntCode pk addr src = do -- dst is a reg, but src could be anything assignReg_IntCode _ reg src = do - dflags <- getDynFlags - let dst = getRegisterReg (targetPlatform dflags) reg + platform <- getPlatform + let dst = getRegisterReg platform reg r <- getRegister src return $ case r of Any _ code -> code dst @@ -1053,8 +1052,8 @@ genJump (CmmLit (CmmLabel lbl)) regs genJump tree gregs = do - dflags <- getDynFlags - genJump' tree (platformToGCP (targetPlatform dflags)) gregs + platform <- getPlatform + genJump' tree (platformToGCP platform) gregs genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock @@ -1132,9 +1131,8 @@ genCCall (PrimTarget (MO_Prefetch_Data _)) _ _ = return $ nilOL genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] - = do dflags <- getDynFlags - let platform = targetPlatform dflags - fmt = intFormat width + = do platform <- getPlatform + let fmt = intFormat width reg_dst = getRegisterReg platform (CmmLocal dst) (instr, n_code) <- case amop of AMO_Add -> getSomeRegOrImm ADD True reg_dst @@ -1184,9 +1182,8 @@ genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] return (op dst dst (RIReg n_reg), n_code) genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr] - = do dflags <- getDynFlags - let platform = targetPlatform dflags - fmt = intFormat width + = do platform <- getPlatform + let fmt = intFormat width reg_dst = getRegisterReg platform (CmmLocal dst) form = if widthInBits width == 64 then DS else D Amode addr_reg addr_code <- getAmode form addr @@ -1216,9 +1213,8 @@ genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do return $ unitOL(HWSYNC) `appOL` code genCCall (PrimTarget (MO_Clz width)) [dst] [src] - = do dflags <- getDynFlags - let platform = targetPlatform dflags - reg_dst = getRegisterReg platform (CmmLocal dst) + = do platform <- getPlatform + let reg_dst = getRegisterReg platform (CmmLocal dst) if target32Bit platform && width == W64 then do ChildCode64 code vr_lo <- iselExpr64 src @@ -1268,9 +1264,8 @@ genCCall (PrimTarget (MO_Clz width)) [dst] [src] return $ s_code `appOL` pre `appOL` cntlz `appOL` post genCCall (PrimTarget (MO_Ctz width)) [dst] [src] - = do dflags <- getDynFlags - let platform = targetPlatform dflags - reg_dst = getRegisterReg platform (CmmLocal dst) + = do platform <- getPlatform + let reg_dst = getRegisterReg platform (CmmLocal dst) if target32Bit platform && width == W64 then do let format = II32 @@ -1334,8 +1329,7 @@ genCCall (PrimTarget (MO_Ctz width)) [dst] [src] ] genCCall target dest_regs argsAndHints - = do dflags <- getDynFlags - let platform = targetPlatform dflags + = do platform <- getPlatform case target of PrimTarget (MO_S_QuotRem width) -> divOp1 platform True width dest_regs argsAndHints @@ -1354,7 +1348,8 @@ genCCall target dest_regs argsAndHints dest_regs argsAndHints PrimTarget MO_F64_Fabs -> fabs platform dest_regs argsAndHints PrimTarget MO_F32_Fabs -> fabs platform dest_regs argsAndHints - _ -> genCCall' dflags (platformToGCP platform) + _ -> do config <- getConfig + genCCall' config (platformToGCP platform) target dest_regs argsAndHints where divOp1 platform signed width [res_q, res_r] [arg_x, arg_y] = do let reg_q = getRegisterReg platform (CmmLocal res_q) @@ -1586,7 +1581,7 @@ platformToGCP platform genCCall' - :: DynFlags + :: NCGConfig -> GenCCallPlatform -> ForeignTarget -- function to call -> [CmmFormal] -- where to put the result @@ -1639,7 +1634,7 @@ genCCall' -} -genCCall' dflags gcp target dest_regs args +genCCall' config gcp target dest_regs args = do (finalStack,passArgumentsCode,usedRegs) <- passArguments (zip3 args argReps argHints) @@ -1705,7 +1700,6 @@ genCCall' dflags gcp target dest_regs args `snocOL` BCTRL usedRegs `appOL` codeAfter) where - config = initConfig dflags platform = ncgPlatform config uses_pic_base_implicitly = do @@ -1777,7 +1771,7 @@ genCCall' dflags gcp target dest_regs args passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed) passArguments ((arg,arg_ty,_):args) gprs fprs stackOffset accumCode accumUsed | isWord64 arg_ty - && target32Bit (targetPlatform dflags) = + && target32Bit (ncgPlatform config) = do ChildCode64 code vr_lo <- iselExpr64 arg let vr_hi = getHiVRegFromLo vr_lo @@ -1945,8 +1939,7 @@ genCCall' dflags gcp target dest_regs args outOfLineMachOp mop = do - dflags <- getDynFlags - mopExpr <- cmmMakeDynamicReference dflags CallReference $ + mopExpr <- cmmMakeDynamicReference config CallReference $ mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction let mopLabelOrExpr = case mopExpr of CmmLit (CmmLabel lbl) -> Left lbl @@ -2041,8 +2034,8 @@ genCCall' dflags gcp target dest_regs args -- ----------------------------------------------------------------------------- -- Generating a table-branch -genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock -genSwitch dflags expr targets +genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch config expr targets | OSAIX <- platformOS platform = do (reg,e_code) <- getSomeReg (cmmOffset platform expr offset) @@ -2050,7 +2043,7 @@ genSwitch dflags expr targets sha = if target32Bit platform then 2 else 3 tmp <- getNewRegNat fmt lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let code = e_code `appOL` t_code `appOL` toOL [ SL fmt tmp reg (RIImm (ImmInt sha)), @@ -2067,7 +2060,7 @@ genSwitch dflags expr targets sha = if target32Bit platform then 2 else 3 tmp <- getNewRegNat fmt lbl <- getNewLabelNat - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let code = e_code `appOL` t_code `appOL` toOL [ SL fmt tmp reg (RIImm (ImmInt sha)), @@ -2095,7 +2088,6 @@ genSwitch dflags expr targets where (offset, ids) = switchTargetsToTable targets platform = ncgPlatform config - config = initConfig dflags generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr) @@ -2334,9 +2326,9 @@ coerceInt2FP' ArchPPC fromRep toRep x = do lbl <- getNewLabelNat itmp <- getNewRegNat II32 ftmp <- getNewRegNat FF64 - dflags <- getDynFlags + config <- getConfig platform <- getPlatform - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl Amode addr addr_code <- getAmode D dynRef let code' dst = code `appOL` maybe_exts `appOL` toOL [ diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs index 94609fbcc1..f88b2140a1 100644 --- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs @@ -53,7 +53,6 @@ import GHC.CmmToAsm.CPrim -- The rest: import GHC.Types.Basic -import GHC.Driver.Session import FastString import OrdList import Outputable @@ -455,7 +454,7 @@ genCCall target dest_regs args let transfer_code = toOL (move_final vregs allArgRegs extraStackArgsHere) - dflags <- getDynFlags + platform <- getPlatform return $ argcode `appOL` move_sp_down `appOL` @@ -463,7 +462,7 @@ genCCall target dest_regs args callinsns `appOL` unitOL NOP `appOL` move_sp_up `appOL` - assign_code (targetPlatform dflags) dest_regs + assign_code platform dest_regs -- | Generate code to calculate an argument, and move it into one @@ -594,8 +593,8 @@ outOfLineMachOp mop = do let functionName = outOfLineMachOp_table mop - dflags <- getDynFlags - mopExpr <- cmmMakeDynamicReference dflags CallReference + config <- getConfig + mopExpr <- cmmMakeDynamicReference config CallReference $ mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction let mopLabelOrExpr diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs index 834cd68d32..4bbf791102 100644 --- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs @@ -104,26 +104,13 @@ is32BitPlatform = do sse2Enabled :: NatM Bool sse2Enabled = do - platform <- getPlatform - case platformArch platform of - -- We Assume SSE1 and SSE2 operations are available on both - -- x86 and x86_64. Historically we didn't default to SSE2 and - -- SSE1 on x86, which results in defacto nondeterminism for how - -- rounding behaves in the associated x87 floating point instructions - -- because variations in the spill/fpu stack placement of arguments for - -- operations would change the precision and final result of what - -- would otherwise be the same expressions with respect to single or - -- double precision IEEE floating point computations. - ArchX86_64 -> return True - ArchX86 -> return True - _ -> panic "trying to generate x86/x86_64 on the wrong platform" - + config <- getConfig + return (ncgSseVersion config >= Just SSE2) sse4_2Enabled :: NatM Bool sse4_2Enabled = do - dflags <- getDynFlags - return (isSse4_2Enabled dflags) - + config <- getConfig + return (ncgSseVersion config >= Just SSE42) cmmTopCodeGen :: RawCmmDecl @@ -1474,11 +1461,11 @@ memConstant :: Alignment -> CmmLit -> NatM Amode memConstant align lit = do lbl <- getNewLabelNat let rosection = Section ReadOnlyData lbl - dflags <- getDynFlags + config <- getConfig platform <- getPlatform (addr, addr_code) <- if target32Bit platform then do dynRef <- cmmMakeDynamicReference - dflags + config DataReference lbl Amode addr addr_code <- getAmode dynRef @@ -2122,10 +2109,10 @@ genCCall is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid | otherwise = do code_src <- getAnyReg src - platform <- ncgPlatform <$> getConfig + config <- getConfig + let platform = ncgPlatform config let dst_r = getRegisterReg platform (CmmLocal dst) - dflags <- getDynFlags - if isBmi2Enabled dflags + if ncgBmiVersion config >= Just BMI2 then do src_r <- getNewRegNat (intFormat width) let instrs = appOL (code_src src_r) $ case width of @@ -2158,13 +2145,13 @@ genCCall is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] bid bw = widthInBits width genCCall bits mop dst args bid = do - dflags <- getDynFlags - instr <- genCCall' dflags bits mop dst args bid + config <- getConfig + instr <- genCCall' config bits mop dst args bid return (instr, Nothing) -- genCCall' handles cases not introducing new code blocks. genCCall' - :: DynFlags + :: NCGConfig -> Bool -- 32 bit platform? -> ForeignTarget -- function to call -> [CmmFormal] -- where to put the result @@ -2174,9 +2161,9 @@ genCCall' -- Unroll memcpy calls if the number of bytes to copy isn't too -- large. Otherwise, call C's memcpy. -genCCall' dflags _ (PrimTarget (MO_Memcpy align)) _ +genCCall' config _ (PrimTarget (MO_Memcpy align)) _ [dst, src, CmmLit (CmmInt n _)] _ - | fromInteger insns <= maxInlineMemcpyInsns dflags = do + | fromInteger insns <= ncgInlineThresholdMemcpy config = do code_dst <- getAnyReg dst dst_r <- getNewRegNat format code_src <- getAnyReg src @@ -2185,7 +2172,7 @@ genCCall' dflags _ (PrimTarget (MO_Memcpy align)) _ return $ code_dst dst_r `appOL` code_src src_r `appOL` go dst_r src_r tmp_r (fromInteger n) where - platform = targetPlatform dflags + platform = ncgPlatform config -- The number of instructions we will generate (approx). We need 2 -- instructions per move. insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes) @@ -2224,12 +2211,12 @@ genCCall' dflags _ (PrimTarget (MO_Memcpy align)) _ dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone (ImmInteger (n - i)) -genCCall' dflags _ (PrimTarget (MO_Memset align)) _ +genCCall' config _ (PrimTarget (MO_Memset align)) _ [dst, CmmLit (CmmInt c _), CmmLit (CmmInt n _)] _ - | fromInteger insns <= maxInlineMemsetInsns dflags = do + | fromInteger insns <= ncgInlineThresholdMemset config = do code_dst <- getAnyReg dst dst_r <- getNewRegNat format if format == II64 && n >= 8 then do @@ -2242,7 +2229,7 @@ genCCall' dflags _ (PrimTarget (MO_Memset align)) _ return $ code_dst dst_r `appOL` go4 dst_r (fromInteger n) where - platform = targetPlatform dflags + platform = ncgPlatform config maxAlignment = wordAlignment platform -- only machine word wide MOVs are supported effectiveAlignment = min (alignmentOf align) maxAlignment format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment @@ -2348,10 +2335,10 @@ genCCall' _ is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] _ = do where format = intFormat width -genCCall' dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] +genCCall' config is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] args@[src] bid = do sse4_2 <- sse4_2Enabled - platform <- ncgPlatform <$> getConfig + let platform = ncgPlatform config if sse4_2 then do code_src <- getAnyReg src src_r <- getNewRegNat format @@ -2369,20 +2356,20 @@ genCCall' dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r)) else nilOL) else do - targetExpr <- cmmMakeDynamicReference dflags + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn) - genCCall' dflags is32Bit target dest_regs args bid + genCCall' config is32Bit target dest_regs args bid where format = intFormat width lbl = mkCmmCodeLabel primUnitId (fsLit (popCntLabel width)) -genCCall' dflags is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst] +genCCall' config is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst] args@[src, mask] bid = do - platform <- ncgPlatform <$> getConfig - if isBmi2Enabled dflags + let platform = ncgPlatform config + if ncgBmiVersion config >= Just BMI2 then do code_src <- getAnyReg src code_mask <- getAnyReg mask src_r <- getNewRegNat format @@ -2402,20 +2389,20 @@ genCCall' dflags is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst] unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r)) else nilOL) else do - targetExpr <- cmmMakeDynamicReference dflags + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn) - genCCall' dflags is32Bit target dest_regs args bid + genCCall' config is32Bit target dest_regs args bid where format = intFormat width lbl = mkCmmCodeLabel primUnitId (fsLit (pdepLabel width)) -genCCall' dflags is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst] +genCCall' config is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst] args@[src, mask] bid = do - platform <- ncgPlatform <$> getConfig - if isBmi2Enabled dflags + let platform = ncgPlatform config + if ncgBmiVersion config >= Just BMI2 then do code_src <- getAnyReg src code_mask <- getAnyReg mask src_r <- getNewRegNat format @@ -2435,30 +2422,31 @@ genCCall' dflags is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst] unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r)) else nilOL) else do - targetExpr <- cmmMakeDynamicReference dflags + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn) - genCCall' dflags is32Bit target dest_regs args bid + genCCall' config is32Bit target dest_regs args bid where format = intFormat width lbl = mkCmmCodeLabel primUnitId (fsLit (pextLabel width)) -genCCall' dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid +genCCall' config is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid | is32Bit && width == W64 = do -- Fallback to `hs_clz64` on i386 - targetExpr <- cmmMakeDynamicReference dflags CallReference lbl + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn) - genCCall' dflags is32Bit target dest_regs args bid + genCCall' config is32Bit target dest_regs args bid | otherwise = do code_src <- getAnyReg src - platform <- ncgPlatform <$> getConfig + config <- getConfig + let platform = ncgPlatform config let dst_r = getRegisterReg platform (CmmLocal dst) - if isBmi2Enabled dflags + if ncgBmiVersion config >= Just BMI2 then do src_r <- getNewRegNat (intFormat width) return $ appOL (code_src src_r) $ case width of @@ -2489,13 +2477,13 @@ genCCall' dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bw = widthInBits width lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width)) -genCCall' dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do - targetExpr <- cmmMakeDynamicReference dflags +genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn) - genCCall' dflags is32Bit target dest_regs args bid + genCCall' config is32Bit target dest_regs args bid where lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) @@ -3142,8 +3130,8 @@ outOfLineCmmOp :: BlockId -> CallishMachOp -> Maybe CmmFormal -> [CmmActual] -> NatM InstrBlock outOfLineCmmOp bid mop res args = do - dflags <- getDynFlags - targetExpr <- cmmMakeDynamicReference dflags CallReference lbl + config <- getConfig + targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [] [] CmmMayReturn) @@ -3252,7 +3240,6 @@ genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock genSwitch expr targets = do config <- getConfig - dflags <- getDynFlags let platform = ncgPlatform config if ncgPIC config then do @@ -3272,7 +3259,7 @@ genSwitch expr targets = do -- if L0 is not preceded by a non-anonymous label in its section. OSDarwin | not is32bit -> Section Text lbl _ -> Section ReadOnlyData lbl - dynRef <- cmmMakeDynamicReference dflags DataReference lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl (tableReg,t_code) <- getSomeReg $ dynRef let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs index b2299a1403..3e85251da2 100644 --- a/compiler/GHC/Driver/Packages.hs +++ b/compiler/GHC/Driver/Packages.hs @@ -2155,9 +2155,8 @@ displayInstalledUnitId pkgstate uid = fmap sourcePackageIdString (lookupInstalledPackage pkgstate uid) -- | Will the 'Name' come from a dynamically linked package? -isDynLinkName :: DynFlags -> Module -> Name -> Bool -isDynLinkName dflags this_mod name - | not (gopt Opt_ExternalDynamicRefs dflags) = False +isDynLinkName :: Platform -> Module -> Name -> Bool +isDynLinkName platform this_mod name | Just mod <- nameModule_maybe name -- Issue #8696 - when GHC is dynamically linked, it will attempt -- to load the dynamic dependencies of object files at compile @@ -2171,7 +2170,7 @@ isDynLinkName dflags this_mod name -- In the mean time, always force dynamic indirections to be -- generated: when the module name isn't the module being -- compiled, references are dynamic. - = case platformOS $ targetPlatform dflags of + = case platformOS platform of -- On Windows the hack for #8696 makes it unlinkable. -- As the entire setup of the code from Cmm down to the RTS expects -- the use of trampolines for the imported functions only when diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 8f64966131..94d3d771fc 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -5054,13 +5054,6 @@ setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags -- check if SSE is enabled, we might have x86-64 imply the -msse2 -- flag. -data SseVersion = SSE1 - | SSE2 - | SSE3 - | SSE4 - | SSE42 - deriving (Eq, Ord) - isSseEnabled :: DynFlags -> Bool isSseEnabled dflags = case platformArch (targetPlatform dflags) of ArchX86_64 -> True @@ -5106,10 +5099,6 @@ isAvx512pfEnabled dflags = avx512pf dflags -- ----------------------------------------------------------------------------- -- BMI2 -data BmiVersion = BMI1 - | BMI2 - deriving (Eq, Ord) - isBmiEnabled :: DynFlags -> Bool isBmiEnabled dflags = case platformArch (targetPlatform dflags) of ArchX86_64 -> bmiVersion dflags >= Just BMI1 diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs index 7ee13baef8..aefb49d988 100644 --- a/compiler/GHC/Stg/Syntax.hs +++ b/compiler/GHC/Stg/Syntax.hs @@ -126,15 +126,17 @@ data StgArg -- If so, we can't allocate it statically isDllConApp :: DynFlags -> Module -> DataCon -> [StgArg] -> Bool isDllConApp dflags this_mod con args - | platformOS (targetPlatform dflags) == OSMinGW32 - = isDynLinkName dflags this_mod (dataConName con) || any is_dll_arg args + | not (gopt Opt_ExternalDynamicRefs dflags) = False + | platformOS platform == OSMinGW32 + = isDynLinkName platform this_mod (dataConName con) || any is_dll_arg args | otherwise = False where + platform = targetPlatform dflags -- NB: typePrimRep1 is legit because any free variables won't have -- unlifted type (there are no unlifted things at top level) is_dll_arg :: StgArg -> Bool is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep1 (idType v)) - && isDynLinkName dflags this_mod (idName v) + && isDynLinkName platform this_mod (idName v) is_dll_arg _ = False -- True of machine addresses; these are the things that don't work across DLLs. diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs index b5091ae8e8..7af9cc0890 100644 --- a/libraries/ghc-boot/GHC/Platform.hs +++ b/libraries/ghc-boot/GHC/Platform.hs @@ -2,37 +2,38 @@ -- | A description of the platform we're compiling for. -- -module GHC.Platform ( - PlatformMini(..), - PlatformWordSize(..), - Platform(..), platformArch, platformOS, - Arch(..), - OS(..), - ArmISA(..), - ArmISAExt(..), - ArmABI(..), - PPC_64ABI(..), - ByteOrder(..), - - target32Bit, - isARM, - osElfTarget, - osMachOTarget, - osSubsectionsViaSymbols, - platformUsesFrameworks, - platformWordSizeInBytes, - platformWordSizeInBits, - platformMinInt, - platformMaxInt, - platformMaxWord, - platformInIntRange, - platformInWordRange, - - PlatformMisc(..), - IntegerLibrary(..), - - stringEncodeArch, - stringEncodeOS, +module GHC.Platform + ( PlatformMini(..) + , PlatformWordSize(..) + , Platform(..) + , platformArch + , platformOS + , Arch(..) + , OS(..) + , ArmISA(..) + , ArmISAExt(..) + , ArmABI(..) + , PPC_64ABI(..) + , ByteOrder(..) + , target32Bit + , isARM + , osElfTarget + , osMachOTarget + , osSubsectionsViaSymbols + , platformUsesFrameworks + , platformWordSizeInBytes + , platformWordSizeInBits + , platformMinInt + , platformMaxInt + , platformMaxWord + , platformInIntRange + , platformInWordRange + , PlatformMisc(..) + , IntegerLibrary(..) + , stringEncodeArch + , stringEncodeOS + , SseVersion (..) + , BmiVersion (..) ) where @@ -338,3 +339,24 @@ platformInIntRange platform x = x >= platformMinInt platform && x <= platformMax -- | Test if the given Integer is representable with a platform Word platformInWordRange :: Platform -> Integer -> Bool platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform + + +-------------------------------------------------- +-- Instruction sets +-------------------------------------------------- + +-- | x86 SSE instructions +data SseVersion + = SSE1 + | SSE2 + | SSE3 + | SSE4 + | SSE42 + deriving (Eq, Ord) + +-- | x86 BMI (bit manipulation) instructions +data BmiVersion + = BMI1 + | BMI2 + deriving (Eq, Ord) + diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs index a7e93259ca..efe955414c 100644 --- a/testsuite/tests/regalloc/regalloc_unit_tests.hs +++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs @@ -26,6 +26,8 @@ import qualified GHC.CmmToAsm.X86.Instr as X86.Instr import GHC.Driver.Main import GHC.StgToCmm.CgUtils import GHC.CmmToAsm +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Monad as NCGConfig import GHC.Cmm.Info.Build import GHC.Cmm.Pipeline import GHC.Cmm.Parser @@ -97,13 +99,13 @@ assertIO = assertOr $ \msg -> void (throwIO . RegAllocTestException $ msg) compileCmmForRegAllocStats :: DynFlags -> FilePath -> - (DynFlags -> + (NCGConfig -> NcgImpl (Alignment, RawCmmStatics) X86.Instr.Instr X86.Instr.JumpDest) -> UniqSupply -> IO [( Maybe [Color.RegAllocStats (Alignment, RawCmmStatics) X86.Instr.Instr] , Maybe [Linear.RegAllocStats])] compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do - let ncgImpl = ncgImplF dflags + let ncgImpl = ncgImplF (NCGConfig.initConfig dflags) hscEnv <- newHscEnv dflags -- parse the cmm file and output any warnings or errors |