gdbm: Add generate-shim. Drop compile-bundle and install-bundle.

LIAR/C's bundles cannot be built outside the core build tree.  So
compile-bundle is just e.g. compile.scm, and install-bundle is merged
with install-shim.  Generate-shim actually handles the whole process
from *.cdecl's to -shim.c and -const.bin, eliminating 4 tedious little
rules from every wrapper's Makefile.

diff --git a/src/README.txt b/src/README.txt
index e278f55d259babe45f16ab0ad12dc2dedccf29e5..1ec888fbdab99b2d17420a0cba3975b9f481e917 100644 (file)
--- a/src/README.txt
+++ b/src/README.txt
@@ -73,6 +73,12 @@ The editor subsystem consists of two directories:
 * "edwin" contains our Emacs-like editor written in Scheme.
 
 * "imail" contains an email-reading program for Edwin.
+
+There is one C/Unix FFI wrapper thus far:
+
+* "gdbm" wraps libgdbm, the GNU dbm database routines, and provides a
+  drop-in replacement for the microcode module based package (runtime
+  gdbm).
 \f
 These are miscellaneous extras:
 

diff --git a/src/ffi/build.scm.in b/src/ffi/build.scm.in
index 847c1995dcf64289994041663c617f368804e54e..5e646bab1224454264e7585a288086d2896fb856 100644 (file)
--- a/src/ffi/build.scm.in
+++ b/src/ffi/build.scm.in
@@ -27,41 +27,45 @@ USA.
 ;;;; Build Utilities
 ;;; package: (ffi build)
 
-(define (compile-bundle)
-  (with-system-library-directories
-   '("./")
-   (lambda ()
-     (if (eq? microcode-id/compiled-code-type 'C)
-        (fluid-let ((compiler:invoke-c-compiler? #f))
-          (compile-dir)
-          (c-compile-pkgs))
-        (compile-dir)))))
-
 (define (compile-shim)
   (run-command (append cc-cmdline-prefix (command-line))))
 
 (define (link-shim)
   (run-command (append CCLD LDFLAGS (command-line) MODULE_LDFLAGS)))
 
-(define (install-bundle)
-  (let* ((name (working-directory-name))
-        (target-dir (->namestring (system-library-pathname name #f))))
-    (run-command (list "rm" "-rf" target-dir))
-    (run-command (list "mkdir" target-dir))
-    (run-command (append (list "install" "-m" "644")
-                        (command-line)
-                        (list target-dir)))))
-
 (define (install-shim libname)
-  (run-command (list "install" "-m" "644"
-                    (string-append libname "-shim.so")
-                    (string-append libname "-types.bin")
-                    (string-append libname "-const.bin")
-                    (->namestring (system-library-directory-pathname)))))
+  (let ((library-dir (->namestring
+                     (system-library-directory-pathname libname))))
+    (run-command (list "rm" "-rf" library-dir))
+    (run-command (list "mkdir" library-dir))
+    (run-command (append (list "install" "-m" "644")
+                        (command-line) (list library-dir)))
+    (run-command (list "install" "-m" "644"
+                      (string-append libname "-shim.so")
+                      (string-append libname "-types.bin")
+                      (string-append libname "-const.bin")
+                      (->namestring
+                       (pathname-new-directory
+                        library-dir
+                        (except-last-pair
+                         (pathname-directory library-dir))))))))
+
+(define (generate-shim library #!optional prefix)
+  (let ((-const (string-append library"-const"))
+       (-const.c (string-append library"-const.c"))
+       (-const.o (string-append library"-const.o")))
+    (c-generate library prefix)
+    (run-command (append CC CFLAGS (list "-c" -const.c)))
+    (run-command (append CC LDFLAGS (list "-o" -const -const.o)))
+    (run-command (list (->namestring
+                       (merge-pathnames -const (working-directory-pathname)))))
+    (sf -const)))
 \f
 (define (parse-words string)
   (burst-string string char-set:whitespace #t))
 
+(define CC (parse-words "@CC@"))
+(define CFLAGS (parse-words "@CFLAGS@"))
 (define CCLD (parse-words "@CCLD@"))
 (define LDFLAGS (parse-words "@LDFLAGS@"))
 (define MODULE_LDFLAGS (parse-words "@MODULE_LDFLAGS@"))
@@ -92,33 +96,4 @@ USA.
                  (car command) (cdr command)
                  'working-directory (working-directory-pathname))))
        (if (not (zero? code))
-          (error "Process exited with error code:" code command))))))
-
-(define (compile-dir)
-  (let ((name (working-directory-name)))
-    (if (file-exists? (pathname-new-type name "sf"))
-       (begin
-         (load (pathname-new-type name "sf"))
-         (load (pathname-new-type name "cbf")))
-       (load "compile"))))
-
-(define (c-compile-pkgs)
-  (let* ((name (working-directory-name))
-        (root
-            (if (string=? name "star-parser")
-                "parser"
-                name))
-        (compile-pkg
-         (lambda (os)
-           (cbf-conditionally (string-append root "-" os ".pkd")))))
-    (compile-pkg "unx")
-    (compile-pkg "w32")
-    (compile-pkg "os2")))
-
-(define (cbf-conditionally pathname)
-  (let ((input (pathname-default-type pathname "bin"))
-       (file-type (if (eq? microcode-id/compiled-code-type 'C)
-                      "c" "com")))
-    (if (file-modification-time<? (pathname-new-type pathname file-type)
-                                 input)
-       (compile-file input))))
\ No newline at end of file
+          (error "Process exited with error code:" code command))))))
\ No newline at end of file

diff --git a/src/ffi/ffi.pkg b/src/ffi/ffi.pkg
index b166a0216baac7b7a2095904bd2022af42b73e67..685b23eb5f74f4371c8ec85731b66642b537fc14 100644 (file)
--- a/src/ffi/ffi.pkg
+++ b/src/ffi/ffi.pkg
@@ -43,8 +43,7 @@ FFI System Packaging |#
   (import (runtime pathname)
          library-directory-path)
   (export (ffi)
+         generate-shim
          compile-shim
          link-shim
-         install-shim
-         compile-bundle
-         install-bundle))
\ No newline at end of file
+         install-shim))
\ No newline at end of file

