[MLton-commit] r7082

adam at mlton.org adam at mlton.org
Tue Apr 14 18:16:54 PDT 2009


Change IEEEReal.setRoundingMode to throw exception if setting the mode fails

As per
http://www.standardml.org/Basis/ieee-float.html#SIG:IEEE_REAL.setRoundingMode:VAL
IEEEReal.setRoundingMode should probably throw an exception if
the hardware doesn't support it. This is common on ARM, which is only
guaranteed to support the default mode.

This throws PosixError.inval, as suggested by
http://mlton.org/pipermail/mlton/2009-April/030535.html

The MLB file had to be reordered a bit to define the exception
to be raised. ./bin/regression shows no regressions on x86_64.
----------------------------------------------------------------------

U   mlton/trunk/basis-library/build/sources.mlb
U   mlton/trunk/basis-library/primitive/basis-ffi.sml
U   mlton/trunk/basis-library/real/IEEE-real.sml
U   mlton/trunk/runtime/basis/Real/IEEEReal.c
U   mlton/trunk/runtime/basis-ffi.h
U   mlton/trunk/runtime/gen/basis-ffi.def
U   mlton/trunk/runtime/gen/basis-ffi.h
U   mlton/trunk/runtime/gen/basis-ffi.sml

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/build/sources.mlb
===================================================================
--- mlton/trunk/basis-library/build/sources.mlb	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/basis-library/build/sources.mlb	2009-04-15 01:16:52 UTC (rev 7082)
@@ -181,6 +181,20 @@
    ../util/CUtil.sig
    ../util/CUtil.sml
 
+   ../util/unique-id.sig
+   ../util/unique-id.fun
+   ../util/cleaner.sig
+   ../util/cleaner.sml
+   ../util/abs-rep.sig
+   ../util/abs-rep.fun
+
+   ../config/c/sys-types.sml
+   ../system/pre-os.sml
+   ../posix/pre-posix.sml
+
+   ../posix/error.sig
+   ../posix/error.sml
+
    ../real/IEEE-real.sig
    ../real/IEEE-real.sml
    ../real/math.sig
@@ -208,20 +222,6 @@
       ../config/c/sys-word.sml
    end end
 
-   ../util/unique-id.sig
-   ../util/unique-id.fun
-   ../util/cleaner.sig
-   ../util/cleaner.sml
-   ../util/abs-rep.sig
-   ../util/abs-rep.fun
-
-   ../config/c/sys-types.sml
-   ../system/pre-os.sml
-   ../posix/pre-posix.sml
-
-   ../posix/error.sig
-   ../posix/error.sml
-
    ../system/time.sig
    ../system/time.sml
    ../system/date.sig

Modified: mlton/trunk/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/trunk/basis-library/primitive/basis-ffi.sml	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/basis-library/primitive/basis-ffi.sml	2009-04-15 01:16:52 UTC (rev 7082)
@@ -61,7 +61,7 @@
 val FE_TOWARDZERO = _const "IEEEReal_RoundingMode_FE_TOWARDZERO" : C_Int.t;
 val FE_UPWARD = _const "IEEEReal_RoundingMode_FE_UPWARD" : C_Int.t;
 end
-val setRoundingMode = _import "IEEEReal_setRoundingMode" private : C_Int.t -> unit;
+val setRoundingMode = _import "IEEEReal_setRoundingMode" private : C_Int.t -> C_Int.t;
 end
 structure MinGW = 
 struct

Modified: mlton/trunk/basis-library/real/IEEE-real.sml
===================================================================
--- mlton/trunk/basis-library/real/IEEE-real.sml	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/basis-library/real/IEEE-real.sml	2009-04-15 01:16:52 UTC (rev 7082)
@@ -86,7 +86,12 @@
 
       datatype rounding_mode = datatype RoundingMode.t
 
