[commit: ghc] simd: Add support for -mavx and -mavx=2 flags. (834d3b2)

Geoffrey Mainland gmainlan at microsoft.com
Tue Mar 26 13:55:47 CET 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : simd

https://github.com/ghc/ghc/commit/834d3b2f4379d251cd40ce74590c1053a04cd97b

>---------------------------------------------------------------

commit 834d3b2f4379d251cd40ce74590c1053a04cd97b
Author: Geoffrey Mainland <gmainlan at microsoft.com>
Date:   Wed Feb 13 16:33:01 2013 +0000

    Add support for -mavx and -mavx=2 flags.

>---------------------------------------------------------------

 compiler/main/CmdLineParser.hs  | 35 ++++++++++++++++++++++-------------
 compiler/main/DriverPipeline.hs | 14 +++++++++++++-
 compiler/main/DynFlags.hs       | 27 +++++++++++++++++++++++----
 3 files changed, 58 insertions(+), 18 deletions(-)

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 252a376..b8086fa 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -54,6 +54,7 @@ data OptKind m                             -- Suppose the flag is -f
     | PrefixPred    (String -> Bool) (String -> EwM m ())
     | AnySuffixPred (String -> Bool) (String -> EwM m ())
     | VersionSuffix (Int -> Int -> EwM m ())
+    | OptVersionSuffix (Int -> Int -> EwM m ())
       -- -f or -f=maj.min; pass major and minor version to fn
 
 
@@ -205,6 +206,13 @@ processOneArg opt_kind rest arg args
                           Just maj <- parseInt maj_s -> Right (f maj 0, args)
                         | otherwise -> Left ("malformed version argument in " ++ dash_arg)
 
+        OptVersionSuffix f | [maj_s, min_s] <- split '.' rest_no_eq,
+                             Just maj <- parseInt maj_s,
+                             Just min <- parseInt min_s -> Right (f maj min, args)
+                           | [maj_s] <- split '.' rest_no_eq,
+                             Just maj <- parseInt maj_s -> Right (f maj 0, args)
+                           | otherwise -> Right (f 1 0, args)
+
 
 findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
 findArg spec arg =
@@ -219,19 +227,20 @@ findArg spec arg =
         (one:_) -> Just one
 
 arg_ok :: OptKind t -> [Char] -> String -> Bool
-arg_ok (NoArg           _)  rest _   = null rest
-arg_ok (HasArg          _)  _    _   = True
-arg_ok (SepArg          _)  rest _   = null rest
-arg_ok (Prefix          _)  rest _   = notNull rest
-arg_ok (PrefixPred p    _)  rest _   = notNull rest && p (dropEq rest)
-arg_ok (OptIntSuffix    _)  _    _   = True
-arg_ok (IntSuffix       _)  _    _   = True
-arg_ok (FloatSuffix     _)  _    _   = True
-arg_ok (OptPrefix       _)  _    _   = True
-arg_ok (PassFlag        _)  rest _   = null rest
-arg_ok (AnySuffix       _)  _    _   = True
-arg_ok (AnySuffixPred p _)  _    arg = p arg
-arg_ok (VersionSuffix   _)  _    _   = True
+arg_ok (NoArg            _)  rest _   = null rest
+arg_ok (HasArg           _)  _    _   = True
+arg_ok (SepArg           _)  rest _   = null rest
+arg_ok (Prefix           _)  rest _   = notNull rest
+arg_ok (PrefixPred p     _)  rest _   = notNull rest && p (dropEq rest)
+arg_ok (OptIntSuffix     _)  _    _   = True
+arg_ok (IntSuffix        _)  _    _   = True
+arg_ok (FloatSuffix      _)  _    _   = True
+arg_ok (OptPrefix        _)  _    _   = True
+arg_ok (PassFlag         _)  rest _   = null rest
+arg_ok (AnySuffix        _)  _    _   = True
+arg_ok (AnySuffixPred p  _)  _    arg = p arg
+arg_ok (VersionSuffix    _)  _    _   = True
+arg_ok (OptVersionSuffix _)  _    _   = True
 
 -- | Parse an Int
 --
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index fdae0fa..a4d826b 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1458,7 +1458,8 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
                 ++ [SysTools.Option tbaa]
                 ++ map SysTools.Option fpOpts
                 ++ map SysTools.Option abiOpts
-                ++ map SysTools.Option sseOpts)
+                ++ map SysTools.Option sseOpts
+                ++ map SysTools.Option avxOpts)
 
     return (RealPhase next_phase, output_fn)
   where
