aboutsummaryrefslogtreecommitdiffstats
path: root/bytenumb.scm
diff options
context:
space:
mode:
Diffstat (limited to 'bytenumb.scm')
-rw-r--r--bytenumb.scm346
1 files changed, 346 insertions, 0 deletions
diff --git a/bytenumb.scm b/bytenumb.scm
new file mode 100644
index 0000000..68ee748
--- /dev/null
+++ b/bytenumb.scm
@@ -0,0 +1,346 @@
+;;; "bytenumb.scm" Byte integer and IEEE floating-point conversions.
+; Copyright (c) 2003 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1. Any copy made of this software must include this copyright notice
+;in full.
+;
+;2. I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3. In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'byte)
+(require 'logical)
+
+(define bn:expt
+ (if (provided? 'inexact) expt
+ (lambda (n k) (if (negative? k) 0 (integer-expt n k)))))
+
+;;@code{(require 'byte-number)}
+;;@ftindex byte-number
+
+;;@noindent
+;;The multi-byte sequences produced and used by numeric conversion
+;;routines are always big-endian. Endianness can be changed during
+;;reading and writing bytes using @code{read-bytes} and
+;;@code{write-bytes} @xref{Byte, read-bytes}.
+;;
+;;@noindent
+;;The sign of the length argument to bytes/integer conversion
+;;procedures determines the signedness of the number.
+
+;;@body
+;;Converts the first @code{(abs @var{n})} bytes of big-endian @1 array
+;;to an integer. If @2 is negative then the integer coded by the
+;;bytes are treated as two's-complement (can be negative).
+;;
+;;@example
+;;(bytes->integer (bytes 0 0 0 15) -4) @result{} 15
+;;(bytes->integer (bytes 0 0 0 15) 4) @result{} 15
+;;(bytes->integer (bytes 255 255 255 255) -4) @result{} -1
+;;(bytes->integer (bytes 255 255 255 255) 4) @result{} 4294967295
+;;(bytes->integer (bytes 128 0 0 0) -4) @result{} -2147483648
+;;(bytes->integer (bytes 128 0 0 0) 4) @result{} 2147483648
+;;@end example
+(define (bytes->integer bytes n)
+ (define cnt (abs n))
+ (cond ((zero? n) 0)
+ ((and (negative? n) (> (byte-ref bytes 0) 127))
+ (do ((lng (- 255 (byte-ref bytes 0))
+ (+ (- 255 (byte-ref bytes idx)) (* 256 lng)))
+ (idx 1 (+ 1 idx)))
+ ((>= idx cnt) (- -1 lng))))
+ (else
+ (do ((lng (byte-ref bytes 0)
+ (+ (byte-ref bytes idx) (* 256 lng)))
+ (idx 1 (+ 1 idx)))
+ ((>= idx cnt) lng)))))
+
+;;@body
+;;Converts the integer @1 to a byte-array of @code{(abs @var{n})}
+;;bytes. If @1 and @2 are both negative, then the bytes in the
+;;returned array are coded two's-complement.
+;;
+;;@example
+;;(bytes->list (integer->bytes 15 -4)) @result{} (0 0 0 15)
+;;(bytes->list (integer->bytes 15 4)) @result{} (0 0 0 15)
+;;(bytes->list (integer->bytes -1 -4)) @result{} (255 255 255 255)
+;;(bytes->list (integer->bytes 4294967295 4)) @result{} (255 255 255 255)
+;;(bytes->list (integer->bytes -2147483648 -4)) @result{} (128 0 0 0)
+;;(bytes->list (integer->bytes 2147483648 4)) @result{} (128 0 0 0)
+;;@end example
+(define (integer->bytes n len)
+ (define bytes (make-bytes (abs len)))
+ (cond ((and (negative? n) (negative? len))
+ (do ((idx (+ -1 (abs len)) (+ -1 idx))
+ (res (- -1 n) (quotient res 256)))
+ ((negative? idx) bytes)
+ (byte-set! bytes idx (- 255 (modulo res 256)))))
+ (else
+ (do ((idx (+ -1 (abs len)) (+ -1 idx))
+ (res n (quotient res 256)))
+ ((negative? idx) bytes)
+ (byte-set! bytes idx (modulo res 256))))))
+
+;;@body
+;;@1 must be a 4-element byte-array. @0 calculates and returns the
+;;value of @1 interpreted as a big-endian IEEE 4-byte (32-bit) number.
+(define (bytes->ieee-float bytes)
+ (define zero (or (string->number "0.0") 0))
+ (define one (or (string->number "1.0") 1))
+ (define len (bytes-length bytes))
+ (define S (logbit? 7 (byte-ref bytes 0)))
+ (define E (+ (ash (logand #x7F (byte-ref bytes 0)) 1)
+ (ash (logand #x80 (byte-ref bytes 1)) -7)))
+ (if (not (eqv? 4 len))
+ (slib:error 'bytes->ieee-float 'wrong 'length len))
+ (do ((F (byte-ref bytes (+ -1 len))
+ (+ (byte-ref bytes idx) (/ F 256)))
+ (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) (bn:expt 2 (- E 127)) (+ 1 F)))
+ ((zero? E)
+ (if (zero? F)
+ (if S (- zero) zero)
+ (* (if S -1 1) (expt 2 -126) F)))
+ ;; E must be 255
+ ((not (zero? F)) (/ zero zero))
+ (else (/ (if S (- one) one) zero))))))
+
+;; S EEEEEEE E FFFFFFF FFFFFFFF FFFFFFFF
+;; ========= ========= ======== ========
+;; 0 1 8 9 31
+
+;;@example
+;;(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
+;;
+;;(bytes->ieee-float (bytes 0 #x80 0 0)) @result{} 11.754943508222875e-39
+;;(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 #x7f #x80 0 1)) @result{} 0/0
+;;@end example
+
+;;@body
+;;@1 must be a 8-element byte-array. @0 calculates and returns the
+;;value of @1 interpreted as a big-endian IEEE 8-byte (64-bit) number.
+(define (bytes->ieee-double bytes)
+ (define zero (or (string->number "0.0") 0))
+ (define one (or (string->number "1.0") 1))
+ (define len (bytes-length bytes))
+ (define S (logbit? 7 (byte-ref bytes 0)))
+ (define E (+ (ash (logand #x7F (byte-ref bytes 0)) 4)
+ (ash (logand #xF0 (byte-ref bytes 1)) -4)))
+ (if (not (eqv? 8 len))
+ (slib:error 'bytes->ieee-double 'wrong 'length len))
+ (do ((F (byte-ref bytes (+ -1 len))
+ (+ (byte-ref bytes idx) (/ F 256)))
+ (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) (bn:expt 2 (- E 1023)) (+ 1 F)))
+ ((zero? E)
+ (if (zero? F)
+ (if S (- zero) zero)
+ (* (if S -1 1) (expt 2 -1022) F)))
+ ;; E must be 2047
+ ((not (zero? F)) (/ zero zero))
+ (else (/ (if S (- one) one) zero))))))
+
+;; S EEEEEEE EEEE FFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF
+;; ========= ========= ======== ======== ======== ======== ======== ========
+;; 0 1 11 12 63
+
+;;@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 #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
+;;
+;;(bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) @result{} 11.125369292536006e-309
+;;(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 #x7F #xF8 0 0 0 0 0 0)) @result{} 0/0
+;;@end example
+
+;;@args x
+;;Returns a 4-element byte-array encoding the IEEE single-precision
+;;floating-point of @1.
+(define ieee-float->bytes
+ (let ((zero (or (string->number "0.0") 0))
+ (exactify (if (provided? 'inexact) inexact->exact identity)))
+ (lambda (flt)
+ (define byts (make-bytes 4 0))
+ (define S (negative? flt))
+ (define (scale flt scl)
+ (cond ((zero? scl) (out (/ flt 2) scl))
+ ((zero? flt) byts)
+ ((>= 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))
+ byts)
+ (else (scale flt/16 (+ scl 4))))))
+ ((>= flt 2) (scale (/ flt 2) (+ scl 1)))
+ ((and (>= scl 4)
+ (< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4)))
+ ((< flt 1) (scale (* flt 2) (+ scl -1)))
+ (else (out (+ -1 flt) scl))))
+ (define (out flt scl)
+ (do ((flt (* 128 flt) (* 256 (- flt val)))
+ (val (exactify (floor (* 128 flt)))
+ (exactify (floor (* 256 (- flt val)))))
+ (idx 1 (+ 1 idx)))
+ ((> idx 3)
+ (byte-set! byts 1 (bitwise-if #x80 (ash scl 7) (byte-ref byts 1)))
+ (byte-set! byts 0 (+ (if S 128 0) (ash scl -1)))
+ byts)
+ (byte-set! byts idx val)))
+ (scale (abs flt) 127))))
+;;@example
+;;(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)
+;;
+;;(bytes->list (ieee-float->bytes 11.754943508222875e-39)) @result{} ( 0 128 0 0)
+;;(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 0/0)) @result{} (127 128 0 1)
+;;@end example
+
+
+;;@args x
+;;Returns a 8-element byte-array encoding the IEEE double-precision
+;;floating-point of @1.
+(define ieee-double->bytes
+ (let ((zero (or (string->number "0.0") 0))
+ (exactify (if (provided? 'inexact) inexact->exact identity)))
+ (lambda (flt)
+ (define byts (make-bytes 8 0))
+ (define S (negative? flt))
+ (define (scale flt scl)
+ (cond ((zero? scl) (out (/ flt 2) scl))
+ ((zero? flt) byts)
+ ((>= 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))
+ byts)
+ (else (scale flt/16 (+ scl 4))))))
+ ((>= flt 2) (scale (/ flt 2) (+ scl 1)))
+ ((and (>= scl 4)
+ (< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4)))
+ ((< flt 1) (scale (* flt 2) (+ scl -1)))
+ (else (out (+ -1 flt) scl))))
+ (define (out flt scl)
+ (do ((flt (* 16 flt) (* 256 (- flt val)))
+ (val (exactify (floor (* 16 flt)))
+ (exactify (floor (* 256 (- flt val)))))
+ (idx 1 (+ 1 idx)))
+ ((> idx 7)
+ (byte-set! byts 1 (bitwise-if #xF0 (ash scl 4) (byte-ref byts 1)))
+ (byte-set! byts 0 (+ (if S 128 0) (ash scl -4)))
+ byts)
+ (byte-set! byts idx val)))
+ (scale (abs flt) 1023))))
+;;@example
+;;(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)
+;;
+;;(bytes->list (ieee-double->bytes 11.125369292536006e-309))
+;; @result{} ( 0 8 0 0 0 0 0 0)
+;;(bytes->list (ieee-double->bytes 5.562684646268003e-309))
+;; @result{} ( 0 4 0 0 0 0 0 0)
+;;(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 0/0)) @result{} (127 248 0 0 0 0 0 0)
+;;@end example
+
+;;@subsubheading Byte Collation Order
+;;
+;;@noindent
+;;The @code{string<?} ordering of big-endian byte-array
+;;representations of fixed and IEEE floating-point numbers agrees with
+;;the numerical ordering only when those numbers are non-negative.
+;;
+;;@noindent
+;;Straighforward modification of these formats can extend the
+;;byte-collating order to work for their entire ranges. This
+;;agreement enables the full range of numbers as keys in
+;;@dfn{indexed-sequential-access-method} databases.
+
+;;@body
+;;Modifies sign bit of @1 so that @code{string<?} ordering of
+;;two's-complement byte-vectors matches numerical order. @0 returns
+;;@1 and is its own functional inverse.
+(define (integer-byte-collate! byte-vector)
+ (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))
+ byte-vector)
+
+;;@body
+;;Returns copy of @1 with sign bit modified so that @code{string<?}
+;;ordering of two's-complement byte-vectors matches numerical order.
+;;@0 is its own functional inverse.
+(define (integer-byte-collate byte-vector)
+ (integer-byte-collate! (bytes-copy byte-vector)))
+
+;;@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)
+ (cond ((logtest #x80 (byte-ref byte-vector 0))
+ (do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx)))
+ ((negative? idx))
+ (byte-set! byte-vector idx
+ (logxor #xFF (byte-ref byte-vector idx)))))
+ (else
+ (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
+;;modifications.
+(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))
+ (byte-set! byte-vector idx
+ (logxor #xFF (byte-ref byte-vector idx)))))
+ (else
+ (byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0)))))
+ byte-vector)
+
+;;@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)))
+;;@body
+;;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)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-18 18:36:17 +0000