diff --git a/src/gdbm/Makefile b/src/gdbm/Makefile
index 4d27d0541cceb1ceec6bb343e566657bbfe41969..f5a855bdacc2ca7bed8328c777f0f7b4a2e495b7 100644 (file)
--- a/src/gdbm/Makefile
+++ b/src/gdbm/Makefile
@@ -23,15 +23,14 @@
 MIT_SCHEME_EXE = mit-scheme
 EXE = '$(MIT_SCHEME_EXE)' --batch-mode
 
-build: gdbm-shim.so gdbm-types.bin gdbm-const.bin
-       echo "(compile-bundle)" | $(EXE)
+build: gdbm-shim.so
+       echo '(load "compile")' | $(EXE)
 
 check:
        echo '(load "check")' | $(EXE)
 
 install: build
-       echo "(install-bundle)" | $(EXE) -- *.com *.bci *.pkd make.scm
-       echo '(install-shim "gdbm")' | $(EXE)
+       echo '(install-shim "gdbm")' | $(EXE) -- *.com *.bci *.pkd make.scm
 
 clean:
        rm -f gdbm-const.scm gdbm-const gdbm-const.c gdbm-shim.c
@@ -49,19 +48,7 @@ gdbm-adapter.o: gdbm-adapter.c gdbm-shim.h
 gdbm-shim.o: gdbm-shim.c gdbm-shim.h
        echo '(compile-shim)' | $(EXE) -- -c $<
 
-gdbm-shim.c gdbm-const.c gdbm-types.bin: gdbm-shim.h gdbm.cdecl
+gdbm-shim.c: gdbm.cdecl gdbm-shim.h
        echo '(generate-shim "gdbm" "#include \"gdbm-shim.h\"")' | $(EXE)
 
-gdbm-const.bin: gdbm-const.scm
-       echo '(sf "gdbm-const")' | $(EXE)
-
-gdbm-const.scm: gdbm-const
-       ./gdbm-const
-
-gdbm-const: gdbm-const.o
-       $(CC) $(LDFLAGS) -o $@ $^
-
-gdbm-const.o: gdbm-const.c gdbm-shim.h
-       $(CC) $(CFLAGS) -c $<
-
 .PHONY: build install clean
\ No newline at end of file

diff --git a/src/gdbm/README b/src/gdbm/README
new file mode 100644 (file)
index 0000000..bb998aa
--- /dev/null
+++ b/src/gdbm/README
@@ -0,0 +1,12 @@
+The libgdbm wrapper.
+
+This wrapper is not part of the core build and can be built outside
+the core build tree.  There is no ./configure script yet.  If you know
+you have libgdbm installed, you should win with this command:
+
+       make build check install
+
+The install target copies a shared library shim and compiled Scheme
+files into the system library path.  You can override the default
+command name "mit-scheme" (and system library path) by setting
+MIT_SCHEME_EXE.

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 629b14ddba3fc9f3e7a11f4adf39b0d45fda9ca2..056ef55a4753d3ae140114b01f5f0d2e8fc94a25 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -527,7 +527,7 @@ USA.
 
 (define (generate-shim library #!optional prefix)
   (load-ffi-quietly)
-  ((environment-lookup (->environment '(ffi)) 'c-generate) library prefix))
+  ((environment-lookup (->environment '(ffi)) 'generate-shim) library prefix))
 
 (define (compile-shim)
   (load-ffi-quietly)
@@ -541,21 +541,16 @@ USA.
   (load-ffi-quietly)
   ((environment-lookup (->environment '(ffi)) 'install-shim) library))
 
-(define (compile-bundle)
-  (load-ffi-quietly)
-  ((environment-lookup (->environment '(ffi)) 'compile-bundle)))
-
-(define (install-bundle)
-  (load-ffi-quietly)
-  ((environment-lookup (->environment '(ffi)) 'install-bundle)))
-
 (define (load-ffi-quietly)
   (if (not (name->package '(FFI)))
-      (with-notification
-       (lambda (port) (write-string "Loading FFI option" port))
-       (lambda ()
-        (fluid-let ((load/suppress-loading-message? #t))
-          (load-option 'ffi))))))
+      (let ((kernel (lambda ()
+                     (fluid-let ((load/suppress-loading-message? #t))
+                       (load-option 'FFI)))))
+       (if (nearest-cmdl/batch-mode?)
+           (kernel)
+           (with-notification (lambda (port)
+                                (write-string "Loading FFI option" port))
+                              kernel)))))
 \f
 
 (define calloutback-stack '())