From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 13 Nov 2009 03:48:28 +0000 (-0500)
Subject: Fix flonum case of ROUND to use IEEE round-to-even, per the R5RS.
X-Git-Tag: 20100708-Gtk~245
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a35f193f67449520b47d663124eda13851579171;p=mit-scheme.git

Fix flonum case of ROUND to use IEEE round-to-even, per the R5RS.
---

diff --git a/src/microcode/artutl.c b/src/microcode/artutl.c
index cd6addc5f..9c4ed7544 100644
--- a/src/microcode/artutl.c
+++ b/src/microcode/artutl.c
@@ -126,7 +126,15 @@ double_truncate (double x)
 double
 double_round (double x)
 {
-  return (double_truncate ((x < 0) ? (x - 0.5) : (x + 0.5)));
+  double integral;
+  double fractional = (fabs (modf (x, (&integral))));
+
+  if ((fractional == 0.5)
+      ? ((fmod (integral, 2.0)) == 0.0)
+      : (! (0.5 < fractional)))
+    return (integral);
+  else
+    return (integral + (copysign (x, 1.0)));
 }
 
 /* Conversions between Scheme types and Scheme types. */