adding mechanism to statically include modules which use C code

Makefile

@@ -17,7 +17,8 @@ MANDIR   ?= $(PREFIX)/share/man/man1
 
 DESTDIR  ?=
 
-GENSTUBS ?= ./tools/genstubs.scm
+GENSTUBS  ?= ./tools/genstubs.scm
+GENSTATIC ?= ./tools/genstatic.scm
 
 ########################################################################
 # system configuration - if not using GNU make, set PLATFORM and the
@@ -50,6 +51,7 @@ CC = gcc
 CLIBFLAGS = -shared
 CPPFLAGS += -DSEXP_USE_STRING_STREAMS=0 -DBUILDING_DLL -DSEXP_USE_DEBUG=0
 LDFLAGS += -Wl,--out-implib,libchibi-scheme$(SO).a
+STATICFLAGS = -DSEXP_USE_DL=0
 else
 SO  = .so
 EXE =
@@ -118,10 +120,16 @@ chibi-scheme$(EXE): main.o libchibi-scheme$(SO)
 	$(CC) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -L. -lchibi-scheme
 
 chibi-scheme-static$(EXE): main.o eval.o sexp.o
-	$(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(XLDFLAGS)
+	$(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS) -lm
+
+clibs.c: $(GENSTATIC) lib lib/chibi lib/srfi
+	make chibi-scheme$(EXE)
+	make libs
+	LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) PATH=.:$(PATH) $(GENSTATIC) $< > $@
 
 %.c: %.stub $(GENSTUBS)
-	LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) PATH=.:$(PATH) $(GENSTUBS) $<
+	make chibi-scheme$(EXE)
+	-LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) PATH=.:$(PATH) $(GENSTUBS) $<
 
 lib/%$(SO): lib/%.c $(INCLUDES)
 	-$(CC) $(CLIBFLAGS) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -L. -lchibi-scheme
@@ -178,7 +186,7 @@ install: chibi-scheme$(EXE)
 	-cp libchibi-scheme.a $(DESTDIR)$(LIBDIR)/
 	mkdir -p $(DESTDIR)$(MANDIR)
 	cp doc/chibi-scheme.1 $(DESTDIR)$(MANDIR)/
-	if type ldconfig >/dev/null 2>/dev/null; then ldconfig; fi
+	-if type ldconfig >/dev/null 2>/dev/null; then ldconfig; fi
 
 uninstall:
 	rm -f $(DESTDIR)$(BINDIR)/chibi-scheme$(EXE)

README

@@ -41,6 +41,22 @@ directly from make with:
 
   make SEXP_USE_BOEHM=1
 
+To compile a static executable, use
+
+  make chibi-scheme-static SEXP_USE_DL=0
+
+To compile a static executable with all C libraries statically
+included, first you need to create a clibs.c file, which can be done
+with:
+
+  make clibs.c
+
+or edited manually.  Be sure to run this with a non-static
+chibi-scheme.  Then you can make the static executable with:
+
+  make cleaner
+  make chibi-scheme-static SEXP_USE_DL=0 CPPFLAGS=-DSEXP_USE_STATIC_LIBS
+
 ------------------------------------------------------------------------
 CHIBI-SCHEME LANGUAGE
 

eval.c

@@ -2414,6 +2414,10 @@ sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index) {
 
 #endif
 
+#if SEXP_USE_STATIC_LIBS
+#include "clibs.c"
+#endif
+
 /*********************** standard environment *************************/
 
 static struct sexp_struct core_forms[] = {
@@ -2606,6 +2610,9 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
     }
     sexp_env_define(ctx, e, sym, tmp);
   }
+#endif
+#if SEXP_USE_STATIC_LIBS
+  sexp_init_all_libraries(ctx, e);
 #endif
   sexp_gc_release3(ctx);
   return sexp_exceptionp(tmp) ? tmp : e;

include/chibi/features.h

@@ -17,6 +17,16 @@
 /*   sexp_init_library(ctx, env) function provided. */
 /* #define SEXP_USE_DL 0 */
 
+/* uncomment this to statically compile all C libs */
+/*   If set, this will statically include the clibs.c file */
+/*   into the standard environment, so that you can have */
+/*   access to a predefined set of C libraries without */
+/*   needing dynamic loading.  The clibs.c file is generated */
+/*   automatically by searching the lib directory for */
+/*   modules with include-shared, but can be hand-tailored */
+/*   to your needs. */
+/* #define SEXP_USE_STATIC_LIBS 1 */
+
 /* uncomment this to disable a simplifying optimization pass */
 /*   This performs some simple optimizations such as dead-code */
 /*   elimination, constant-folding, and directly propagating */
@@ -179,6 +189,10 @@
 #endif
 #endif
 
+#ifndef SEXP_USE_STATIC_LIBS
+#define SEXP_USE_STATIC_LIBS 0
+#endif
+
 #ifndef SEXP_USE_SIMPLIFY
 #define SEXP_USE_SIMPLIFY ! SEXP_USE_NO_FEATURES
 #endif

lib/chibi/ast.module

@@ -10,5 +10,6 @@
           set-var set-value set-var-set! set-value-set!
           ref-name ref-cell ref-name-set! ref-cell-set!
           seq-ls seq-ls-set! lit-value lit-value-set!)
