[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