From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 1 Dec 2018 02:05:40 +0000 (+0000)
Subject: Make ieee754-binary-hex-string follow IEEE 754-2008.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~80
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b5695ab51d10a1da4bf714a0d20816e8f871857a;p=mit-scheme.git

Make ieee754-binary-hex-string follow IEEE 754-2008.
---

diff --git a/src/runtime/ieee754.scm b/src/runtime/ieee754.scm
index 9ca331c27..48efbecb8 100644
--- a/src/runtime/ieee754.scm
+++ b/src/runtime/ieee754.scm
@@ -202,9 +202,7 @@ USA.
     bias exp-subnormal exp-inf/nan
     (define (symbolic sign name extra)
       (assert (or (= sign 0) (= sign 1)))
-      (assert (<= 0 extra))
-      (let ((extra (number->string extra #x10)))
-        (string-append (if (zero? sign) "+" "-") name "." extra)))
+      (string-append (if (zero? sign) "+" "-") name extra))
     (define (numeric sign integer width fractional exponent)
       (assert (or (= sign 0) (= sign 1)))
       (assert (or (= integer 0) (= integer 1)))
@@ -257,9 +255,10 @@ USA.
                (fractional (extract-bit-field width 0 significand)))
           (numeric sign 1 width fractional exponent)))
       (lambda (sign)
-        (symbolic sign "inf" 0))
+        (symbolic sign "inf" ""))
       (lambda (sign quiet payload)
-        (symbolic sign (if (zero? quiet) "sNaN" "qNaN") payload)))))
+        payload                         ;XXX Use this.
+        (symbolic sign (if (zero? quiet) "sNaN" "NaN") "")))))
 
 (define (ieee754-binary32-hex-string x #!optional mark)
   (ieee754-binary-hex-string x 8 24 mark))
diff --git a/tests/runtime/test-ieee754.scm b/tests/runtime/test-ieee754.scm
index c71e364d6..bf6d24504 100644
--- a/tests/runtime/test-ieee754.scm
+++ b/tests/runtime/test-ieee754.scm
@@ -162,7 +162,13 @@ USA.
     (-257/256 "-0x1.01p+0")
     (12345 "0x1.81c8p+13")
     (123456 "0x1.e24p+16")
-    (1.2061684984132626e-11 "0x1.a862p-37"))
+    (1.2061684984132626e-11 "0x1.a862p-37")
+    (+inf.0 "+inf")
+    (-inf.0 "-inf")
+    (,(flo:qnan) "+NaN")
+    (,(flo:negate (flo:qnan)) "-NaN")
+    (,(flo:snan) "+sNaN")
+    (,(flo:negate (flo:snan)) "-sNaN"))
   (lambda (x s #!optional xfail)
     (with-expected-failure xfail
       (lambda ()