diff options
Diffstat (limited to 'bytenumb.scm')
| -rw-r--r-- | bytenumb.scm | 47 |
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))) |