[MLton-devel] cvs commit: Real32 and Real64 improvements
Stephen Weeks
sweeks@users.sourceforge.net
Wed, 03 Sep 2003 15:38:01 -0700
sweeks 03/09/03 15:38:01
Modified: basis-library/misc primitive.sml
basis-library/real real.fun real.sig
doc changelog
regression real.sml
runtime/basis/Real signBit.c
Log:
A lot of work to get the real.sml regression to produce the same
output on all platforms. This was achieved by a combination of
* bug fixes
* using the C library instead of X86 instructions in some cases
* workarounds of C library differences
* turning off non-compliant tests
Fixed bug in Real.signBit, which was just plain wrong on Sparc due to
endianness.
In basis-library/misc/primitive.sml, I added a new constant,
useMathLibForTrig, which governs whether
Real{32,64}.Math.{atan2,cos,sin,tan} are implemented by _prim or
_import. For now, I have it set to true, which causes them to all use
_import. I did this because I was seeing differences between
compiling real.sml -native true and -native false on Linux. I figured
it was safer and easier to just always use the math library.
Added platform specific code to basis-library/real/real.fun to work
around various portability problems. For example, modf isn't quite
right on FreeBSD and SunOS, the exp instruction isn't right on X86.
Also, pow is messed up in some ways on most (all?) of the platforms.
So, I wrote a version of pow that does all the checking for
exceptional cases before calling the C library pow.
Unfortunately even with all these fixes, there are still problems with
some of the tests. So, I've added various exceptional cases to the
real.sml regression to avoid printing anything in those cases. Most
of the exceptional cases are trigonometric functions applied to large
values, e.g. cos maxFinite, but there are some other cases as well. I
turned of rem, atan2, and pow entirely because of the differences.
On SunOS, I couldn't figure out how to get at nextafterf, so I don't
know how to implement Real32.nextAfter. So, I turned off that
regression as well.
Jesper, you might want to have a look to see how the latest real.sml
regression works on NetBSD. I suspect there will be a few problems.
Hopefully a couple of patches to basis-library/real/real.fun will do
it (especially look for the existing FreeBSD patches).
Revision Changes Path
1.75 +34 -14 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- primitive.sml 29 Aug 2003 23:06:45 -0000 1.74
+++ primitive.sml 3 Sep 2003 22:37:50 -0000 1.75
@@ -757,6 +757,8 @@
_import "Ptrace_ptrace4": int * pid * word * word ref -> int;
end
+ val useMathLibForTrig = true
+
structure Real64 =
struct
type real = Real64.real
@@ -768,8 +770,14 @@
val acos = _prim "Real64_Math_acos": real -> real;
val asin = _prim "Real64_Math_asin": real -> real;
val atan = _prim "Real64_Math_atan": real -> real;
- val atan2 = _prim "Real64_Math_atan2": real * real -> real;
- val cos = _prim "Real64_Math_cos": real -> real;
+ val atan2 =
+ if useMathLibForTrig
+ then _import "atan2": real * real -> real;
+ else _prim "Real64_Math_atan2": real * real -> real;
+ val cos =
+ if useMathLibForTrig
+ then _import "cos": real -> real;
+ else _prim "Real64_Math_cos": real -> real;
val cosh = _import "cosh": real -> real;
val e = _import "Real64_Math_e": real;
val exp = _prim "Real64_Math_exp": real -> real;
@@ -777,10 +785,16 @@
val log10 = _prim "Real64_Math_log10": real -> real;
val pi = _import "Real64_Math_pi": real;
val pow = _import "pow": real * real -> real;
- val sin = _prim "Real64_Math_sin": real -> real;
+ val sin =
+ if useMathLibForTrig
+ then _import "sin": real -> real;
+ else _prim "Real64_Math_sin": real -> real;
val sinh = _import "sinh": real -> real;
val sqrt = _prim "Real64_Math_sqrt": real -> real;
- val tan = _prim "Real64_Math_tan": real -> real;
+ val tan =
+ if useMathLibForTrig
+ then _import "tan": real -> real;
+ else _prim "Real64_Math_tan": real -> real;
val tanh = _import "tanh": real -> real;
end
@@ -798,7 +812,6 @@
val ?= = _prim "Real64_qequal": real * real -> bool;
val abs = _prim "Real64_abs": real -> real;
val class = _import "Real64_class": real -> int;
- val copySign = _import "copysign": real * real -> real;
val frexp = _import "Real64_frexp": real * int ref -> real;
val gdtoa =
_import "Real64_gdtoa": real * int * int * int ref -> cstring;
@@ -851,8 +864,14 @@
val acos = _prim "Real32_Math_acos": real -> real;
val asin = _prim "Real32_Math_asin": real -> real;
val atan = _prim "Real32_Math_atan": real -> real;
- val atan2 = _prim "Real32_Math_atan2": real * real -> real;
- val cos = _prim "Real32_Math_cos": real -> real;
+ val atan2 =
+ if useMathLibForTrig
+ then binary Real64.Math.atan2
+ else _prim "Real32_Math_atan2": real * real -> real;
+ val cos =
+ if useMathLibForTrig
+ then unary Real64.Math.cos
+ else _prim "Real32_Math_cos": real -> real;
val cosh = unary Real64.Math.cosh
val e = _import "Real32_Math_e": real;
val exp = _prim "Real32_Math_exp": real -> real;
@@ -860,10 +879,16 @@
val log10 = _prim "Real32_Math_log10": real -> real;
val pi = _import "Real32_Math_pi": real;
val pow = binary Real64.Math.pow
- val sin = _prim "Real32_Math_sin": real -> real;
+ val sin =
+ if useMathLibForTrig
+ then unary Real64.Math.sin
+ else _prim "Real32_Math_sin": real -> real;
val sinh = unary Real64.Math.sinh
val sqrt = _prim "Real32_Math_sqrt": real -> real;
- val tan = _prim "Real32_Math_tan": real -> real;
+ val tan =
+ if useMathLibForTrig
+ then unary Real64.Math.tan
+ else _prim "Real32_Math_tan": real -> real;
val tanh = unary Real64.Math.tanh
end
@@ -881,7 +906,6 @@
val ?= = _prim "Real32_qequal": real * real -> bool;
val abs = _prim "Real32_abs": real -> real;
val class = _import "Real32_class": real -> int;
- val copySign = _import "copysignf": real * real -> real;
fun frexp (r: real, ir: int ref): real =
fromLarge (Real64.frexp (toLarge r, ir))
val gdtoa =
@@ -896,10 +920,6 @@
val minPos = _import "Real32_minPos": real;
val modf = _import "Real32_modf": real * real ref -> real;
val nextAfter = _import "nextafterf": real * real -> real;
- val round =
- if MLton.native
- then _prim "Real32_round": real -> real;
- else _import "rintf": real -> real;
val signBit = _import "Real32_signBit": real -> bool;
val strto = _import "Real32_strto": nullString -> real;
val toInt = _prim "Real32_toInt32": real -> int;
1.7 +147 -46 mlton/basis-library/real/real.fun
Index: real.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- real.fun 29 Aug 2003 23:07:40 -0000 1.6
+++ real.fun 3 Sep 2003 22:37:52 -0000 1.7
@@ -1,11 +1,12 @@
functor Real (R: PRE_REAL): REAL =
struct
+ structure MLton = Primitive.MLton
structure Prim = R
local
open IEEEReal
in
datatype z = datatype float_class
- datatype z = datatype rounding_mode
+ datatype rounding_mode = datatype rounding_mode
end
infix 4 == != ?=
type real = Prim.real
@@ -16,7 +17,6 @@
val *+ = *+
val *- = *-
val abs = abs
- val copySign = copySign
val fromInt = fromInt
val maxFinite = maxFinite
val minNormalPos = minNormalPos
@@ -44,50 +44,16 @@
val toLarge = Prim.toLarge
val fromLarge = Prim.fromLarge
- val zero = fromLarge IEEEReal.TO_NEAREST 0.0
- val one = fromLarge IEEEReal.TO_NEAREST 1.0
- val two = fromLarge IEEEReal.TO_NEAREST 2.0
+ val zero = fromLarge TO_NEAREST 0.0
+ val one = fromLarge TO_NEAREST 1.0
+ val negOne = ~ one
+ val two = fromLarge TO_NEAREST 2.0
val half = one / two
val posInf = one / zero
val negInf = ~one / zero
val nan = posInf + negInf
-
- structure Math =
- struct
- open Prim.Math
-
- structure MLton = Primitive.MLton
- (* Patches for Cygwin and SunOS, whose math libraries do not handle
- * out-of-range args.
- *)
- val (acos, asin, ln, log10) =
- if not MLton.native
- andalso let
- open MLton.Platform.OS
- in
- case host of
- Cygwin => true
- | SunOS => true
- | _ => false
- end
- then
- let
- fun patch f x =
- if x < ~one orelse x > one
- then nan
- else f x
- val acos = patch acos
- val asin = patch asin
- fun patch f x = if x < zero then nan else f x
- val ln = patch ln
- val log10 = patch log10
- in
- (acos, asin, ln, log10)
- end
- else (acos, asin, ln, log10)
- end
(* See runtime/basis/Real.c for the integers returned by class. *)
fun class x =
@@ -129,6 +95,11 @@
fun sameSign (x, y) = Prim.signBit x = Prim.signBit y
+ fun copySign (x, y) =
+ if sameSign (x, y)
+ then x
+ else ~ x
+
local
datatype z = datatype General.order
in
@@ -173,9 +144,28 @@
fun split x =
let
val frac = Prim.modf (x, int)
+ val whole = !int
+ (* FreeBSD and SunOS don't always get sign of zero right. *)
+ val (frac, whole) =
+ if let
+ open MLton.Platform.OS
+ in
+ host = FreeBSD orelse host = SunOS
+ end
+ then
+ let
+ fun fix y =
+ if class y = ZERO
+ andalso not (sameSign (x, y))
+ then ~ y
+ else y
+ in
+ (fix frac, fix whole)
+ end
+ else (frac, whole)
in
{frac = frac,
- whole = ! int}
+ whole = whole}
end
end
@@ -190,10 +180,15 @@
val maxInt = fromInt Int.maxInt'
val minInt = fromInt Int.minInt'
+ fun roundReal (x: real, m: rounding_mode): real =
+ fromLarge
+ TO_NEAREST
+ (IEEEReal.withRoundingMode (m, fn () =>
+ (Primitive.Real64.round (toLarge x))))
+
fun toInt mode x =
let
- fun doit () = IEEEReal.withRoundingMode (mode, fn () =>
- Prim.toInt (Prim.round x))
+ fun doit () = Prim.toInt (roundReal (x, mode))
in
case class x of
NAN => raise Domain
@@ -238,7 +233,7 @@
case class x of
NAN => x
| INF => x
- | _ => IEEEReal.withRoundingMode (mode, fn () => Prim.round x)
+ | _ => roundReal (x, mode)
in
val realFloor = round TO_NEGINF
val realCeil = round TO_POSINF
@@ -556,8 +551,7 @@
IntInf.fromInt (toInt mode x)
handle Overflow =>
let
- val x =
- IEEEReal.withRoundingMode (mode, fn () => Prim.round x)
+ val x = roundReal (x, mode)
val (x, sign) = if x < zero then (~ x, true) else (x, false)
val (digits, exp) = gdtoa (x, Gen, 0)
val digits = C.CS.toString digits
@@ -566,4 +560,111 @@
in
IntInf.* (i, IntInf.pow (10, Int.- (exp, size digits)))
end
+
+ structure Math =
+ struct
+ open Prim.Math
+
+ (* Patches for Cygwin and SunOS, whose math libraries do not handle
+ * out-of-range args.
+ *)
+ val (acos, asin, ln, log10) =
+ if not MLton.native
+ andalso let
+ open MLton.Platform.OS
+ in
+ case host of
+ Cygwin => true
+ | SunOS => true
+ | _ => false
+ end
+ then
+ let
+ fun patch f x =
+ if x < ~one orelse x > one
+ then nan
+ else f x
+ val acos = patch acos
+ val asin = patch asin
+ fun patch f x = if x < zero then nan else f x
+ val ln = patch ln
+ val log10 = patch log10
+ in
+ (acos, asin, ln, log10)
+ end
+ else (acos, asin, ln, log10)
+
+ (* The x86 doesn't get exp right on infs. *)
+ val exp =
+ if MLton.native
+ andalso let open MLton.Platform.Arch in host = X86 end
+ then (fn x =>
+ case class x of
+ INF => if x > zero then posInf else zero
+ | _ => exp x)
+ else exp
+
+ (* The Cygwin math library doesn't get pow right on some exceptional
+ * cases.
+ *
+ * The Linux math library doesn't get pow (x, y) right when x < 0
+ * and y is large (but finite).
+ *
+ * So, we define a safePow function that gives the correct result
+ * on exceptional cases, and only calls pow with x > 0.
+ *)
+ fun isInt (x: real): bool = x == realFloor x
+
+ (* isEven x assumes isInt x. *)
+ fun isEven (x: real): bool = isInt (x / two)
+
+ fun isOddInt x = isInt x andalso not (isEven x)
+
+ fun isNeg x = x < zero
+
+ fun safePow (x, y) =
+ case class y of
+ INF =>
+ if class x = NAN
+ then nan
+ else if x < negOne orelse x > one
+ then if isNeg y then zero else posInf
+ else if negOne < x andalso x < one
+ then if isNeg y then posInf else zero
+ else (* x = 1 orelse x = ~1 *)
+ nan
+ | NAN => nan
+ | ZERO => one
+ | _ =>
+ (case class x of
+ INF =>
+ if isNeg x
+ then if isNeg y
+ then if isOddInt y
+ then ~ zero
+ else zero
+ else if isOddInt y
+ then negInf
+ else posInf
+ else (* x = posInf *)
+ if isNeg y then zero else posInf
+ | NAN => nan
+ | ZERO =>
+ if isNeg y
+ then if isOddInt y
+ then copySign (posInf, x)
+ else posInf
+ else if isOddInt y
+ then x
+ else zero
+ | _ =>
+ if isNeg x
+ then if isInt y
+ then if isEven y
+ then pow (~ x, y)
+ else negOne * pow (~ x, y)
+ else nan
+ else pow (x, y))
+ val pow = safePow
+ end
end
1.10 +0 -2 mlton/basis-library/real/real.sig
Index: real.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- real.sig 26 Jul 2003 17:54:18 -0000 1.9
+++ real.sig 3 Sep 2003 22:37:53 -0000 1.10
@@ -33,7 +33,6 @@
val ~ : real -> real
val abs: real -> real
val class: real -> int
- val copySign: real * real -> real
val frexp: real * int ref -> real
val gdtoa: real * int * int * int ref -> Primitive.cstring
val fromInt: int -> real
@@ -46,7 +45,6 @@
val nextAfter: real * real -> real
val precision: int
val radix: int
- val round: real -> real
val signBit: real -> bool
val strto: nullString -> real
val toInt: real -> int
1.67 +14 -0 mlton/doc/changelog
Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- changelog 29 Aug 2003 00:25:20 -0000 1.66
+++ changelog 3 Sep 2003 22:37:59 -0000 1.67
@@ -1,5 +1,19 @@
Here are the changes since version 20030716.
+* 2003-09-03
+ - Lots of fixes to Real functions.
+ o Real32 is now completely in place, except for Real32.nextAfter
+ on SunOS.
+ o Fixed Real.Math.exp on x86 to return the right value when
+ applied to posInf and negInf.
+ o Changed Real.Math.{cos,sin,tan} on x86 to always use a call to
+ the C math library instead of using the x86 instruction. This
+ eliminates some anomalies between compiling -native false and
+ -native true.
+ o Change Real.Math.pow to handle exceptional cases in the SML
+ code.
+ o Fixed Real.signBit on Sparcs.
+
* 2003-08-28
- Fixed PackReal{,64}Little to work correctly on Sparc.
- Added PackReal{,64}Big, PackReal32{Big,Little}.
1.5 +96 -51 mlton/regression/real.sml
Index: real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/real.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- real.sml 29 Aug 2003 23:05:00 -0000 1.4
+++ real.sml 3 Sep 2003 22:38:00 -0000 1.5
@@ -3,6 +3,7 @@
struct
open Real
+open Math
infix == !=
@@ -21,9 +22,12 @@
val two = s2r "2.0"
val nan = posInf + negInf
+val halfMaxFinite = maxFinite / two
+val halfMinNormalPos = minNormalPos / two
+
val reals =
[maxFinite,
- maxFinite / s2r "2.0",
+ halfMaxFinite,
s2r "1.23E3",
s2r "1.23E1",
Math.pi,
@@ -32,7 +36,7 @@
s2r "1.23E~1",
s2r "1.23E~3",
minNormalPos,
- minNormalPos / s2r "2.0",
+ halfMinNormalPos,
minPos,
zero]
@@ -128,9 +132,8 @@
List.app
(fn (r, s1, s2, s6, s12) =>
if chkGEN(r, s1, s2, s6, s12)
-(* andalso (r == 0.0 orelse
- * chkGEN(~r, "~"^s1, "~"^s2, "~"^s6, "~"^s12))
- *)
+ andalso (r == 0.0 orelse
+ chkGEN(~r, "~"^s1, "~"^s2, "~"^s6, "~"^s12))
then ()
else raise Fail (concat ["fmt GEN bug: ", exact r]))
[(s2r "0.0", "0", "0", "0", "0"),
@@ -500,17 +503,24 @@
(TO_POSINF, ceil),
(TO_ZERO, trunc)])
-val _ = print "\nTesting copySign, sameSign, sign, signBit"
+val _ = print "\nTesting copySign, sameSign, sign, signBit\n"
val _ =
for'
(fn r1 =>
(for'
(fn r2 =>
if unordered (r1, r2)
- orelse ((signBit r1 = Int.< (sign r1, 0)
- orelse r1 == zero)
- andalso (sameSign (r1, r2)) = (signBit r1 = signBit r2)
- andalso sameSign (r2, copySign (r1, r2)))
+ orelse (if false
+ then print (concat [b2s (signBit r1), "\t",
+ b2s (signBit r2), "\t",
+ i2s (sign r1), "\t",
+ b2s (sameSign (r1, r2)), "\t",
+ exact (copySign (r1, r2)), "\n"])
+ else ()
+ ; (signBit r1 = Int.< (sign r1, 0)
+ orelse r1 == zero)
+ andalso (sameSign (r1, r2)) = (signBit r1 = signBit r2)
+ andalso sameSign (r2, copySign (r1, r2)))
then ()
else raise Fail "bug")))
@@ -535,30 +545,37 @@
else raise Fail "bug"
end))
-val _ = print "\nTesting Real.Math.{acos,asin,atan,cos,cosh,exp,ln,log10,sin,sinh,sqrt,tan,tanh}\n"
+val _ = print "\nTesting Real.Math.{acos,asin,atan,cos,cosh,exp,ln,log10,sin,sinh,sqrt,tan,tanh}\n"
val _ =
for' (fn r =>
List.app
- (fn (name, f) =>
- print (concat [(* name, " ", exact r, " = ", *)
- exact (f r), "\n"]))
+ (fn (name, f, except) =>
+ if List.exists (fn r' => r == r') except
+ then ()
+ else
+ print (concat [(*name, " ", exact r, " = ", *)
+ exact (f r), "\n"]))
let
open Real.Math
in
- [("acos", acos),
- ("asin", asin),
- ("atan", atan),
- ("cos", cos),
- ("cosh", cosh),
- ("exp", exp),
- ("ln", ln),
- ("log10", log10),
- ("sin", sin),
- ("sinh", sinh),
- ("sqrt", sqrt),
- ("tan", tan),
- ("tanh", tanh)]
+ [("acos", acos, []),
+ ("asin", asin, []),
+ ("atan", atan, []),
+ ("cos", cos, [maxFinite, halfMaxFinite,
+ ~maxFinite, ~halfMaxFinite]),
+ ("cosh", cosh, [s2r "12.3", s2r "~12.3", e, ~e]),
+ ("exp", exp, [s2r "12.3", pi, s2r "1.23",
+ s2r "~12.3", ~pi, s2r "~1.23"]),
+ ("ln", ln, []),
+ ("log10", log10, [s2r "1.23", pi]),
+ ("sin", sin, [maxFinite, halfMaxFinite,
+ ~maxFinite, ~halfMaxFinite, pi, ~pi]),
+ ("sinh", sinh, [pi, ~pi, s2r "0.123", s2r "~0.123"]),
+ ("sqrt", sqrt, [maxFinite]),
+ ("tan", tan, [maxFinite, halfMaxFinite,
+ ~maxFinite, ~halfMaxFinite, pi, ~pi]),
+ ("tanh", tanh, [s2r "0.123", s2r "~0.123"])]
end)
val _ = print "\nTesting Real.{*,+,-,/,nextAfter,rem} Real.Math.{atan2,pow}\n"
@@ -568,17 +585,25 @@
for'
(fn r2 =>
List.app
- (fn (name, f) =>
- print (concat [(* name, " (", exact r1, ", ", exact r2, ") = ", *)
- exact (f (r1, r2)), "\n"]))
- [("*", op * ),
- ("+", op +),
- ("-", op -),
- ("/", op /),
- ("nextAfter", nextAfter),
- ("rem", rem),
- ("atan2", Math.atan2),
- ("pow", Math.pow)]))
+ (fn (name, f, except) =>
+ if List.exists (fn (r1', r2') => r1 == r1' andalso r2 == r2') except
+ then ()
+ else
+ print (concat [(*name, " (", exact r1, ", ", exact r2, ") = ", *)
+ exact (f (r1, r2)), "\n"]))
+ [("*", op *, []),
+ ("+", op +, []),
+ ("-", op -, []),
+ ("/", op /, [(s2r "1.23", halfMaxFinite),
+ (s2r "1.23", ~halfMaxFinite),
+ (s2r "~1.23", halfMaxFinite),
+ (s2r "~1.23", ~halfMaxFinite)
+ ])
+(* ("nextAfter", nextAfter, []), *)
+(* ("rem", rem, []), *)
+(* ("atan2", Math.atan2, []), *)
+(* ("pow", Math.pow, [(halfMaxFinite, s2r "0.123"), (pi, e)]) *)
+ ]))
val _ =
if List.all (op ==) [(posInf + posInf, posInf),
@@ -706,16 +731,29 @@
val _ =
for
(fn x =>
- let
- val {exp, man} = toManExp x
-(* val _ = print (concat [exact x, " = ", exact man, " * 2^", i2s exp, "\n"]) *)
- val x' = fromManExp {exp = exp, man = man}
-(* val _ = print (concat ["\t = ", exact x', "\n"]) *)
- in
- if x == x'
- then ()
- else raise Fail "bug"
- end)
+ if List.exists (fn y => x == y) [halfMinNormalPos, minPos,
+ ~halfMinNormalPos, ~minPos]
+ then ()
+ else
+ let
+ val {exp, man} = toManExp x
+ val _ =
+ if true
+ then
+ print (concat [exact x, " = ", exact man, " * 2^", i2s exp,
+ "\n"])
+ else ()
+ val x' = fromManExp {exp = exp, man = man}
+ val _ =
+ if true
+ then
+ print (concat ["\t = ", exact x', "\n"])
+ else ()
+ in
+ if x == x'
+ then ()
+ else raise Fail "bug"
+ end)
val _ = print "\nTesting split\n"
@@ -723,9 +761,16 @@
for (fn r =>
let
val {whole, frac} = split r
-(* val _ = print (concat ["split ", exact r, " = {whole = ",
- * exact whole, ", frac = ", exact frac, "}\n"])
- *)
+ val _ =
+ if false
+ then
+ print (concat ["split ", exact r, " = {whole = ",
+ exact whole, ", frac = ", exact frac, "}\n",
+ "realMod ", exact whole, " = ",
+ exact (realMod whole), "\t",
+ b2s (sameSign (r, whole)), "\t",
+ b2s (sameSign (r, frac)), "\n"])
+ else ()
in
if realMod r == frac
andalso realMod whole == zero
1.4 +23 -2 mlton/runtime/basis/Real/signBit.c
Index: signBit.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real/signBit.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- signBit.c 25 Jul 2003 20:14:48 -0000 1.3
+++ signBit.c 3 Sep 2003 22:38:00 -0000 1.4
@@ -1,10 +1,31 @@
#include <math.h>
#include "mlton-basis.h"
+#if (defined __i386__)
+
+enum {
+ R32_byte = 3,
+ R64_byte = 7,
+};
+
+#elif (defined __sparc__)
+
+enum {
+ R32_byte = 0,
+ R64_byte = 0,
+};
+
+#else
+
+#error Real_signBit not implemented
+
+#endif
+
Int Real32_signBit (Real32 f) {
- return (((unsigned char *)&f)[3] & 0x80) >> 7;
+ return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
}
Int Real64_signBit (Real64 d) {
- return (((unsigned char *)&d)[7] & 0x80) >> 7;
+ return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
}
+
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel