From b5695ab51d10a1da4bf714a0d20816e8f871857a Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 1 Dec 2018 02:05:40 +0000 Subject: [PATCH] Make ieee754-binary-hex-string follow IEEE 754-2008. --- src/runtime/ieee754.scm | 9 ++++----- tests/runtime/test-ieee754.scm | 8 +++++++- 2 files changed, 11 insertions(+), 6 deletions(-) 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 () -- 2.25.1