Add leb128 library
This commit is contained in:
parent
e48bc05a60
commit
7077044530
|
|
@ -13,4 +13,13 @@ run-test*
|
||||||
Akku.*
|
Akku.*
|
||||||
srfi
|
srfi
|
||||||
snow
|
snow
|
||||||
|
*.wasm
|
||||||
|
*.js
|
||||||
|
*.a
|
||||||
|
*.o
|
||||||
|
*.so
|
||||||
|
*.import.*
|
||||||
|
*.link
|
||||||
|
core.*
|
||||||
|
venv*
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -27,7 +27,7 @@ ARG SCHEME=chibi
|
||||||
FROM docker.io/schemers/${IMAGE}
|
FROM docker.io/schemers/${IMAGE}
|
||||||
|
|
||||||
COPY --from=build /build /build
|
COPY --from=build /build /build
|
||||||
RUN apt-get update && apt-get install -y make curl
|
RUN apt-get update && apt-get install -y make curl libcurl4-openssl-dev emscripten
|
||||||
WORKDIR /build/chibi-scheme
|
WORKDIR /build/chibi-scheme
|
||||||
RUN make install
|
RUN make install
|
||||||
WORKDIR /build/akku
|
WORKDIR /build/akku
|
||||||
|
|
@ -42,6 +42,10 @@ RUN mkdir -p /root/.snow && echo "()" > /root/.snow/config.scm
|
||||||
WORKDIR /workdir
|
WORKDIR /workdir
|
||||||
ARG SCHEME=chibi
|
ARG SCHEME=chibi
|
||||||
ENV COMPILE_R7RS=${SCHEME}
|
ENV COMPILE_R7RS=${SCHEME}
|
||||||
|
RUN snow-chibi install --impls=${SCHEME} --always-yes srfi.64
|
||||||
|
RUN snow-chibi install --impls=${SCHEME} --always-yes retropikzel.mouth
|
||||||
|
RUN snow-chibi install --impls=${SCHEME} --always-yes retropikzel.ctrf
|
||||||
COPY Makefile .
|
COPY Makefile .
|
||||||
COPY retropikzel retropikzel/
|
COPY retropikzel retropikzel/
|
||||||
|
RUN make retropikzel/wasm/plus.wasm
|
||||||
|
|
||||||
|
|
|
||||||
58
Makefile
58
Makefile
|
|
@ -1,6 +1,7 @@
|
||||||
SCHEME=chibi
|
SCHEME=chibi
|
||||||
RNRS=r7rs
|
RNRS=r7rs
|
||||||
LIBRARY=ctrf
|
LIBRARY=ctrf
|
||||||
|
VENV=venv-${SCHEME}-${RNRS}-${LIBRARY}
|
||||||
AUTHOR=retropikzel
|
AUTHOR=retropikzel
|
||||||
|
|
||||||
LIBRARY_FILE=retropikzel/${LIBRARY}.sld
|
LIBRARY_FILE=retropikzel/${LIBRARY}.sld
|
||||||
|
|
@ -29,30 +30,35 @@ install:
|
||||||
uninstall:
|
uninstall:
|
||||||
-snow-chibi remove --impls=${SCHEME} ${PKG}
|
-snow-chibi remove --impls=${SCHEME} ${PKG}
|
||||||
|
|
||||||
run-test-venv: build
|
logs:
|
||||||
rm -rf venv
|
mkdir -p logs
|
||||||
scheme-venv ${SCHEME} ${RNRS} venv
|
|
||||||
echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (retropikzel mouth) (srfi 64) (retropikzel ctrf) (retropikzel ${LIBRARY}))" > venv/test.scm
|
|
||||||
echo "(test-runner-current (ctrf-runner))" >> venv/test.scm
|
|
||||||
printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :98) (retropikzel mouth) (retropikzel ${LIBRARY}))" > venv/test.sps
|
|
||||||
cat ${TESTFILE} >> venv/test.scm
|
|
||||||
cat ${TESTFILE} >> venv/test.sps
|
|
||||||
if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
|
|
||||||
if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install retropikzel.mouth; fi
|
|
||||||
if [ "${RNRS}" = "r7rs" ]; then printf "1\n1\n" | ./venv/bin/snow-chibi install retropikzel.ctrf; fi
|
|
||||||
if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi
|
|
||||||
if [ "${SCHEME}" = "chezscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
|
|
||||||
if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
|
|
||||||
if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
|
|
||||||
if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
|
|
||||||
if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/akku install; fi
|
|
||||||
if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
|
|
||||||
if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi
|
|
||||||
if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi
|
|
||||||
if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi
|
|
||||||
./venv/test
|
|
||||||
|
|
||||||
run-test-system: build
|
${VENV}:
|
||||||
|
scheme-venv ${SCHEME} ${RNRS} ${VENV}
|
||||||
|
if [ "${RNRS}" = "r7rs" ]; then ${VENV}/bin/snow-chibi install --always-yes srfi.64; fi
|
||||||
|
if [ "${RNRS}" = "r7rs" ]; then ${VENV}/bin/snow-chibi install retropikzel.mouth; fi
|
||||||
|
if [ "${RNRS}" = "r7rs" ]; then ${VENV}/bin/snow-chibi install --always-yes retropikzel.ctrf; fi
|
||||||
|
if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ${VENV}/bin/snow-chibi install --always-yes srfi.64; fi
|
||||||
|
if [ "${SCHEME}" = "chezscheme" ]; then ${VENV}/bin/akku install akku-r7rs chez-srfi; fi
|
||||||
|
if [ "${SCHEME}" = "ikarus" ]; then ${VENV}/bin/akku install akku-r7rs chez-srfi; fi
|
||||||
|
if [ "${SCHEME}" = "ironscheme" ]; then ${VENV}/bin/akku install akku-r7rs chez-srfi; fi
|
||||||
|
if [ "${SCHEME}" = "racket" ]; then ${VENV}/bin/akku install akku-r7rs chez-srfi; fi
|
||||||
|
|
||||||
|
run-test-venv: ${VENV} logs build
|
||||||
|
echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (retropikzel mouth) (srfi 64) (retropikzel ctrf) (retropikzel ${LIBRARY}))" > ${VENV}/test.scm
|
||||||
|
echo "(test-runner-current (ctrf-runner))" >> ${VENV}/test.scm
|
||||||
|
printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :98) (retropikzel mouth) (retropikzel ${LIBRARY}))" > ${VENV}/test.sps
|
||||||
|
cat ${TESTFILE} >> ${VENV}/test.scm
|
||||||
|
cat ${TESTFILE} >> ${VENV}/test.sps
|
||||||
|
if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel ${VENV}/lib/; fi
|
||||||
|
if [ "${RNRS}" = "r6rs" ]; then ${VENV}/bin/akku install; fi
|
||||||
|
if [ "${RNRS}" = "r7rs" ]; then ${VENV}/bin/snow-chibi install ${PKG}; fi
|
||||||
|
if [ "${RNRS}" = "r6rs" ]; then ${VENV}/bin/scheme-compile ${VENV}/test.sps; fi
|
||||||
|
if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl" ${VENV}/bin/scheme-compile ${VENV}/test.scm; fi
|
||||||
|
cd ${VENV} && ./test
|
||||||
|
mv ${VENV}/*.json logs/ || true
|
||||||
|
|
||||||
|
run-test-system: logs build
|
||||||
printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :98) (retropikzel mouth) (retropikzel ctrf) (retropikzel ${LIBRARY}))" > run-test.sps
|
printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :98) (retropikzel mouth) (retropikzel ctrf) (retropikzel ${LIBRARY}))" > run-test.sps
|
||||||
echo "(test-runner-current (ctrf-runner))" >> run-test.sps
|
echo "(test-runner-current (ctrf-runner))" >> run-test.sps
|
||||||
cat ${TESTFILE} >> run-test.sps
|
cat ${TESTFILE} >> run-test.sps
|
||||||
|
|
@ -73,10 +79,14 @@ run-test-system: build
|
||||||
if [ "${RNRS}" = "r6rs" ]; then COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib run-test.sps; fi
|
if [ "${RNRS}" = "r6rs" ]; then COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib run-test.sps; fi
|
||||||
if [ "${RNRS}" = "r7rs" ]; then COMPILE_R7RS=${SCHEME} CSC_OPTIONS="-L -lcurl" compile-scheme run-test.scm; fi
|
if [ "${RNRS}" = "r7rs" ]; then COMPILE_R7RS=${SCHEME} CSC_OPTIONS="-L -lcurl" compile-scheme run-test.scm; fi
|
||||||
./run-test
|
./run-test
|
||||||
|
mv *.json logs/ || true
|
||||||
|
|
||||||
run-test-docker:
|
run-test-docker:
|
||||||
docker build --build-arg IMAGE=${DOCKERIMG} -f Dockerfile.test --tag=scheme-libraries-${SCHEME}-${RNRS} .
|
docker build --build-arg IMAGE=${DOCKERIMG} -f Dockerfile.test --tag=scheme-libraries-${SCHEME}-${RNRS} .
|
||||||
docker run -v "${PWD}:/workdir" -w /workdir scheme-libraries-${SCHEME}-${RNRS} sh -c "make SCHEME=${SCHEME} RNRS=${RNRS} LIBRARY=${LIBRARY} run-test-system ; chmod 755 *.json || true"
|
docker run -v "${PWD}/logs:/workdir/logs" -w /workdir scheme-libraries-${SCHEME}-${RNRS} sh -c "make SCHEME=${SCHEME} RNRS=${RNRS} LIBRARY=${LIBRARY} run-test-system"
|
||||||
|
|
||||||
|
retropikzel/wasm/plus.wasm: retropikzel/wasm/plus.c
|
||||||
|
emcc -o retropikzel/wasm/plus.js retropikzel/wasm/plus.c
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
git clean -X -f
|
git clean -X -f
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,113 @@
|
||||||
|
(define (integer->leb128 value)
|
||||||
|
(when (not (exact-integer? value))
|
||||||
|
(error "integer->leb128: value must be exact integer" value))
|
||||||
|
(letrec*
|
||||||
|
((more 1)
|
||||||
|
(byte #f)
|
||||||
|
(sign-bit #f)
|
||||||
|
(bytes (bytevector))
|
||||||
|
(negative-at-start? (negative? value))
|
||||||
|
(looper
|
||||||
|
(lambda ()
|
||||||
|
(set! byte (bitwise-and value #x7f))
|
||||||
|
(set! value (arithmetic-shift value -7))
|
||||||
|
(set! sign-bit (bitwise-and byte #x40))
|
||||||
|
(if (or (and (= value 0) (= sign-bit 0))
|
||||||
|
(and (= value -1) (not (= sign-bit 0))))
|
||||||
|
(set! more 0)
|
||||||
|
(set! byte (bitwise-ior byte #x80)))
|
||||||
|
(set! bytes (bytevector-append bytes (bytevector byte)))
|
||||||
|
(when (not (= more 0)) (looper)))))
|
||||||
|
(looper)
|
||||||
|
bytes))
|
||||||
|
|
||||||
|
(define (leb128->integer-and-length bytes . start-index)
|
||||||
|
(when (not (bytevector? bytes))
|
||||||
|
(error "leb128->integer-and-lenght: bytes must be bytevector" bytes))
|
||||||
|
(when (and (not (null? start-index))
|
||||||
|
(not (exact-integer? (car start-index))))
|
||||||
|
(error "leb128->integer-and-length: start-index must be exact integer"
|
||||||
|
(car start-index)))
|
||||||
|
(letrec*
|
||||||
|
((result 0)
|
||||||
|
(shift 0)
|
||||||
|
(byte #f)
|
||||||
|
(index (if (null? start-index) 0 (car start-index)))
|
||||||
|
(looper
|
||||||
|
(lambda ()
|
||||||
|
(set! byte (bytevector-u8-ref bytes index))
|
||||||
|
(set! result (+ result (arithmetic-shift (bitwise-and byte #x7f) shift)))
|
||||||
|
(when (not (= (bitwise-and byte #x80) 0))
|
||||||
|
(set! shift (+ shift 7))
|
||||||
|
(set! index (+ index 1))
|
||||||
|
(looper)))))
|
||||||
|
(looper)
|
||||||
|
(cons
|
||||||
|
(if (not (= (bitwise-and byte #x40) 0))
|
||||||
|
(bitwise-ior result (* (arithmetic-shift 1 (+ shift 7)) -1))
|
||||||
|
result)
|
||||||
|
(+ index 1))))
|
||||||
|
|
||||||
|
(define (leb128->integer bytes . start-index)
|
||||||
|
(when (not (bytevector? bytes))
|
||||||
|
(error "leb128->integer: bytes must be bytevector" bytes))
|
||||||
|
(when (and (not (null? start-index))
|
||||||
|
(not (exact-integer? (car start-index))))
|
||||||
|
(error "leb128->integer: start-index must be exact integer"
|
||||||
|
(car start-index)))
|
||||||
|
(car (leb128->integer-and-length bytes
|
||||||
|
(if (null? start-index)
|
||||||
|
0
|
||||||
|
(car start-index)))))
|
||||||
|
|
||||||
|
(define (integer->uleb128 value)
|
||||||
|
(when (not (exact-integer? value)) (error "integer->uleb128: value must be exact integer" value))
|
||||||
|
(when (and (not (positive? value))
|
||||||
|
(not (zero? value)))
|
||||||
|
(error "integer->uleb128: value must be unsigned integer" value))
|
||||||
|
(letrec*
|
||||||
|
((byte #f)
|
||||||
|
(bytes (bytevector))
|
||||||
|
(looper
|
||||||
|
(lambda ()
|
||||||
|
(set! byte (bitwise-and value #x7f))
|
||||||
|
(set! value (arithmetic-shift value -7))
|
||||||
|
(when (not (= value 0)) (set! byte (bitwise-ior byte #x80)))
|
||||||
|
(set! bytes (bytevector-append bytes (bytevector byte)))
|
||||||
|
(if (not (= value 0)) (looper)))))
|
||||||
|
(looper)
|
||||||
|
bytes))
|
||||||
|
|
||||||
|
(define (uleb128->integer-and-length bytes . start-index)
|
||||||
|
(when (not (bytevector? bytes))
|
||||||
|
(error "uleb128->integer-and-length: bytes must be bytevector" bytes))
|
||||||
|
(when (and (not (null? start-index))
|
||||||
|
(not (exact-integer? (car start-index))))
|
||||||
|
(error "uleb128->integer-and-lenght: start-index must be exact integer"
|
||||||
|
(car start-index)))
|
||||||
|
(letrec*
|
||||||
|
((uleb-bytes-count 1)
|
||||||
|
(index (if (null? start-index) 0 (car start-index)))
|
||||||
|
(byte (bytevector-u8-ref bytes index))
|
||||||
|
(shift 0)
|
||||||
|
(result (arithmetic-shift (bitwise-and byte #x7f) shift))
|
||||||
|
(looper
|
||||||
|
(lambda ()
|
||||||
|
(cond
|
||||||
|
((= (bitwise-and byte #x80) 0) (cons result uleb-bytes-count))
|
||||||
|
(else
|
||||||
|
(set! uleb-bytes-count (+ uleb-bytes-count 1))
|
||||||
|
(set! index (+ index 1))
|
||||||
|
(set! byte (bytevector-u8-ref bytes index))
|
||||||
|
(set! result (bitwise-ior result (arithmetic-shift (bitwise-and byte #x7f) shift)))
|
||||||
|
(set! shift (+ shift 7))
|
||||||
|
(looper))))))
|
||||||
|
(set! shift (+ shift 7))
|
||||||
|
(looper)))
|
||||||
|
|
||||||
|
(define (uleb128->integer bytes . start-index)
|
||||||
|
(when (not (bytevector? bytes)) (error "uleb128->integer: bytes must be bytevector" bytes))
|
||||||
|
(when (and (not (null? start-index))
|
||||||
|
(not (exact-integer? (car start-index))))
|
||||||
|
(error "uleb128->integer: start-index must be exact integer" (car start-index)))
|
||||||
|
(car (uleb128->integer-and-length bytes (if (null? start-index) 0 (car start-index)))))
|
||||||
|
|
@ -0,0 +1,12 @@
|
||||||
|
(define-library
|
||||||
|
(retropikzel leb128)
|
||||||
|
(import (scheme base)
|
||||||
|
(scheme write)
|
||||||
|
(srfi 60))
|
||||||
|
(export integer->leb128
|
||||||
|
leb128->integer
|
||||||
|
leb128->integer-and-length
|
||||||
|
integer->uleb128
|
||||||
|
uleb128->integer
|
||||||
|
uleb128->integer-and-length)
|
||||||
|
(include "leb128.scm"))
|
||||||
|
|
@ -0,0 +1,165 @@
|
||||||
|
GNU LESSER GENERAL PUBLIC LICENSE
|
||||||
|
Version 3, 29 June 2007
|
||||||
|
|
||||||
|
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||||
|
Everyone is permitted to copy and distribute verbatim copies
|
||||||
|
of this license document, but changing it is not allowed.
|
||||||
|
|
||||||
|
|
||||||
|
This version of the GNU Lesser General Public License incorporates
|
||||||
|
the terms and conditions of version 3 of the GNU General Public
|
||||||
|
License, supplemented by the additional permissions listed below.
|
||||||
|
|
||||||
|
0. Additional Definitions.
|
||||||
|
|
||||||
|
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||||
|
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||||
|
General Public License.
|
||||||
|
|
||||||
|
"The Library" refers to a covered work governed by this License,
|
||||||
|
other than an Application or a Combined Work as defined below.
|
||||||
|
|
||||||
|
An "Application" is any work that makes use of an interface provided
|
||||||
|
by the Library, but which is not otherwise based on the Library.
|
||||||
|
Defining a subclass of a class defined by the Library is deemed a mode
|
||||||
|
of using an interface provided by the Library.
|
||||||
|
|
||||||
|
A "Combined Work" is a work produced by combining or linking an
|
||||||
|
Application with the Library. The particular version of the Library
|
||||||
|
with which the Combined Work was made is also called the "Linked
|
||||||
|
Version".
|
||||||
|
|
||||||
|
The "Minimal Corresponding Source" for a Combined Work means the
|
||||||
|
Corresponding Source for the Combined Work, excluding any source code
|
||||||
|
for portions of the Combined Work that, considered in isolation, are
|
||||||
|
based on the Application, and not on the Linked Version.
|
||||||
|
|
||||||
|
The "Corresponding Application Code" for a Combined Work means the
|
||||||
|
object code and/or source code for the Application, including any data
|
||||||
|
and utility programs needed for reproducing the Combined Work from the
|
||||||
|
Application, but excluding the System Libraries of the Combined Work.
|
||||||
|
|
||||||
|
1. Exception to Section 3 of the GNU GPL.
|
||||||
|
|
||||||
|
You may convey a covered work under sections 3 and 4 of this License
|
||||||
|
without being bound by section 3 of the GNU GPL.
|
||||||
|
|
||||||
|
2. Conveying Modified Versions.
|
||||||
|
|
||||||
|
If you modify a copy of the Library, and, in your modifications, a
|
||||||
|
facility refers to a function or data to be supplied by an Application
|
||||||
|
that uses the facility (other than as an argument passed when the
|
||||||
|
facility is invoked), then you may convey a copy of the modified
|
||||||
|
version:
|
||||||
|
|
||||||
|
a) under this License, provided that you make a good faith effort to
|
||||||
|
ensure that, in the event an Application does not supply the
|
||||||
|
function or data, the facility still operates, and performs
|
||||||
|
whatever part of its purpose remains meaningful, or
|
||||||
|
|
||||||
|
b) under the GNU GPL, with none of the additional permissions of
|
||||||
|
this License applicable to that copy.
|
||||||
|
|
||||||
|
3. Object Code Incorporating Material from Library Header Files.
|
||||||
|
|
||||||
|
The object code form of an Application may incorporate material from
|
||||||
|
a header file that is part of the Library. You may convey such object
|
||||||
|
code under terms of your choice, provided that, if the incorporated
|
||||||
|
material is not limited to numerical parameters, data structure
|
||||||
|
layouts and accessors, or small macros, inline functions and templates
|
||||||
|
(ten or fewer lines in length), you do both of the following:
|
||||||
|
|
||||||
|
a) Give prominent notice with each copy of the object code that the
|
||||||
|
Library is used in it and that the Library and its use are
|
||||||
|
covered by this License.
|
||||||
|
|
||||||
|
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||||
|
document.
|
||||||
|
|
||||||
|
4. Combined Works.
|
||||||
|
|
||||||
|
You may convey a Combined Work under terms of your choice that,
|
||||||
|
taken together, effectively do not restrict modification of the
|
||||||
|
portions of the Library contained in the Combined Work and reverse
|
||||||
|
engineering for debugging such modifications, if you also do each of
|
||||||
|
the following:
|
||||||
|
|
||||||
|
a) Give prominent notice with each copy of the Combined Work that
|
||||||
|
the Library is used in it and that the Library and its use are
|
||||||
|
covered by this License.
|
||||||
|
|
||||||
|
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||||
|
document.
|
||||||
|
|
||||||
|
c) For a Combined Work that displays copyright notices during
|
||||||
|
execution, include the copyright notice for the Library among
|
||||||
|
these notices, as well as a reference directing the user to the
|
||||||
|
copies of the GNU GPL and this license document.
|
||||||
|
|
||||||
|
d) Do one of the following:
|
||||||
|
|
||||||
|
0) Convey the Minimal Corresponding Source under the terms of this
|
||||||
|
License, and the Corresponding Application Code in a form
|
||||||
|
suitable for, and under terms that permit, the user to
|
||||||
|
recombine or relink the Application with a modified version of
|
||||||
|
the Linked Version to produce a modified Combined Work, in the
|
||||||
|
manner specified by section 6 of the GNU GPL for conveying
|
||||||
|
Corresponding Source.
|
||||||
|
|
||||||
|
1) Use a suitable shared library mechanism for linking with the
|
||||||
|
Library. A suitable mechanism is one that (a) uses at run time
|
||||||
|
a copy of the Library already present on the user's computer
|
||||||
|
system, and (b) will operate properly with a modified version
|
||||||
|
of the Library that is interface-compatible with the Linked
|
||||||
|
Version.
|
||||||
|
|
||||||
|
e) Provide Installation Information, but only if you would otherwise
|
||||||
|
be required to provide such information under section 6 of the
|
||||||
|
GNU GPL, and only to the extent that such information is
|
||||||
|
necessary to install and execute a modified version of the
|
||||||
|
Combined Work produced by recombining or relinking the
|
||||||
|
Application with a modified version of the Linked Version. (If
|
||||||
|
you use option 4d0, the Installation Information must accompany
|
||||||
|
the Minimal Corresponding Source and Corresponding Application
|
||||||
|
Code. If you use option 4d1, you must provide the Installation
|
||||||
|
Information in the manner specified by section 6 of the GNU GPL
|
||||||
|
for conveying Corresponding Source.)
|
||||||
|
|
||||||
|
5. Combined Libraries.
|
||||||
|
|
||||||
|
You may place library facilities that are a work based on the
|
||||||
|
Library side by side in a single library together with other library
|
||||||
|
facilities that are not Applications and are not covered by this
|
||||||
|
License, and convey such a combined library under terms of your
|
||||||
|
choice, if you do both of the following:
|
||||||
|
|
||||||
|
a) Accompany the combined library with a copy of the same work based
|
||||||
|
on the Library, uncombined with any other library facilities,
|
||||||
|
conveyed under the terms of this License.
|
||||||
|
|
||||||
|
b) Give prominent notice with the combined library that part of it
|
||||||
|
is a work based on the Library, and explaining where to find the
|
||||||
|
accompanying uncombined form of the same work.
|
||||||
|
|
||||||
|
6. Revised Versions of the GNU Lesser General Public License.
|
||||||
|
|
||||||
|
The Free Software Foundation may publish revised and/or new versions
|
||||||
|
of the GNU Lesser General Public License from time to time. Such new
|
||||||
|
versions will be similar in spirit to the present version, but may
|
||||||
|
differ in detail to address new problems or concerns.
|
||||||
|
|
||||||
|
Each version is given a distinguishing version number. If the
|
||||||
|
Library as you received it specifies that a certain numbered version
|
||||||
|
of the GNU Lesser General Public License "or any later version"
|
||||||
|
applies to it, you have the option of following the terms and
|
||||||
|
conditions either of that published version or of any later version
|
||||||
|
published by the Free Software Foundation. If the Library as you
|
||||||
|
received it does not specify a version number of the GNU Lesser
|
||||||
|
General Public License, you may choose any version of the GNU Lesser
|
||||||
|
General Public License ever published by the Free Software Foundation.
|
||||||
|
|
||||||
|
If the Library as you received it specifies that a proxy can decide
|
||||||
|
whether future versions of the GNU Lesser General Public License shall
|
||||||
|
apply, that proxy's public statement of acceptance of any version is
|
||||||
|
permanent authorization for you to choose that version for the
|
||||||
|
Library.
|
||||||
|
|
@ -0,0 +1,8 @@
|
||||||
|
LEB128 or Little Endian Base 128 is a variable-length code compression used to store arbitrarily large integers in a small number of bytes.
|
||||||
|
|
||||||
|
|
||||||
|
Resources used:
|
||||||
|
https://en.wikipedia.org/wiki/LEB128
|
||||||
|
- Mostly turning pseudocode from here to Scheme
|
||||||
|
https://github.com/mohanson/leb128
|
||||||
|
- Code for leb128 to integer handling as we dont know integer size like in C
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
0.1.0
|
||||||
|
|
@ -0,0 +1,55 @@
|
||||||
|
(test-begin "leb128")
|
||||||
|
|
||||||
|
;; Cant use #u8(...) or #vu8(...) because tests need to work on both R6RS and R7RS
|
||||||
|
(define bv-42 (let ((bv (make-bytevector 1))) (bytevector-u8-set! bv 0 #x2A) bv))
|
||||||
|
(define bv-minus-42 (let ((bv (make-bytevector 1))) (bytevector-u8-set! bv 0 #x56) bv))
|
||||||
|
(define bv-123456
|
||||||
|
(let ((bv (make-bytevector 3)))
|
||||||
|
(bytevector-u8-set! bv 0 #xC0)
|
||||||
|
(bytevector-u8-set! bv 1 #xC4)
|
||||||
|
(bytevector-u8-set! bv 2 #x07)
|
||||||
|
bv))
|
||||||
|
(define bv-minus-123456
|
||||||
|
(let ((bv (make-bytevector 3)))
|
||||||
|
(bytevector-u8-set! bv 0 #xC0)
|
||||||
|
(bytevector-u8-set! bv 1 #xBB)
|
||||||
|
(bytevector-u8-set! bv 2 #x78)
|
||||||
|
bv))
|
||||||
|
|
||||||
|
(test-begin "integer->leb128")
|
||||||
|
(test-equal bv-42 (integer->leb128 42))
|
||||||
|
(test-equal bv-minus-42 (integer->leb128 -42))
|
||||||
|
(test-equal bv-123456 (integer->leb128 123456))
|
||||||
|
(test-equal bv-minus-123456 (integer->leb128 -123456))
|
||||||
|
(test-end "integer->leb128")
|
||||||
|
|
||||||
|
(test-begin "leb128->integer")
|
||||||
|
(test-equal 42 (leb128->integer (integer->leb128 42)))
|
||||||
|
(test-equal 123456 (leb128->integer (integer->leb128 123456)))
|
||||||
|
(test-equal -42 (leb128->integer (integer->leb128 -42)))
|
||||||
|
(test-equal -123456 (leb128->integer (integer->leb128 -123456)))
|
||||||
|
(test-end "leb128->integer")
|
||||||
|
|
||||||
|
(test-begin "leb128->integer-and-length")
|
||||||
|
(test-equal 123456 (car (leb128->integer-and-length bv-123456)))
|
||||||
|
(test-equal 3 (cdr (leb128->integer-and-length bv-123456)))
|
||||||
|
(test-equal -123456 (car (leb128->integer-and-length bv-minus-123456)))
|
||||||
|
(test-equal 3 (cdr (leb128->integer-and-length bv-minus-123456)))
|
||||||
|
(test-end "leb128->integer-and-length")
|
||||||
|
|
||||||
|
(test-begin "integer->uleb128")
|
||||||
|
(test-equal bv-42 (integer->uleb128 42))
|
||||||
|
(test-equal bv-123456 (integer->uleb128 123456))
|
||||||
|
(test-end "integer->uleb128")
|
||||||
|
|
||||||
|
(test-begin "uleb128->integer")
|
||||||
|
(test-equal 42 (uleb128->integer (integer->uleb128 42)))
|
||||||
|
(test-equal 123456 (uleb128->integer (integer->uleb128 123456)))
|
||||||
|
(test-end "uleb128->integer")
|
||||||
|
|
||||||
|
(test-begin "uleb128->integer-and-length")
|
||||||
|
(test-equal 123456 (car (uleb128->integer-and-length bv-123456)))
|
||||||
|
(test-equal 3 (cdr (uleb128->integer-and-length bv-123456)))
|
||||||
|
(test-end "uleb128->integer-and-length")
|
||||||
|
|
||||||
|
(test-end "leb128")
|
||||||
Loading…
Reference in New Issue