diff --git a/lib/chibi/bytevector-test.sld b/lib/chibi/bytevector-test.sld index e2e5993f..eb8cb0e3 100644 --- a/lib/chibi/bytevector-test.sld +++ b/lib/chibi/bytevector-test.sld @@ -36,7 +36,7 @@ (define (run-tests) (test-begin "bytevector") - (test-group "reading" + (test-group "reading ieee" (do ((ls floats (cdr ls)) (i 0 (+ i 4))) @@ -48,7 +48,7 @@ ((null? ls)) (test (car ls) (bytevector-ieee-double-native-ref f64-le i)))) - (test-group "writing" + (test-group "writing ieee" (do ((ls floats (cdr ls)) (i 0 (+ i 4))) @@ -64,4 +64,16 @@ (bytevector-ieee-double-native-set! bv 0 (car ls)) (test (bytevector-copy f64-le i (+ i 8)) (values bv))))) + (test-group "ber integers" + (do ((ls '(0 1 128 16383 32767 + 18446744073709551615 + 340282366920938463463374607431768211456) + (cdr ls))) + ((null? ls)) + (let ((bv (make-bytevector 256))) + (do ((offsets '(0 1 27) (cdr offsets))) + ((null? offsets)) + (bytevector-ber-set! bv (car ls) (car offsets)) + (test (car ls) (bytevector-ber-ref bv (car offsets))))))) + (test-end)))) diff --git a/lib/chibi/bytevector.scm b/lib/chibi/bytevector.scm index 89e5d186..4de88ef1 100644 --- a/lib/chibi/bytevector.scm +++ b/lib/chibi/bytevector.scm @@ -33,6 +33,46 @@ (arithmetic-shift (bytevector-u8-ref bv (+ i 2)) 8) (bytevector-u8-ref bv (+ i 3)))) +;;> \section{Bignum encodings} + +;;> A BER compressed integer (X.209) is an unsigned integer in base 128, +;;> most significant digit first, where the high bit is set on all but the +;;> final (least significant) byte. Thus any size integer can be +;;> encoded, but the encoding is efficient and small integers don't take +;;> up any more space than they would in normal char/short/int encodings. + +(define (bytevector-ber-ref bv . o) + (let ((end (if (and (pair? o) (pair? (cdr o))) + (cadr o) + (bytevector-length bv)))) + (let lp ((acc 0) (i (if (pair? o) (car o) 0))) + (if (>= i end) + (error "unterminated ber integer in bytevector" bv) + (let ((b (bytevector-u8-ref bv i))) + (if (< b 128) + (+ acc b) + (lp (arithmetic-shift (+ acc (bitwise-and b 127)) 7) + (+ i 1)))))))) + +(define (bytevector-ber-set! bv n . o) + ;;(assert (integer? number) (not (negative? number))) + (let ((start (if (pair? o) (car o) 0)) + (end (if (and (pair? o) (pair? (cdr o))) + (cadr o) + (bytevector-length bv)))) + (let lp ((n (arithmetic-shift n -7)) + (ls (list (bitwise-and n 127)))) + (if (zero? n) + (do ((i start (+ i 1)) + (ls ls (cdr ls))) + ((null? ls)) + (if (>= i end) + (error "integer doesn't fit in bytevector as ber" + bv n start end) + (bytevector-u8-set! bv i (car ls)))) + (lp (arithmetic-shift n -7) + (cons (+ 128 (bitwise-and n 127)) ls)))))) + ;;> \section{Integer conversion} ;;> Convert an unsigned integer \var{n} to a bytevector representing diff --git a/lib/chibi/bytevector.sld b/lib/chibi/bytevector.sld index c3956414..8bb1f017 100644 --- a/lib/chibi/bytevector.sld +++ b/lib/chibi/bytevector.sld @@ -5,6 +5,7 @@ (export bytevector-u16-ref-le bytevector-u16-ref-be bytevector-u32-ref-le bytevector-u32-ref-be + bytevector-ber-ref bytevector-ber-set! bytevector-pad-left integer->bytevector bytevector->integer integer->hex-string hex-string->integer