leb128.lisp

(defpackage :leb128
  (:use :cl)
  (:export :encode-signed :decode-signed
           :encode-unsigned :decode-unsigned))
(in-package :leb128)

;; This function has thus far been the bane of my existence so I have
;; resorted to using an adjustable array. If this is too slow,
;; reimplment it, it shouldn't be hard.
(defmethod encode-signed (i)
  "Encode an integer of arbitrary length into a leb128 unsigned-8 buffer"
  (let ((more t) (curr) (in 0) (int (make-array
                                     4
                                     :adjustable t
                                     :fill-pointer 0
                                     :element-type '(unsigned-byte 8)))) ;(neg (< i 0))
    (loop while more do
      (setf curr (logand i #x7f))
      (setf i (ash i -7))
      (if (or (and (= i 0)  (= (logand curr #x40) 0))
              (and (= i -1) (= (logand curr #x40) 64)))
          (setf more nil)
          (setf curr (logior curr #x80)))
      (vector-push-extend curr int)
      (incf in))
    (let ((ret (make-array (length int) :element-type '(unsigned-byte 8) :initial-contents int)))
      ret)))

(defmethod decode-signed ((s stream) &key (start 0))
  "decode signed integer from stream. Returns (values decoded-integer
num-bytes-consumed)"
  (when (not (= start 0))
    (loop for i from 0 upto start do (read-byte s)))
  (let ((result 0) (shift 0) (curr) (counter 0))
    (loop do 
         (setf curr (read-byte s))
         (setf result (logior result (ash (logand curr #x7f) shift)))
         (setf shift (+ 7 shift))
         (incf counter)
         (when (= 0 (logand curr #x80))
           (if (= 64 (logand curr #x40))
               (return-from decode-signed (values (logior result (ash (lognot 0) shift)) counter))
               (return-from decode-signed (values result counter)))))))

(defmethod decode-signed ((buf array) &key (start 0))
  "decode signed integer from buffer. Returns (values decoded-integer
num-bytes-consumed)"
  (let ((result 0) (shift 0) (curr) (counter 0))
    (loop do 
         (setf curr (aref buf start))
         (setf start (+ 1 start))
         (setf result (logior result (ash (logand curr #x7f) shift)))
         (setf shift (+ 7 shift))
         (incf counter)
         (when (= 0 (logand curr #x80))
           (if (= 64 (logand curr #x40))
               (return-from decode-signed (values (logior result (ash (lognot 0) shift)) counter))
               (return-from decode-signed (values result counter)))))))

(defmethod encode-unsigned (i)
  "Encode an arbitrarily large unsigned integer in leb128"
  (declare (type unsigned-byte i))
  (let ((more t) (curr) (in 0) (ret (make-array
                                     (if (= i 0)
                                         1
                                         (ceiling  (/ (log (+ i 1) 2) 7)))
                                     :element-type '(unsigned-byte 8)))) ;(neg (< i 0))
    (loop while more do
         (setf curr (logand i #x7f))
         (setf i (ash i -7))
         (if (= i 0)
             (setf more nil)
             (setf curr (logior curr #x80)))
         (setf (aref ret in) curr)
         (incf in))
    ret))

(defmethod decode-unsigned ((s stream) &key (start 0))
  "Decode an arbitrarily large unsigned integer from stream. Skip
_start_ number bytes. Return (values integer-decoded
num-bytes-consumed)"
  (when (not (= start 0))
    (loop for i from 0 upto start do (read-byte s)))
  (let ((result 0) (shift 0) (curr) (counter 0))
    (loop do 
         (setf curr (read-byte s))
         (setf result (logior result (ash (logand curr #x7f) shift)))
         (setf shift (+ 7 shift))
         (incf counter)
         (when (= 0 (logand curr #x80))
           (return-from decode-unsigned (values result counter))))))

(defmethod decode-unsigned ((buf array) &key (start 0))
  "decode signed integer from buffer. Returns (values decoded-integer
num-bytes-consumed)"
  (let ((result 0) (shift 0) (curr) (counter 0))
    (loop do 
         (setf curr (aref buf start))
         (setf start (+ 1 start))
         (setf result (logior result (ash (logand curr #x7f) shift)))
         (setf shift (+ 7 shift))
         (incf counter)
         (when (= 0 (logand curr #x80))
           (return-from decode-unsigned (values result counter))))))