Coverage report: /home/ellis/comp/core/std/num/leb128.lisp

KindCoveredAll%
expression192294 65.3
branch1630 53.3
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; leb128.lisp --- Little-Endian Base 128 Variable Encoding
2
 
3
 ;; (U)LEB128 encoders based on CL-LEB128
4
 
5
 ;; see https://github.com/mahirvaluj/cl-leb128/blob/main/leb128.lisp
6
 
7
 ;;; Commentary:
8
 
9
 ;; ref: https://en.wikipedia.org/wiki/LEB128
10
 ;; opt: https://arxiv.org/abs/1503.07387 VByte
11
 ;; opt: https://arxiv.org/pdf/1709.08990 VByte streaming
12
 
13
 ;;; Code:
14
 (in-package :std/num)
15
 
16
 (defun encode-leb128 (i)
17
   "Encode an integer of arbitrary length into a leb128 unsigned-8 buffer"
18
   (let ((more t) (curr) (in 0) (int (make-array
19
                                      4
20
                                      :fill-pointer 0
21
                                      :element-type '(unsigned-byte 8)))) ;(neg (< i 0))
22
     (declare (fixnum i in))
23
     (loop while more do
24
       (setf curr (logand i #x7f))
25
       (setf i (ash i -7))
26
       (if (or (and (= i 0)  (= (logand curr #x40) 0))
27
               (and (= i -1) (= (logand curr #x40) 64)))
28
           (setf more nil)
29
           (setf curr (logior curr #x80)))
30
       (vector-push-extend curr int)
31
       (incf in))
32
     (let ((ret (make-array (length int) :element-type '(unsigned-byte 8) :initial-contents int)))
33
       ret)))
34
 
35
 (defun read-leb128 (s &optional (start 0))
36
   "decode signed integer from stream. Returns (values decoded-integer
37
 num-bytes-consumed)"
38
   (declare (fixnum start))
39
   (when (not (= start 0))
40
     (loop for i from 0 upto start do (read-byte s)))
41
   (let ((result 0) (shift 0) (curr) (counter 0))
42
     (declare (fixnum result shift counter))
43
     (loop do 
44
          (setf curr (read-byte s))
45
          (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
46
          (setf shift (+ 7 shift))
47
          (incf counter)
48
          (when (= 0 (logand curr #x80))
49
            (if (= 64 (logand curr #x40))
50
                (return-from read-leb128 (values (logior result (the fixnum (ash (lognot 0) shift))) counter))
51
                (return-from read-leb128 (values result counter)))))))
52
 
53
 (defun decode-leb128 (buf &optional (start 0))
54
   "decode signed integer from buffer. Returns (values decoded-integer
55
 num-bytes-consumed)"
56
   (declare (fixnum start) (vector buf))
57
   (let ((result 0) (shift 0) (curr 0) (counter 0))
58
     (declare (fixnum result shift counter))
59
     (loop do 
60
          (setf curr (the (unsigned-byte 8) (aref buf start)))
61
          (setf start (+ 1 start))
62
          (setf result (logior result (the fixnum (ash (logand curr #x7f) shift))))
63
          (setf shift (+ 7 shift))
64
          (incf counter)
65
          (when (= 0 (logand curr #x80))
66
            (if (= 64 (logand curr #x40))
67
                (return-from decode-leb128 (values (logior result (the fixnum (ash (lognot 0) shift))) counter))
68
                (return-from decode-leb128 (values result counter)))))))
69
 
70
 (declaim (ftype (function (integer &optional (unsigned-byte 8)) (array (unsigned-byte 8))) encode-uleb128))
71
 (defun encode-uleb128 (int &optional size)
72
   "Encode an integer INT as a ULEB128 byte array with SIZE (in bytes)."
73
   (declare (integer int))
74
   (let ((more t) (curr) (in 0) (ret (make-array
75
                                      (if size
76
                                          size
77
                                          (if (zerop int)
78
                                              1
79
                                              (ceiling  (/ (log (+ int 1) 2) 7))))
80
                                      :element-type '(unsigned-byte 8)))) ;(neg (< int 0))
81
     (loop while more do
82
          (setf curr (logand int #x7f))
83
          (setf int (ash int -7))
84
          (if (= int 0)
85
              (setf more nil)
86
              (setf curr (logior curr #x80)))
87
          (setf (aref ret in) curr)
88
          (incf in))
89
     ret))
90
 
91
 (declaim (ftype (function (vector &optional t) integer) decode-uleb128))
92
 (defun decode-uleb128 (bits &optional (start 0))
93
   "Decode an unsigned integer from ULEB128 byte array."
94
   (let ((result 0) (shift 0) (curr) (counter 0))
95
     (declare (fixnum shift counter))
96
     (loop do 
97
          (setf curr (aref bits start))
98
          (setf start (+ 1 start))
99
          (setf result (logior result (ash (logand curr #x7f) shift)))
100
          (setf shift (+ 7 shift))
101
          (incf counter)
102
          (when (= 0 (logand curr #x80))
103
            (return-from decode-uleb128 (values result counter))))))
104
 
105
 (defun read-uleb128 (s &optional (start 0))
106
   "Decode an arbitrarily large unsigned integer from stream. Skip
107
 START number bytes. Return (values integer-decoded
108
 num-bytes-consumed)"
109
   (declare (fixnum start))
110
   (when (not (= start 0))
111
     (loop for i from 0 upto start do (read-byte s)))
112
   (let ((result 0) (shift 0) (curr) (counter 0))
113
     (declare (fixnum shift counter))
114
     (loop do 
115
          (setf curr (read-byte s))
116
          (setf result (logior result (ash (logand curr #x7f) shift)))
117
          (setf shift (+ 7 shift))
118
          (incf counter)
119
          (when (= 0 (logand curr #x80))
120
            (return-from read-uleb128 (values result counter))))))