From d440eb43cc0c6e6b12e6f5824a1ae3831e339696 Mon Sep 17 00:00:00 2001
From: Nick Bowler <nbowler@draconx.ca>
Date: Wed, 13 Oct 2010 18:38:48 -0400
Subject: [PATCH] fenv: Separate exception testing from environment
 save/restore.

---
 Data/Floating/Environment.hs | 20 ++++++++++++++------
 cfloat.c                     | 19 ++++++++-----------
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/Data/Floating/Environment.hs b/Data/Floating/Environment.hs
index e1af2b3..c90ee11 100644
--- a/Data/Floating/Environment.hs
+++ b/Data/Floating/Environment.hs
@@ -53,7 +53,7 @@ module Data.Floating.Environment (
     -- floating point environment will affect all floating point computations
     -- that have not yet been evaluated.
     unsafeSaveEnvironment, unsafeRestoreEnvironment,
-    unsafeRaiseExceptions,
+    unsafeTestExceptions,  unsafeRaiseExceptions,
     unsafeSetRoundingMode, getRoundingMode
 ) where
 
@@ -77,10 +77,12 @@ foreign import ccall unsafe "get_roundmode"
 
 foreign import ccall unsafe "fegetenv"
     c_fegetenv :: Ptr FEnvState -> IO CInt
+foreign import ccall unsafe "fesetenv"
+    c_fesetenv :: Ptr FEnvState -> IO CInt
 foreign import ccall unsafe "feholdexcept"
     c_feholdexcept :: Ptr FEnvState -> IO CInt
-foreign import ccall unsafe "fenv_restore"
-    fenv_restore :: Ptr FEnvState -> Ptr CUInt -> IO CInt
+foreign import ccall unsafe "fenv_test_excepts"
+    fenv_test_excepts :: IO CUInt
 foreign import ccall unsafe "fenv_raise_excepts"
     fenv_raise_excepts :: CUInt -> IO CInt
 
@@ -205,10 +207,16 @@ unsafeSaveEnvironment reset = alloca $ \env -> do
 -- list of floating point exceptions that occurred prior to restoring the
 -- environment.
 unsafeRestoreEnvironment :: FEnvState -> IO [FloatException]
-unsafeRestoreEnvironment (FEnvState fp) = alloca $ \pe -> do
-    rc <- withForeignPtr fp (flip fenv_restore pe)
+unsafeRestoreEnvironment (FEnvState fp) = do
+    excepts <- unsafeTestExceptions
+    rc <- withForeignPtr fp c_fesetenv
     unless (rc == 0) $ fail "Error restoring floating point environment."
-    rawExcepts <- peek pe
+    return excepts
+
+-- | Return the currently raised floating point exceptions as a list.
+unsafeTestExceptions :: IO [FloatException]
+unsafeTestExceptions = do
+    rawExcepts <- fenv_test_excepts
     return $! filter (testBit rawExcepts . fromEnum) [minBound..maxBound]
 
 -- | Raises the given floating point exceptions.
diff --git a/cfloat.c b/cfloat.c
index 06048d7..58af4b9 100644
--- a/cfloat.c
+++ b/cfloat.c
@@ -146,31 +146,28 @@ int get_roundmode(void)
 	}
 }
 
-int fenv_restore(fenv_t *env, unsigned *excepts)
+unsigned fenv_test_excepts(void)
 {
 	int raw_excepts = fetestexcept(FE_ALL_EXCEPT);
-
-	if (excepts) {
-		*excepts = 0;
+	unsigned excepts = 0;
 
 #ifdef FE_DIVBYZERO
-		if (raw_excepts & FE_DIVBYZERO) *excepts |= 0x01;
+	if (raw_excepts & FE_DIVBYZERO) excepts |= 0x01;
 #endif
 #ifdef FE_INEXACT
-		if (raw_excepts & FE_INEXACT)   *excepts |= 0x02;
+	if (raw_excepts & FE_INEXACT)   excepts |= 0x02;
 #endif
 #ifdef FE_INVALID
-		if (raw_excepts & FE_INVALID)   *excepts |= 0x04;
+	if (raw_excepts & FE_INVALID)   excepts |= 0x04;
 #endif
 #ifdef FE_OVERFLOW
-		if (raw_excepts & FE_OVERFLOW)  *excepts |= 0x08;
+	if (raw_excepts & FE_OVERFLOW)  excepts |= 0x08;
 #endif
 #ifdef FE_UNDERFLOW
-		if (raw_excepts & FE_UNDERFLOW) *excepts |= 0x10;
+	if (raw_excepts & FE_UNDERFLOW) excepts |= 0x10;
 #endif
-	}
 
-	return fesetenv(env);
+	return excepts;
 }
 
 int fenv_raise_excepts(unsigned excepts)
-- 
2.11.4.GIT