summaryrefslogtreecommitdiffstats
path: root/bytenumb.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
commit64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (patch)
tree1b23b8e8005328194e2fb4bf653806c85050933f /bytenumb.scm
parent5bea21e81ed516440e34e480f2c33ca41aa8c597 (diff)
downloadslib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.tar.gz
slib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.zip
Import Upstream version 3a5upstream/3a5
Diffstat (limited to 'bytenumb.scm')
-rw-r--r--bytenumb.scm47
1 files changed, 30 insertions, 17 deletions
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)))