From: Nikodemus Siivola Date: Mon, 29 Nov 2004 10:49:36 +0000 (+0000) Subject: 0.8.17.1: reloading shared object files X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4919f9971429d18fab618b9b49e164c6b57bea6f;p=sbcl.git 0.8.17.1: reloading shared object files * If an object file is reloaded, call dlclose on the old handle, and relink using the new handle. --- diff --git a/NEWS b/NEWS index 3d66399..b091151 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +changes in sbcl-0.8.18 relative to sbcl-0.8.17: + * new feature: reloading changed shared object files with + LOAD-SHARED-OBJECT now causes the new definitions to take effect. + changes in sbcl-0.8.17 relative to sbcl-0.8.16: * new feature: a build-time option (controlled by the :SB-UNICODE keyword feature, enabled by default) for building the system with diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e8c2302..ea8878b 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -759,9 +759,6 @@ retained, possibly temporariliy, because it might be used internally." ;; INFO stuff doesn't belong in a user-visible package, we ;; should be able to change it without apology. "*INFO-ENVIRONMENT*" - - ;; stepping control - "*STEPPING*" "*STEP*" "CLEAR-INFO" "COMPACT-INFO-ENVIRONMENT" "DEFINE-INFO-CLASS" "DEFINE-INFO-TYPE" @@ -769,6 +766,9 @@ retained, possibly temporariliy, because it might be used internally." "INFO" "MAKE-INFO-ENVIRONMENT" + ;; stepping control + "*STEPPING*" "*STEP*" + ;; packages grabbed once and for all "*KEYWORD-PACKAGE*" "*CL-PACKAGE*" @@ -1774,6 +1774,7 @@ SB-KERNEL) have been undone, but probably more remain." ;; SB!KERNEL.) "%PRIMITIVE" "%STANDARD-CHAR-P" + "*FOREIGN-LOCK*" "*LINKAGE-INFO*" "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*" "*RUNTIME-DLHANDLE*" @@ -1825,7 +1826,8 @@ SB-KERNEL) have been undone, but probably more remain." "SIGNED-SAP-REF-64" "SIGNED-SAP-REF-8" ;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL. "STRUCTURE!OBJECT" "STRUCTURE!OBJECT-MAKE-LOAD-FORM" - "SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P" "VECTOR-SAP" + "SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P" + "UPDATE-LINKAGE-TABLE" "VECTOR-SAP" "WAIT-UNTIL-FD-USABLE" "WITH-ENABLED-INTERRUPTS" "WITH-FD-HANDLER" "WITH-INTERRUPTS" "WITH-PINNED-OBJECTS" "WITHOUT-GCING" diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp index d678b0d..fae0fb4 100644 --- a/src/code/foreign-load.lisp +++ b/src/code/foreign-load.lisp @@ -11,6 +11,12 @@ (in-package "SB!ALIEN") +;;; Used to serialize modifications to *linkage-info*, +;;; *shared-objects* and the linkage-table proper. Calls thru +;;; linkage-table are unaffected. +(defvar *foreign-lock* + (sb!thread:make-mutex :name "foreign definition lock")) + (define-unsupported-fun load-foreign "Unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT." "~S is unsupported as of SBCL 0.8.13. See LOAD-SHARED-OBJECT." @@ -38,55 +44,82 @@ (defstruct shared-object file sap) -(defun dlopen-or-lose (filename) - (dlerror) ; clear old errors - (let ((sap (dlopen filename (logior rtld-global rtld-now)))) +(defun dlopen-or-lose (&optional (obj nil objp)) + (when objp + (dlclose-or-lose obj)) + (dlerror) ; clear errors + (let* ((file (when obj (shared-object-file obj))) + (sap (dlopen file (logior rtld-global rtld-now)))) + (aver (or (not objp) file)) (when (zerop (sap-int sap)) + (if objp + (setf (shared-object-sap obj) *runtime-dlhandle*) + (setf *runtime-dlhandle* nil)) (error "Could not open ~:[runtime~;~:*shared object ~S~]: ~A" - filename (dlerror))) + obj (dlerror))) + (when objp + (setf (shared-object-sap obj) sap)) sap)) +(defun dlclose-or-lose (&optional (obj nil objp)) + (dlerror) + (let (dlerror) + (cond ((and (not objp) *runtime-dlhandle*) + (dlclose *runtime-dlhandle*) + (setf dlerror (dlerror) + *runtime-dlhandle* nil)) + ((and objp (shared-object-sap obj)) + (dlclose (shared-object-sap obj)) + (setf dlerror (dlerror) + (shared-object-sap obj) nil))) + (when dlerror + (cerror dlerror)))) + (defun load-shared-object (file) - "Load a shared library/dynamic shared object file/general -dlopenable alien container, such as a .so on an ELF platform. + "Load a shared library/dynamic shared object file/general dlopenable +alien container, such as a .so on an ELF platform. + +Reloading the same shared object will replace the old definitions; if +a symbol was previously referenced thru the object and is not present +in the reloaded version an error will be signalled. Sameness is +determined using the library filename. Reloading may not work as +expected if user or library-code has called dlopen on FILE. References to foreign symbols in loaded shared objects do not survive intact through SB-EXT:SAVE-LISP-AND die on all platforms. See SB-EXT:SAVE-LISP-AND-DIE for details." - (let* ((real-file (or (unix-namestring file) file)) - (sap (dlopen-or-lose real-file)) - (obj (make-shared-object :file real-file :sap sap))) - (unless (member sap *shared-objects* - :test #'sap= :key #'shared-object-sap) - (setf *shared-objects* (append *shared-objects* (list obj)))) - (pathname real-file))) + (sb!thread:with-mutex (*foreign-lock*) + (let* ((filename (or (unix-namestring file) file)) + (old (find filename *shared-objects* :key #'shared-object-file :test #'equal)) + (obj (or old (make-shared-object :file filename)))) + (dlopen-or-lose obj) + (setf *shared-objects* (append (remove obj *shared-objects*) + (list obj))) + #!+linkage-table + (when old + (update-linkage-table)) + (pathname filename)))) (defun try-reopen-shared-object (obj) - (restart-case - (let ((sap (dlopen-or-lose (shared-object-file obj)))) - (setf (shared-object-sap obj) sap) - obj) - (skip () - :report "Skip this shared object and continue. References to ~ - foreign symbols in this shared object will fail, ~ - causing potential corruption." - *runtime-dlhandle*))) + (with-simple-restart (skip "~@") + (dlopen-or-lose obj) + obj)) ;;; Open libraries in *SHARED-OBJECTS* and the runtime. Called during ;;; initialization. (defun reopen-shared-objects () ;; Ensure that the runtime is open - (setf *runtime-dlhandle* (dlopen-or-lose nil) + (setf *runtime-dlhandle* (dlopen-or-lose) *shared-objects* (mapcar #'try-reopen-shared-object *shared-objects*))) ;;; Close all dlopened libraries and clear out sap entries in ;;; *SHARED-OBJECTS*. (defun close-shared-objects () - (dolist (obj (reverse *shared-objects*)) - (dlclose (shared-object-sap obj)) - (setf (shared-object-sap obj) nil)) - (dlclose *runtime-dlhandle*) - (setf *runtime-dlhandle* nil)) + (mapc #'dlclose-or-lose (reverse *shared-objects*)) + (dlclose-or-lose)) (defun get-dynamic-foreign-symbol-address (symbol) (dlerror) ; clear old errors diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index 5cc3cd3..d80955b 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -61,7 +61,7 @@ #!+os-provides-dlopen (reopen-shared-objects) #!+linkage-table - (linkage-table-reinit)) + (update-linkage-table)) ;;; Cleanups before saving a core #-sb-xc-host @@ -120,7 +120,7 @@ (dolist (symbol *!initial-foreign-symbols*) (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))) #!+os-provides-dlopen - (setf *runtime-dlhandle* (dlopen-or-lose nil) + (setf *runtime-dlhandle* (dlopen-or-lose) *shared-objects* nil)) #!-os-provides-dlopen diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp index 49bf3ba..31d561d 100644 --- a/src/code/linkage-table.lisp +++ b/src/code/linkage-table.lisp @@ -19,10 +19,7 @@ (in-package "SB!IMPL") -;;; Used to serialize modifications to *linkage-info* and the linkage-table -;;; proper. Calls thru linkage-table are unaffected. -(defvar *linkage-table-lock* - (sb!thread:make-mutex :name "linkage-table lock")) +(defvar *foreign-lock*) ; initialized in foreign-load.lisp (define-alien-routine arch-write-linkage-table-jmp void (table-address system-area-pointer) @@ -65,23 +62,22 @@ ;;; in the linkage table. (defun ensure-foreign-symbol-linkage (name datap) (/show0 "ensure-foreign-symbol-linkage") - (sb!thread:with-mutex (*linkage-table-lock*) + (sb!thread:with-mutex (*foreign-lock*) (let ((info (or (gethash name *linkage-info*) (link-foreign-symbol name datap)))) (when info (linkage-info-address info))))) -;;; Initialize the linkage-table. Called during initialization after -;;; all shared libraries have been reopened. -(defun linkage-table-reinit () - (/show0 "linkage-table-reinit") - ;; No locking here, as this should be done just once per image initialization, - ;; before any threads user are spawned. +;;; Update the linkage-table. Called during initialization after all +;;; shared libraries have been reopened, and after a previously loaded +;;; shared object is reloaded. +(defun update-linkage-table () + ;; Doesn't take care of it's own locking -- callers are responsible (maphash (lambda (name info) - (let ((datap (linkage-info-datap info)) - (table-address (linkage-info-address info)) - (real-address (get-dynamic-foreign-symbol-address name))) - (cond (real-address + (let ((datap (linkage-info-datap info)) + (table-address (linkage-info-address info)) + (real-address (get-dynamic-foreign-symbol-address name))) + (cond (real-address (write-linkage-table-entry table-address real-address datap)) @@ -92,4 +88,4 @@ segfaults, and potential corruption." "Could not resolve foreign function ~S for ~ linkage-table." name))))) - *linkage-info*)) + *linkage-info*)) diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index 9ae8a48..aac8a70 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -23,20 +23,34 @@ PUNT=104 testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$ -# Make a little shared object file to test with. +## Make a little shared object files to test with. + echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c echo 'int numberish = 42;' >> $testfilestem.c echo 'int nummish(int x) { return numberish + x; }' >> $testfilestem.c cc -c $testfilestem.c -o $testfilestem.o ld -shared -o $testfilestem.so $testfilestem.o -# Foreign definitions & load +echo 'int foo = 13;' > $testfilestem-foobar.c +echo 'int bar() { return 42; }' >> $testfilestem-foobar.c +cc -c $testfilestem-foobar.c -o $testfilestem-foobar.o +ld -shared -o $testfilestem-foobar.so $testfilestem-foobar.o + +echo 'int foo = 42;' > $testfilestem-foobar2.c +echo 'int bar() { return 13; }' >> $testfilestem-foobar2.c +cc -c $testfilestem-foobar2.c -o $testfilestem-foobar2.o +ld -shared -o $testfilestem-foobar2.so $testfilestem-foobar2.o + +## Foreign definitions & load + cat > $testfilestem.def.lisp < $testfilestem.def.lisp < $testfilestem.test.lisp <