[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