fenv: Separate exception testing from environment save/restore.
authorNick Bowler <nbowler@draconx.ca>
Wed, 13 Oct 2010 22:38:48 +0000 (13 18:38 -0400)
committerNick Bowler <nbowler@draconx.ca>
Wed, 13 Oct 2010 22:38:48 +0000 (13 18:38 -0400)
Data/Floating/Environment.hs
cfloat.c

index e1af2b3..c90ee11 100644 (file)
@@ -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.
index 06048d7..58af4b9 100644 (file)
--- 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)