From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:38 -0800
Subject: Import Upstream version 3a5

---
 bytenumb.scm | 47 ++++++++++++++++++++++++++++++-----------------
 1 file changed, 30 insertions(+), 17 deletions(-)

(limited to 'bytenumb.scm')

diff --git a/bytenumb.scm b/bytenumb.scm
index cb9b5c5..053a433 100644
--- a/bytenumb.scm
+++ b/bytenumb.scm
@@ -130,6 +130,7 @@
 ;;(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
+;;(bytes->ieee-float (bytes #x7f #xc0 0 0))  @result{}  0/0
 ;;@end example
 
 ;;@body
@@ -189,12 +190,11 @@
       (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt))))
       (define (scale flt scl)
 	(cond ((zero? scl)            (out (/ flt 2) scl))
-	      ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
-	      ((or (not (real? flt)) (>= flt 16))
+	      ((>= flt 16)
 	       (let ((flt/16 (/ flt 16)))
 		 (cond ((= flt/16 flt)
 			(byte-set! byts 0 (if S #xFF #x7F))
-			(byte-set! byts 1 (if (= flt (* zero flt)) #xC0 #x80))
+			(byte-set! byts 1 #x80)
 			byts)
 		       (else          (scale flt/16 (+ scl 4))))))
 	      ((>= flt 2)             (scale (/ flt 2) (+ scl 1)))
@@ -212,7 +212,14 @@
 	     (byte-set! byts 0 (+ (if S 128 0) (ash scl -1)))
 	     byts)
 	  (byte-set! byts idx val)))
-      (scale (abs flt) 127))))
+      (set! flt (magnitude flt))
+      (cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
+	    ((or (not (real? flt))
+		 (not (= flt flt)))
+	     (byte-set! byts 0 (if S #xFF #x7F))
+	     (byte-set! byts 1 #xC0)
+	     byts)
+	    (else (scale 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)
@@ -226,7 +233,7 @@
 ;;
 ;;(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)
+;;(bytes->list (ieee-float->bytes  0/0))                    @result{} (127 192 0 0)
 ;;@end example
 
 
@@ -241,12 +248,11 @@
       (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt))))
       (define (scale flt scl)
 	(cond ((zero? scl)            (out (/ flt 2) scl))
-	      ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
-	      ((or (not (real? flt)) (>= flt 16))
+	      ((>= flt 16)
 	       (let ((flt/16 (/ flt 16)))
 		 (cond ((= flt/16 flt)
 			(byte-set! byts 0 (if S #xFF #x7F))
-			(byte-set! byts 1 (if (= flt (* zero flt)) #xF8 #xF0))
+			(byte-set! byts 1 #xF0)
 			byts)
 		       (else          (scale flt/16 (+ scl 4))))))
 	      ((>= flt 2)             (scale (/ flt 2) (+ scl 1)))
@@ -264,7 +270,14 @@
 	     (byte-set! byts 0 (+ (if S 128 0) (ash scl -4)))
 	     byts)
 	  (byte-set! byts idx val)))
-      (scale (abs flt) 1023))))
+      (set! flt (magnitude flt))
+      (cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts)
+	    ((or (not (real? flt))
+		 (not (= flt flt)))
+	     (byte-set! byts 0 #x7F)
+	     (byte-set! byts 1 #xF8)
+	     byts)
+	    (else (scale 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)
@@ -315,7 +328,7 @@
 ;;@body
 ;;Modifies @1 so that @code{string<?} ordering of IEEE floating-point
 ;;byte-vectors matches numerical order.  @0 returns @1.
-(define (IEEE-byte-collate! byte-vector)
+(define (ieee-byte-collate! byte-vector)
   (cond ((logtest #x80 (byte-ref byte-vector 0))
 	 (do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx)))
 	     ((negative? idx))
@@ -325,9 +338,9 @@
 	 (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))))
   byte-vector)
 ;;@body
-;;Given @1 modified by @code{IEEE-byte-collate!}, reverses the @1
+;;Given @1 modified by @code{ieee-byte-collate!}, reverses the @1
 ;;modifications.
-(define (IEEE-byte-decollate! byte-vector)
+(define (ieee-byte-decollate! byte-vector)
   (cond ((not (logtest #x80 (byte-ref byte-vector 0)))
 	 (do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx)))
 	     ((negative? idx))
@@ -340,10 +353,10 @@
 ;;@body
 ;;Returns copy of @1 encoded so that @code{string<?} ordering of IEEE
 ;;floating-point byte-vectors matches numerical order.
-(define (IEEE-byte-collate byte-vector)
-  (IEEE-byte-collate! (bytes-copy byte-vector)))
+(define (ieee-byte-collate byte-vector)
+  (ieee-byte-collate! (bytes-copy byte-vector)))
 ;;@body
-;;Given @1 returned by @code{IEEE-byte-collate}, reverses the @1
+;;Given @1 returned by @code{ieee-byte-collate}, reverses the @1
 ;;modifications.
-(define (IEEE-byte-decollate byte-vector)
-  (IEEE-byte-decollate! (bytes-copy byte-vector)))
+(define (ieee-byte-decollate byte-vector)
+  (ieee-byte-decollate! (bytes-copy byte-vector)))
-- 
cgit v1.2.3