From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 5 Nov 2018 04:41:14 +0000 (+0000)
Subject: Fix sign of (flo:ulp -infinity).  Simplify.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~120
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=682178dbb3ad5dbd4e789fb7d6d6321d3ad154d8;p=mit-scheme.git

Fix sign of (flo:ulp -infinity).  Simplify.

flo:ulp is supposed to return a positive magnitude, in particular the
absolute distance from x to the next larger floating-point number in
magnitude.
---

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index bbe4b8af4..af3b0f834 100644
--- a/src/runtime/primitive-arithmetic.scm
+++ b/src/runtime/primitive-arithmetic.scm
@@ -249,14 +249,17 @@ USA.
 	   (eq? (flo:safe-negative? x)
 		(flo:safe-negative? y)))))
 
+;;; Measure the distance from x to the next floating-point number of
+;;; the same sign as x and larger in magnitude.  For +/-0, this yields
+;;; the smallest subnormal.  For +/-inf, this yields +inf.  For NaN
+;;; this yields some NaN.
+
 (define (flo:ulp x)
-  ;; Measure the distance from x to the next float in the direction of
-  ;; the sign of x.
   (if (flo:finite? x)
-      (let* ((direction (flo:copysign (flo:+inf.0) x))
-             (x* (flo:nextafter x direction)))
-        (flo:* (flo:copysign 1. x) (flo:- x* x)))
-      x))
+      (let* ((x0 (flo:abs x))
+             (x1 (flo:nextafter x0 (flo:+inf.0))))
+        (flo:- x1 x0))
+      (flo:+inf.0)))
 
 (define (int:->flonum n)
   ((ucode-primitive integer->flonum 2) n #b10))
diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index e9730c18a..ff82933ce 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -119,13 +119,17 @@ USA.
 
 (define-enumerated-test 'flo:ulp
   (vector
-   (vector (flo:-inf.0) (flo:-inf.0))
+   (vector (flo:-inf.0) (flo:+inf.0))
+   (vector (+ -3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
+   (vector -3. (* 2 flo:ulp-of-one))
    (vector -2. (* 2 flo:ulp-of-one))
    (vector -1. flo:ulp-of-one)
    (vector -0. "4.9406564584124654e-324")
    (vector 0. "4.9406564584124654e-324")
    (vector 1. flo:ulp-of-one)
    (vector 2. (* 2 flo:ulp-of-one))
+   (vector 3. (* 2 flo:ulp-of-one))
+   (vector (- 3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one))
    (vector (flo:+inf.0) (flo:+inf.0)))
   (lambda (v)
     (let ((x (vector-ref v 0))