From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 5 Sep 2013 17:19:56 +0000 (-0700)
Subject: gdbm: Add generate-shim. Drop compile-bundle and install-bundle.
X-Git-Tag: release-9.2.0~130
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1f5cb0a79bf05f7d10887e5794bdd11aeb0fd1b4;p=mit-scheme.git
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 e278f55d2..1ec888fbd 100644
--- 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).
These are miscellaneous extras:
diff --git a/src/ffi/build.scm.in b/src/ffi/build.scm.in
index 847c1995d..5e646bab1 100644
--- 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)))
(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 b166a0216..685b23eb5 100644
--- 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 4d27d0541..f5a855bda 100644
--- 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
index 000000000..bb998aa1c
--- /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 629b14ddb..056ef55a4 100644
--- 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)))))
(define calloutback-stack '())