@@ -1491,6 +1492,10 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
                 | isSse2Enabled dflags   = ["-mattr=+sse2"]
                 | otherwise              = []
 
+        avxOpts | isAvxEnabled dflags    = ["-mattr=+avx"]
+                | isAvx2Enabled dflags   = ["-mattr=+avx2"]
+                | otherwise              = []
+
 -----------------------------------------------------------------------------
 -- LlvmMangle phase
 
@@ -2061,6 +2066,12 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
           [ "-D__SSE2__=1" | sse2 || sse4_2 ] ++
           [ "-D__SSE4_2__=1" | sse4_2 ]
 
+    let avx = isAvxEnabled dflags
+        avx2 = isAvx2Enabled dflags
+        avx_defs =
+          [ "-D__AVX__=1" | avx || avx2 ] ++
+          [ "-D__AVX2__=1" | avx2 ]
+
     backend_defs <- getBackendDefs dflags
 
     cpp_prog       (   map SysTools.Option verbFlags
@@ -2071,6 +2082,7 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
                     ++ map SysTools.Option hscpp_opts
                     ++ map SysTools.Option cc_opts
                     ++ map SysTools.Option sse_defs
+                    ++ map SysTools.Option avx_defs
                     ++ [ SysTools.Option     "-x"
                        , SysTools.Option     "c"
                        , SysTools.Option     input_fn
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 060619d..3632ba1 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -124,9 +124,12 @@ module DynFlags (
 
         unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
 
-        -- * SSE
+        -- * SSE and AVX
         isSse2Enabled,
         isSse4_2Enabled,
+
+        isAvxEnabled,
+        isAvx2Enabled
   ) where
 
 #include "HsVersions.h"
@@ -724,7 +727,8 @@ data DynFlags = DynFlags {
   nextWrapperNum        :: IORef Int,
 
   -- | Machine dependant flags (-m<blah> stuff)
-  sseVersion            :: Maybe (Int, Int)  -- (major, minor)
+  sseVersion            :: Maybe (Int, Int), -- (major, minor)
+  avxVersion            :: Maybe (Int, Int)  -- (major, minor)
  }
 
 class HasDynFlags m where
@@ -1327,7 +1331,8 @@ defaultDynFlags mySettings =
         llvmVersion = panic "defaultDynFlags: No llvmVersion",
         interactivePrint = Nothing,
         nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
-        sseVersion = Nothing
+        sseVersion = Nothing,
+        avxVersion = Nothing
       }
 
 defaultWays :: Settings -> [Way]
@@ -2194,6 +2199,7 @@ dynamic_flags = [
   , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
   , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
   , Flag "msse"         (versionSuffix (\maj min d -> d{ sseVersion = Just (maj, min) }))
+  , Flag "mavx"         (optVersionSuffix (\maj min d -> d{ avxVersion = Just (maj, min) }))
 
      ------ Warning opts -------------------------------------------------
   , Flag "W"      (NoArg (mapM_ setWarningFlag minusWOpts))
@@ -2962,6 +2968,9 @@ optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
 versionSuffix :: (Int -> Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
 versionSuffix fn = VersionSuffix (\maj min -> upd (fn maj min))
 
+optVersionSuffix :: (Int -> Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
+optVersionSuffix fn = OptVersionSuffix (\maj min -> upd (fn maj min))
+
 setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
 setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
 
@@ -3443,7 +3452,7 @@ setUnsafeGlobalDynFlags :: DynFlags -> IO ()
 setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
 
 -- -----------------------------------------------------------------------------
--- SSE
+-- SSE and AVX
 
 -- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to
 -- check if SSE is enabled, we might have x86-64 imply the -msse2
@@ -3462,3 +3471,13 @@ isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
 
 isSse4_2Enabled :: DynFlags -> Bool
 isSse4_2Enabled dflags = sseVersion dflags >= Just (4,2)
+
+isAvxEnabled :: DynFlags -> Bool
+isAvxEnabled dflags = case platformArch (targetPlatform dflags) of
+    ArchX86_64 -> avxVersion dflags >= Just (1,0)
+    _          -> False
+
+isAvx2Enabled :: DynFlags -> Bool
+isAvx2Enabled dflags = case platformArch (targetPlatform dflags) of
+    ArchX86_64 -> avxVersion dflags >= Just (2,0)
+    _          -> False





More information about the ghc-commits mailing list