diff --git a/include/chibi/sexp-huff.c b/include/chibi/sexp-huff.c new file mode 100644 index 00000000..abf6bc9f --- /dev/null +++ b/include/chibi/sexp-huff.c @@ -0,0 +1,128 @@ + {12, 0x0C00}, /* '\x00' */ + {15, 0x0000}, /* '\x01' */ + {15, 0x4000}, /* '\x02' */ + {15, 0x2000}, /* '\x03' */ + {15, 0x6000}, /* '\x04' */ + {15, 0x0800}, /* '\x05' */ + {15, 0x4800}, /* '\x06' */ + {15, 0x2800}, /* '\x07' */ + {15, 0x6800}, /* '\x08' */ + {15, 0x1800}, /* '\x09' */ + {15, 0x5800}, /* '\x0a' */ + {15, 0x3800}, /* '\x0b' */ + {15, 0x7800}, /* '\x0c' */ + {15, 0x0100}, /* '\x0d' */ + {15, 0x4100}, /* '\x0e' */ + {15, 0x2100}, /* '\x0f' */ + {15, 0x6100}, /* '\x10' */ + {15, 0x1100}, /* '\x11' */ + {15, 0x5100}, /* '\x12' */ + {15, 0x3100}, /* '\x13' */ + {15, 0x7100}, /* '\x14' */ + {15, 0x0900}, /* '\x15' */ + {15, 0x4900}, /* '\x16' */ + {15, 0x2900}, /* '\x17' */ + {15, 0x6900}, /* '\x18' */ + {15, 0x1900}, /* '\x19' */ + {15, 0x5900}, /* '\x1a' */ + {15, 0x3900}, /* '\x1b' */ + {15, 0x7900}, /* '\x1c' */ + {15, 0x0500}, /* '\x1d' */ + {15, 0x4500}, /* '\x1e' */ + {15, 0x2500}, /* '\x1f' */ + {15, 0x6500}, /* '\x20' */ + { 8, 0x0040}, /* '!' */ + {15, 0x1500}, /* '"' */ + {15, 0x5500}, /* '#' */ + {15, 0x3500}, /* '$' */ + {15, 0x7500}, /* '%' */ + {15, 0x0D00}, /* '&' */ + {15, 0x4D00}, /* '\'' */ + {15, 0x2D00}, /* '(' */ + {15, 0x6D00}, /* ')' */ + {11, 0x0300}, /* '*' */ + {10, 0x0180}, /* '+' */ + {15, 0x1D00}, /* ',' */ + { 4, 0x000D}, /* '-' */ + {15, 0x5D00}, /* '.' */ + {10, 0x0380}, /* '/' */ + {15, 0x3D00}, /* '0' */ + {15, 0x7D00}, /* '1' */ + {14, 0x0080}, /* '2' */ + {14, 0x2080}, /* '3' */ + {14, 0x1080}, /* '4' */ + {14, 0x3080}, /* '5' */ + {14, 0x0880}, /* '6' */ + {14, 0x2880}, /* '7' */ + {14, 0x1880}, /* '8' */ + {14, 0x3880}, /* '9' */ + {14, 0x0480}, /* ':' */ + {14, 0x2480}, /* ';' */ + { 7, 0x0050}, /* '<' */ + { 7, 0x0042}, /* '=' */ + { 7, 0x0022}, /* '>' */ + { 5, 0x0009}, /* '?' */ + {14, 0x1480}, /* '@' */ + {14, 0x3480}, /* 'A' */ + {14, 0x0C80}, /* 'B' */ + {14, 0x2C80}, /* 'C' */ + {14, 0x1C80}, /* 'D' */ + {14, 0x3C80}, /* 'E' */ + {14, 0x0280}, /* 'F' */ + {14, 0x2280}, /* 'G' */ + {14, 0x1280}, /* 'H' */ + {14, 0x3280}, /* 'I' */ + {14, 0x0A80}, /* 'J' */ + {14, 0x2A80}, /* 'K' */ + {14, 0x1A80}, /* 'L' */ + {14, 0x3A80}, /* 'M' */ + {14, 0x0680}, /* 'N' */ + {14, 0x2680}, /* 'O' */ + {14, 0x1680}, /* 'P' */ + {14, 0x3680}, /* 'Q' */ + {14, 0x0E80}, /* 'R' */ + {14, 0x2E80}, /* 'S' */ + {14, 0x1E80}, /* 'T' */ + {14, 0x3E80}, /* 'U' */ + {14, 0x0200}, /* 'V' */ + {14, 0x2200}, /* 'W' */ + {14, 0x1200}, /* 'X' */ + {14, 0x3200}, /* 'Y' */ + {14, 0x0A00}, /* 'Z' */ + {14, 0x2A00}, /* '[' */ + {14, 0x1A00}, /* '\\' */ + {14, 0x3A00}, /* ']' */ + {14, 0x0600}, /* '^' */ + {14, 0x2600}, /* '_' */ + {14, 0x1600}, /* '`' */ + { 3, 0x0007}, /* 'a' */ + { 7, 0x0020}, /* 'b' */ + { 4, 0x0004}, /* 'c' */ + { 5, 0x001A}, /* 'd' */ + { 4, 0x0006}, /* 'e' */ + { 7, 0x0002}, /* 'f' */ + { 5, 0x0011}, /* 'g' */ + { 6, 0x0012}, /* 'h' */ + { 4, 0x000C}, /* 'i' */ + {12, 0x0400}, /* 'j' */ + { 8, 0x00C0}, /* 'k' */ + { 5, 0x0018}, /* 'l' */ + { 6, 0x0032}, /* 'm' */ + { 4, 0x0005}, /* 'n' */ + { 5, 0x000A}, /* 'o' */ + { 5, 0x0001}, /* 'p' */ + { 7, 0x0070}, /* 'q' */ + { 3, 0x0003}, /* 'r' */ + { 5, 0x0008}, /* 's' */ + { 4, 0x000E}, /* 't' */ + { 5, 0x0019}, /* 'u' */ + { 7, 0x0062}, /* 'v' */ + { 7, 0x0030}, /* 'w' */ + { 7, 0x0060}, /* 'x' */ + { 7, 0x0010}, /* 'y' */ + {11, 0x0700}, /* 'z' */ + {14, 0x3600}, /* '{' */ + {14, 0x0E00}, /* '|' */ + {14, 0x2E00}, /* '}' */ + {14, 0x1E00}, /* '~' */ + {14, 0x3E00}, /* '\x7f' */ diff --git a/include/chibi/sexp-hufftabdefs.h b/include/chibi/sexp-hufftabdefs.h new file mode 100644 index 00000000..3bf05f3f --- /dev/null +++ b/include/chibi/sexp-hufftabdefs.h @@ -0,0 +1,7 @@ + +char _huff_tab1[8], _huff_tab2[8], _huff_tab3[2], _huff_tab4[2], + _huff_tab5[4], _huff_tab6[2], _huff_tab7[4], _huff_tab8[4], + _huff_tab9[4], _huff_tab10[4], _huff_tab11[4], _huff_tab12[2], + _huff_tab13[8], _huff_tab14[2], _huff_tab15[8], _huff_tab16[8], + _huff_tab17[8], _huff_tab18[8], _huff_tab19[4], _huff_tab20[8], + _huff_tab21[8]; diff --git a/include/chibi/sexp-hufftabs.c b/include/chibi/sexp-hufftabs.c new file mode 100644 index 00000000..7704184f --- /dev/null +++ b/include/chibi/sexp-hufftabs.c @@ -0,0 +1,92 @@ +/* auto-generated by ./symhuff.scm on Sun Feb 25 23:12:52 2007 */ + +char _huff_tab21[] = { + '\x01', '\x00', '\x03', '\x00', '\x02', '\x00', '\x04', '\x00', +}; + +char _huff_tab19[] = { + '\x01', 'j', '\x01', '\x00', +}; + +char _huff_tab20[] = { + '\x05', '\x09', '\x07', '\x0b', '\x06', '\x0a', '\x08', '\x0c', +}; + +char _huff_tab18[] = { + '2', ':', '6', 'B', '4', '@', '8', 'D', + '3', ';', '7', 'C', '5', 'A', '9', 'E', +}; + +char _huff_tab17[] = { + '\x0d', '\x1d', '\x15', '&', '\x11', '"', '\x19', ',', + '\x0f', '\x1f', '\x17', '(', '\x13', '$', '\x1b', '0', + '\x0e', '\x1e', '\x16', '\'', '\x12', '#', '\x1a', '.', + '\x10', '\x20', '\x18', ')', '\x14', '%', '\x1c', '1', +}; + +char _huff_tab16[] = { + 'V', '^', 'Z', '|', 'X', '`', '\\', '~', + 'W', '_', '[', '}', 'Y', '{', ']', '\x7f', +}; + +char _huff_tab15[] = { + 'F', 'N', 'J', 'R', 'H', 'P', 'L', 'T', + 'G', 'O', 'K', 'S', 'I', 'Q', 'M', 'U', +}; + +char _huff_tab13[] = { + '\x00', '\x00', '\x00', '+', '\x00', '\x00', '\x00', '/', +}; + +char _huff_tab14[] = { + '*', 'z', +}; + +char _huff_tab11[] = { + '\x00', 'b', '\x00', 'x', +}; + +char _huff_tab12[] = { + '!', 'k', +}; + +char _huff_tab9[] = { + '\x00', 's', '\x00', 'l', +}; + +char _huff_tab10[] = { + 'y', 'w', '<', 'q', +}; + +char _huff_tab8[] = { + 'p', '?', 'g', 'u', +}; + +char _huff_tab7[] = { + 'f', '>', '=', 'v', +}; + +char _huff_tab5[] = { + '\x00', 'o', '\x00', 'd', +}; + +char _huff_tab6[] = { + 'h', 'm', +}; + +char _huff_tab4[] = { + 'c', 'i', +}; + +char _huff_tab3[] = { + 'n', '-', +}; + +char _huff_tab1[] = { + '\x00', '\x00', '\x00', 'r', '\x00', '\x00', '\x00', 'a', +}; + +char _huff_tab2[] = { + 'e', 't', +}; + diff --git a/include/chibi/sexp-unhuff.c b/include/chibi/sexp-unhuff.c new file mode 100644 index 00000000..fa142e16 --- /dev/null +++ b/include/chibi/sexp-unhuff.c @@ -0,0 +1,71 @@ +/* auto-generated by ./symhuff.scm on Sun Feb 25 23:12:52 2007 */ + +res = c & 7; +c = c >> 3; +if (res == 0) { + res = c & 3; + c = c >> 2; + if (res == 0) { + res = c & 3; + c = c >> 2; + if (res == 0) { + res = c & 7; + c = c >> 3; + if (res == 0) { + res = c & 3; + c = c >> 2; + if (res == 0) { + res = _huff_tab21[c & 7]; + c = c >> 3; + } else if ((res = _huff_tab19[res]) == '\x01') { + res = _huff_tab20[c & 7]; + c = c >> 3; + } + } else if (res == 1) { + res = _huff_tab18[c & 15]; + c = c >> 4; + } else if (res == 2) { + res = _huff_tab17[c & 31]; + c = c >> 5; + } else if (res == 4) { + res = _huff_tab16[c & 15]; + c = c >> 4; + } else if (res == 5) { + res = _huff_tab15[c & 15]; + c = c >> 4; + } else if ((res = _huff_tab13[res]) == '\x00') { + res = _huff_tab14[c & 1]; + c = c >> 1; + } + } else if ((res = _huff_tab11[res]) == '\x00') { + res = _huff_tab12[c & 1]; + c = c >> 1; + } + } else if ((res = _huff_tab9[res]) == '\x00') { + res = _huff_tab10[c & 3]; + c = c >> 2; + } + } else if (res == 1) { + res = _huff_tab8[c & 3]; + c = c >> 2; + } else if (res == 2) { + res = c & 3; + c = c >> 2; + if (res == 0) { + res = _huff_tab7[c & 3]; + c = c >> 2; + } else if ((res = _huff_tab5[res]) == '\x00') { + res = _huff_tab6[c & 1]; + c = c >> 1; + } + } else if (res == 4) { + res = _huff_tab4[c & 1]; + c = c >> 1; + } else if (res == 5) { + res = _huff_tab3[c & 1]; + c = c >> 1; + } else if ((res = _huff_tab1[res]) == '\x00') { + res = _huff_tab2[c & 1]; + c = c >> 1; + } + diff --git a/lib/chibi/io/io.stub b/lib/chibi/io/io.stub index 5c423820..1bb4871f 100644 --- a/lib/chibi/io/io.stub +++ b/lib/chibi/io/io.stub @@ -11,7 +11,7 @@ (string (value 1 size_t) size_t (default (current-input-port) input-port))) )) -(c-include "port.c") +(c-include-verbatim "port.c") (define-c-const int (seek/set "SEEK_SET")) (define-c-const int (seek/cur "SEEK_CUR")) diff --git a/lib/chibi/net.stub b/lib/chibi/net.stub index 35137b48..f77228a2 100644 --- a/lib/chibi/net.stub +++ b/lib/chibi/net.stub @@ -97,7 +97,7 @@ ;;> The constants for the addrinfo struct. ;;/ -(c-include "accept.c") +(c-include-verbatim "accept.c") (define-c errno (get-peer-name getpeername) (fileno sockaddr (result (value (sizeof sockaddr) socklen_t)))) diff --git a/lib/chibi/process.stub b/lib/chibi/process.stub index 10513f79..fbfc1cf2 100644 --- a/lib/chibi/process.stub +++ b/lib/chibi/process.stub @@ -42,7 +42,7 @@ (define-c-const int (signal/tty-input "SIGTTIN")) (define-c-const int (signal/tty-output "SIGTTOU")) -(c-include "signal.c") +(c-include-verbatim "signal.c") ;;> \procedure{(set-signal-action! signal handler)} diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c index 5bd9f127..8c4d92df 100644 --- a/lib/srfi/95/qsort.c +++ b/lib/srfi/95/qsort.c @@ -6,9 +6,9 @@ #if SEXP_USE_HUFF_SYMS #if SEXP_USE_STATIC_LIBS -#include "../../../opt/sexp-hufftabdefs.h" +#include "chibi/sexp-hufftabdefs.h" #else -#include "../../../opt/sexp-hufftabs.c" +#include "chibi/sexp-hufftabs.c" #endif #endif @@ -45,10 +45,10 @@ static int sexp_isymbol_compare (sexp ctx, sexp a, sexp b) { int res, res2, tmp; sexp_uint_t c = ((sexp_uint_t)a)>>3, d = ((sexp_uint_t)b)>>3; while (c && d) { -#include "../../../opt/sexp-unhuff.c" +#include "chibi/sexp-unhuff.c" #define c d #define res res2 -#include "../../../opt/sexp-unhuff.c" +#include "chibi/sexp-unhuff.c" #undef c #undef res if ((tmp=res-res2) != 0) diff --git a/sexp.c b/sexp.c index 58eeee50..756f9dcf 100644 --- a/sexp.c +++ b/sexp.c @@ -11,9 +11,9 @@ struct sexp_huff_entry { }; #if SEXP_USE_HUFF_SYMS -#include "opt/sexp-hufftabs.c" +#include "chibi/sexp-hufftabs.c" static struct sexp_huff_entry huff_table[] = { -#include "opt/sexp-huff.c" +#include "chibi/sexp-huff.c" }; #endif @@ -2218,7 +2218,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) { if (sexp_isymbolp(obj)) { c = ((sexp_uint_t)obj)>>3; while (c) { -#include "opt/sexp-unhuff.c" +#include "chibi/sexp-unhuff.c" sexp_write_char(ctx, res, out); } } diff --git a/tools/chibi-ffi b/tools/chibi-ffi index 64203351..16271293 100755 --- a/tools/chibi-ffi +++ b/tools/chibi-ffi @@ -43,6 +43,7 @@ (define *tags* '()) (define *open-namespaces* '()) (define *c++?* #f) +(define wdir ".") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; type objects @@ -396,6 +397,18 @@ (define (c-system-include header) (cat "\n#include <" header ">\n")) +(define (c-include-verbatim file) + (call-with-input-file (if (eqv? #\/ (string-ref file 0)) + file + (string-append wdir "/" file)) + (lambda (in) + (let lp () + (let ((c (read-char in))) + (cond + ((not (eof-object? c)) + (write-char c) + (lp)))))))) + (define (c-init x) (set! *inits* (cons x *inits*))) @@ -1589,10 +1602,7 @@ (define (type-getter-name type name field) (let ((c-name (if (pair? (cadr field)) (cadr (cadr field)) (cadr field)))) (string-append "sexp_" (x->string (type-name (parse-type name))) - "_get_" (x->string c-name))) - ;; (string-append "sexp_" (x->string (type-name (parse-type name))) - ;; "_get_" (x->string (type-base (parse-type (cadr field))))) - ) + "_get_" (x->string c-name)))) (define (verify-accessor field) (if (and (pair? field) @@ -1927,36 +1937,49 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main -(let ((args (command-line))) - (let* ((args (if (pair? args) (cdr args) args)) - (compile? (and (pair? args) (member (car args) '("-c" "--compile")))) - (args (if compile? (cdr args) args)) - (cflags (if (and (pair? args) (member (car args) '("-f" "--flags"))) - (string-split (cadr args) #\space) - #f)) - (args (if cflags (cddr args) args)) - (src (if (pair? args) (car args) "/dev/stdin")) - (dest - (case (length args) - ((0) "-") - ((1) (string-append (strip-extension src) ".c")) - ((2) (cadr args)) - (else (error "usage: chibi-ffi [-c] []"))))) - (if (equal? "-" dest) - (generate src) - (with-output-to-file dest (lambda () (generate src)))) - (cond - ((and compile? (not (equal? "-" dest))) - ;; This has to use `eval' for bootstrapping, since we need - ;; chibi-ffi to compile to (chibi process) module. - (let* ((so (string-append (strip-extension src) - *shared-object-extension*)) - (execute (begin (eval '(import (chibi process))) - (eval 'execute))) - (base-args (append (or cflags '()) - `("-o" ,so ,dest "-lchibi-scheme"))) - (args (cond-expand - (macosx (append '("-dynamiclib" "-Oz") base-args)) - (else (append '("-fPIC" "-shared" "-Os") base-args)))) - (cc (if *c++?* "c++" "cc"))) - (execute cc (cons cc args))))))) +(define (string-scan-right str ch) + (let lp ((i (string-cursor-end str))) + (let ((i2 (string-cursor-prev str i))) + (cond ((string-cursor []"))))) + (if (not (equal? "/dev/stdin" src)) + (let ((slash (string-scan-right src #\/))) + (if (> slash 0) + (set! wdir (substring-cursor src 0 slash))))) + (if (equal? "-" dest) + (generate src) + (with-output-to-file dest (lambda () (generate src)))) + (cond + ((and compile? (not (equal? "-" dest))) + ;; This has to use `eval' for bootstrapping, since we need + ;; chibi-ffi to compile to (chibi process) module. + (let* ((so (string-append (strip-extension src) + *shared-object-extension*)) + (execute (begin (eval '(import (chibi process))) + (eval 'execute))) + (base-args (append (or cflags '()) + `("-o" ,so ,dest "-lchibi-scheme"))) + (args (cond-expand + (macosx (append '("-dynamiclib" "-Oz") base-args)) + (else (append '("-fPIC" "-shared" "-Os") base-args)))) + (cc (if *c++?* "c++" "cc"))) + (execute cc (cons cc args))))))