From: Andreas Fuchs Date: Mon, 19 Jul 2004 20:13:22 +0000 (+0000) Subject: 0.8.12.38: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=192731b882467a9014b64b1eb097c8000441da31;p=sbcl.git 0.8.12.38: Deprecate LOAD-FOREIGN and LOAD-1-FOREIGN for good. Couldn't think of a witty tagline for that change, sorry. * Deprecate LOAD-FOREIGN and LOAD-1-FOREIGN * Add LOAD-SHARED-OBJECT as a LOAD-1-FOREIGN replacement * Fix the test cases to use LOAD-SHARED-OBJECT * Fix the manual * Grovel dlopen constants via grovel-headers.c * In the process, delete quite a number of TODO:s and FIXME:s Yay! --- diff --git a/NEWS b/NEWS index 705db45..0045920 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,11 @@ changes in sbcl-0.8.13 relative to sbcl-0.8.12: removing :SB-PACKAGE-LOCKS in customize-target-features.lisp, but if no major problems are found then it is likely that they will be compiled in unconditionally. + * major incompatible change: LOAD-FOREIGN and LOAD-1-FOREIGN are now + unsupported operators. To load a shared library into SBCL, use + SB-ALIEN:LOAD-SHARED-OBJECT. To load a non-shared object file, + link it into a shared library outside of SBCL and load it using + SB-ALIEN:LOAD-SHARED-OBJECT. * minor incompatible change: as threatened around sbcl-0.8.0, the home package of MOP-related symbols is now SB-MOP, not SB-PCL. The symbols are also exported from SB-PCL for backwards diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd index 7fb71ed..5efe694 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.asd +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.asd @@ -67,7 +67,7 @@ (let ((co (make-instance 'compile-op))) (let ((filename (car (output-files co c)))) #+cmu (ext:load-foreign filename) - #+sbcl (sb-alien:load-1-foreign filename)))) + #+sbcl (sb-alien:load-shared-object filename)))) (defsystem sb-bsd-sockets :version "0.58" diff --git a/contrib/sb-posix/sb-posix.asd b/contrib/sb-posix/sb-posix.asd index b2a87ab..3902c11 100644 --- a/contrib/sb-posix/sb-posix.asd +++ b/contrib/sb-posix/sb-posix.asd @@ -71,7 +71,7 @@ (let ((co (make-instance 'compile-op))) (let ((filename (car (output-files co c)))) #+cmu (ext:load-foreign filename) - #+sbcl (sb-alien:load-1-foreign filename)))) + #+sbcl (sb-alien:load-shared-object filename)))) (defsystem sb-posix :depends-on (sb-grovel) diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 3a60c57..03a5082 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -347,12 +347,13 @@ the @code{inspect} prompt. SBCL has the ability to save its state as a file for later execution. This functionality is important for its bootstrapping process, and is also provided as an extension to the user. Note that -foreign libraries loaded via @code{load-1-foreign} don't survive this -process; a core should not be saved in this case. +foreign libraries loaded via @code{load-shared-object} don't survive +this process; a core should not be saved in this case. @emph{FIXME: what should be done for foreign libraries?} -@emph{FIXME: document load-1-foreign somewhere} +@emph{FIXME: document load-shared-object somewhere - it's in +ffi.texinfo?} @include fun-sb-ext-save-lisp-and-die.texinfo diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo index feed6a8..e028c0c 100644 --- a/doc/manual/ffi.texinfo +++ b/doc/manual/ffi.texinfo @@ -716,21 +716,14 @@ which can be manipulated in Lisp like this: @section Loading Unix Object Files Foreign object files can be loaded into the running Lisp process by -calling the functions @code{load-foreign} or @code{load-1-foreign}. +calling @code{load-shared-object}. -The @code{sb-alien:load-1-foreign} function is the more primitive of -the two operations. It loads a single object file into the currently -running Lisp. The external symbols defining routines and variables are -made available for future external references (e.g. by +The @code{sb-alien:load-shared-object} loads a single object file into +the currently running Lisp. The external symbols defining routines and +variables are made available for future external references (e.g. by @code{extern-alien}). Forward references to foreign symbols aren't -supported: @code{load-1-foreign} must be run before any of the defined -symbols are referenced. - -@code{sb-alien:load-foreign} is built in terms of -@code{load-1-foreign} and some other machinery like -@code{sb-ext:run-program}. It accepts a list of files and libraries, -and runs the linker on the files and libraries, creating an absolute -Unix object file which is then processed by @code{load-1-foreign}. +supported: @code{load-shared-object} must be run before any of the +defined symbols are referenced. @quotation Note: As of SBCL 0.7.5, all foreign code (code loaded with @@ -1204,9 +1197,9 @@ It is possible to call this C function from Lisp using the file @end lisp To execute the above example, it is necessary to compile the C -routine, e.g.: @samp{cc -c test.c} (In order to enable incremental -loading with some linkers, you may need to say @samp{cc -G 0 -c -test.c}) +routine, e.g.: @samp{cc -c test.c && ld -shared -o test.so test.o} (In +order to enable incremental loading with some linkers, you may need to +say @samp{cc -G 0 -c test.c}) Once the C code has been compiled, you can start up Lisp and load it in: @samp{sbcl} Lisp should start up with its normal prompt. @@ -1216,8 +1209,8 @@ separately. You don't have to recompile every time.) @samp{(compile-file "test.lisp")} Within Lisp, load the foreign object file to define the necessary -symbols: @samp{(load-foreign "test.o")}. This must be done before -loading any code that refers to these symbols. +symbols: @samp{(load-shared-object "test.so")}. This must be done +before loading any code that refers to these symbols. Now you can load the compiled Lisp (``fasl'') file into Lisp: @samp{(load "test.fasl")} diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index b4f3176..7a235f7 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -51,7 +51,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "FREE-ALIEN" "GET-ERRNO" "INT" - "LOAD-FOREIGN" "LOAD-1-FOREIGN" "LONG" + "LOAD-1-FOREIGN" "LOAD-FOREIGN" "LOAD-SHARED-OBJECT" "LONG" "MAKE-ALIEN" "NULL-ALIEN" "SAP-ALIEN" "SHORT" "SIGNED" "SLOT" "STRUCT" diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index 29d1d7a..fc4a3b8 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -12,43 +12,6 @@ (in-package "SB-ALIEN") ; (SB-ALIEN, not SB!ALIEN, since we're in warm load.) -;;; SEMI-KLUDGE: Preferable would be to use something like O_NOFOLLOW -;;; which will refuse to open() a file if it is a symlink; but I've -;;; been told that is a FreeBSD/Linux-only thing. Meanwhile, this will -;;; make our filenames a lot less predictable. -;;; (The man file for open() says O_EXCL should treat even a symlink as -;;; an existing file. I wonder if it really does that.) -;;; Also, no more dependence on ASCII character ordering. -;;; -- mrd 20021101 -(defun generate-random-string (&optional (len 6)) - (let* ((characters "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") - (num (length characters)) - (string (make-string len))) - (dotimes (i len string) - (setf (char string i) - (char characters (random num)))))) - -(defun pick-temporary-file-name (&optional - (base "/tmp/sbcl-tmp-~D~A")) - (let ((code (generate-random-string))) - (loop - (let ((name (format nil base (sb-unix:unix-getpid) code))) - (multiple-value-bind (fd errno) - (sb-unix:unix-open name - (logior sb-unix:o_wronly - sb-unix:o_creat - sb-unix:o_excl) - #o666) - (cond ((not (null fd)) - (sb-unix:unix-close fd) - (return name)) - ((not (= errno sb-unix:eexist)) - (simple-file-perror "couldn't create temporary file ~S" - name - errno)) - (t - (setf code (generate-random-string))))))))) - ;;; On any OS where we don't support foreign object file loading, any ;;; query of a foreign symbol value is answered with "no definition ;;; known", i.e. NIL. @@ -62,29 +25,22 @@ ;;; work on any ELF system with dlopen(3) and dlsym(3) ;;; It also works on OpenBSD, which isn't ELF, but is otherwise modern ;;; enough to have a fairly well working dlopen/dlsym implementation. -#-(or linux sunos FreeBSD OpenBSD NetBSD darwin) -(macrolet ((define-unsupported-fun (fun-name) +(macrolet ((define-unsupported-fun (fun-name &optional (error-message "unsupported on this system")) `(defun ,fun-name (&rest rest) - "unsupported on this system" + ,error-message (declare (ignore rest)) (error 'unsupported-operator :name ',fun-name)))) - (define-unsupported-fun load-1-foreign) - (define-unsupported-fun load-foreign)) -#+(or linux sunos FreeBSD OpenBSD NetBSD darwin) -(progn + #-(or linux sunos FreeBSD OpenBSD NetBSD darwin) + (define-unsupported-fun load-shared-object) + #+(or linux sunos FreeBSD OpenBSD NetBSD darwin) + (progn -;;; flags for dlopen() -(defconstant rtld-lazy 1) ; lazy function call binding? -(defconstant rtld-now 2) ; immediate function call binding? -(defconstant rtld-global #x100) ; symbols of loaded obj file - ; (and its dependencies) made - ; visible (as though the - ; obj file were linked directly - ; into the program)? + (define-unsupported-fun load-foreign "Unsupported as of SBCL 0.8.13.") + (define-unsupported-fun load-1-foreign "Unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT.") ;;; a list of handles returned from dlopen(3) (or possibly some ;;; bogus value temporarily during initialization) -(defvar *handles-from-dlopen* nil) + (defvar *handles-from-dlopen* nil) ;;; Dynamically loaded stuff isn't there upon restoring from a save. ;;; Clearing the variable this way was originally done primarily for @@ -108,20 +64,15 @@ ;;; dan 2001.05.10 suspects that objection (1) is bogus for ;;; dlsym()-enabled systems -(push (lambda () (setq *handles-from-dlopen* nil)) - *after-save-initializations*) + (push (lambda () (setq *handles-from-dlopen* nil)) + *after-save-initializations*) -(defvar *dso-linker* "/usr/bin/ld") -(defvar *dso-linker-options* - #-darwin '("-shared" "-o") - #+darwin '("-bundle" "-o")) - -(sb-alien:define-alien-routine dlopen system-area-pointer - (file sb-alien:c-string) (mode sb-alien:int)) -(sb-alien:define-alien-routine dlsym system-area-pointer - (lib system-area-pointer) - (name sb-alien:c-string)) -(sb-alien:define-alien-routine dlerror sb-alien:c-string) + (sb-alien:define-alien-routine dlopen system-area-pointer + (file sb-alien:c-string) (mode sb-alien:int)) + (sb-alien:define-alien-routine dlsym system-area-pointer + (lib system-area-pointer) + (name sb-alien:c-string)) + (sb-alien:define-alien-routine dlerror sb-alien:c-string) ;;; Ensure that we've opened our own binary so we can dynamically resolve ;;; symbols in the C runtime. @@ -135,130 +86,53 @@ ;;; ;;; FIXME: It would work just as well to do it once at startup, actually. ;;; Then at least we know it's done. -dan 2001.05.10 -(defun ensure-runtime-symbol-table-opened () - (unless *handles-from-dlopen* - ;; Prevent recursive call if dlopen() isn't defined. - (setf *handles-from-dlopen* (int-sap 0)) - (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy))) - (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*))) - (error "can't open our own binary's symbol table: ~S" (dlerror))))) - -(defun load-1-foreign (file) - "the primitive upon which the more general LOAD-FOREIGN is built: load - a single foreign object file - - To use LOAD-1-FOREIGN, at the Unix command line do this: + (defun ensure-runtime-symbol-table-opened () + (unless *handles-from-dlopen* + ;; Prevent recursive call if dlopen() isn't defined. + (setf *handles-from-dlopen* (int-sap 0)) + (setf *handles-from-dlopen* (list (dlopen nil rtld-lazy))) + (when (zerop (sb-sys:sap-int (first *handles-from-dlopen*))) + (error "can't open our own binary's symbol table: ~S" (dlerror))))) + + (defun load-shared-object (file) + "Load a shared library/dynamic shared object file/general + dlopenable alien container. + + To use LOAD-SHARED-OBJECT, at the Unix command line do this: echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c make /tmp/ffi-test.o # i.e. cc -c -o /tmp/ffi-test.o /tmp/ffi-test.c ld -shared -o /tmp/ffi-test.so /tmp/ffi-test.o then in SBCL do this: - (LOAD-1-FOREIGN \"/tmp/ffi-test.so\") + (LOAD-SHARED-OBJECT \"/tmp/ffi-test.so\") (DEFINE-ALIEN-ROUTINE SUMMISH INT (X INT) (Y INT)) Now running (SUMMISH 10 20) should return 31. " - (ensure-runtime-symbol-table-opened) - ;; Note: We use RTLD-GLOBAL so that it can find all the symbols - ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if - ;; not all symbols are defined. - (let* ((real-file (or (unix-namestring file) file)) - (sap (dlopen real-file (logior rtld-now rtld-global)))) - (if (zerop (sap-int sap)) - (error "can't open object ~S: ~S" real-file (dlerror)) - (pushnew sap *handles-from-dlopen* :test #'sap=))) - (values)) - -(defun get-dynamic-foreign-symbol-address (symbol) - (ensure-runtime-symbol-table-opened) - ;; Find the symbol in any of the loaded object files. Search in - ;; reverse order of loading, so that later loadings take precedence. - ;; - ;; FIXME: The way that we use PUSHNEW SAP in LOAD-1-FOREIGN means - ;; that the list isn't guaranteed to be in reverse order of loading, - ;; at least not if a file is loaded more than once. Is this the - ;; right thing? (In what cases does it matter?) - (dolist (handle (reverse *handles-from-dlopen*)) - ;; KLUDGE: We implicitly exclude the possibility that the variable - ;; could actually be NULL, but the man page for dlsym(3) - ;; recommends doing a more careful test. -- WHN 20000825 - (let ((possible-result (sap-int (dlsym handle symbol)))) - (unless (zerop possible-result) - (return possible-result))))) - -;;; Dan Barlow's quick summary from IRC 2003-06-21: -;;; fwiw, load-foreign does random stuff with ld so that you can use -;;; it with static libraries -;;; if you have shared objects, load-1-foreign will do fine -;;; and -;;; I think my position on this matter is consistent with Tim Moore's: -;;; use (cmucl equivalent of) load-1-foreign, load-foreign is arse -;;; though he may say ass -(defun load-foreign (files - &key - (libraries '("-lc")) - ;; FIXME: The old documentation said - ;; The BASE-FILE argument is used to specify a - ;; file to use as the starting place for - ;; defined symbols. The default is the C start - ;; up code for Lisp. - ;; But the code ignored the BASE-FILE argument. - ;; The comment above - ;; (DECLARE (IGNORE BASE-FILE)) - ;; said - ;; dlopen() remembers the name of an object, - ;; when dlopen()ing the same name twice, the - ;; old object is reused. - ;; So I deleted all reference to BASE-FILE, - ;; including the now-bogus reference to the - ;; BASE-FILE argument in the documentation. But - ;; are there any other subtleties of the new code - ;; which need to be documented in its place? - (env nil env-p) - (environment (if env-p - (unix-environment-sbcl-from-cmu env) - (posix-environ)) - environment-p)) - #+sb-doc - "LOAD-FOREIGN loads a list of C object files into a running Lisp. The FILES - argument should be a single file or a list of files. The files may be - specified as namestrings or as pathnames. The libraries argument should be a - list of library files as would be specified to ld. They will be searched in - the order given. The default is just \"-lc\", i.e., the C library. The - ENVIRONMENT argument is a list of SIMPLE-STRINGs corresponding to the Unix - environment (\"man environ\") definitions for the invocation of the linker. - The default is the environment that Lisp is itself running in. Instead of - using the ENVIRONMENT argument, it is also possible to use the ENV argument, - using the older, lossy CMU CL representation." - (when (and env-p environment-p) - (error "can't specify :ENV and :ENVIRONMENT simultaneously")) - (let ((output-file (pick-temporary-file-name - (concatenate 'string "/tmp/~D~A" (string (gensym))))) - (error-output (make-string-output-stream))) - - (/show "running" *dso-linker*) - (force-output) - (unwind-protect - (let ((proc (sb-ext:run-program - *dso-linker* - (append *dso-linker-options* - (list output-file) - (append (mapcar (lambda (name) - (unix-namestring name nil)) - (if (atom files) - (list files) - files)) - libraries)) - :environment environment - :input nil - :output error-output - :error :output))) - (unless proc - (error "could not run ~A" *dso-linker*)) - (unless (zerop (sb-ext:process-exit-code proc)) - (sb-sys:serve-all-events 0) - (error "~A failed:~%~A" *dso-linker* - (get-output-stream-string error-output))) - (load-1-foreign output-file)) - #-sb-show (sb-unix:unix-unlink output-file) - #+sb-show (/show "not unlinking" output-file)))) ; so we can look at it - -) ; PROGN + (ensure-runtime-symbol-table-opened) + ;; Note: We use RTLD-GLOBAL so that it can find all the symbols + ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if + ;; not all symbols are defined. + (let* ((real-file (or (unix-namestring file) file)) + (sap (dlopen real-file (logior rtld-now rtld-global)))) + (if (zerop (sap-int sap)) + (error "can't open object ~S: ~S" real-file (dlerror)) + (pushnew sap *handles-from-dlopen* :test #'sap=))) + (values)) + + (defun get-dynamic-foreign-symbol-address (symbol) + (ensure-runtime-symbol-table-opened) + ;; Find the symbol in any of the loaded object files. Search in + ;; reverse order of loading, so that later loadings take precedence. + ;; + ;; FIXME: The way that we use PUSHNEW SAP in LOAD-SHARED-OBJECT means + ;; that the list isn't guaranteed to be in reverse order of loading, + ;; at least not if a file is loaded more than once. Is this the + ;; right thing? (In what cases does it matter?) + (dolist (handle (reverse *handles-from-dlopen*)) + ;; KLUDGE: We implicitly exclude the possibility that the variable + ;; could actually be NULL, but the man page for dlsym(3) + ;; recommends doing a more careful test. -- WHN 20000825 + (let ((possible-result (sap-int (dlsym handle symbol)))) + (unless (zerop possible-result) + (return possible-result))))) + + )) ; PROGN, MACROLET diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh index 48597b5..dca23a0 100644 --- a/tests/compiler.test.sh +++ b/tests/compiler.test.sh @@ -265,7 +265,7 @@ expect_failed_compile $tmpfilename # references to the unbound variable. cat > $tmpfilename < #include #include +#include #include "genesis/config.h" @@ -61,6 +62,14 @@ main(int argc, char *argv[]) \n\ "); + printf("(in-package \"SB!ALIEN\")\n\n"); + + printf (";;;flags for dlopen()\n"); + + defconstant ("rtld-lazy", RTLD_LAZY); + defconstant ("rtld-now", RTLD_NOW); + defconstant ("rtld-global", RTLD_GLOBAL); + printf("(in-package \"SB!UNIX\")\n\n"); printf(";;; types, types, types\n"); diff --git a/version.lisp-expr b/version.lisp-expr index 8ffa9ec..ee2715d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.12.37" +"0.8.12.38"