From eb79e98d20f1cb47b84a15770a4ce769d47573e5 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 16 Apr 2017 22:06:56 +0900 Subject: [PATCH] adding (srfi 142), using that in place of (srfi 33) --- Makefile | 12 +-- lib/chibi/base64.scm | 24 ++--- lib/chibi/base64.sld | 12 ++- lib/chibi/binary-record.sld | 1 + lib/chibi/bytevector.sld | 1 + lib/chibi/crypto/md5.sld | 1 + lib/chibi/crypto/rsa.sld | 1 + lib/chibi/crypto/sha2.sld | 1 + lib/chibi/filesystem-test.sld | 1 + lib/chibi/iset/base.sld | 1 + lib/chibi/iset/constructors.sld | 1 + lib/chibi/iset/iterators.sld | 1 + lib/chibi/iset/optimize.scm | 2 +- lib/chibi/iset/optimize.sld | 1 + lib/chibi/math/prime.sld | 1 + lib/chibi/net.sld | 1 + lib/chibi/net/server-util.sld | 2 +- lib/chibi/process.sld | 2 +- lib/chibi/quoted-printable.sld | 1 + lib/chibi/regexp.sld | 1 + lib/chibi/regexp/pcre.sld | 1 + lib/chibi/snow/commands.sld | 1 + lib/chibi/snow/fort.sld | 7 +- lib/chibi/stty.sld | 2 +- lib/chibi/tar.sld | 7 +- lib/chibi/temp-file.sld | 1 + lib/chibi/term/edit-line.sld | 7 +- lib/srfi/128.sld | 2 +- lib/srfi/142.sld | 24 +++++ lib/srfi/{33 => 142}/bit.c | 2 +- lib/srfi/142/bitwise.scm | 155 ++++++++++++++++++++++++++++++++ lib/srfi/142/test.sld | 112 +++++++++++++++++++++++ lib/srfi/33.sld | 23 ++++- lib/srfi/33/bitwise.scm | 61 ------------- lib/srfi/33/test.sld | 5 +- 35 files changed, 373 insertions(+), 105 deletions(-) create mode 100644 lib/srfi/142.sld rename lib/srfi/{33 => 142}/bit.c (99%) create mode 100644 lib/srfi/142/bitwise.scm create mode 100644 lib/srfi/142/test.sld delete mode 100644 lib/srfi/33/bitwise.scm diff --git a/Makefile b/Makefile index 8ad5c250..78e96741 100644 --- a/Makefile +++ b/Makefile @@ -34,7 +34,7 @@ EXTRA_COMPILED_LIBS ?= COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \ $(CHIBI_OPT_COMPILED_LIBS) $(CHIBI_CRYPTO_COMPILED_LIBS) \ $(EXTRA_COMPILED_LIBS) \ - lib/srfi/18/threads$(SO) lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ + lib/srfi/18/threads$(SO) lib/srfi/27/rand$(SO) lib/srfi/142/bit$(SO) \ lib/srfi/39/param$(SO) lib/srfi/69/hash$(SO) lib/srfi/95/qsort$(SO) \ lib/srfi/98/env$(SO) lib/scheme/time$(SO) @@ -281,7 +281,7 @@ install-base: all $(MKDIR) $(DESTDIR)$(MODDIR)/chibi/char-set $(DESTDIR)$(MODDIR)/chibi/crypto $(DESTDIR)$(MODDIR)/chibi/io $(DESTDIR)$(MODDIR)/chibi/iset $(DESTDIR)$(MODDIR)/chibi/loop $(DESTDIR)$(MODDIR)/chibi/match $(DESTDIR)$(MODDIR)/chibi/math $(DESTDIR)$(MODDIR)/chibi/monad $(DESTDIR)$(MODDIR)/chibi/net $(DESTDIR)$(MODDIR)/chibi/optimize $(DESTDIR)$(MODDIR)/chibi/parse $(DESTDIR)$(MODDIR)/chibi/regexp $(DESTDIR)$(MODDIR)/chibi/show $(DESTDIR)$(MODDIR)/chibi/snow $(DESTDIR)$(MODDIR)/chibi/term $(MKDIR) $(DESTDIR)$(MODDIR)/scheme/char $(MKDIR) $(DESTDIR)$(MODDIR)/scheme/time - $(MKDIR) $(DESTDIR)$(MODDIR)/srfi/1 $(DESTDIR)$(MODDIR)/srfi/18 $(DESTDIR)$(MODDIR)/srfi/27 $(DESTDIR)$(MODDIR)/srfi/33 $(DESTDIR)$(MODDIR)/srfi/39 $(DESTDIR)$(MODDIR)/srfi/69 $(DESTDIR)$(MODDIR)/srfi/95 $(DESTDIR)$(MODDIR)/srfi/99 $(DESTDIR)$(MODDIR)/srfi/99/records + $(MKDIR) $(DESTDIR)$(MODDIR)/srfi/1 $(DESTDIR)$(MODDIR)/srfi/18 $(DESTDIR)$(MODDIR)/srfi/27 $(DESTDIR)$(MODDIR)/srfi/142 $(DESTDIR)$(MODDIR)/srfi/39 $(DESTDIR)$(MODDIR)/srfi/69 $(DESTDIR)$(MODDIR)/srfi/95 $(DESTDIR)$(MODDIR)/srfi/99 $(DESTDIR)$(MODDIR)/srfi/99/records $(INSTALL) -m0644 $(META_FILES) $(DESTDIR)$(MODDIR)/ $(INSTALL) -m0644 lib/*.scm $(DESTDIR)$(MODDIR)/ $(INSTALL) -m0644 lib/chibi/*.sld lib/chibi/*.scm $(DESTDIR)$(MODDIR)/chibi/ @@ -307,17 +307,17 @@ install-base: all $(INSTALL) -m0644 lib/srfi/1/*.scm $(DESTDIR)$(MODDIR)/srfi/1/ $(INSTALL) -m0644 lib/srfi/18/*.scm $(DESTDIR)$(MODDIR)/srfi/18/ $(INSTALL) -m0644 lib/srfi/27/*.scm $(DESTDIR)$(MODDIR)/srfi/27/ - $(INSTALL) -m0644 lib/srfi/33/*.scm $(DESTDIR)$(MODDIR)/srfi/33/ $(INSTALL) -m0644 lib/srfi/39/*.scm $(DESTDIR)$(MODDIR)/srfi/39/ $(INSTALL) -m0644 lib/srfi/69/*.scm $(DESTDIR)$(MODDIR)/srfi/69/ $(INSTALL) -m0644 lib/srfi/95/*.scm $(DESTDIR)$(MODDIR)/srfi/95/ $(INSTALL) -m0644 lib/srfi/99/*.sld $(DESTDIR)$(MODDIR)/srfi/99/ $(INSTALL) -m0644 lib/srfi/99/records/*.sld lib/srfi/99/records/*.scm $(DESTDIR)$(MODDIR)/srfi/99/records/ + $(INSTALL) -m0644 lib/srfi/142/*.scm $(DESTDIR)$(MODDIR)/srfi/142/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/crypto/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/io/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/chibi/optimize/ $(MKDIR) $(DESTDIR)$(BINMODDIR)/scheme/ - $(MKDIR) $(DESTDIR)$(BINMODDIR)/srfi/18 $(DESTDIR)$(BINMODDIR)/srfi/27 $(DESTDIR)$(BINMODDIR)/srfi/33 $(DESTDIR)$(BINMODDIR)/srfi/39 $(DESTDIR)$(BINMODDIR)/srfi/69 $(DESTDIR)$(BINMODDIR)/srfi/95 $(DESTDIR)$(BINMODDIR)/srfi/98 + $(MKDIR) $(DESTDIR)$(BINMODDIR)/srfi/18 $(DESTDIR)$(BINMODDIR)/srfi/27 $(DESTDIR)$(BINMODDIR)/srfi/142 $(DESTDIR)$(BINMODDIR)/srfi/39 $(DESTDIR)$(BINMODDIR)/srfi/69 $(DESTDIR)$(BINMODDIR)/srfi/95 $(DESTDIR)$(BINMODDIR)/srfi/98 $(INSTALL_EXE) -m0755 $(CHIBI_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/ $(INSTALL_EXE) -m0755 $(CHIBI_CRYPTO_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/crypto/ $(INSTALL_EXE) -m0755 $(CHIBI_IO_COMPILED_LIBS) $(DESTDIR)$(BINMODDIR)/chibi/io/ @@ -325,11 +325,11 @@ install-base: all $(INSTALL_EXE) -m0755 lib/scheme/time$(SO) $(DESTDIR)$(BINMODDIR)/scheme/ $(INSTALL_EXE) -m0755 lib/srfi/18/threads$(SO) $(DESTDIR)$(BINMODDIR)/srfi/18 $(INSTALL_EXE) -m0755 lib/srfi/27/rand$(SO) $(DESTDIR)$(BINMODDIR)/srfi/27 - $(INSTALL_EXE) -m0755 lib/srfi/33/bit$(SO) $(DESTDIR)$(BINMODDIR)/srfi/33 $(INSTALL_EXE) -m0755 lib/srfi/39/param$(SO) $(DESTDIR)$(BINMODDIR)/srfi/39 $(INSTALL_EXE) -m0755 lib/srfi/69/hash$(SO) $(DESTDIR)$(BINMODDIR)/srfi/69 $(INSTALL_EXE) -m0755 lib/srfi/95/qsort$(SO) $(DESTDIR)$(BINMODDIR)/srfi/95 $(INSTALL_EXE) -m0755 lib/srfi/98/env$(SO) $(DESTDIR)$(BINMODDIR)/srfi/98 + $(INSTALL_EXE) -m0755 lib/srfi/142/bit$(SO) $(DESTDIR)$(BINMODDIR)/srfi/142 $(MKDIR) $(DESTDIR)$(INCDIR) $(INSTALL) -m0644 $(INCLUDES) $(DESTDIR)$(INCDIR)/ $(MKDIR) $(DESTDIR)$(LIBDIR) @@ -396,13 +396,13 @@ uninstall: -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/1 $(DESTDIR)$(BINMODDIR)/srfi/1 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/18 $(DESTDIR)$(BINMODDIR)/srfi/18 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/27 $(DESTDIR)$(BINMODDIR)/srfi/27 - -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/33 $(DESTDIR)$(BINMODDIR)/srfi/33 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/39 $(DESTDIR)$(BINMODDIR)/srfi/39 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/69 $(DESTDIR)$(BINMODDIR)/srfi/69 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/95 $(DESTDIR)$(BINMODDIR)/srfi/95 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/98 $(DESTDIR)$(BINMODDIR)/srfi/98 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/99/records $(DESTDIR)$(BINMODDIR)/srfi/99/records -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/99 $(DESTDIR)$(BINMODDIR)/srfi/99 + -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi/142 $(DESTDIR)$(BINMODDIR)/srfi/142 -$(RMDIR) $(DESTDIR)$(MODDIR)/srfi $(DESTDIR)$(BINMODDIR)/srfi -$(RMDIR) $(DESTDIR)$(MODDIR) $(DESTDIR)$(BINMODDIR) -$(RM) $(DESTDIR)$(MANDIR)/chibi-scheme.1 $(DESTDIR)$(MANDIR)/chibi-ffi.1 $(DESTDIR)$(MANDIR)/chibi-doc.1 diff --git a/lib/chibi/base64.scm b/lib/chibi/base64.scm index 5923d9e5..bbb4b971 100644 --- a/lib/chibi/base64.scm +++ b/lib/chibi/base64.scm @@ -141,18 +141,18 @@ dst j (bitwise-ior (arithmetic-shift b1 2) - (extract-bit-field 2 4 b2))) + (bit-field b2 4 6))) (bytevector-u8-set! dst (+ j 1) (bitwise-ior - (arithmetic-shift (extract-bit-field 4 0 b2) 4) - (extract-bit-field 4 2 b3))) + (arithmetic-shift (bit-field b2 0 4) 4) + (bit-field b3 2 6))) (bytevector-u8-set! dst (+ j 2) (bitwise-ior - (arithmetic-shift (extract-bit-field 2 0 b3) 6) + (arithmetic-shift (bit-field b3 0 2) 6) c)) (lp (+ i 1) (+ j 3) *outside-char* *outside-char* *outside-char*))))))) @@ -172,7 +172,7 @@ (bytevector-u8-set! dst j (bitwise-ior (arithmetic-shift b1 2) - (extract-bit-field 2 4 b2))) + (bit-field b2 4 6))) (cond ((eqv? b3 *outside-char*) (+ j 1)) @@ -180,8 +180,8 @@ (bytevector-u8-set! dst (+ j 1) (bitwise-ior - (arithmetic-shift (extract-bit-field 4 0 b2) 4) - (extract-bit-field 4 2 b3))) + (arithmetic-shift (bit-field b2 0 4) 4) + (bit-field b3 2 6))) (+ j 2)))))) ;;> Variation of the above to read and write to ports. @@ -282,11 +282,11 @@ (+ j 1) (enc (bitwise-ior (arithmetic-shift (bitwise-and #b11 b1) 4) - (extract-bit-field 4 4 b2)))) + (bit-field b2 4 8)))) (bytevector-u8-set! res (+ j 2) - (enc (arithmetic-shift (extract-bit-field 4 0 b2) 2))) + (enc (arithmetic-shift (bit-field b2 0 4) 2))) (bytevector-u8-set! res (+ j 3) (char->integer #\=)) (+ j 4))) (else @@ -300,13 +300,13 @@ (+ j 1) (enc (bitwise-ior (arithmetic-shift (bitwise-and #b11 b1) 4) - (extract-bit-field 4 4 b2)))) + (bit-field b2 4 8)))) (bytevector-u8-set! res (+ j 2) (enc (bitwise-ior - (arithmetic-shift (extract-bit-field 4 0 b2) 2) - (extract-bit-field 2 6 b3)))) + (arithmetic-shift (bit-field b2 0 4) 2) + (bit-field b3 6 8)))) (bytevector-u8-set! res (+ j 3) (enc (bitwise-and #b111111 b3))) (lp (+ i 3) (+ j 4))))))) diff --git a/lib/chibi/base64.sld b/lib/chibi/base64.sld index 53cd87e4..74ea10a5 100644 --- a/lib/chibi/base64.sld +++ b/lib/chibi/base64.sld @@ -6,14 +6,20 @@ (import (scheme base) (chibi string)) (cond-expand + ((library (srfi 142)) + (import (srfi 142))) ((library (srfi 33)) - (import (srfi 33))) + (import (srfi 33)) + (begin + (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) + (define (bit-field n start end) + (bitwise-and (arithmetic-shift n (- start)) (mask (- end start)))))) (else (import (srfi 60)) (begin (define (%mask size) (bitwise-not (arithmetic-shift -1 size))) - (define (extract-bit-field size position n) - (bitwise-and (%mask size) (arithmetic-shift n (- position))))))) + (define (bit-field n start end) + (bitwise-and (arithmetic-shift n (- start)) (mask (- end start))))))) (cond-expand (chibi (import (chibi io))) (else diff --git a/lib/chibi/binary-record.sld b/lib/chibi/binary-record.sld index cd515842..63baebe9 100644 --- a/lib/chibi/binary-record.sld +++ b/lib/chibi/binary-record.sld @@ -2,6 +2,7 @@ (define-library (chibi binary-record) (import (scheme base) (srfi 1)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (cond-expand diff --git a/lib/chibi/bytevector.sld b/lib/chibi/bytevector.sld index 23ad337a..b963d19c 100644 --- a/lib/chibi/bytevector.sld +++ b/lib/chibi/bytevector.sld @@ -11,6 +11,7 @@ bytevector->hex-string hex-string->bytevector) (import (scheme base)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "bytevector.scm")) diff --git a/lib/chibi/crypto/md5.sld b/lib/chibi/crypto/md5.sld index b053ae70..048109ad 100644 --- a/lib/chibi/crypto/md5.sld +++ b/lib/chibi/crypto/md5.sld @@ -5,6 +5,7 @@ (define-library (chibi crypto md5) (import (scheme base) (chibi bytevector)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (export md5) diff --git a/lib/chibi/crypto/rsa.sld b/lib/chibi/crypto/rsa.sld index 74c3d722..9eb148bd 100644 --- a/lib/chibi/crypto/rsa.sld +++ b/lib/chibi/crypto/rsa.sld @@ -5,6 +5,7 @@ (import (scheme base) (srfi 27) (chibi bytevector) (chibi math prime)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (export make-rsa-key rsa-key-gen rsa-key-gen-from-primes rsa-pub-key diff --git a/lib/chibi/crypto/sha2.sld b/lib/chibi/crypto/sha2.sld index 37e67208..6218c656 100644 --- a/lib/chibi/crypto/sha2.sld +++ b/lib/chibi/crypto/sha2.sld @@ -11,6 +11,7 @@ (include-shared "crypto")) (else (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (import (chibi bytevector)) diff --git a/lib/chibi/filesystem-test.sld b/lib/chibi/filesystem-test.sld index e43d4bf5..5c40b1e4 100644 --- a/lib/chibi/filesystem-test.sld +++ b/lib/chibi/filesystem-test.sld @@ -3,6 +3,7 @@ (import (scheme base) (scheme file) (scheme write) (chibi filesystem) (chibi test)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (begin diff --git a/lib/chibi/iset/base.sld b/lib/chibi/iset/base.sld index 380dc773..9f8dcb63 100644 --- a/lib/chibi/iset/base.sld +++ b/lib/chibi/iset/base.sld @@ -4,6 +4,7 @@ (chibi (import (chibi) (srfi 9))) (else (import (scheme base)))) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "base.scm") diff --git a/lib/chibi/iset/constructors.sld b/lib/chibi/iset/constructors.sld index 9351fe9f..3e6e55bd 100644 --- a/lib/chibi/iset/constructors.sld +++ b/lib/chibi/iset/constructors.sld @@ -5,6 +5,7 @@ (else (import (scheme base)))) (import (chibi iset base) (chibi iset iterators)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "constructors.scm") diff --git a/lib/chibi/iset/iterators.sld b/lib/chibi/iset/iterators.sld index d63611b2..41e87c26 100644 --- a/lib/chibi/iset/iterators.sld +++ b/lib/chibi/iset/iterators.sld @@ -5,6 +5,7 @@ (else (import (scheme base)))) (import (chibi iset base)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "iterators.scm") diff --git a/lib/chibi/iset/optimize.scm b/lib/chibi/iset/optimize.scm index ad10bf0b..8657cdb5 100644 --- a/lib/chibi/iset/optimize.scm +++ b/lib/chibi/iset/optimize.scm @@ -81,7 +81,7 @@ (%make-iset (+ start last) (+ start lo -1) - (extract-bit-field (- lo last) last bits) + (bit-field bits last lo) #f #f)) nodes) diff --git a/lib/chibi/iset/optimize.sld b/lib/chibi/iset/optimize.sld index 66fb53a3..13727d7b 100644 --- a/lib/chibi/iset/optimize.sld +++ b/lib/chibi/iset/optimize.sld @@ -7,6 +7,7 @@ (chibi iset iterators) (chibi iset constructors)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)) diff --git a/lib/chibi/math/prime.sld b/lib/chibi/math/prime.sld index 82651004..b4fd92e6 100644 --- a/lib/chibi/math/prime.sld +++ b/lib/chibi/math/prime.sld @@ -2,6 +2,7 @@ (define-library (chibi math prime) (import (scheme base) (scheme inexact) (srfi 27)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (export prime? nth-prime prime-above prime-below factor perfect? diff --git a/lib/chibi/net.sld b/lib/chibi/net.sld index bfe9b0e8..a5330257 100644 --- a/lib/chibi/net.sld +++ b/lib/chibi/net.sld @@ -23,6 +23,7 @@ sockaddr addrinfo) (import (chibi) (chibi filesystem)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include-shared "net") diff --git a/lib/chibi/net/server-util.sld b/lib/chibi/net/server-util.sld index 36d12e09..0ad08b06 100644 --- a/lib/chibi/net/server-util.sld +++ b/lib/chibi/net/server-util.sld @@ -3,7 +3,7 @@ (import (chibi) (chibi io) (chibi net) (chibi string) (chibi uri) (chibi process) (chibi time) (chibi pathname) (chibi filesystem) (chibi temp-file) - (srfi 33) (srfi 69)) + (srfi 69) (srfi 142)) (export line-handler command-handler parse-command get-host file-mime-type) (include "server-util.scm")) diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld index 40d9849d..da825797 100644 --- a/lib/chibi/process.sld +++ b/lib/chibi/process.sld @@ -18,6 +18,6 @@ process->string process->sexp process->string-list process->output+error process->output+error+status) (import (chibi) (chibi io) (chibi string) (chibi filesystem)) - (cond-expand (threads (import (srfi 18) (srfi 33))) (else #f)) + (cond-expand (threads (import (srfi 18) (srfi 142))) (else #f)) (include-shared "process") (include "process.scm")) diff --git a/lib/chibi/quoted-printable.sld b/lib/chibi/quoted-printable.sld index b94676b6..4cfeccce 100644 --- a/lib/chibi/quoted-printable.sld +++ b/lib/chibi/quoted-printable.sld @@ -7,6 +7,7 @@ quoted-printable-decode-bytevector) (import (scheme base)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (cond-expand diff --git a/lib/chibi/regexp.sld b/lib/chibi/regexp.sld index 108c7ce7..945d48c2 100644 --- a/lib/chibi/regexp.sld +++ b/lib/chibi/regexp.sld @@ -57,6 +57,7 @@ (define %char-set:iso-control (char-set-intersection char-set:ascii char-set:iso-control))))) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (import (chibi char-set boundary)) diff --git a/lib/chibi/regexp/pcre.sld b/lib/chibi/regexp/pcre.sld index d08c1d99..8418b6f3 100644 --- a/lib/chibi/regexp/pcre.sld +++ b/lib/chibi/regexp/pcre.sld @@ -5,6 +5,7 @@ (srfi 1) (chibi string) (chibi regexp)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "pcre.scm")) diff --git a/lib/chibi/snow/commands.sld b/lib/chibi/snow/commands.sld index a49d121a..fa1ee6c6 100644 --- a/lib/chibi/snow/commands.sld +++ b/lib/chibi/snow/commands.sld @@ -56,6 +56,7 @@ (chibi uri) (chibi zlib)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (include "commands.scm")) diff --git a/lib/chibi/snow/fort.sld b/lib/chibi/snow/fort.sld index f2ad9dec..506535ee 100644 --- a/lib/chibi/snow/fort.sld +++ b/lib/chibi/snow/fort.sld @@ -29,10 +29,9 @@ (chibi sxml) (chibi tar)) (cond-expand - ((library (srfi 33)) - (import (srfi 33))) - (else - (import (srfi 60)))) + ((library (srfi 142)) (import (srfi 142))) + ((library (srfi 33)) (import (srfi 33))) + (else (import (srfi 60)))) (cond-expand (chibi (import (only (chibi ast) diff --git a/lib/chibi/stty.sld b/lib/chibi/stty.sld index d054486e..1c5dac08 100644 --- a/lib/chibi/stty.sld +++ b/lib/chibi/stty.sld @@ -3,6 +3,6 @@ (export stty with-stty with-raw-io get-terminal-width get-terminal-dimensions TCSANOW TCSADRAIN TCSAFLUSH) - (import (chibi) (srfi 33) (srfi 69)) + (import (chibi) (srfi 69) (srfi 142)) (include-shared "stty") (include "stty.scm")) diff --git a/lib/chibi/tar.sld b/lib/chibi/tar.sld index 009fedbb..76184e39 100644 --- a/lib/chibi/tar.sld +++ b/lib/chibi/tar.sld @@ -4,10 +4,9 @@ (chibi string) (chibi binary-record) (chibi pathname) (chibi filesystem)) (cond-expand - ((library (srfi 33)) - (import (srfi 33))) - (else - (import (srfi 60)))) + ((library (srfi 142)) (import (srfi 142))) + ((library (srfi 33)) (import (srfi 33))) + (else (import (srfi 60)))) (cond-expand (chibi (import (chibi system))) diff --git a/lib/chibi/temp-file.sld b/lib/chibi/temp-file.sld index a8892c69..652173ba 100644 --- a/lib/chibi/temp-file.sld +++ b/lib/chibi/temp-file.sld @@ -3,6 +3,7 @@ (import (scheme base) (scheme time) (chibi filesystem) (chibi pathname)) (cond-expand + ((library (srfi 142)) (import (srfi 142))) ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) (cond-expand diff --git a/lib/chibi/term/edit-line.sld b/lib/chibi/term/edit-line.sld index c87a9fe5..668504e7 100644 --- a/lib/chibi/term/edit-line.sld +++ b/lib/chibi/term/edit-line.sld @@ -9,10 +9,9 @@ make-keymap make-standard-keymap) (import (scheme base) (scheme char) (scheme write)) (cond-expand - ((library (srfi 33)) - (import (srfi 33))) - (else - (import (srfi 60)))) + ((library (srfi 142)) (import (srfi 142))) + ((library (srfi 33)) (import (srfi 33))) + (else (import (srfi 60)))) (cond-expand (chibi (import (chibi stty))) diff --git a/lib/srfi/128.sld b/lib/srfi/128.sld index 6629f9f2..7c1529f9 100644 --- a/lib/srfi/128.sld +++ b/lib/srfi/128.sld @@ -1,6 +1,6 @@ (define-library (srfi 128) (import (scheme base) (scheme char) - (srfi 27) (srfi 33) (srfi 69) (srfi 95) (srfi 98) + (srfi 27) (srfi 69) (srfi 95) (srfi 98) (srfi 142) (only (chibi) fixnum? er-macro-transformer)) (export ;; Predicates: diff --git a/lib/srfi/142.sld b/lib/srfi/142.sld new file mode 100644 index 00000000..6b79b162 --- /dev/null +++ b/lib/srfi/142.sld @@ -0,0 +1,24 @@ + +(define-library (srfi 142) + (export bitwise-not + bitwise-and bitwise-ior + bitwise-xor bitwise-eqv + bitwise-nand bitwise-nor + bitwise-andc1 bitwise-andc2 + bitwise-orc1 bitwise-orc2 + arithmetic-shift bit-count integer-length + bitwise-if + bit-set? any-bit-set? every-bit-set? + first-set-bit + bit-field bit-field-any? bit-field-every? + bit-field-clear bit-field-set + bit-field-replace bit-field-replace-same + bit-field-rotate bit-field-reverse + copy-bit integer->list list->integer + integer->vector vector->integer + bits bit-swap + bitwise-fold bitwise-for-each bitwise-unfold + make-bitwise-generator) + (import (chibi)) + (include-shared "142/bit") + (include "142/bitwise.scm")) diff --git a/lib/srfi/33/bit.c b/lib/srfi/142/bit.c similarity index 99% rename from lib/srfi/33/bit.c rename to lib/srfi/142/bit.c index 538f2d3d..6a4f749f 100644 --- a/lib/srfi/33/bit.c +++ b/lib/srfi/142/bit.c @@ -1,5 +1,5 @@ /* bit.c -- bitwise operators */ -/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2017 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #include diff --git a/lib/srfi/142/bitwise.scm b/lib/srfi/142/bitwise.scm new file mode 100644 index 00000000..09154062 --- /dev/null +++ b/lib/srfi/142/bitwise.scm @@ -0,0 +1,155 @@ +;; bitwise.scm -- high-level bitwise functions +;; Copyright (c) 2009-2017 Alex Shinn. All rights reserved. +;; BSD-style license: http://synthcode.com/license.txt + +(define (bitwise-not i) (- -1 i)) + +(define (bitwise-complement f) (lambda args (bitwise-not (apply f args)))) + +(define (make-nary proc2 default) + (lambda args + (if (null? args) + default + (let lp ((i (car args)) (ls (cdr args))) + (if (null? ls) + i + (lp (proc2 i (car ls)) (cdr ls))))))) + +(define bitwise-and (make-nary bit-and -1)) +(define bitwise-ior (make-nary bit-ior 0)) +(define bitwise-xor (make-nary bit-xor 0)) + +(define bitwise-eqv (bitwise-complement (make-nary bit-xor -1))) +(define bitwise-nand (bitwise-complement (make-nary bit-and 0))) +(define bitwise-nor (bitwise-complement (make-nary bit-ior -1))) + +(define (bitwise-andc1 i j) (bit-and (bitwise-not i) j)) +(define (bitwise-andc2 i j) (bit-and i (bitwise-not j))) +(define (bitwise-orc1 i j) (bit-ior (bitwise-not i) j)) +(define (bitwise-orc2 i j) (bit-ior i (bitwise-not j))) + +(define (any-bit-set? test-bits i) + (not (zero? (bitwise-and test-bits i)))) +(define (every-bit-set? test-bits i) + (= test-bits (bitwise-and test-bits i))) + +(define (first-set-bit i) + (if (zero? i) + -1 + (integer-length (- i (bit-and i (- i 1)))))) + +(define (mask len) + (- (arithmetic-shift 1 len) 1)) + +(define (range start end) + (arithmetic-shift (mask (- end start)) start)) + +(define (bitwise-if mask n m) + (bit-ior (bit-and mask n) (bit-and (bitwise-not mask) m))) + +(define (bit-field n start end) + (bit-and (arithmetic-shift n (- start)) (mask (- end start)))) + +(define (bit-field-any? n start end) + (not (zero? (bit-and (arithmetic-shift n (- start)) (mask (- end start)))))) + +(define (bit-field-every? n start end) + (= (arithmetic-shift n (- start)) (mask (- end start)))) + +(define (copy-bit index i boolean) + (bit-field-replace i (if boolean 1 0) index (+ index 1))) + +(define (bit-swap i1 i2 i) + (let ((b1 (bit-set? i1 i)) + (b2 (bit-set? i2 i))) + (copy-bit i2 (copy-bit i1 i b2) b1))) + +(define (bit-field-clear n start end) + (bit-field-replace n 0 start end)) + +(define (bit-field-set n start end) + (bit-ior n (range start end))) + +(define (bit-field-replace dst src start end) + (bit-field-replace-same dst (arithmetic-shift src start) start end)) + +(define (bit-field-replace-same dst src start end) + (bitwise-if (range start end) src dst)) + +(define (bit-rotate i count) + (let ((len (integer-length i))) + (bit-ior (bit-and (arithmetic-shift i count) (mask len)) + (arithmetic-shift i (- count len))))) + +(define (bit-field-rotate i count start end) + (bitwise-if (range start end) + i + (arithmetic-shift (bit-rotate (bit-field i start end) count) + start))) + +(define (bit-reverse i) + (let ((len (integer-length i))) + (let lp ((i i) (res 0)) + (if (zero? i) + res + (lp (arithmetic-shift i -1) + (bit-ior (arithmetic-shift res 1) + (bit-and i 1))))))) + +(define (bit-field-reverse i start end) + (bitwise-if (range start end) + i + (arithmetic-shift (bit-reverse (bit-field i start end)) start))) + +(define (vector->integer vec) + (let ((len (vector-length vec))) + (let lp ((i 0) (exp 1) (res 0)) + (cond + ((= i len) res) + ((vector-ref vec i) (lp (+ i 1) (* exp 2) (+ res exp))) + (else (lp (+ i 1) (* exp 2) res)))))) + +(define (integer->vector n . o) + (let* ((len (if (pair? o) (car o) (integer-length n))) + (res (make-vector len #f))) + (let lp ((n n) (i 0)) + (cond + ((>= i len) + res) + (else + (if (odd? n) + (vector-set! res i #t)) + (lp (arithmetic-shift n -1) (+ i 1))))))) + +(define (list->integer ls) + (vector->integer (list->vector ls))) + +(define (integer->list n . o) + (vector->list (apply integer->vector n o))) + +(define (bits . o) (list->integer o)) + +(define (bitwise-fold kons knil i) + (let lp ((i i) (acc knil)) + (if (zero? i) + acc + (lp (arithmetic-shift i -1) (kons (odd? i) acc))))) + +(define (bitwise-for-each proc i) + (bitwise-fold (lambda (b acc) (proc b)) #f i)) + +(define (bitwise-unfold stop? mapper successor seed) + (let lp ((state seed) (exp 1) (i 0)) + (if (stop? state) + i + (lp (successor state) + (* exp 2) + (if (mapper state) (+ i exp) i))))) + +(define make-bitwise-generator + (let ((eof (read-char (open-input-string "")))) + (lambda (i) + (lambda () + (let ((res (odd? i))) + (set! i (arithmetic-shift i -1)) + res))))) diff --git a/lib/srfi/142/test.sld b/lib/srfi/142/test.sld new file mode 100644 index 00000000..d044472f --- /dev/null +++ b/lib/srfi/142/test.sld @@ -0,0 +1,112 @@ +(define-library (srfi 142 test) + (export run-tests) + (import (scheme base) (srfi 142) (chibi test)) + (begin + (define (run-tests) + (test-begin "srfi-142: bitwise operations") + + (test 0 (bitwise-and #b0 #b1)) + (test 1 (bitwise-and #b1 #b1)) + (test 0 (bitwise-and #b1 #b10)) + (test #b10 (bitwise-and #b11 #b10)) + (test #b101 (bitwise-and #b101 #b111)) + (test #b111 (bitwise-and -1 #b111)) + (test #b110 (bitwise-and -2 #b111)) + (test 3769478 (bitwise-and -4290775858 1694076839)) + (test 1680869008 (bitwise-and -193073517 1689392892)) + (test -4294967295 (bitwise-ior 1 (- -1 #xffffffff))) + (test -18446744073709551615 (bitwise-ior 1 (- -1 #xffffffffffffffff))) + (test -4294967126 (bitwise-xor #b10101010 (- -1 #xffffffff))) + (test -18446744073709551446 (bitwise-xor #b10101010 (- -1 #xffffffffffffffff))) + (test -2600468497 (bitwise-ior 1694076839 -4290775858)) + (test -184549633 (bitwise-ior -193073517 1689392892)) + (test -2604237975 (bitwise-xor 1694076839 -4290775858)) + (test -1865418641 (bitwise-xor -193073517 1689392892)) + (test 3769478 (bitwise-and 1694076839 -4290775858)) + (test 1680869008 (bitwise-and -193073517 1689392892)) + + (test 1 (arithmetic-shift 1 0)) + (test 2 (arithmetic-shift 1 1)) + (test 4 (arithmetic-shift 1 2)) + (test 8 (arithmetic-shift 1 3)) + (test 16 (arithmetic-shift 1 4)) + (test (expt 2 31) (arithmetic-shift 1 31)) + (test (expt 2 32) (arithmetic-shift 1 32)) + (test (expt 2 33) (arithmetic-shift 1 33)) + (test (expt 2 63) (arithmetic-shift 1 63)) + (test (expt 2 64) (arithmetic-shift 1 64)) + (test (expt 2 65) (arithmetic-shift 1 65)) + (test (expt 2 127) (arithmetic-shift 1 127)) + (test (expt 2 128) (arithmetic-shift 1 128)) + (test (expt 2 129) (arithmetic-shift 1 129)) + (test 3028397001194014464 (arithmetic-shift 11829675785914119 8)) + + (test -1 (arithmetic-shift -1 0)) + (test -2 (arithmetic-shift -1 1)) + (test -4 (arithmetic-shift -1 2)) + (test -8 (arithmetic-shift -1 3)) + (test -16 (arithmetic-shift -1 4)) + (test (- (expt 2 31)) (arithmetic-shift -1 31)) + (test (- (expt 2 32)) (arithmetic-shift -1 32)) + (test (- (expt 2 33)) (arithmetic-shift -1 33)) + (test (- (expt 2 63)) (arithmetic-shift -1 63)) + (test (- (expt 2 64)) (arithmetic-shift -1 64)) + (test (- (expt 2 65)) (arithmetic-shift -1 65)) + (test (- (expt 2 127)) (arithmetic-shift -1 127)) + (test (- (expt 2 128)) (arithmetic-shift -1 128)) + (test (- (expt 2 129)) (arithmetic-shift -1 129)) + + (test 0 (arithmetic-shift 1 -63)) + (test 0 (arithmetic-shift 1 -64)) + (test 0 (arithmetic-shift 1 -65)) + + (test #x1000000000000000100000000000000000000000000000000 + (arithmetic-shift #x100000000000000010000000000000000 64)) + (test #x8e73b0f7da0e6452c810f32b809079e5 + (arithmetic-shift #x8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b -64)) + + (test-not (bit-set? 64 1)) + (test-assert (bit-set? 64 #x10000000000000000)) + + (test #b1010 (bit-field #b1101101010 0 4)) + (test #b101101 (bit-field #b1101101010 3 9)) + (test #b10110 (bit-field #b1101101010 4 9)) + (test #b110110 (bit-field #b1101101010 4 10)) + + (test 3 (bitwise-if 1 1 2)) + (test #b00110011 (bitwise-if #b00111100 #b11110000 #b00001111)) + + (test #b1 (copy-bit 0 0 #t)) + (test #b100 (copy-bit 2 0 #t)) + (test #b1011 (copy-bit 2 #b1111 #f)) + + (test #b1110 (bit-swap 0 1 #b1101)) + (test #b1011 (bit-swap 1 2 #b1101)) + (test #b1011 (bit-swap 2 1 #b1101)) + (test #b10000000101 (bit-swap 3 10 #b1101)) + + (test '(#t #t #t #f #t #f #t) (integer->list #b1010111)) + (test '(#t #t #t #f #t) (integer->list #b1010111 5)) + (test '(#t #t #t #f #t #f #t #f #f) (integer->list #b1010111 9)) + (test '#(#t #t #t #f #t #f #t) (integer->vector #b1010111)) + (test '#(#t #t #t #f #t #f #t #f #f) (integer->vector #b1010111 9)) + + (test #b1010111 (list->integer '(#t #t #t #f #t #f #t))) + (test #b1010111 (list->integer '(#t #t #t #f #t #f #t #f #f))) + (test #b1010111 (vector->integer '#(#t #t #t #f #t #f #t))) + (test #b1010111 (vector->integer '#(#t #t #t #f #t #f #t #f #f))) + (test #b1010111 (bits #t #t #t #f #t #f #t)) + (test #b1010111 (bits #t #t #t #f #t #f #t #f #f)) + + (test '(#t #f #t #f #t #t #t) (bitwise-fold cons '() #b1010111)) + + (test 5 + (let ((count 0)) + (bitwise-for-each (lambda (b) (if b (set! count (+ count 1)))) + #b1010111) + count)) + + (test #b101010101 + (bitwise-unfold (lambda (i) (= i 10)) even? (lambda (i) (+ i 1)) 0)) + + (test-end)))) diff --git a/lib/srfi/33.sld b/lib/srfi/33.sld index 6a6a7cbc..5b3c4e75 100644 --- a/lib/srfi/33.sld +++ b/lib/srfi/33.sld @@ -11,7 +11,22 @@ bit-set? any-bits-set? all-bits-set? first-set-bit extract-bit-field test-bit-field? clear-bit-field - replace-bit-field copy-bit-field) - (import (chibi)) - (include-shared "33/bit") - (include "33/bitwise.scm")) + replace-bit-field copy-bit-field) + (import (scheme base) + (rename (srfi 142) + (bitwise-if bitwise-merge) + (any-bit-set? any-bits-set?) + (every-bit-set? all-bits-set?) + (bit-field-any? test-bit-field?) + (bit-field-clear clear-bit-field))) + (begin + (define (mask len) + (- (arithmetic-shift 1 len) 1)) + (define (extract-bit-field size position n) + (bitwise-and (arithmetic-shift n (- position)) (mask size))) + (define (replace-bit-field size position newfield n) + (bitwise-ior + (bitwise-and n (bitwise-not (arithmetic-shift (mask size) position))) + (arithmetic-shift newfield position))) + (define (copy-bit-field size position from to) + (bitwise-merge (arithmetic-shift (mask size) position) to from)))) diff --git a/lib/srfi/33/bitwise.scm b/lib/srfi/33/bitwise.scm deleted file mode 100644 index 690b81c3..00000000 --- a/lib/srfi/33/bitwise.scm +++ /dev/null @@ -1,61 +0,0 @@ -;; bitwise.scm -- high-level bitwise functions -;; Copyright (c) 2009 Alex Shinn. All rights reserved. -;; BSD-style license: http://synthcode.com/license.txt - -(define (bitwise-not i) (- -1 i)) - -(define (bitwise-complement f) (lambda args (bitwise-not (apply f args)))) - -(define (make-nary proc2 default) - (lambda args - (if (null? args) - default - (let lp ((i (car args)) (ls (cdr args))) - (if (null? ls) - i - (lp (proc2 i (car ls)) (cdr ls))))))) - -(define bitwise-and (make-nary bit-and -1)) -(define bitwise-ior (make-nary bit-ior 0)) -(define bitwise-xor (make-nary bit-xor 0)) - -(define bitwise-eqv (bitwise-complement (make-nary bit-xor -1))) -(define bitwise-nand (bitwise-complement (make-nary bit-and 0))) -(define bitwise-nor (bitwise-complement (make-nary bit-ior -1))) - -(define (bitwise-andc1 i j) (bit-and (bitwise-not i) j)) -(define (bitwise-andc2 i j) (bit-and i (bitwise-not j))) -(define (bitwise-orc1 i j) (bit-ior (bitwise-not i) j)) -(define (bitwise-orc2 i j) (bit-ior i (bitwise-not j))) - -(define (any-bits-set? test-bits i) - (not (zero? (bitwise-and test-bits i)))) -(define (all-bits-set? test-bits i) - (= test-bits (bitwise-and test-bits i))) - -(define (first-set-bit i) - (if (zero? i) - -1 - (integer-length (- i (bit-and i (- i 1)))))) - -(define (mask len) (- (arithmetic-shift 1 len) 1)) - -(define (bitwise-merge mask n m) - (bit-ior (bit-and mask n) (bit-and (bitwise-not mask) m))) - -(define (extract-bit-field size position n) - (bit-and (arithmetic-shift n (- position)) (mask size))) - -(define (test-bit-field? size position n) - (not (zero? (bit-and (arithmetic-shift n (- position)) (mask size))))) - -(define (replace-bit-field size position newfield n) - (bit-ior (bit-and n (bitwise-not (arithmetic-shift (mask size) position))) - (arithmetic-shift newfield position))) - -(define (clear-bit-field size position n) - (replace-bit-field size position 0 n)) - -(define (copy-bit-field size position from to) - (bitwise-merge (arithmetic-shift (mask size) position) to from)) - diff --git a/lib/srfi/33/test.sld b/lib/srfi/33/test.sld index 4487dbda..9d1a746b 100644 --- a/lib/srfi/33/test.sld +++ b/lib/srfi/33/test.sld @@ -1,6 +1,6 @@ (define-library (srfi 33 test) (export run-tests) - (import (chibi) (srfi 33) (chibi test)) + (import (scheme base) (srfi 33) (chibi test)) (begin (define (run-tests) (test-begin "srfi-33: bitwise operations") @@ -68,4 +68,7 @@ (test-not (bit-set? 64 1)) (test-assert (bit-set? 64 #x10000000000000000)) + (test 3 (bitwise-merge 1 1 2)) + (test #b00110011 (bitwise-merge #b00111100 #b11110000 #b00001111)) + (test-end))))