1.1--- a/lisp/std/num/leb128.lisp	Sun Jul 14 19:59:58 2024 -0400
     1.2+++ b/lisp/std/num/leb128.lisp	Sun Jul 14 22:34:13 2024 -0400
     1.3@@ -10,3 +10,36 @@
     1.4 
     1.5 ;;; Code:
     1.6 (in-package :std/num)
     1.7+
     1.8+(defun encode-unsigned-leb128 (int)
     1.9+  "Encode an integer INT as an octet-vector with LEB128 encoding."
    1.10+  (declare (fixnum int))
    1.11+  (let ((more t) (curr) (in 0) (ret (make-array
    1.12+                                     (if (zerop int)
    1.13+                                         1
    1.14+                                         (ceiling  (/ (log (+ int 1) 2) 7)))
    1.15+                                     :element-type '(unsigned-byte 8)))) ;(neg (< int 0))
    1.16+    (loop while more do
    1.17+         (setf curr (logand int #x7f))
    1.18+         (setf int (ash int -7))
    1.19+         (if (= int 0)
    1.20+             (setf more nil)
    1.21+             (setf curr (logior curr #x80)))
    1.22+         (setf (aref ret in) curr)
    1.23+         (incf in))
    1.24+    ret))
    1.25+
    1.26+(declaim (ftype (function ((simple-array unsigned-byte) &optional t) fixnum) decode-unsigned-leb128))
    1.27+(defun decode-unsigned-leb128 (bits &optional (start 0))
    1.28+  "Decode an unsigned integer from LEB128-encoded octet-vector BITS."
    1.29+  (declare (type (array unsigned-byte) bits))
    1.30+  (let ((result 0) (shift 0) (curr) (counter 0))
    1.31+    (declare (fixnum result shift counter))
    1.32+    (loop do 
    1.33+         (setf curr (the (unsigned-byte 8) (aref bits start)))
    1.34+         (setf start (+ 1 start))
    1.35+         (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
    1.36+         (setf shift (+ 7 shift))
    1.37+         (incf counter)
    1.38+         (when (= 0 (logand curr #x80))
    1.39+           (return-from decode-unsigned-leb128 (values result counter))))))