1 |
;;; "bytenumb.scm" Byte integer and IEEE floating-point conversions. |
2 |
; Copyright (C) 2003 Aubrey Jaffer |
3 |
; |
4 |
;Permission to copy this software, to modify it, to redistribute it, |
5 |
;to distribute modified versions, and to use it for any purpose is |
6 |
;granted, subject to the following restrictions and understandings. |
7 |
; |
8 |
;1. Any copy made of this software must include this copyright notice |
9 |
;in full. |
10 |
; |
11 |
;2. I have made no warranty or representation that the operation of |
12 |
;this software will be error-free, and I am under no obligation to |
13 |
;provide any services, by way of maintenance, update, or otherwise. |
14 |
; |
15 |
;3. In conjunction with products arising from the use of this |
16 |
;material, there shall be no use of my name in any advertising, |
17 |
;promotional, or sales literature without prior written consent in |
18 |
;each case. |
19 |
|
20 |
(require 'byte) |
21 |
(require 'logical) |
22 |
|
23 |
;;@code{(require 'byte-number)} |
24 |
;;@ftindex byte-number |
25 |
|
26 |
;;@noindent |
27 |
;;The multi-byte sequences produced and used by numeric conversion |
28 |
;;routines are always big-endian. Endianness can be changed during |
29 |
;;reading and writing bytes using @code{read-bytes} and |
30 |
;;@code{write-bytes} @xref{Byte, read-bytes}. |
31 |
;; |
32 |
;;@noindent |
33 |
;;The sign of the length argument to bytes/integer conversion |
34 |
;;procedures determines the signedness of the number. |
35 |
|
36 |
;;@body |
37 |
;;Converts the first @code{(abs @var{n})} bytes of big-endian @1 array |
38 |
;;to an integer. If @2 is negative then the integer coded by the |
39 |
;;bytes are treated as two's-complement (can be negative). |
40 |
;; |
41 |
;;@example |
42 |
;;(bytes->integer (bytes 0 0 0 15) -4) @result{} 15 |
43 |
;;(bytes->integer (bytes 0 0 0 15) 4) @result{} 15 |
44 |
;;(bytes->integer (bytes 255 255 255 255) -4) @result{} -1 |
45 |
;;(bytes->integer (bytes 255 255 255 255) 4) @result{} 4294967295 |
46 |
;;(bytes->integer (bytes 128 0 0 0) -4) @result{} -2147483648 |
47 |
;;(bytes->integer (bytes 128 0 0 0) 4) @result{} 2147483648 |
48 |
;;@end example |
49 |
(define (bytes->integer bytes n) |
50 |
(define cnt (abs n)) |
51 |
(cond ((zero? n) 0) |
52 |
((and (negative? n) (> (byte-ref bytes 0) 127)) |
53 |
(do ((lng (- 255 (byte-ref bytes 0)) |
54 |
(+ (- 255 (byte-ref bytes idx)) (* 256 lng))) |
55 |
(idx 1 (+ 1 idx))) |
56 |
((>= idx cnt) (- -1 lng)))) |
57 |
(else |
58 |
(do ((lng (byte-ref bytes 0) |
59 |
(+ (byte-ref bytes idx) (* 256 lng))) |
60 |
(idx 1 (+ 1 idx))) |
61 |
((>= idx cnt) lng))))) |
62 |
|
63 |
;;@body |
64 |
;;Converts the integer @1 to a byte-array of @code{(abs @var{n})} |
65 |
;;bytes. If @1 and @2 are both negative, then the bytes in the |
66 |
;;returned array are coded two's-complement. |
67 |
;; |
68 |
;;@example |
69 |
;;(bytes->list (integer->bytes 15 -4)) @result{} (0 0 0 15) |
70 |
;;(bytes->list (integer->bytes 15 4)) @result{} (0 0 0 15) |
71 |
;;(bytes->list (integer->bytes -1 -4)) @result{} (255 255 255 255) |
72 |
;;(bytes->list (integer->bytes 4294967295 4)) @result{} (255 255 255 255) |
73 |
;;(bytes->list (integer->bytes -2147483648 -4)) @result{} (128 0 0 0) |
74 |
;;(bytes->list (integer->bytes 2147483648 4)) @result{} (128 0 0 0) |
75 |
;;@end example |
76 |
(define (integer->bytes n len) |
77 |
(define bytes (make-bytes (abs len))) |
78 |
(cond ((and (negative? n) (negative? len)) |
79 |
(do ((idx (+ -1 (abs len)) (+ -1 idx)) |
80 |
(res (- -1 n) (quotient res 256))) |
81 |
((negative? idx) bytes) |
82 |
(byte-set! bytes idx (- 255 (modulo res 256))))) |
83 |
(else |
84 |
(do ((idx (+ -1 (abs len)) (+ -1 idx)) |
85 |
(res n (quotient res 256))) |
86 |
((negative? idx) bytes) |
87 |
(byte-set! bytes idx (modulo res 256)))))) |
88 |
|
89 |
;;@body |
90 |
;;@1 must be a 4-element byte-array. @0 calculates and returns the |
91 |
;;value of @1 interpreted as a big-endian IEEE 4-byte (32-bit) number. |
92 |
(define (bytes->ieee-float bytes) |
93 |
(define zero (or (string->number "0.0") 0)) |
94 |
(define one (or (string->number "1.0") 1)) |
95 |
(define len (bytes-length bytes)) |
96 |
(define S (logbit? 7 (byte-ref bytes 0))) |
97 |
(define E (+ (ash (logand #x7F (byte-ref bytes 0)) 1) |
98 |
(ash (logand #x80 (byte-ref bytes 1)) -7))) |
99 |
(if (not (eqv? 4 len)) |
100 |
(slib:error 'bytes->ieee-float 'wrong 'length len)) |
101 |
(do ((F (byte-ref bytes (+ -1 len)) |
102 |
(+ (byte-ref bytes idx) (/ F 256))) |
103 |
(idx (+ -2 len) (+ -1 idx))) |
104 |
((<= idx 1) |
105 |
(set! F (/ (+ (logand #x7F (byte-ref bytes 1)) (/ F 256)) 128)) |
106 |
(cond ((< 0 E 255) (* (if S (- one) one) (expt 2 (- E 127)) (+ 1 F))) |
107 |
((zero? E) |
108 |
(if (zero? F) |
109 |
(if S (- zero) zero) |
110 |
(* (if S (- one) one) (expt 2 -126) F))) |
111 |
;; E must be 255 |
112 |
((not (zero? F)) (/ zero zero)) |
113 |
(else (/ (if S (- one) one) zero)))))) |
114 |
|
115 |
;; S EEEEEEE E FFFFFFF FFFFFFFF FFFFFFFF |
116 |
;; ========= ========= ======== ======== |
117 |
;; 0 1 8 9 31 |
118 |
|
119 |
;;@example |
120 |
;;(bytes->ieee-float (bytes 0 0 0 0)) @result{} 0.0 |
121 |
;;(bytes->ieee-float (bytes #x80 0 0 0)) @result{} -0.0 |
122 |
;;(bytes->ieee-float (bytes #x40 0 0 0)) @result{} 2.0 |
123 |
;;(bytes->ieee-float (bytes #x40 #xd0 0 0)) @result{} 6.5 |
124 |
;;(bytes->ieee-float (bytes #xc0 #xd0 0 0)) @result{} -6.5 |
125 |
;; |
126 |
;;(bytes->ieee-float (bytes 0 #x80 0 0)) @result{} 11.754943508222875e-39 |
127 |
;;(bytes->ieee-float (bytes 0 #x40 0 0)) @result{} 5.877471754111437e-39 |
128 |
;;(bytes->ieee-float (bytes 0 0 0 1)) @result{} 1.401298464324817e-45 |
129 |
;; |
130 |
;;(bytes->ieee-float (bytes #xff #x80 0 0)) @result{} -inf.0 |
131 |
;;(bytes->ieee-float (bytes #x7f #x80 0 0)) @result{} +inf.0 |
132 |
;;(bytes->ieee-float (bytes #x7f #x80 0 1)) @result{} 0/0 |
133 |
;;(bytes->ieee-float (bytes #x7f #xc0 0 0)) @result{} 0/0 |
134 |
;;@end example |
135 |
|
136 |
;;@body |
137 |
;;@1 must be a 8-element byte-array. @0 calculates and returns the |
138 |
;;value of @1 interpreted as a big-endian IEEE 8-byte (64-bit) number. |
139 |
(define (bytes->ieee-double bytes) |
140 |
(define zero (or (string->number "0.0") 0)) |
141 |
(define one (or (string->number "1.0") 1)) |
142 |
(define len (bytes-length bytes)) |
143 |
(define S (logbit? 7 (byte-ref bytes 0))) |
144 |
(define E (+ (ash (logand #x7F (byte-ref bytes 0)) 4) |
145 |
(ash (logand #xF0 (byte-ref bytes 1)) -4))) |
146 |
(if (not (eqv? 8 len)) |
147 |
(slib:error 'bytes->ieee-double 'wrong 'length len)) |
148 |
(do ((F (byte-ref bytes (+ -1 len)) |
149 |
(+ (byte-ref bytes idx) (/ F 256))) |
150 |
(idx (+ -2 len) (+ -1 idx))) |
151 |
((<= idx 1) |
152 |
(set! F (/ (+ (logand #x0F (byte-ref bytes 1)) (/ F 256)) 16)) |
153 |
(cond ((< 0 E 2047) (* (if S (- one) one) (expt 2 (- E 1023)) (+ 1 F))) |
154 |
((zero? E) |
155 |
(if (zero? F) |
156 |
(if S (- zero) zero) |
157 |
(* (if S (- one) one) (expt 2 -1022) F))) |
158 |
;; E must be 2047 |
159 |
((not (zero? F)) (/ zero zero)) |
160 |
(else (/ (if S (- one) one) zero)))))) |
161 |
|
162 |
;; S EEEEEEE EEEE FFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF |
163 |
;; ========= ========= ======== ======== ======== ======== ======== ======== |
164 |
;; 0 1 11 12 63 |
165 |
|
166 |
;;@example |
167 |
;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) @result{} 0.0 |
168 |
;;(bytes->ieee-double (bytes #x80 0 0 0 0 0 0 0)) @result{} -0.0 |
169 |
;;(bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2.0 |
170 |
;;(bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0)) @result{} 6.5 |
171 |
;;(bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0)) @result{} -6.5 |
172 |
;; |
173 |
;;(bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) @result{} 11.125369292536006e-309 |
174 |
;;(bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{} 5.562684646268003e-309 |
175 |
;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{} 4.0e-324 |
176 |
;; |
177 |
;;(bytes->ieee-double (list->bytes '(127 239 255 255 255 255 255 255))) 179.76931348623157e306 |
178 |
;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) @result{} -inf.0 |
179 |
;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) @result{} +inf.0 |
180 |
;;(bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) @result{} 0/0 |
181 |
;;@end example |
182 |
|
183 |
;;@args x |
184 |
;;Returns a 4-element byte-array encoding the IEEE single-precision |
185 |
;;floating-point of @1. |
186 |
(define ieee-float->bytes |
187 |
(let ((exactify (if (provided? 'inexact) inexact->exact identity))) |
188 |
(lambda (flt) |
189 |
(define byts (make-bytes 4 0)) |
190 |
(define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) |
191 |
(define (scale flt scl) |
192 |
(cond ((zero? scl) (out (/ flt 2) scl)) |
193 |
((>= flt 16) |
194 |
(let ((flt/16 (/ flt 16))) |
195 |
(cond ((= flt/16 flt) |
196 |
(byte-set! byts 0 (if S #xFF #x7F)) |
197 |
(byte-set! byts 1 #x80) |
198 |
byts) |
199 |
(else (scale flt/16 (+ scl 4)))))) |
200 |
((>= flt 2) (scale (/ flt 2) (+ scl 1))) |
201 |
((and (>= scl 4) |
202 |
(< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4))) |
203 |
((< flt 1) (scale (* flt 2) (+ scl -1))) |
204 |
(else (out (+ -1 flt) scl)))) |
205 |
(define (out flt scl) |
206 |
(do ((flt (* 128 flt) (* 256 (- flt val))) |
207 |
(val (exactify (floor (* 128 flt))) |
208 |
(exactify (floor (* 256 (- flt val))))) |
209 |
(idx 1 (+ 1 idx))) |
210 |
((> idx 3) |
211 |
(byte-set! byts 1 (bitwise-if #x80 (ash scl 7) (byte-ref byts 1))) |
212 |
(byte-set! byts 0 (+ (if S 128 0) (ash scl -1))) |
213 |
byts) |
214 |
(byte-set! byts idx val))) |
215 |
(set! flt (magnitude flt)) |
216 |
(cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) |
217 |
((or (not (real? flt)) |
218 |
(not (= flt flt))) |
219 |
(byte-set! byts 0 (if S #xFF #x7F)) |
220 |
(byte-set! byts 1 #xC0) |
221 |
byts) |
222 |
(else (scale flt 127)))))) |
223 |
;;@example |
224 |
;;(bytes->list (ieee-float->bytes 0.0)) @result{} (0 0 0 0) |
225 |
;;(bytes->list (ieee-float->bytes -0.0)) @result{} (128 0 0 0) |
226 |
;;(bytes->list (ieee-float->bytes 2.0)) @result{} (64 0 0 0) |
227 |
;;(bytes->list (ieee-float->bytes 6.5)) @result{} (64 208 0 0) |
228 |
;;(bytes->list (ieee-float->bytes -6.5)) @result{} (192 208 0 0) |
229 |
;; |
230 |
;;(bytes->list (ieee-float->bytes 11.754943508222875e-39)) @result{} ( 0 128 0 0) |
231 |
;;(bytes->list (ieee-float->bytes 5.877471754111438e-39)) @result{} ( 0 64 0 0) |
232 |
;;(bytes->list (ieee-float->bytes 1.401298464324817e-45)) @result{} ( 0 0 0 1) |
233 |
;; |
234 |
;;(bytes->list (ieee-float->bytes -inf.0)) @result{} (255 128 0 0) |
235 |
;;(bytes->list (ieee-float->bytes +inf.0)) @result{} (127 128 0 0) |
236 |
;;(bytes->list (ieee-float->bytes 0/0)) @result{} (127 192 0 0) |
237 |
;;@end example |
238 |
|
239 |
|
240 |
;;@args x |
241 |
;;Returns a 8-element byte-array encoding the IEEE double-precision |
242 |
;;floating-point of @1. |
243 |
(define ieee-double->bytes |
244 |
(let ((exactify (if (provided? 'inexact) inexact->exact identity))) |
245 |
(lambda (flt) |
246 |
(define byts (make-bytes 8 0)) |
247 |
(define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) |
248 |
(define (scale flt scl) |
249 |
(cond ((zero? scl) (out (/ flt 2) scl)) |
250 |
((>= flt 16) |
251 |
(let ((flt/16 (/ flt 16))) |
252 |
(cond ((= flt/16 flt) |
253 |
(byte-set! byts 0 (if S #xFF #x7F)) |
254 |
(byte-set! byts 1 #xF0) |
255 |
byts) |
256 |
(else (scale flt/16 (+ scl 4)))))) |
257 |
((>= flt 2) (scale (/ flt 2) (+ scl 1))) |
258 |
((and (>= scl 4) |
259 |
(< (* 16 flt) 1)) (scale (* flt 16) (+ scl -4))) |
260 |
((< flt 1) (scale (* flt 2) (+ scl -1))) |
261 |
(else (out (+ -1 flt) scl)))) |
262 |
(define (out flt scl) |
263 |
(do ((flt (* 16 flt) (* 256 (- flt val))) |
264 |
(val (exactify (floor (* 16 flt))) |
265 |
(exactify (floor (* 256 (- flt val))))) |
266 |
(idx 1 (+ 1 idx))) |
267 |
((> idx 7) |
268 |
(byte-set! byts 1 (bitwise-if #xF0 (ash scl 4) (byte-ref byts 1))) |
269 |
(byte-set! byts 0 (+ (if S 128 0) (ash scl -4))) |
270 |
byts) |
271 |
(byte-set! byts idx val))) |
272 |
(set! flt (magnitude flt)) |
273 |
(cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) |
274 |
((or (not (real? flt)) |
275 |
(not (= flt flt))) |
276 |
(byte-set! byts 0 #x7F) |
277 |
(byte-set! byts 1 #xF8) |
278 |
byts) |
279 |
(else (scale flt 1023)))))) |
280 |
;;@example |
281 |
;;(bytes->list (ieee-double->bytes 0.0)) @result{} (0 0 0 0 0 0 0 0) |
282 |
;;(bytes->list (ieee-double->bytes -0.0)) @result{} (128 0 0 0 0 0 0 0) |
283 |
;;(bytes->list (ieee-double->bytes 2.0)) @result{} (64 0 0 0 0 0 0 0) |
284 |
;;(bytes->list (ieee-double->bytes 6.5)) @result{} (64 26 0 0 0 0 0 0) |
285 |
;;(bytes->list (ieee-double->bytes -6.5)) @result{} (192 26 0 0 0 0 0 0) |
286 |
;; |
287 |
;;(bytes->list (ieee-double->bytes 11.125369292536006e-309)) |
288 |
;; @result{} ( 0 8 0 0 0 0 0 0) |
289 |
;;(bytes->list (ieee-double->bytes 5.562684646268003e-309)) |
290 |
;; @result{} ( 0 4 0 0 0 0 0 0) |
291 |
;;(bytes->list (ieee-double->bytes 4.0e-324)) |
292 |
;; @result{} ( 0 0 0 0 0 0 0 1) |
293 |
;; |
294 |
;;(bytes->list (ieee-double->bytes -inf.0)) @result{} (255 240 0 0 0 0 0 0) |
295 |
;;(bytes->list (ieee-double->bytes +inf.0)) @result{} (127 240 0 0 0 0 0 0) |
296 |
;;(bytes->list (ieee-double->bytes 0/0)) @result{} (127 248 0 0 0 0 0 0) |
297 |
;;@end example |
298 |
|
299 |
;;@subsubheading Byte Collation Order |
300 |
;; |
301 |
;;@noindent |
302 |
;;The @code{string<?} ordering of big-endian byte-array |
303 |
;;representations of fixed and IEEE floating-point numbers agrees with |
304 |
;;the numerical ordering only when those numbers are non-negative. |
305 |
;; |
306 |
;;@noindent |
307 |
;;Straighforward modification of these formats can extend the |
308 |
;;byte-collating order to work for their entire ranges. This |
309 |
;;agreement enables the full range of numbers as keys in |
310 |
;;@dfn{indexed-sequential-access-method} databases. |
311 |
|
312 |
;;@body |
313 |
;;Modifies sign bit of @1 so that @code{string<?} ordering of |
314 |
;;two's-complement byte-vectors matches numerical order. @0 returns |
315 |
;;@1 and is its own functional inverse. |
316 |
(define (integer-byte-collate! byte-vector) |
317 |
(byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0))) |
318 |
byte-vector) |
319 |
|
320 |
;;@body |
321 |
;;Returns copy of @1 with sign bit modified so that @code{string<?} |
322 |
;;ordering of two's-complement byte-vectors matches numerical order. |
323 |
;;@0 is its own functional inverse. |
324 |
(define (integer-byte-collate byte-vector) |
325 |
(integer-byte-collate! (bytes-copy byte-vector))) |
326 |
|
327 |
;;@body |
328 |
;;Modifies @1 so that @code{string<?} ordering of IEEE floating-point |
329 |
;;byte-vectors matches numerical order. @0 returns @1. |
330 |
(define (ieee-byte-collate! byte-vector) |
331 |
(cond ((logtest #x80 (byte-ref byte-vector 0)) |
332 |
(do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx))) |
333 |
((negative? idx)) |
334 |
(byte-set! byte-vector idx |
335 |
(logxor #xFF (byte-ref byte-vector idx))))) |
336 |
(else |
337 |
(byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0))))) |
338 |
byte-vector) |
339 |
;;@body |
340 |
;;Given @1 modified by @code{ieee-byte-collate!}, reverses the @1 |
341 |
;;modifications. |
342 |
(define (ieee-byte-decollate! byte-vector) |
343 |
(cond ((not (logtest #x80 (byte-ref byte-vector 0))) |
344 |
(do ((idx (+ -1 (bytes-length byte-vector)) (+ -1 idx))) |
345 |
((negative? idx)) |
346 |
(byte-set! byte-vector idx |
347 |
(logxor #xFF (byte-ref byte-vector idx))))) |
348 |
(else |
349 |
(byte-set! byte-vector 0 (logxor #x80 (byte-ref byte-vector 0))))) |
350 |
byte-vector) |
351 |
|
352 |
;;@body |
353 |
;;Returns copy of @1 encoded so that @code{string<?} ordering of IEEE |
354 |
;;floating-point byte-vectors matches numerical order. |
355 |
(define (ieee-byte-collate byte-vector) |
356 |
(ieee-byte-collate! (bytes-copy byte-vector))) |
357 |
;;@body |
358 |
;;Given @1 returned by @code{ieee-byte-collate}, reverses the @1 |
359 |
;;modifications. |
360 |
(define (ieee-byte-decollate byte-vector) |
361 |
(ieee-byte-decollate! (bytes-copy byte-vector))) |