summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-03-16 16:46:39 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-21 06:39:32 -0400
commit747093b7c23a1cf92b564eb3d9efe2adc15330df (patch)
tree06b74ab72984f98036a40fc441d37438a49a26a8
parentf2a98996e7792f572ab685f29742e3476be81166 (diff)
downloadhaskell-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.hs18
-rw-r--r--compiler/GHC/Cmm/Info/Build.hs7
-rw-r--r--compiler/GHC/CmmToAsm.hs91
-rw-r--r--compiler/GHC/CmmToAsm/Config.hs31
-rw-r--r--compiler/GHC/CmmToAsm/Monad.hs52
-rw-r--r--compiler/GHC/CmmToAsm/PIC.hs63
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs86
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen.hs9
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs101
-rw-r--r--compiler/GHC/Driver/Packages.hs7
-rw-r--r--compiler/GHC/Driver/Session.hs11
-rw-r--r--compiler/GHC/Stg/Syntax.hs8
-rw-r--r--libraries/ghc-boot/GHC/Platform.hs84
-rw-r--r--testsuite/tests/regalloc/regalloc_unit_tests.hs6
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