From 6777c2eb2f1efab124f19677d25e2f64bc6c6680 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 2 Sep 2023 12:07:04 -0700
Subject: [PATCH] leb128: support unsigned and signed LEB128 format

---
 extra/leb128/leb128-docs.factor  | 31 +++++++++++
 extra/leb128/leb128-tests.factor |  8 ++-
 extra/leb128/leb128.factor       | 93 +++++++++++++++++++++++++++-----
 3 files changed, 117 insertions(+), 15 deletions(-)
 create mode 100644 extra/leb128/leb128-docs.factor

diff --git a/extra/leb128/leb128-docs.factor b/extra/leb128/leb128-docs.factor
new file mode 100644
index 0000000000..3a3a3cc15a
--- /dev/null
+++ b/extra/leb128/leb128-docs.factor
@@ -0,0 +1,31 @@
+
+USING: byte-arrays help.markup help.syntax ;
+
+IN: leb128
+
+ARTICLE: "leb128" "LEB128 Encoding"
+
+Implements support for the LEB128 (Little Endian Base 128) encoding format,
+both unsigned and signed.
+
+Unsigned LEB123:
+{ $subsections
+    >uleb128
+    uleb128>
+    write-uleb128
+    stream-write-uleb128
+    read-uleb128
+    stream-read-uleb128
+}
+
+Signed LEB123:
+{ $subsections
+    >leb128
+    leb128>
+    write-leb128
+    stream-write-leb128
+    read-leb128
+    stream-read-leb128
+} ;
+
+ABOUT: "leb128"
diff --git a/extra/leb128/leb128-tests.factor b/extra/leb128/leb128-tests.factor
index c9b6d7d8cc..0e34b5ccf1 100644
--- a/extra/leb128/leb128-tests.factor
+++ b/extra/leb128/leb128-tests.factor
@@ -1,8 +1,12 @@
 
 USING: leb128 tools.test ;
 
-{ B{ 0xe5 0x8e 0x26 } } [ 624485 >leb128 ] unit-test
-{ 624485 } [ B{ 0xe5 0x8e 0x26 } leb128> ] unit-test
+{ B{ 0xe5 0x8e 0x26 } } [ 624485 >uleb128 ] unit-test
+{ 624485 } [ B{ 0xe5 0x8e 0x26 } uleb128> ] unit-test
+{ B{ 255 255 127 } } [ 0x1fffff >uleb128 ] unit-test
+{ 0x1fffff } [ B{ 255 255 127 } uleb128> ] unit-test
 
+{ B{ 255 255 255 0 } } [ 0x1fffff >leb128 ] unit-test
+{ 0x1fffff } [ B{ 255 255 255 0 } leb128> ] unit-test
 { B{ 0xc0 0xbb 0x78 } } [ -123456 >leb128 ] unit-test
 { -123456 } [ B{ 0xc0 0xbb 0x78 } leb128> ] unit-test
diff --git a/extra/leb128/leb128.factor b/extra/leb128/leb128.factor
index b1381d267d..d27637f333 100644
--- a/extra/leb128/leb128.factor
+++ b/extra/leb128/leb128.factor
@@ -1,21 +1,88 @@
 ! Copyright (C) 2023 John Benediktsson
 ! See https://factorcode.org/license.txt for BSD license
 
-USING: combinators.short-circuit kernel make math sequences ;
+USING: byte-vectors combinators.short-circuit io
+io.streams.byte-array kernel math namespaces sequences ;
 
 IN: leb128
 
-:: >leb128 ( n -- byte-array )
-    [
-        n [
-            [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
-            {
-                [ i zero? b 6 bit? not and ]
-                [ i -1 = b 6 bit? and ]
-            } 0|| [ f b ] [ t b 0x80 bitor ] if ,
-        ] loop drop
-    ] B{ } make ;
+! Unsigned LEB128
+
+<PRIVATE
+
+:: (write-uleb128) ( n quot: ( b -- ) -- )
+    n assert-non-negative [
+        [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
+        dup zero? [ f b ] [ t b 0x80 bitor ] if
+        quot call
+    ] loop drop ; inline
+
+PRIVATE>
+
+: stream-write-uleb128 ( n stream -- )
+    '[ _ stream-write1 ] (write-uleb128) ;
+
+: write-uleb128 ( n -- )
+    output-stream get stream-write-uleb128 ;
+
+: >uleb128 ( n -- byte-array )
+    16 <byte-vector> clone [
+        '[ _ push ] (write-uleb128)
+    ] keep B{ } like ;
+
+:: stream-read-uleb128 ( stream -- n )
+    0 0 [
+        stream stream-read1 :> ( i b )
+        b 0x7f bitand i 7 * shift +
+        i 1 + b 7 bit?
+    ] loop drop ;
+
+: read-uleb128 ( -- n )
+    input-stream get stream-read-uleb128 ;
+
+: uleb128> ( byte-array -- n )
+    0 byte-reader boa stream-read-uleb128 ;
+
+! Signed LEB128
+
+<PRIVATE
+
+:: (write-leb128) ( n quot: ( b -- ) -- )
+    n [
+        [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
+        {
+            [ i zero? b 6 bit? not and ]
+            [ i -1 = b 6 bit? and ]
+        } 0|| [ f b ] [ t b 0x80 bitor ] if
+        quot call
+    ] loop drop ; inline
+
+PRIVATE>
+
+: stream-write-leb128 ( n stream -- )
+    '[ _ stream-write1 ] (write-leb128) ;
+
+: write-leb128 ( n -- )
+    output-stream get stream-write-leb128 ;
+
+: >leb128 ( n -- byte-array )
+    16 <byte-vector> clone [
+        '[ _ push ] (write-leb128)
+    ] keep B{ } like ;
+
+:: stream-read-leb128 ( stream -- n )
+    0 0 [
+        stream stream-read1 :> ( i b )
+        b 0x7f bitand i 7 * shift +
+        i 1 + b 7 bit? dup [
+            b 6 bit? [
+                [ [ 7 * 2^ neg bitor ] keep ] dip
+            ] when
+        ] unless
+    ] loop drop ;
+
+: read-leb128 ( -- n )
+    input-stream get stream-read-leb128 ;
 
 : leb128> ( byte-array -- n )
-    [ 0 [ [ 0x7f bitand ] [ 7 * shift ] bi* + ] reduce-index ] keep
-    dup last 6 bit? [ length 7 * 2^ neg bitor ] [ drop ] if ;
+    0 byte-reader boa stream-read-leb128 ;
-- 
2.34.1