Import Upstream version 3a3upstream/3a3

1 files changed, 26 insertions, 19 deletions

diff --git a/bytenumb.scm b/bytenumb.scm
index 7febf64..cb9b5c5 100644
--- a/bytenumb.scm
+++ b/bytenumb.scm
@@ -103,11 +103,11 @@
        (idx (+ -2 len) (+ -1 idx)))
       ((<= idx 1)
        (set! F (/ (+ (logand #x7F (byte-ref bytes 1)) (/ F 256)) 128))
-       (cond ((< 0 E 255) (* (if S -1 1) (expt 2 (- E 127)) (+ 1 F)))
+       (cond ((< 0 E 255) (* (if S (- one) one) (expt 2 (- E 127)) (+ 1 F)))
 	     ((zero? E)
 	      (if (zero? F)
 		  (if S (- zero) zero)
-		  (* (if S -1 1) (expt 2 -126) F)))
+		  (* (if S (- one) one) (expt 2 -126) F)))
 	     ;; E must be 255
 	     ((not (zero? F)) (/ zero zero))
 	     (else (/ (if S (- one) one) zero))))))
@@ -117,6 +117,8 @@
 ;;  0 1       8 9                      31
 
 ;;@example
+;;(bytes->ieee-float (bytes    0    0 0 0))  @result{}  0.0
+;;(bytes->ieee-float (bytes #x80    0 0 0))  @result{} -0.0
 ;;(bytes->ieee-float (bytes #x40    0 0 0))  @result{}  2.0
 ;;(bytes->ieee-float (bytes #x40 #xd0 0 0))  @result{}  6.5
 ;;(bytes->ieee-float (bytes #xc0 #xd0 0 0))  @result{} -6.5
@@ -125,8 +127,8 @@
 ;;(bytes->ieee-float (bytes    0 #x40 0 0))  @result{}  5.877471754111437e-39
 ;;(bytes->ieee-float (bytes    0    0 0 1))  @result{}  1.401298464324817e-45
 ;;
-;;(bytes->ieee-float (bytes #xff #x80 0 0))  @result{} -1/0
-;;(bytes->ieee-float (bytes #x7f #x80 0 0))  @result{}  1/0
+;;(bytes->ieee-float (bytes #xff #x80 0 0))  @result{} -inf.0
+;;(bytes->ieee-float (bytes #x7f #x80 0 0))  @result{} +inf.0
 ;;(bytes->ieee-float (bytes #x7f #x80 0 1))  @result{}  0/0
 ;;@end example
 
@@ -147,11 +149,11 @@
        (idx (+ -2 len) (+ -1 idx)))
       ((<= idx 1)
        (set! F (/ (+ (logand #x0F (byte-ref bytes 1)) (/ F 256)) 16))
-       (cond ((< 0 E 2047) (* (if S -1 1) (expt 2 (- E 1023)) (+ 1 F)))
+       (cond ((< 0 E 2047) (* (if S (- one) one) (expt 2 (- E 1023)) (+ 1 F)))
 	     ((zero? E)
 	      (if (zero? F)
 		  (if S (- zero) zero)
-		  (* (if S -1 1) (expt 2 -1022) F)))
+		  (* (if S (- one) one) (expt 2 -1022) F)))
 	     ;; E must be 2047
 	     ((not (zero? F)) (/ zero zero))
 	     (else (/ (if S (- one) one) zero))))))
@@ -162,7 +164,8 @@
 
 ;;@example
 ;;(bytes->ieee-double (bytes    0    0 0 0 0 0 0 0))  @result{}  0.0
-;;(bytes->ieee-double (bytes #x40    0 0 0 0 0 0 0))  @result{}  2
+;;(bytes->ieee-double (bytes #x80    0 0 0 0 0 0 0))  @result{} -0.0
+;;(bytes->ieee-double (bytes #x40    0 0 0 0 0 0 0))  @result{}  2.0
 ;;(bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0))  @result{}  6.5
 ;;(bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0))  @result{} -6.5
 ;;
@@ -170,8 +173,8 @@
 ;;(bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{}  5.562684646268003e-309
 ;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{}  4.0e-324
 ;;
-;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0))  @result{} -1/0
-;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0))  @result{}  1/0
+;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0))  @result{} -inf.0
+;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0))  @result{} +inf.0
 ;;(bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0))  @result{}  0/0
 ;;@end example
 
@@ -183,11 +186,11 @@
 	(exactify (if (provided? 'inexact) inexact->exact identity)))
     (lambda (flt)
       (define byts (make-bytes 4 0))
-      (define S (negative? flt))
+      (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt))))
       (define (scale flt scl)
 	(cond ((zero? scl)            (out (/ flt 2) scl))
-	      ((zero? flt) byts)
-	      ((>= flt 16)
+	      ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
+	      ((or (not (real? flt)) (>= flt 16))
 	       (let ((flt/16 (/ flt 16)))
 		 (cond ((= flt/16 flt)
 			(byte-set! byts 0 (if S #xFF #x7F))
@@ -211,6 +214,8 @@
 	  (byte-set! byts idx val)))
       (scale (abs flt) 127))))
 ;;@example
+;;(bytes->list (ieee-float->bytes  0.0))                    @result{} (0     0 0 0)
+;;(bytes->list (ieee-float->bytes -0.0))                    @result{} (128   0 0 0)
 ;;(bytes->list (ieee-float->bytes  2.0))                    @result{} (64    0 0 0)
 ;;(bytes->list (ieee-float->bytes  6.5))                    @result{} (64  208 0 0)
 ;;(bytes->list (ieee-float->bytes -6.5))                    @result{} (192 208 0 0)
@@ -219,8 +224,8 @@
 ;;(bytes->list (ieee-float->bytes  5.877471754111438e-39))  @result{} (  0  64 0 0)
 ;;(bytes->list (ieee-float->bytes  1.401298464324817e-45))  @result{} (  0   0 0 1)
 ;;
-;;(bytes->list (ieee-float->bytes -1/0))                    @result{} (255 128 0 0)
-;;(bytes->list (ieee-float->bytes  1/0))                    @result{} (127 128 0 0)
+;;(bytes->list (ieee-float->bytes -inf.0))                  @result{} (255 128 0 0)
+;;(bytes->list (ieee-float->bytes +inf.0))                  @result{} (127 128 0 0)
 ;;(bytes->list (ieee-float->bytes  0/0))                    @result{} (127 128 0 1)
 ;;@end example
 
@@ -233,11 +238,11 @@
 	(exactify (if (provided? 'inexact) inexact->exact identity)))
     (lambda (flt)
       (define byts (make-bytes 8 0))
-      (define S (negative? flt))
+      (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt))))
       (define (scale flt scl)
 	(cond ((zero? scl)            (out (/ flt 2) scl))
-	      ((zero? flt) byts)
-	      ((>= flt 16)
+	      ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
+	      ((or (not (real? flt)) (>= flt 16))
 	       (let ((flt/16 (/ flt 16)))
 		 (cond ((= flt/16 flt)
 			(byte-set! byts 0 (if S #xFF #x7F))
@@ -261,6 +266,8 @@
 	  (byte-set! byts idx val)))
       (scale (abs flt) 1023))))
 ;;@example
+;;(bytes->list (ieee-double->bytes  0.0)) @result{} (0     0 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes -0.0)) @result{} (128   0 0 0 0 0 0 0)
 ;;(bytes->list (ieee-double->bytes  2.0)) @result{} (64    0 0 0 0 0 0 0)
 ;;(bytes->list (ieee-double->bytes  6.5)) @result{} (64   26 0 0 0 0 0 0)
 ;;(bytes->list (ieee-double->bytes -6.5)) @result{} (192  26 0 0 0 0 0 0)
@@ -272,8 +279,8 @@
 ;;(bytes->list (ieee-double->bytes  4.0e-324))
 ;;                                        @result{} (  0   0 0 0 0 0 0 1)
 ;;
-;;(bytes->list (ieee-double->bytes -1/0)) @result{} (255 240 0 0 0 0 0 0)
-;;(bytes->list (ieee-double->bytes  1/0)) @result{} (127 240 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes -inf.0)) @result{} (255 240 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes +inf.0)) @result{} (127 240 0 0 0 0 0 0)
 ;;(bytes->list (ieee-double->bytes  0/0)) @result{} (127 248 0 0 0 0 0 0)
 ;;@end example