1 ;;;; Loading shared object files
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!ALIEN")
14 (define-unsupported-fun load-foreign
15 "Unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT."
16 "~S is unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT."
19 (define-unsupported-fun load-1-foreign
20 "Unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT."
21 "~S is unsupported as of SBCL 0.8.13. Please use LOAD-SHARED-OBJECT."
24 (define-alien-routine dlopen system-area-pointer
25 (file c-string) (mode int))
27 (define-alien-routine dlclose int
28 (handle system-area-pointer))
30 (define-alien-routine dlerror c-string)
32 (define-alien-routine dlsym system-area-pointer
33 (handle system-area-pointer)
36 (defvar *runtime-dlhandle*)
37 (defvar *shared-objects*)
39 (defstruct shared-object file sap)
41 (defun dlopen-or-lose (filename)
42 (dlerror) ; clear old errors
43 (let ((sap (dlopen filename (logior rtld-global rtld-now))))
44 (when (zerop (sap-int sap))
45 (error "Could not open ~:[runtime~;~:*shared object ~S~]: ~A"
49 (defun load-shared-object (file)
50 "Load a shared library/dynamic shared object file/general
51 dlopenable alien container.
53 To use LOAD-SHARED-OBJECT, at the Unix command line do this:
55 echo 'int summish(int x, int y) { return 1 + x + y; }' > /tmp/ffi-test.c
56 make /tmp/ffi-test.o # i.e. cc -c -o /tmp/ffi-test.o /tmp/ffi-test.c
57 ld -shared -o /tmp/ffi-test.so /tmp/ffi-test.o
61 (load-shared-object \"/tmp/ffi-test.so\")
62 (define-alien-routine summish int (x int) (y int))
64 Now running (summish 10 20) should return 31."
65 (let* ((real-file (or (unix-namestring file) file))
66 (sap (dlopen-or-lose real-file))
67 (obj (make-shared-object :file real-file :sap sap)))
68 (unless (member sap *shared-objects*
69 :test #'sap= :key #'shared-object-sap)
70 (setf *shared-objects* (append *shared-objects* (list obj))))
71 (pathname real-file)))
73 (defun try-reopen-shared-object (obj)
75 (let ((sap (dlopen-or-lose (shared-object-file obj))))
76 (setf (shared-object-sap obj) sap)
79 :report "Skip this shared object and continue. References to ~
80 foreign symbols in this shared object will fail, ~
81 causing potential corruption."
84 ;;; Open libraries in *SHARED-OBJECTS* and the runtime. Called during
86 (defun reopen-shared-objects ()
87 ;; Ensure that the runtime is present in the list
88 (setf *runtime-dlhandle* (dlopen-or-lose nil)
89 *shared-objects* (mapcar #'try-reopen-shared-object *shared-objects*)))
91 ;;; Close all dlopened libraries and clear out sap entries in
93 (defun close-shared-objects ()
94 (dolist (obj (reverse *shared-objects*))
95 (dlclose (shared-object-sap obj))
96 (setf (shared-object-sap obj) nil))
97 (dlclose *runtime-dlhandle*)
98 (setf *runtime-dlhandle* nil))
100 (defun get-dynamic-foreign-symbol-address (symbol)
101 (dlerror) ; clear old errors
102 (let ((result (sap-int (dlsym *runtime-dlhandle* symbol)))
104 (if (or (not (zerop result)) (not err))
106 (dolist (obj *shared-objects*)
107 (setf result (sap-int (dlsym (shared-object-sap obj) symbol))
109 (when (or (not (zerop result)) (not err))