X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flinkage-table.lisp;h=e9fa8d4ff938e3e17e629f17319a9f808e6ba202;hb=0c3bbfaa2286626a2d915c8810f690aefc702661;hp=74e461dafb932ed2ba380d976e3699fa3453db30;hpb=5e1fcdac979db9a6aebe69531229355def8c0f90;p=sbcl.git diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp index 74e461d..e9fa8d4 100644 --- a/src/code/linkage-table.lisp +++ b/src/code/linkage-table.lisp @@ -19,8 +19,6 @@ (in-package "SB!IMPL") -(defvar *foreign-lock*) ; initialized in foreign-load.lisp - (define-alien-routine arch-write-linkage-table-jmp void (table-address system-area-pointer) (real-address system-area-pointer)) @@ -29,56 +27,53 @@ (table-address system-area-pointer) (real-address system-area-pointer)) -(defvar *linkage-info* (make-hash-table :test 'equal)) - -(defstruct linkage-info datap address) +(defvar *linkage-info* (make-hash-table :test 'equal :synchronized t)) (defun write-linkage-table-entry (table-address real-address datap) (/show0 "write-linkage-table-entry") (let ((reloc (int-sap table-address)) - (target (int-sap real-address))) + (target (int-sap real-address))) (if datap - (arch-write-linkage-table-ref reloc target) - (arch-write-linkage-table-jmp reloc target)))) + (arch-write-linkage-table-ref reloc target) + (arch-write-linkage-table-jmp reloc target)))) ;;; Add the linkage information about a foreign symbol in the ;;; persistent table, and write the linkage-table entry. (defun link-foreign-symbol (name datap) (/show0 "link-foreign-symbol") (let ((table-address (+ (* (hash-table-count *linkage-info*) - sb!vm:linkage-table-entry-size) - sb!vm:linkage-table-space-start)) - (real-address (get-dynamic-foreign-symbol-address name))) + sb!vm:linkage-table-entry-size) + sb!vm:linkage-table-space-start)) + (real-address (ensure-dynamic-foreign-symbol-address name datap))) (aver real-address) (unless (< table-address sb!vm:linkage-table-space-end) (error "Linkage-table full (~D entries): cannot link ~S." (hash-table-count *linkage-info*) name)) (write-linkage-table-entry table-address real-address datap) - (setf (gethash name *linkage-info*) - (make-linkage-info :address table-address :datap datap)))) + (setf (gethash (cons name datap) *linkage-info*) table-address))) ;;; Add a foreign linkage entry if none exists, return the address ;;; in the linkage table. (defun ensure-foreign-symbol-linkage (name datap) (/show0 "ensure-foreign-symbol-linkage") - (sb!thread:with-mutex (*foreign-lock*) - (let ((info (or (gethash name *linkage-info*) - (link-foreign-symbol name datap)))) - (when info - (linkage-info-address info))))) + (with-locked-system-table (*linkage-info*) + (or (gethash (cons name datap) *linkage-info*) + (link-foreign-symbol name datap)))) ;;; Update the linkage-table. Called during initialization after all ;;; shared libraries have been reopened, and after a previously loaded ;;; shared object is reloaded. +;;; +;;; FIXME: Should figure out how to write only those entries that need +;;; updating. (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))) - (aver (and table-address real-address)) - (write-linkage-table-entry table-address - real-address - datap))) - *linkage-info*)) + (dohash ((name-and-datap table-address) *linkage-info* :locked t) + (let* ((name (car name-and-datap)) + (datap (cdr name-and-datap)) + (real-address + (ensure-dynamic-foreign-symbol-address name datap))) + (aver (and table-address real-address)) + (write-linkage-table-entry table-address + real-address + datap))))