diff --git a/Makefile b/Makefile
index 64d64da4..43e2fdc7 100644
--- a/Makefile
+++ b/Makefile
@@ -186,8 +186,8 @@ chibi-scheme-static$(EXE): main.o eval.o sexp.o
chibi-scheme-ulimit$(EXE): main.o eval.o sexp-ulimit.o
$(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS) -lm
-clibs.c: $(GENSTATIC) lib lib/chibi lib/srfi chibi-scheme$(EXE) libs
- $(CHIBI) $< > $@
+clibs.c: $(GENSTATIC) chibi-scheme$(EXE)
+ $(FIND) lib -name \*.sld | $(CHIBI) $(GENSTATIC) > $@
%.c: %.stub $(GENSTUBS) chibi-scheme$(EXE)
-$(CHIBI) $(GENSTUBS) $<
diff --git a/tools/chibi-genstatic b/tools/chibi-genstatic
index 4477035e..f2cde26d 100755
--- a/tools/chibi-genstatic
+++ b/tools/chibi-genstatic
@@ -1,7 +1,27 @@
#! /usr/bin/env chibi-scheme
+;; This is a build-only tool (not installed) used to generate the
+;; clibs.c file used by Chibi for a SEXP_USE_STATIC_LIBS=1 build,
+;; i.e. a build of Chibi with all libraries that would be loaded
+;; dynamically included statically into libchibi-scheme (though not
+;; necessarily statically linked).
+;;
+;; usage: find
-name \*.sld | chibi-genstatic [-x ...] > clibs.c
+;;
+;; where is a list of modules _not_ to generate static bindings for.
+;;
+;; This is only intended for libraries in the core distribution, and
+;; currently makes the assumption that the .sld files contain a
+;; `define-library' form. If you want to make a custom build with
+;; your own libraries included statically, be sure to follow this
+;; convention.
+;;
+;; This relies on an external find, instead of one from (chibi
+;; filesystem), because the latter is a dynamically loaded library
+;; which presents a bootstrapping issue on platforms with no dynamic
+;; loading.
+
(import (scheme)
- (chibi filesystem)
(chibi pathname)
(only (meta) find-module))
@@ -15,6 +35,16 @@
((number? x) (number->string x))
(else (error "non-stringable object" x))))
+(define (string-split str c . o)
+ (let ((start (if (pair? o) (car o) 0))
+ (end (string-length str)))
+ (let lp ((from start) (i start) (res '()))
+ (define (collect) (if (= i from) res (cons (substring str from i) res)))
+ (cond
+ ((>= i end) (reverse (collect)))
+ ((eqv? c (string-ref str i)) (lp (+ i 1) (+ i 1) (collect)))
+ (else (lp from (+ i 1) res))))))
+
(define (string-scan c str . o)
(let ((limit (string-length str)))
(let lp ((i (if (pair? o) (car o) 0)))
@@ -48,64 +78,57 @@
(string-replace (string-replace (c-escape (x->string x)) #\- "_") #\? "_p")
#\! "_x"))
+(define (read-line . o)
+ (let ((in (if (pair? o) (car o) (current-input-port))))
+ (let lp ((res '()))
+ (let ((c (read-char in)))
+ (if (or (eof-object? c) (eqv? c #\newline))
+ (list->string (reverse res))
+ (lp (cons c res)))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (path-relative path dir)
- (let ((p-len (string-length path))
- (d-len (string-length dir)))
- (and (> p-len d-len)
- (string=? dir (substring path 0 d-len))
- (cond
- ((eqv? #\/ (string-ref path d-len))
- (substring path (+ d-len 1) p-len))
- ((eqv? #\/ (string-ref path (- d-len 1)))
- (substring path d-len p-len))
- (else #f)))))
-
-(define (path-split file)
- (let ((len (string-length file)))
- (let lp ((i 0) (res '()))
- (let ((j (string-scan #\/ file i)))
- (cond
- (j (lp (+ j 1) (cons (substring file i j) res)))
- (else (reverse (if (= i len)
- res
- (cons (substring file i len) res)))))))))
-
(define (init-name mod)
(string-append "sexp_init_lib_"
(string-concatenate (map mangle mod) "_")))
-(define (find-c-libs basedir)
- (define (process-dir dir)
- (directory-fold
- dir
- (lambda (f x)
- (if (and (not (equal? "" f)) (not (eqv? #\. (string-ref f 0))))
- (process (string-append dir "/" f))))
- #f))
+(define (find-c-libs excluded-c-libs)
+ (define (extract-module-name file)
+ (call-with-input-file file
+ (lambda (in)
+ (let lp ()
+ (let ((expr (read in)))
+ (cond
+ ((eof-object? expr) #f)
+ ((and (pair? expr)
+ (pair? (cdr expr))
+ (memq (car expr)
+ '(define-library define-module library module)))
+ (cadr expr))
+ (else (lp))))))))
(define (process file)
- (cond
- ((file-directory? file)
- (process-dir file))
- ((equal? "sld" (path-extension file))
- (let* ((mod-path (path-strip-extension (path-relative file basedir)))
- (mod-name (map (lambda (x) (or (string->number x) (string->symbol x)))
- (path-split mod-path))))
- (cond
- ((find-module mod-name)
- => (lambda (mod)
- (cond
- ((assq 'include-shared (vector-ref mod 2))
- => (lambda (x)
- (set! c-libs
- (cons (cons (string-append
- (path-directory file)
- "/"
- (cadr x))
- mod-name)
- c-libs))))))))))))
- (process-dir basedir))
+ (let ((mod-name (extract-module-name file)))
+ (cond
+ ((and mod-name
+ (not (member mod-name excluded-c-libs))
+ (find-module mod-name))
+ => (lambda (mod)
+ (cond
+ ((assq 'include-shared (vector-ref mod 2))
+ => (lambda (x)
+ (set! c-libs
+ (cons (cons (string-append
+ (path-directory file)
+ "/"
+ (cadr x))
+ mod-name)
+ c-libs))))))))))
+ (let lp ()
+ (let ((file (read-line)))
+ (cond
+ ((not (or (eof-object? file) (equal? "" file)))
+ (process file)
+ (lp))))))
(define (include-c-lib lib)
(display "#define sexp_init_library ")
@@ -127,7 +150,13 @@
(display " },\n"))
(define (main args)
- (find-c-libs (if (and (pair? args) (pair? (cdr args))) (cadr args) "lib"))
+ (find-c-libs
+ (if (and (pair? args) (member (car args) '("-x" "--exclude")))
+ (map (lambda (m)
+ (map (lambda (x) (or (string->number x) (string->symbol x)))
+ (string-split m #\.)))
+ (cdr args))
+ '()))
(newline)
(for-each include-c-lib c-libs)
(newline)