[commit: ghc] master: Clean up -msse flag handling (b7189de)

Johan Tibell johan.tibell at gmail.com
Fri Jan 18 00:11:43 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b7189de72d5967caf5e848ccf4cce3bed2064f5b

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

commit b7189de72d5967caf5e848ccf4cce3bed2064f5b
Author: Johan Tibell <johan.tibell at gmail.com>
Date:   Thu Jan 17 11:11:49 2013 -0800

    Clean up -msse flag handling
    
    We know have a single flag that takes a version number, instead of one
    flag per SSE version.

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

 compiler/main/CmdLineParser.hs |   10 +++++++++
 compiler/main/DynFlags.hs      |   43 ++++++++++++++++++---------------------
 2 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index b6618af..252a376 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -53,6 +53,8 @@ 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
 
 
 --------------------------------------------------------
@@ -196,6 +198,13 @@ 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)
+                        | otherwise -> Left ("malformed version argument in " ++ dash_arg)
+
 
 findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
 findArg spec arg =
@@ -222,6 +231,7 @@ 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 f3e5df3..bead9ad 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -322,8 +322,6 @@ data GeneralFlag
    | Opt_EmitExternalCore
    | Opt_SharedImplib
    | Opt_BuildingCabalPackage
-   | Opt_SSE2
-   | Opt_SSE4_2
    | Opt_IgnoreDotGhci
    | Opt_GhciSandbox
    | Opt_GhciHistory
@@ -711,7 +709,10 @@ data DynFlags = DynFlags {
 
   llvmVersion           :: IORef Int,
 
-  nextWrapperNum        :: IORef Int
+  nextWrapperNum        :: IORef Int,
+
+  -- | Machine dependant flags (-m<blah> stuff)
+  sseVersion            :: Maybe (Int, Int)  -- (major, minor)
  }
 
 class HasDynFlags m where
@@ -1305,7 +1306,8 @@ defaultDynFlags mySettings =
         profAuto = NoProfAuto,
         llvmVersion = panic "defaultDynFlags: No llvmVersion",
         interactivePrint = Nothing,
-        nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum"
+        nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
+        sseVersion = Nothing
       }
 
 defaultWays :: Settings -> [Way]
@@ -2181,13 +2183,7 @@ dynamic_flags = [
   , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
   , 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 "msse2"        (NoArg (setGeneralFlag Opt_SSE2))
-  , Flag "msse4.2"      (NoArg (setGeneralFlag Opt_SSE4_2))
-    -- at some point we should probably have a single SSE flag that
-    -- contains the SSE version, instead of having a different flag
-    -- per version. That would make it easier to e.g. check if SSE2 is
-    -- enabled as you wouldn't have to check if either Opt_SSE2 or
-    -- Opt_SSE4_2 is set (as the latter implies the former).
+  , Flag "msse"         (versionSuffix (\maj min d -> d{ sseVersion = Just (maj, min) }))
 
      ------ Warning opts -------------------------------------------------
   , Flag "W"      (NoArg (mapM_ setWarningFlag minusWOpts))
@@ -2944,6 +2940,9 @@ 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)
 
@@ -3412,17 +3411,15 @@ makeDynFlagsConsistent dflags
 -- SSE
 
 isSse2Enabled :: DynFlags -> Bool
-isSse2Enabled dflags = isSse4_2Enabled dflags || isSse2Enabled'
-  where
-    isSse2Enabled' = case platformArch (targetPlatform dflags) of
-        ArchX86_64 -> -- SSE2 is fixed on for x86_64.  It would be
-                      -- possible to make it optional, but we'd need to
-                      -- fix at least the foreign call code where the
-                      -- calling convention specifies the use of xmm regs,
-                      -- and possibly other places.
-                      True
-        ArchX86    -> gopt Opt_SSE2 dflags
-        _          -> False
+isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
+    ArchX86_64 -> -- SSE2 is fixed on for x86_64.  It would be
+                  -- possible to make it optional, but we'd need to
+                  -- fix at least the foreign call code where the
+                  -- calling convention specifies the use of xmm regs,
+                  -- and possibly other places.
+                  True
+    ArchX86    -> sseVersion dflags >= Just (2,0)
+    _          -> False
 
 isSse4_2Enabled :: DynFlags -> Bool
-isSse4_2Enabled dflags = gopt Opt_SSE4_2 dflags
+isSse4_2Enabled dflags = sseVersion dflags >= Just (4,2)





More information about the ghc-commits mailing list