diff --git a/NEWS b/NEWS index 67ef9b3a1..f93704c39 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,12 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- +changes relative to sbcl-2.1.9: + * new feature: there is now a defined interface for defining foreign + callable functions, which can be used for passing callbacks to foreign + functions or for calling Lisp code from the foreign world as a shared + library (preliminary support). See the revised manual section "Calling + into Lisp From C" for more details. + changes in sbcl-2.1.9 relative to sbcl-2.1.8: * minor incompatible change: the experimental DEFCAS macro has been removed. * minor incompatible change: finalizing classes with slots with duplicate diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo index 747ec6cbb..400023be7 100644 --- a/doc/manual/ffi.texinfo +++ b/doc/manual/ffi.texinfo @@ -26,6 +26,7 @@ notably in the name of the @code{SB-ALIEN} package. * Foreign Data Structure Examples:: * Loading Shared Object Files:: * Foreign Function Calls:: +* Calling Lisp From C:: * Step-By-Step Example of the Foreign Function Interface:: @end menu @@ -718,7 +719,6 @@ the only documentation. Users of a Lisp built with the * The alien-funcall Primitive:: * The define-alien-routine Macro:: * define-alien-routine Example:: -* Calling Lisp From C:: @end menu @node The alien-funcall Primitive @@ -883,40 +883,6 @@ This can be described by the following call to The Lisp function @code{cfoo} will have two arguments (@var{str} and @var{a}) and two return values (@var{a} and @var{i}). -@node Calling Lisp From C -@comment node-name, next, previous, up -@subsection Calling Lisp From C - -Calling Lisp functions from C is sometimes possible, but is extremely -hackish and poorly supported as of SBCL 0.7.5. See @code{funcall0} -@dots{} @code{funcall3} in the runtime system. The arguments must be -valid SBCL object descriptors (so that e.g. fixnums must be -left-shifted by 2.) As of SBCL 0.7.5, the format of object descriptors -is documented only by the source code and, in parts, by the old CMUCL -@file{INTERNALS} documentation. - -Note that the garbage collector moves objects, and won't be -able to fix up any references in C variables. There are three -mechanisms for coping with this: - -@enumerate -@item -The @code{sb-ext:purify} moves all live Lisp -data into static or read-only areas such that it will never be moved -(or freed) again in the life of the Lisp session - -@item -@code{sb-sys:with-pinned-objects} is a macro which arranges for some -set of objects to be pinned in memory for the dynamic extent of its -body forms. On ports which use the generational garbage collector (most, -as of this writing) this affects exactly the specified objects. On -other ports it is implemented by turning off GC for the duration (so -could be said to have a whole-world granularity). - -@item -Disable GC, using the @code{without-gcing} macro. -@end enumerate - @c +@node Calling Lisp From C +@comment node-name, next, previous, up +@section Calling Lisp From C + +SBCL supports the calling of Lisp functions using the C calling +convention. This is useful for both defining callbacks and for creating +an interface for calling into Lisp as a shared library directly from C. + +The @code{define-alien-callable} macro wraps Lisp code and creates a C +foreign function which can be called with the C calling convention. + +@include macro-sb-alien-define-alien-callable.texinfo + +The @code{alien-callable-function} function returns the foreign callable +value associated with any name defined by @code{define-alien-callable}, +so that we can, for example, pass the callable value to C as a callback. + +@include fun-sb-alien-alien-callable-function.texinfo + +Note that the garbage collector moves objects, and won't be able to fix +up any references in C variables. There are three mechanisms for coping +with this: + +@enumerate +@item +The @code{sb-ext:purify} moves all live Lisp data into static or +read-only areas such that it will never be moved (or freed) again in the +life of the Lisp session + +@item +@code{sb-sys:with-pinned-objects} is a macro which arranges for some set +of objects to be pinned in memory for the dynamic extent of its body +forms. On ports which use the generational garbage collector (most, as +of this writing) this affects exactly the specified objects. On other +ports it is implemented by turning off GC for the duration (so could be +said to have a whole-world granularity). + +@item +Disable GC, using the @code{without-gcing} macro. +@end enumerate + +@menu +* Lisp as a Shared Library:: +@end menu + +@node Lisp as a Shared Library +@comment node-name, next, previous, up +@subsection Lisp as a Shared Library +SBCL supports the use of Lisp as a shared library that can be used by C +programs using the @code{define-alien-callable} interface. See the +@code{:callable-exports} keyword to @code{save-lisp-and-die} for how to +save the Lisp image in a way that allows a C program to initialize the +Lisp runtime and the exported symbols. When SBCL is built as a library, +it exposes the symbol @code{initialize_lisp} which can be used in +conjunction with a core initializing global symbols to foreign callables +as function pointers and with object code allocating those symbols to +initialize the runtime properly. The arguments to @code{initialize_lisp} +are the same as the arguments to the main @code{sbcl} program. + +While standalone C code can call exposed Lisp functions which spawn Lisp +threads after the runtime has been initialized, it is currently not +advised to call into Lisp this way from separate C threads running +concurrently. + +Note: There is also currently no way to run exit hooks or otherwise undo +Lisp initialization gracefully from C. @node Step-By-Step Example of the Foreign Function Interface @comment node-name, next, previous, up diff --git a/make-shared-library.sh b/make-shared-library.sh new file mode 100755 index 000000000..9acd9d843 --- /dev/null +++ b/make-shared-library.sh @@ -0,0 +1,8 @@ +#!/bin/sh + +. output/build-config + +echo //entering make-shared-library.sh +echo //building sbcl runtime into a shared library + +$GNUMAKE -C src/runtime libsbcl.so diff --git a/src/code/alien-callback.lisp b/src/code/alien-callback.lisp index 95bb75fea..033c9c734 100644 --- a/src/code/alien-callback.lisp +++ b/src/code/alien-callback.lisp @@ -12,11 +12,16 @@ (in-package "SB-ALIEN") -;;; ALIEN-CALLBACK is supposed to be external in SB-ALIEN-INTERNALS, but the -;;; export gets lost, and then 'chill' gets a conflict with SB-ALIEN over it. +;;; ALIEN-CALLBACK is supposed to be external in SB-ALIEN-INTERNALS, +;;; but the export gets lost (as this is now a warm-loaded file), and +;;; then 'chill' gets a conflict with SB-ALIEN over it. (eval-when (:compile-toplevel :load-toplevel :execute) (export (intern "ALIEN-CALLBACK" "SB-ALIEN-INTERNALS") - "SB-ALIEN-INTERNALS")) + "SB-ALIEN-INTERNALS") + (export (intern "DEFINE-ALIEN-CALLABLE" "SB-ALIEN") + "SB-ALIEN") + (export (intern "ALIEN-CALLABLE-FUNCTION" "SB-ALIEN") + "SB-ALIEN")) ;;;; ALIEN CALLBACKS ;;;; @@ -250,7 +255,7 @@ and a secondary return value of true if the callback is still valid." (defun invalidate-alien-callback (alien) "Invalidates the callback designated by the alien, if any, allowing the associated lisp function to be GC'd, and causing further calls to the same -callback signal an error." +callback to signal an error." (let ((info (alien-callback-info alien))) (when (and info (callback-info-function info)) ;; sap cache @@ -288,6 +293,49 @@ the alien callback for that function with the given alien type." (defun ,name ,lambda-list ,@forms) (defparameter ,name (alien-callback ,specifier #',name))))) +;;;; Alien callables + +(define-load-time-global *alien-callables* (make-hash-table :test #'eq) + "Map from Lisp symbols to the alien callable functions they name.") + +(defmacro define-alien-callable (name result-type typed-lambda-list &body body) + "Define an alien callable function in the alien callable namespace with result +type RESULT-TYPE and with lambda list specifying the alien types of the +arguments." + (multiple-value-bind (lisp-name alien-name) + (pick-lisp-and-alien-names name) + (declare (ignore alien-name)) + `(progn + (invalidate-alien-callable ',lisp-name) + (setf (gethash ',lisp-name *alien-callables*) + (alien-lambda ,result-type ,typed-lambda-list ,@body))))) + +(defun alien-callable-function (name) + "Return the alien callable function associated with NAME." + (gethash name *alien-callables*)) + +(defun invalidate-alien-callable (name) + "Invalidates the callable designated by the alien, if any, allowing the +associated lisp function to be GC'd, and causing further calls to the same +callable to signal an error." + (multiple-value-bind (lisp-name alien-name) + (pick-lisp-and-alien-names name) + (declare (ignore alien-name)) + (let ((alien (alien-callable-function lisp-name))) + (when alien + (invalidate-alien-callback alien))) + (remhash lisp-name *alien-callables*))) + +(defun initialize-alien-callable-symbol (name) + "Initialize the alien symbol named by NAME with its alien callable +function value." + (multiple-value-bind (lisp-name alien-name) + (pick-lisp-and-alien-names name) + (setf (%alien-value (foreign-symbol-sap alien-name t) + 0 + (make-alien-pointer-type)) + (cast (alien-callable-function lisp-name) (* t))))) + (in-package "SB-THREAD") #+sb-thread (defun enter-foreign-callback (index return arguments) diff --git a/src/code/save.lisp b/src/code/save.lisp index dd4ed9246..428c4d9fd 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -80,16 +80,22 @@ sb-thread::*session* sb-kernel::*gc-epoch*)) -(defun start-lisp (toplevel) +(defun start-lisp (toplevel callable-exports) (named-lambda start-lisp () - (handling-end-of-the-world - (reinit t) - (funcall toplevel)))) + (cond (callable-exports + (reinit t) + (dolist (export callable-exports) + (sb-alien::initialize-alien-callable-symbol export))) + (t + (handling-end-of-the-world + (reinit t) + (funcall toplevel)))))) (defun save-lisp-and-die (core-file-name &key - (toplevel #'toplevel-init) + (toplevel #'toplevel-init toplevel-supplied) (executable nil) (save-runtime-options nil) + (callable-exports ()) (purify t) (root-structures ()) (environment-name "auxiliary") @@ -125,6 +131,13 @@ The following &KEY arguments are defined: all command line arguments to be passed to the toplevel. Meaningless if :EXECUTABLE is NIL. + :CALLABLE-EXPORTS + This should be a list of symbols to be initialized to the + appropriate alien callables on startup. All exported symbols should + be present as global symbols in the symbol table of the runtime + before the saved core is loaded. When this list is non-empty, the + :TOPLEVEL argument cannot be supplied. + :PURIFY If true (the default on cheneygc), do a purifying GC which moves all dynamically allocated objects into static space. This takes @@ -194,6 +207,8 @@ sufficiently motivated to do lengthy fixes." (declare (ignore environment-name)) #+gencgc (declare (ignore purify) (ignorable root-structures)) + (when (and callable-exports toplevel-supplied) + (error ":TOPLEVEL cannot be supplied when there are callable exports.")) ;; If the toplevel function is not defined, this will signal an ;; error before saving, not at startup time. (let ((toplevel (%coerce-callable-to-fun toplevel)) @@ -217,7 +232,7 @@ sufficiently motivated to do lengthy fixes." (if value 1 0))) (let ((name (native-namestring (physicalize-pathname core-file-name) :as-file t)) - (startfun (start-lisp toplevel))) + (startfun (start-lisp toplevel callable-exports))) (deinit) ;; FIXME: Would it be possible to unmix the PURIFY logic from this ;; function, and just do a GC :FULL T here? (Then if the user wanted diff --git a/src/runtime/GNUmakefile b/src/runtime/GNUmakefile index bda27b9ce..63d7a246f 100644 --- a/src/runtime/GNUmakefile +++ b/src/runtime/GNUmakefile @@ -122,10 +122,9 @@ libsbcl.so: $(PIC_OBJS) # for this to work, you must have with-gcc-tls in your build features already. # can't define it here because then it conflicts if you have it in both places. %.pic.o: %.c - $(CC) -fPIC -c $(filter-out -fno-pie,$(CFLAGS)) $< -o $@ + $(CC) -fPIC -c $(CPPFLAGS) -DSHARED_LIBRARY=1 $(filter-out -fno-pie,$(CFLAGS)) $< -o $@ %.pic.o: %.S # (-fPIC doesn't affect hand-written assembly source) - $(CC) -c $(CFLAGS) $< -o $@ -testmain: testmain.c libsbcl.so -ldl + $(CC) -c $(CPPFLAGS) -DSHARED_LIBRARY=1 $(CFLAGS) $< -o $@ SHRINKWRAP_DEPS = ../../output/sbcl.core ../../tools-for-build/editcore.lisp shrinkwrap-sbcl.s shrinkwrap-sbcl-core.o: $(SHRINKWRAP_DEPS) diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 7bccddceb..918e69368 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -324,7 +324,7 @@ static void record_signal(int sig, void* context) #define RECORD_SIGNAL(sig,ctxt) #endif -#ifdef LISP_FEATURE_WIN32 +#if defined(SHARED_LIBRARY) || defined(LISP_FEATURE_WIN32) # define should_handle_in_this_thread(c) (1) #else # define should_handle_in_this_thread(c) lisp_thread_p(c) diff --git a/src/runtime/main.c b/src/runtime/main.c index 5dba8087a..18c34fe58 100644 --- a/src/runtime/main.c +++ b/src/runtime/main.c @@ -1,5 +1,9 @@ +#include + int main(int argc, char *argv[], char *envp[]) { - extern int sbcl_main(int argc, char *argv[], char *envp[]); - return sbcl_main(argc, argv, envp); + extern int initialize_lisp(int argc, char *argv[], char *envp[]); + initialize_lisp(argc, argv, envp); + lose("unexpected return from initial thread in main()"); + return 0; } diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 5086fd806..c1d9df49d 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -395,7 +395,7 @@ char *dir_name(char *path) { extern void write_protect_immobile_space(); struct lisp_startup_options lisp_startup_options; int -sbcl_main(int argc, char *argv[], char *envp[]) +initialize_lisp(int argc, char *argv[], char *envp[]) { #ifdef LISP_FEATURE_WIN32 /* Exception handling support structure. Evil Win32 hack. */ @@ -737,6 +737,5 @@ sbcl_main(int argc, char *argv[], char *envp[]) FSHOW((stderr, "/funcalling initial_function=0x%lx\n", (unsigned long)initial_function)); create_main_lisp_thread(initial_function); - lose("unexpected return from initial thread in main()"); return 0; }