1.1--- a/lisp/std/num/leb128.lisp	Sun Jul 14 22:34:13 2024 -0400
     1.2+++ b/lisp/std/num/leb128.lisp	Mon Jul 15 15:18:03 2024 -0400
     1.3@@ -1,6 +1,8 @@
     1.4 ;;; leb128.lisp --- Little-Endian Base 128 Variable Encoding
     1.5 
     1.6-;; (U)LEB128 encoders
     1.7+;; (U)LEB128 encoders based on CL-LEB128
     1.8+
     1.9+;; see https://github.com/mahirvaluj/cl-leb128/blob/main/leb128.lisp
    1.10 
    1.11 ;;; Commentary:
    1.12 
    1.13@@ -11,8 +13,64 @@
    1.14 ;;; Code:
    1.15 (in-package :std/num)
    1.16 
    1.17-(defun encode-unsigned-leb128 (int)
    1.18-  "Encode an integer INT as an octet-vector with LEB128 encoding."
    1.19+(defun encode-leb128 (i)
    1.20+  "Encode an integer of arbitrary length into a leb128 unsigned-8 buffer"
    1.21+  (let ((more t) (curr) (in 0) (int (make-array
    1.22+                                     4
    1.23+                                     :adjustable t
    1.24+                                     :fill-pointer 0
    1.25+                                     :element-type '(unsigned-byte 8)))) ;(neg (< i 0))
    1.26+    (declare (fixnum i in))
    1.27+    (loop while more do
    1.28+      (setf curr (logand i #x7f))
    1.29+      (setf i (ash i -7))
    1.30+      (if (or (and (= i 0)  (= (logand curr #x40) 0))
    1.31+              (and (= i -1) (= (logand curr #x40) 64)))
    1.32+          (setf more nil)
    1.33+          (setf curr (logior curr #x80)))
    1.34+      (vector-push-extend curr int)
    1.35+      (incf in))
    1.36+    (let ((ret (make-array (length int) :element-type '(unsigned-byte 8) :initial-contents int)))
    1.37+      ret)))
    1.38+
    1.39+(defun read-leb128 (s &optional (start 0))
    1.40+  "decode signed integer from stream. Returns (values decoded-integer
    1.41+num-bytes-consumed)"
    1.42+  (declare (fixnum start))
    1.43+  (when (not (= start 0))
    1.44+    (loop for i from 0 upto start do (read-byte s)))
    1.45+  (let ((result 0) (shift 0) (curr) (counter 0))
    1.46+    (declare (fixnum result shift counter))
    1.47+    (loop do 
    1.48+         (setf curr (read-byte s))
    1.49+         (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
    1.50+         (setf shift (+ 7 shift))
    1.51+         (incf counter)
    1.52+         (when (= 0 (logand curr #x80))
    1.53+           (if (= 64 (logand curr #x40))
    1.54+               (return-from read-leb128 (values (logior result (the fixnum (ash (lognot 0) shift))) counter))
    1.55+               (return-from read-leb128 (values result counter)))))))
    1.56+
    1.57+(defun decode-leb128 (buf &optional (start 0))
    1.58+  "decode signed integer from buffer. Returns (values decoded-integer
    1.59+num-bytes-consumed)"
    1.60+  (declare (fixnum start) (vector buf))
    1.61+  (let ((result 0) (shift 0) (curr 0) (counter 0))
    1.62+    (declare (fixnum result shift counter))
    1.63+    (loop do 
    1.64+         (setf curr (the (unsigned-byte 8) (aref buf start)))
    1.65+         (setf start (+ 1 start))
    1.66+         (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
    1.67+         (setf shift (+ 7 shift))
    1.68+         (incf counter)
    1.69+         (when (= 0 (logand curr #x80))
    1.70+           (if (= 64 (logand curr #x40))
    1.71+               (return-from decode-leb128 (values (logior result (the fixnum (ash (lognot 0) shift))) counter))
    1.72+               (return-from decode-leb128 (values result counter)))))))
    1.73+
    1.74+(declaim (ftype (function (fixnum) (simple-array (unsigned-byte 8))) encode-uleb128))
    1.75+(defun encode-uleb128 (int)
    1.76+  "Encode an integer INT as a ULEB128 byte array."
    1.77   (declare (fixnum int))
    1.78   (let ((more t) (curr) (in 0) (ret (make-array
    1.79                                      (if (zerop int)
    1.80@@ -27,19 +85,36 @@
    1.81              (setf curr (logior curr #x80)))
    1.82          (setf (aref ret in) curr)
    1.83          (incf in))
    1.84-    ret))
    1.85+    (coerce ret 'simple-array)))
    1.86 
    1.87-(declaim (ftype (function ((simple-array unsigned-byte) &optional t) fixnum) decode-unsigned-leb128))
    1.88-(defun decode-unsigned-leb128 (bits &optional (start 0))
    1.89-  "Decode an unsigned integer from LEB128-encoded octet-vector BITS."
    1.90-  (declare (type (array unsigned-byte) bits))
    1.91+(declaim (ftype (function ((array (unsigned-byte 8)) &optional t) fixnum) decode-uleb128))
    1.92+(defun decode-uleb128 (bits &optional (start 0))
    1.93+  "Decode an unsigned integer from ULEB128 byte array."
    1.94   (let ((result 0) (shift 0) (curr) (counter 0))
    1.95-    (declare (fixnum result shift counter))
    1.96+    (declare (fixnum result shift counter start)
    1.97+             ((array (unsigned-byte 8)) bits))
    1.98     (loop do 
    1.99-         (setf curr (the (unsigned-byte 8) (aref bits start)))
   1.100+         (setf curr (aref bits start))
   1.101          (setf start (+ 1 start))
   1.102          (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
   1.103          (setf shift (+ 7 shift))
   1.104          (incf counter)
   1.105          (when (= 0 (logand curr #x80))
   1.106-           (return-from decode-unsigned-leb128 (values result counter))))))
   1.107+           (return-from decode-uleb128 (values result counter))))))
   1.108+
   1.109+(defun read-uleb128 (s &optional (start 0))
   1.110+  "Decode an arbitrarily large unsigned integer from stream. Skip
   1.111+START number bytes. Return (values integer-decoded
   1.112+num-bytes-consumed)"
   1.113+  (declare (fixnum start))
   1.114+  (when (not (= start 0))
   1.115+    (loop for i from 0 upto start do (read-byte s)))
   1.116+  (let ((result 0) (shift 0) (curr) (counter 0))
   1.117+    (declare (fixnum result shift counter))
   1.118+    (loop do 
   1.119+         (setf curr (read-byte s))
   1.120+         (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
   1.121+         (setf shift (+ 7 shift))
   1.122+         (incf counter)
   1.123+         (when (= 0 (logand curr #x80))
   1.124+           (return-from read-uleb128 (values result counter))))))

     2.1--- a/lisp/std/pkg.lisp	Sun Jul 14 22:34:13 2024 -0400
     2.2+++ b/lisp/std/pkg.lisp	Mon Jul 15 15:18:03 2024 -0400
     2.3@@ -106,7 +106,14 @@
     2.4    :encode-float32
     2.5    :decode-float32
     2.6    :encode-float64
     2.7-   :decode-float64))
     2.8+   :decode-float64
     2.9+   ;; num/leb128
    2.10+   :read-leb128
    2.11+   :encode-leb128
    2.12+   :decode-leb128
    2.13+   :read-uleb128
    2.14+   :encode-uleb128
    2.15+   :decode-uleb128))
    2.16 
    2.17 (defpkg :std/stream
    2.18   (:use :cl :sb-gray)

     3.1--- a/lisp/std/tests.lisp	Sun Jul 14 22:34:13 2024 -0400
     3.2+++ b/lisp/std/tests.lisp	Mon Jul 15 15:18:03 2024 -0400
     3.3@@ -251,16 +251,26 @@
     3.4                x) ;; 2
     3.5          '(42 42 2)))))
     3.6 
     3.7-(deftest bits (:skip t)
     3.8-  (define-bitfield testbits
     3.9-    (a boolean)
    3.10-    (b (signed-byte 2))
    3.11-    (c (unsigned-byte 3) :initform 1)
    3.12-    (d (integer -100 100))
    3.13-    (e (member foo bar baz)))
    3.14+(define-bitfield testbits
    3.15+  (a boolean)
    3.16+  (b (signed-byte 2))
    3.17+  (c (unsigned-byte 3) :initform 1)
    3.18+  (d (integer -100 100))
    3.19+  (e (member foo bar baz)))
    3.20+
    3.21+(deftest bits ()
    3.22   (let ((bits (make-testbits)))
    3.23     (is (not (testbits-a bits)))
    3.24     (is (= 0 (testbits-b bits)))
    3.25     (is (= 1 (testbits-c bits)))
    3.26     (is (= -100 (testbits-d bits)))
    3.27     (is (eql 'foo (testbits-e bits)))))
    3.28+
    3.29+(deftest leb128 ()
    3.30+  (loop for i from 0 below 1000
    3.31+        do (is (= i (decode-uleb128 (encode-uleb128 i)))))
    3.32+  (signals division-by-zero (decode-uleb128 (encode-uleb128 -1)))
    3.33+  (loop for i from -1000 below 0
    3.34+        do (is (= i (decode-leb128 (encode-leb128 i))))
    3.35+        do (is (= (* i i) (decode-leb128 (encode-leb128 (* i i)))))))
    3.36+