Including local source files verbatim in FFI.

Moving huff includes to include dir.

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' */

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];

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',
+};
+

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;
+ }
+

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"))

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))))

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)}
 

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)

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);
       }
     }

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,21 +1937,34 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; main
 
-(let ((args (command-line)))
-  (let* ((args (if (pair? args) (cdr args) args))
+(define (string-scan-right str ch)
+  (let lp ((i (string-cursor-end str)))
+    (let ((i2 (string-cursor-prev str i)))
+      (cond ((string-cursor<? i2 0) 0)
+            ((eqv? ch (string-cursor-ref str i2)) i)
+            (else (lp i2))))))
+
+(let* ((args (command-line))
+       (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"))
+       (src (if (or (not (pair? args)) (equal? "-" (car args)))
+                "/dev/stdin"
+                (car args)))
        (dest
         (case (length args)
           ((0) "-")
           ((1) (string-append (strip-extension src) ".c"))
           ((2) (cadr args))
           (else (error "usage: chibi-ffi [-c] <file.stub> [<output.c>]")))))
+  (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))))
@@ -1959,4 +1982,4 @@
                   (macosx (append '("-dynamiclib" "-Oz") base-args))
                   (else (append '("-fPIC" "-shared" "-Os") base-args))))
            (cc (if *c++?* "c++" "cc")))
-        (execute cc (cons cc args)))))))
+      (execute cc (cons cc args))))))