From: Matt Birkholz 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-timeenvironment '(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 '())