supporting ber encoding in bytevectors

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))))

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

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