+  (import-immutable (scheme))
   (include-shared "ast"))
 

lib/chibi/filesystem.module

@@ -4,7 +4,7 @@
           duplicate-file-descriptor duplicate-file-descriptor-to
           close-file-descriptor renumber-file-descriptor
           delete-file link-file symbolic-link-file rename-file
-          directory-files create-directory delete-directory
+          directory-files directory-fold create-directory delete-directory
           file-status
           file-device               file-inode
           file-mode                 file-num-links

lib/chibi/heap-stats.module

@@ -1,5 +1,6 @@
 
 (define-module (chibi heap-stats)
   (export heap-stats heap-dump)
+  (import-immutable (scheme))
   (include-shared "heap-stats"))
 

lib/config.scm

@@ -111,15 +111,17 @@
                            (eq? (car x) 'import-immutable))))
            (cdr x)))
          ((include include-shared)
-          (for-each
-           (lambda (f)
-             (let ((f (string-append
-                       dir f
-                       (if (eq? (car x) 'include) "" *shared-object-extension*))))
-               (cond
-                ((find-module-file f) => (lambda (x) (load x env)))
-                (else (error "couldn't find include" f)))))
-           (cdr x)))
+          (if (cond-expand (dynamic-loading #t)
+                           (else (not (eq? 'include-shared (car x)))))
+              (for-each
+               (lambda (f)
+                 (let ((f (string-append
+                           dir f
+                           (if (eq? (car x) 'include) "" *shared-object-extension*))))
+                   (cond
+                    ((find-module-file f) => (lambda (x) (load x env)))
+                    (else (error "couldn't find include" f)))))
+               (cdr x))))
          ((body)
           (for-each (lambda (expr) (eval expr env)) (cdr x)))))
      (module-meta-data mod))

tools/genstatic.scm

@@ -0,0 +1,135 @@
+#! /usr/bin/env chibi-scheme
+
+(import (chibi filesystem)
+        (chibi pathname))
+
+(define c-libs '())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (x->string x)
+  (cond ((string? x) x)
+        ((symbol? x) (symbol->string x))
+        ((number? x) (number->string x))
+        (else (error "non-stringable object" x))))
+
+(define (string-scan c str . o)
+  (let ((limit (string-length str)))
+    (let lp ((i (if (pair? o) (car o) 0)))
+      (cond ((>= i limit) #f)
+            ((eqv? c (string-ref str i)) i)
+            (else (lp (+ i 1)))))))
+
+(define (string-replace str c r)
+  (let ((len (string-length str)))
+    (let lp ((from 0) (i 0) (res '()))
+      (define (collect) (if (= i from) res (cons (substring str from i) res)))
+      (cond
+       ((>= i len) (string-concatenate (reverse (collect))))
+       ((eqv? c (string-ref str i)) (lp (+ i 1) (+ i 1) (cons r (collect))))
+       (else (lp from (+ i 1) res))))))
+
+(define (c-char? c)
+  (or (char-alphabetic? c) (char-numeric? c) (memv c '(#\_ #\- #\! #\?))))
+
+(define (c-escape str)
+  (let ((len (string-length str)))
+    (let lp ((from 0) (i 0) (res '()))
+      (define (collect) (if (= i from) res (cons (substring str from i) res)))
+      (cond
+       ((>= i len) (string-concatenate (reverse (collect))))
+       ((not (c-char? (string-ref str i))) (lp (+ i 1) (+ i 1) (cons "_" (cons (number->string (char->integer (string-ref str i)) 16) (collect)))))
+       (else (lp from (+ i 1) res))))))
+
+(define (mangle x)
+  (string-replace
+   (string-replace (string-replace (c-escape (x->string x)) #\- "_") #\? "_p")
+   #\! "_x"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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 (process file)
+    (cond
+     ((file-directory? file)
+      (process-dir file))
+     ((equal? "module" (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
+         ((eval `(find-module ',mod-name) *config-env*)
+          => (lambda (mod)
+               (cond
+                ((assq 'include-shared (vector-ref mod 2))
+                 => (lambda (x)
+                      (set! c-libs
+                            (cons (cons (string-append
+                                         (path-directory file)
+                                         "/"
+                                         (cadr x)
+                                         ".c")
+                                        (init-name mod-name))
+                                  c-libs))))))))))))
+  (process-dir basedir))
+
+(define (include-c-lib lib)
+  (display "#define sexp_init_library ")
+  (display (cdr lib))
+  (newline)
+  (display "#include \"")
+  (display (car lib))
+  (display "\"")
+  (newline)
+  (display "#undef sexp_init_library")
+  (newline)
+  (newline))
+
+(define (init-c-lib lib)
+  (display "  ")
+  (display (cdr lib))
+  (display "(ctx, env);\n"))
+
+(define (main args)
+  (find-c-libs (if (pair? (cdr args)) (cadr args) "lib"))
+  (newline)
+  (for-each include-c-lib c-libs)
+  (newline)
+  (display "static sexp sexp_init_all_libraries (sexp ctx, sexp env) {\n")
+  (for-each init-c-lib c-libs)
+  (display "  return SEXP_VOID;\n")
+  (display "}\n\n"))
+