[commit: ghc] master: msse flag handling: fix trac issue #9777 (da98592)

git at git.haskell.org git at git.haskell.org
Sat Dec 6 00:35:55 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/da98592026154264d529e2e235ff396dfd6e7c51/ghc

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

commit da98592026154264d529e2e235ff396dfd6e7c51
Author: Denis Redozubov <denis.redozubov at gmail.com>
Date:   Fri Dec 5 14:55:19 2014 -0600

    msse flag handling: fix trac issue #9777
    
    Summary:
    Signed-off-by: Denis Redozubov <denis.redozubov at gmail.com>
    
    SSE version handled by different dynamic flags
    
    Signed-off-by: Denis Redozubov <denis.redozubov at gmail.com>
    
    Test Plan: validate
    
    Reviewers: austin, jstolarek
    
    Reviewed By: austin, jstolarek
    
    Subscribers: kolmodin, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D504
    
    GHC Trac Issues: #9777


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

da98592026154264d529e2e235ff396dfd6e7c51
 compiler/main/CmdLineParser.hs | 12 ------------
 compiler/main/DynFlags.hs      | 25 ++++++++++++++++---------
 2 files changed, 16 insertions(+), 21 deletions(-)

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 561765e..94c786b 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -79,8 +79,6 @@ data OptKind m                             -- Suppose the flag is -f
     | AnySuffix (String -> EwM m ())       -- -f or -farg; pass entire "-farg" to fn
     | PrefixPred    (String -> Bool) (String -> EwM m ())
     | AnySuffixPred (String -> Bool) (String -> EwM m ())
-    | VersionSuffix (Int -> Int -> EwM m ())
-      -- -f or -f=maj.min; pass major and minor version to fn
 
 
 --------------------------------------------------------
@@ -239,15 +237,6 @@ processOneArg opt_kind rest arg args
         AnySuffix f       -> Right (f dash_arg, args)
         AnySuffixPred _ f -> Right (f dash_arg, args)
 
-        VersionSuffix 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)
-                        | null rest_no_eq -> Right (f 1 0, args)
-                        | otherwise -> Left ("malformed version argument in " ++ dash_arg)
-
-
 findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
 findArg spec arg =
     case sortBy (compare `on` (length . fst)) -- prefer longest matching flag
@@ -273,7 +262,6 @@ 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
 
 -- | Parse an Int
 --
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1bac9aa..64a81fc 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -845,7 +845,7 @@ data DynFlags = DynFlags {
   nextWrapperNum        :: IORef (ModuleEnv Int),
 
   -- | Machine dependant flags (-m<blah> stuff)
-  sseVersion            :: Maybe (Int, Int),  -- (major, minor)
+  sseVersion            :: Maybe SseVersion,
   avx                   :: Bool,
   avx2                  :: Bool,
   avx512cd              :: Bool, -- Enable AVX-512 Conflict Detection Instructions.
@@ -2503,8 +2503,11 @@ dynamic_flags = [
 
         ------ Machine dependant (-m<blah>) stuff ---------------------------
 
-  , defGhcFlag "msse"
-      (versionSuffix (\maj min d -> d{ sseVersion = Just (maj, min) }))
+  , defGhcFlag "msse"         (noArg (\d -> d{ sseVersion = Just SSE1 }))
+  , defGhcFlag "msse2"        (noArg (\d -> d{ sseVersion = Just SSE2 }))
+  , defGhcFlag "msse3"        (noArg (\d -> d{ sseVersion = Just SSE3 }))
+  , defGhcFlag "msse4"        (noArg (\d -> d{ sseVersion = Just SSE4 }))
+  , defGhcFlag "msse4.2"      (noArg (\d -> d{ sseVersion = Just SSE42 }))
   , defGhcFlag "mavx"         (noArg (\d -> d{ avx = True }))
   , defGhcFlag "mavx2"        (noArg (\d -> d{ avx2 = True }))
   , defGhcFlag "mavx512cd"    (noArg (\d -> d{ avx512cd = True }))
@@ -3495,9 +3498,6 @@ optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
               -> OptKind (CmdLineP DynFlags)
 optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
 
-versionSuffix :: (Int -> Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
-versionSuffix fn = VersionSuffix (\maj min -> upd (fn maj min))
-
 setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
 setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
 
@@ -4036,10 +4036,17 @@ 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
-    ArchX86    -> sseVersion dflags >= Just (1,0)
+    ArchX86    -> sseVersion dflags >= Just SSE1
     _          -> False
 
 isSse2Enabled :: DynFlags -> Bool
@@ -4050,11 +4057,11 @@ isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
                   -- calling convention specifies the use of xmm regs,
                   -- and possibly other places.
                   True
-    ArchX86    -> sseVersion dflags >= Just (2,0)
+    ArchX86    -> sseVersion dflags >= Just SSE2
     _          -> False
 
 isSse4_2Enabled :: DynFlags -> Bool
-isSse4_2Enabled dflags = sseVersion dflags >= Just (4,2)
+isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
 
 isAvxEnabled :: DynFlags -> Bool
 isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags



More information about the ghc-commits mailing list