From 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:34 -0800 Subject: Import Upstream version 3a3 --- bytenumb.scm | 45 ++++++++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 19 deletions(-) (limited to 'bytenumb.scm') 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 -- cgit v1.2.3