-      val setRoundingMode = Prim.setRoundingMode o RoundingMode.toInt
+      fun setRoundingMode (m: rounding_mode): unit =
+          if Prim.setRoundingMode (RoundingMode.toInt m) = 0
+             then ()
+          else
+             raise PosixError.raiseSys PosixError.inval
+
       val getRoundingMode = RoundingMode.fromInt o Prim.getRoundingMode
 
       fun withRoundingMode (m: rounding_mode, th: unit -> 'a): 'a =

Modified: mlton/trunk/runtime/basis/Real/IEEEReal.c
===================================================================
--- mlton/trunk/runtime/basis/Real/IEEEReal.c	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/runtime/basis/Real/IEEEReal.c	2009-04-15 01:16:52 UTC (rev 7082)
@@ -75,7 +75,7 @@
   return fegetround ();
 }
 
-void IEEEReal_setRoundingMode (C_Int_t m) {
+C_Int_t IEEEReal_setRoundingMode (C_Int_t m) {
   assert (m != IEEEReal_RoundingMode_FE_NOSUPPORT);
-  fesetround (m);
+  return fesetround (m);
 }

Modified: mlton/trunk/runtime/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/basis-ffi.h	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/runtime/basis-ffi.h	2009-04-15 01:16:52 UTC (rev 7082)
@@ -43,7 +43,7 @@
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_TONEAREST;
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_TOWARDZERO;
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
-PRIVATE void IEEEReal_setRoundingMode(C_Int_t);
+PRIVATE C_Int_t IEEEReal_setRoundingMode(C_Int_t);
 PRIVATE C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
 PRIVATE __attribute__((noreturn)) void MLton_bug(String8_t);
 PRIVATE extern const C_Int_t MLton_Itimer_PROF;

Modified: mlton/trunk/runtime/gen/basis-ffi.def
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.def	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/runtime/gen/basis-ffi.def	2009-04-15 01:16:52 UTC (rev 7082)
@@ -36,7 +36,7 @@
 IEEEReal.RoundingMode.FE_TOWARDZERO = _const : C_Int.t
 IEEEReal.RoundingMode.FE_UPWARD = _const : C_Int.t
 IEEEReal.getRoundingMode = _import PRIVATE : unit -> C_Int.t
-IEEEReal.setRoundingMode = _import PRIVATE : C_Int.t -> unit
+IEEEReal.setRoundingMode = _import PRIVATE : C_Int.t -> C_Int.t
 MLton.bug = _import PRIVATE __attribute__((noreturn)) : String8.t -> unit
 MLton.Itimer.PROF = _const : C_Int.t
 MLton.Itimer.REAL = _const : C_Int.t

Modified: mlton/trunk/runtime/gen/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.h	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/runtime/gen/basis-ffi.h	2009-04-15 01:16:52 UTC (rev 7082)
@@ -43,7 +43,7 @@
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_TONEAREST;
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_TOWARDZERO;
 PRIVATE extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
-PRIVATE void IEEEReal_setRoundingMode(C_Int_t);
+PRIVATE C_Int_t IEEEReal_setRoundingMode(C_Int_t);
 PRIVATE C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
 PRIVATE __attribute__((noreturn)) void MLton_bug(String8_t);
 PRIVATE extern const C_Int_t MLton_Itimer_PROF;

Modified: mlton/trunk/runtime/gen/basis-ffi.sml
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.sml	2009-04-15 01:15:44 UTC (rev 7081)
+++ mlton/trunk/runtime/gen/basis-ffi.sml	2009-04-15 01:16:52 UTC (rev 7082)
@@ -61,7 +61,7 @@
 val FE_TOWARDZERO = _const "IEEEReal_RoundingMode_FE_TOWARDZERO" : C_Int.t;
 val FE_UPWARD = _const "IEEEReal_RoundingMode_FE_UPWARD" : C_Int.t;
 end
-val setRoundingMode = _import "IEEEReal_setRoundingMode" private : C_Int.t -> unit;
+val setRoundingMode = _import "IEEEReal_setRoundingMode" private : C_Int.t -> C_Int.t;
 end
 structure MinGW = 
 struct




More information about the MLton-commit mailing list