From dc33d6a6b84f8338e603759cec8e25da29055d50 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 5 Jul 2005 12:27:25 +0000 Subject: [PATCH] 0.9.2.26: refactoring internals of foreign linkage * rename FOREIGN-SYMBOL-ADDRESS => FOREIGN-SYMBOL-SAP, FOREIGN-SYMBOL-ADDRESS-AS-INTEGER => FOREIGN-SYMBOL-ADDRESS, and so forth. Follow this scheme consistently, calling foreign saps saps, and addresses addresses. * split GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS into FIND-DYNAMIC-FOREIGN-SYMBOL-ADDRESS and ENSURE-DYNAMIC-FOREIGN-SYMBOL-ADDRESS. * new function: FIND-FOREIGN-SYMBOL-ADDRESS, which doesn't enter the symbol to linkage table. Use it in SB-POSIX to detect the presence of foreign symbols. * merge patch by David Lichteblau: ENSURE-DYNAMIC-FOREIGN-SYMBOL-ADDRESS keeps track of used foreign symbols in hash-tables instead of lists. --- contrib/sb-posix/macros.lisp | 2 +- contrib/sb-sprof/sb-sprof.lisp | 2 +- doc/internals/foreign-linkage.texinfo | 2 +- package-data-list.lisp-expr | 25 ++++++---- src/code/condition.lisp | 9 +++- src/code/debug-int.lisp | 8 ++-- src/code/fop.lisp | 2 +- src/code/foreign-load.lisp | 81 +++++++++++++++++++------------- src/code/foreign.lisp | 82 ++++++++++++++++++++------------- src/code/linkage-table.lisp | 7 ++- src/code/target-alieneval.lisp | 9 ++-- src/compiler/fndb.lisp | 6 +-- src/compiler/generic/core.lisp | 6 +-- src/compiler/generic/genesis.lisp | 10 ++-- src/compiler/hppa/c-call.lisp | 4 +- src/compiler/mips/c-call.lisp | 4 +- src/compiler/ppc/c-call.lisp | 10 ++-- src/compiler/saptran.lisp | 13 +++--- src/compiler/sparc/c-call.lisp | 8 ++-- src/compiler/target-disassem.lisp | 2 +- src/compiler/x86-64/c-call.lisp | 8 ++-- src/compiler/x86/c-call.lisp | 10 ++-- version.lisp-expr | 2 +- 23 files changed, 175 insertions(+), 137 deletions(-) diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp index 7d388ac..4cff10c 100644 --- a/contrib/sb-posix/macros.lisp +++ b/contrib/sb-posix/macros.lisp @@ -48,7 +48,7 @@ (defmacro define-call-internally (lisp-name c-name return-type error-predicate &rest arguments) - (if (sb-sys:foreign-symbol-address-as-integer-or-nil c-name) + (if (sb-sys:find-foreign-symbol-address c-name) `(progn (declaim (inline ,lisp-name)) (defun ,lisp-name ,(mapcar #'car arguments) diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index cffa4d5..42ea024 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -831,7 +831,7 @@ (declare (type address pc)) (let ((ptr (sb-di::component-ptr-from-pc (int-sap pc)))) (cond ((sap= ptr (int-sap 0)) - (let ((name (foreign-symbol-in-address (int-sap pc)))) + (let ((name (sap-foreign-symbol (int-sap pc)))) (when name (format nil "foreign function ~a" name)))) (t diff --git a/doc/internals/foreign-linkage.texinfo b/doc/internals/foreign-linkage.texinfo index d08d77b..e0987f5 100644 --- a/doc/internals/foreign-linkage.texinfo +++ b/doc/internals/foreign-linkage.texinfo @@ -17,7 +17,7 @@ also utilized to allow references to as-of-yet unknown aliens. @xref{Lazy Alien Resolution}. The SBCL implementation is somewhat simplified from the CMUCL one by -Timothy Moore, but the basic idea and mechanism remains identical: +Timothy Moore, but the basic idea and mechanism remain identical: instead of having addresses from @code{dlsym(3)} in the core, we have addresses to an mmapped memory area (@code{LINKAGE_TABLE_SPACE}) that is initialized at startup to contain jumps & references to the correct diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 872f51b..0719f1a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1858,21 +1858,24 @@ SB-KERNEL) have been undone, but probably more remain." "DEALLOCATE-SYSTEM-MEMORY" "DEFAULT-INTERRUPT" "DEPORT-BOOLEAN" "DEPORT-INTEGER" - "DYNAMIC-FOREIGN-SYMBOLS" + "DYNAMIC-FOREIGN-SYMBOLS-P" "DLOPEN-OR-LOSE" "FROB-DO-BODY" - "ENABLE-INTERRUPT" "ENUMERATION" + "ENABLE-INTERRUPT" + "ENUMERATION" + "ENSURE-DYNAMIC-FOREIGN-SYMBOL-ADDRESS" "EXTERN-ALIEN-NAME" "FD-STREAM" "FD-STREAM-FD" "FD-STREAM-P" + "FIND-DYNAMIC-FOREIGN-SYMBOL-ADDRESS" + "FIND-FOREIGN-SYMBOL-ADDRESS" "FIND-FOREIGN-SYMBOL-IN-TABLE" - "FOREIGN-SYMBOL-ADDRESS" - "FOREIGN-SYMBOL-ADDRESS-AS-INTEGER" - "FOREIGN-SYMBOL-ADDRESS-AS-INTEGER-OR-NIL" - "FOREIGN-SYMBOL-DATAREF-ADDRESS" - "FOREIGN-SYMBOL-IN-ADDRESS" + "FOREIGN-SYMBOL-SAP" + "FOREIGN-SYMBOL-ADDRESS" + "FOREIGN-SYMBOL-DATAREF-SAP" "GET-PAGE-SIZE" "GET-SYSTEM-INFO" "IGNORE-INTERRUPT" "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT" + "LIST-DYNAMIC-FOREIGN-SYMBOLS" "MACRO" "MAKE-FD-STREAM" "MAKE-OBJECT-SET" "MEMMOVE" "NATURALIZE-BOOLEAN" "NATURALIZE-INTEGER" "OBJECT-SET-OPERATION" @@ -1882,7 +1885,9 @@ SB-KERNEL) have been undone, but probably more remain." "REMOVE-FD-HANDLER" "REOPEN-SHARED-OBJECTS" "RESOLVE-LOADED-ASSEMBLER-REFERENCES" - "SAP+" "SAP-" "SAP-INT" + "SAP+" "SAP-" + "SAP-FOREIGN-SYMBOL" + "SAP-INT" "SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-WORD" "SAP-REF-8" "SAP-REF-DESCRIPTOR" @@ -1896,13 +1901,13 @@ SB-KERNEL) have been undone, but probably more remain." ;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL. "STRUCTURE!OBJECT" "STRUCTURE!OBJECT-MAKE-LOAD-FORM" "SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P" + "UNDEFINED-FOREIGN-SYMBOLS-P" "UPDATE-LINKAGE-TABLE" "VECTOR-SAP" "WAIT-UNTIL-FD-USABLE" "WITH-ENABLED-INTERRUPTS" "WITH-FD-HANDLER" "WITH-INTERRUPTS" "WITH-PINNED-OBJECTS" "WITHOUT-GCING" "WITHOUT-INTERRUPTS" "WORDS" - "ALLOCATE-SYSTEM-MEMORY-AT" - "GET-DYNAMIC-FOREIGN-SYMBOL-ADDRESS")) + "ALLOCATE-SYSTEM-MEMORY-AT")) #s(sb-cold:package-data :name "SB!UNIX" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index ea93f2a..e599ccb 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -652,7 +652,7 @@ ((name :reader cell-error-name :initarg :name))) (def!method print-object ((condition cell-error) stream) - (if *print-escape* + (if (and *print-escape* (slot-boundp condition 'name)) (print-unreadable-object (condition stream :type t :identity t) (princ (cell-error-name condition) stream)) (call-next-method))) @@ -975,7 +975,12 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) ) ; progn -(define-condition undefined-alien-error (error) ()) +(define-condition undefined-alien-error (cell-error) () + (:report + (lambda (condition stream) + (if (slot-boundp condition 'name) + (format stream "Undefined alien: ~S" (cell-error-name condition)) + (format stream "Undefined alien symbol."))))) (define-condition undefined-alien-variable-error (undefined-alien-error) () (:report diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index d8f4d72..77fd6dc 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -775,7 +775,7 @@ sb!vm::n-word-bytes))) value)))))) (defun foreign-function-backtrace-name (sap) - (let ((name (foreign-symbol-in-address sap))) + (let ((name (sap-foreign-symbol sap))) (if name (format nil "foreign function: ~A" name) (format nil "foreign function: #x~X" (sap-int sap))))) @@ -3251,9 +3251,9 @@ register." (without-gcing ;; These are really code labels, not variables: but this way we get ;; their addresses. - (let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts")) - (src-end (foreign-symbol-address "fun_end_breakpoint_end")) - (trap-loc (foreign-symbol-address "fun_end_breakpoint_trap")) + (let* ((src-start (foreign-symbol-sap "fun_end_breakpoint_guts")) + (src-end (foreign-symbol-sap "fun_end_breakpoint_end")) + (trap-loc (foreign-symbol-sap "fun_end_breakpoint_trap")) (length (sap- src-end src-start)) (code-object (%primitive sb!c:allocate-code-object (1+ bogus-lra-constants) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 6a44362..95165d9 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -682,7 +682,7 @@ bug.~:@>") (read-n-bytes *fasl-input-stream* sym 0 len) (sb!vm:fixup-code-object code-object (read-word-arg) - (foreign-symbol-address-as-integer sym) + (foreign-symbol-address sym) kind) code-object)) diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp index 8986c97..a37fee8 100644 --- a/src/code/foreign-load.lisp +++ b/src/code/foreign-load.lisp @@ -98,7 +98,7 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (setf *shared-objects* (append (remove obj *shared-objects*) (list obj))) #!+linkage-table - (when (or old (undefined-foreign-symbols)) + (when (or old (undefined-foreign-symbols-p)) (update-linkage-table)) (pathname filename)))) @@ -139,39 +139,54 @@ SB-EXT:SAVE-LISP-AND-DIE for details." (mapc #'dlclose-or-lose (reverse *shared-objects*)) (dlclose-or-lose)) -(let ((symbols ()) - (undefineds ())) - (defun get-dynamic-foreign-symbol-address (symbol &optional datap) - (dlerror) ; clear old errors - (unless *runtime-dlhandle* - (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*")) - ;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op, - ;; but on platforms where dlsym is simulated we use the mangled name. - (let* ((extern (extern-alien-name symbol)) - (result (sap-int (dlsym *runtime-dlhandle* extern))) - (err (dlerror)) - (addr (if (or (not (zerop result)) (not err)) - result - (dolist (obj *shared-objects*) - (let ((sap (shared-object-sap obj))) - (when sap - (setf result (sap-int (dlsym sap extern)) - err (dlerror)) - (when (or (not (zerop result)) (not err)) - (return result)))))))) - (cond ((not addr) - (style-warn "Undefined alien: ~S" symbol) - (pushnew symbol undefineds :test #'equal) - (remove symbol symbols :test #'equal) +(defun find-dynamic-foreign-symbol-address (symbol) + (dlerror) ; clear old errors + (unless *runtime-dlhandle* + (bug "Cannot resolve foreign symbol: lost *runtime-dlhandle*")) + ;; On real ELF & dlsym platforms the EXTERN-ALIEN-NAME is a no-op, + ;; but on platforms where dlsym is simulated we use the mangled name. + (let* ((extern (extern-alien-name symbol)) + (result (sap-int (dlsym *runtime-dlhandle* extern))) + (err (dlerror))) + (if (or (not (zerop result)) (not err)) + result + (dolist (obj *shared-objects*) + (let ((sap (shared-object-sap obj))) + (when sap + (setf result (sap-int (dlsym sap extern)) + err (dlerror)) + (when (or (not (zerop result)) (not err)) + (return result)))))))) + +(let ((symbols (make-hash-table :test #'equal)) + (undefineds (make-hash-table :test #'equal))) + (defun ensure-dynamic-foreign-symbol-address (symbol &optional datap) + "Returns the address of the foreign symbol as an integer. On linkage-table +ports if the symbols isn't found a special guard address is returned instead, +accesses to which will result in an UNDEFINED-ALIEN-ERROR. On other ports an +error is immediately signalled if the symbol isn't found. The returned address +is never in the linkage-table." + (let ((addr (find-dynamic-foreign-symbol-address symbol))) + (cond #!-linkage-table + ((not addr) + (error 'undefined-alien-error :name symbol)) + #!+linkage-table + ((not addr) + (style-warn "Undefined alien: ~S" symbol) + (setf (gethash symbol undefineds) t) + (remhash symbol symbols) (if datap undefined-alien-address - (foreign-symbol-address-as-integer - "undefined_alien_function"))) + (foreign-symbol-address "undefined_alien_function"))) (addr - (pushnew symbol symbols :test #'equal) - (remove symbol undefineds :test #'equal) + (setf (gethash symbol symbols) t) + (remhash symbol undefineds) addr)))) - (defun dynamic-foreign-symbols () - symbols) - (defun undefined-foreign-symbols () - undefineds)) + (defun undefined-foreign-symbols-p () + (plusp (hash-table-count undefineds))) + (defun dynamic-foreign-symbols-p () + (plusp (hash-table-count symbols))) + (defun list-dynamic-foreign-symbols () + (loop for symbol being each hash-key in symbols + collect symbol))) + diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index 39e928c..7f4ca6e 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -28,41 +28,63 @@ (declaim (type hash-table *static-foreign-symbols*)) (defvar *static-foreign-symbols* (make-hash-table :test 'equal)) +(declaim + (ftype (sfunction (string hash-table) (or integer null)) find-foreign-symbol-in-table)) (defun find-foreign-symbol-in-table (name table) (let ((extern (extern-alien-name name))) - (or (gethash extern table) - (gethash (concatenate 'base-string "ldso_stub__" extern) table)))) + (values + (or (gethash extern table) + (gethash (concatenate 'base-string "ldso_stub__" extern) table))))) -(defun foreign-symbol-address-as-integer-or-nil (name &optional datap) - (declare (ignorable datap)) - (or (find-foreign-symbol-in-table name *static-foreign-symbols*) - #!+os-provides-dlopen - (progn - #-sb-xc-host - (values #!-linkage-table - (get-dynamic-foreign-symbol-address name datap) - #!+linkage-table - (ensure-foreign-symbol-linkage name datap) - t)))) - -(defun foreign-symbol-address-as-integer (name &optional datap) - (multiple-value-bind (addr sharedp) - (foreign-symbol-address-as-integer-or-nil name datap) - (if addr - (values addr sharedp) - (error "Unknown foreign symbol: ~S" name)))) +(defun find-foreign-symbol-address (name) + "Returns the address of the foreign symbol NAME, or NIL. Does not enter the +symbol in the linkage table, and never returns an address in the linkage-table." + (or (find-foreign-symbol-in-table name *static-foreign-symbols*) + (find-dynamic-foreign-symbol-address name))) + +(defun foreign-symbol-address (name &optional datap) + "Returns the address of the foreign symbol NAME. DATAP must be true if the +symbol designates a variable (used only on linkage-table platforms). Returns a +secondary value that is true if DATAP was true and the symbol is a dynamic +foreign symbol. + +On linkage-table ports the returned address is always static: either direct +address of a static symbol, or the linkage-table address of a dynamic one. +Dynamic symbols are entered into the linkage-table if they aren't there already. + +On non-linkage-table ports signals an error if the symbol isn't found." + (let ((static (find-foreign-symbol-in-table name *static-foreign-symbols*))) + (if static + (values static nil) + #!+os-provides-dlopen + (progn + #-sb-xc-host + (values #!-linkage-table + (ensure-dynamic-foreign-symbol-address name) + #!+linkage-table + (ensure-foreign-symbol-linkage name datap) + t) + #+sb-xc-host + (error 'undefined-alien-error :name name)) + #!-os-provides-dlopen + (error 'undefined-alien-error :name name)))) -(defun foreign-symbol-address (symbol &optional datap) +(defun foreign-symbol-sap (symbol &optional datap) + "Returns a SAP corresponding to the foreign symbol. DATAP must be true if the +symbol designates a variable (used only on linkage-table platforms). May enter +the symbol into the linkage-table. On non-linkage-table ports signals an error +if the symbol isn't found." (declare (ignorable datap)) #!-linkage-table - (int-sap (foreign-symbol-address-as-integer symbol)) + (int-sap (foreign-symbol-address symbol)) #!+linkage-table (multiple-value-bind (addr sharedp) - (foreign-symbol-address-as-integer symbol datap) + (foreign-symbol-address symbol datap) #+sb-xc-host (aver (not sharedp)) ;; If the address is from linkage-table and refers to data - ;; we need to do a bit of juggling. + ;; we need to do a bit of juggling. It is not the address of the + ;; variable, but the address where the real address is stored. (if (and sharedp datap) (int-sap (sap-ref-word (int-sap addr) 0)) (int-sap addr)))) @@ -77,23 +99,19 @@ ;;; Cleanups before saving a core #-sb-xc-host (defun foreign-deinit () - ;; KLUDGE: Giving this warning only when non-static foreign symbols - ;; are used would be much nicer, but actually pretty hard: we can - ;; get dynamic symbols thru the runtime as well, so cheking the - ;; list of *shared-objects* is not enough. Eugh & blech. #!+(and os-provides-dlopen (not linkage-table)) - (when (dynamic-foreign-symbols) + (when (dynamic-foreign-symbols-p) (warn "~@" (dynamic-foreign-symbols))) + ~{~A~^, ~}~:@>" (list-dynamic-foreign-symbols))) #!+os-provides-dlopen (close-shared-objects)) -(defun foreign-symbol-in-address (sap) +(defun sap-foreign-symbol (sap) (declare (ignorable sap)) #-sb-xc-host (let ((addr (sap-int sap))) @@ -107,7 +125,7 @@ (when (<= table-addr addr (+ table-addr sb!vm:linkage-table-entry-size)) - (return-from foreign-symbol-in-address name)))) + (return-from sap-foreign-symbol name)))) *linkage-info*)) #!+os-provides-dladdr (with-alien ((info (struct dl-info diff --git a/src/code/linkage-table.lisp b/src/code/linkage-table.lisp index 3ccfb4c..cb56720 100644 --- a/src/code/linkage-table.lisp +++ b/src/code/linkage-table.lisp @@ -48,7 +48,7 @@ (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 datap))) + (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." @@ -65,8 +65,7 @@ (sb!thread:with-mutex (*foreign-lock*) (let ((info (or (gethash name *linkage-info*) (link-foreign-symbol name datap)))) - (when info - (linkage-info-address info))))) + (linkage-info-address info)))) ;;; Update the linkage-table. Called during initialization after all ;;; shared libraries have been reopened, and after a previously loaded @@ -77,7 +76,7 @@ (let* ((datap (linkage-info-datap info)) (table-address (linkage-info-address info)) (real-address - (get-dynamic-foreign-symbol-address name datap))) + (ensure-dynamic-foreign-symbol-address name datap))) (aver (and table-address real-address)) (write-linkage-table-entry table-address real-address diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index 019991d..01b46fb 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -73,7 +73,7 @@ (clear-info :variable :constant-value lisp-name) (setf (info :variable :alien-info lisp-name) (make-heap-alien-info :type type - :sap-form `(foreign-symbol-address ',alien-name t))))) + :sap-form `(foreign-symbol-sap ',alien-name t))))) (defmacro extern-alien (name type &environment env) #!+sb-doc @@ -86,7 +86,7 @@ (datap (not (alien-fun-type-p alien-type)))) `(%heap-alien ',(make-heap-alien-info :type alien-type - :sap-form `(foreign-symbol-address ',alien-name ,datap))))) + :sap-form `(foreign-symbol-sap ',alien-name ,datap))))) (defmacro with-alien (bindings &body body &environment env) #!+sb-doc @@ -142,9 +142,8 @@ (/show0 ":EXTERN case") (let ((info (make-heap-alien-info :type alien-type - :sap-form `(foreign-symbol-address - ',initial-value - ,datap)))) + :sap-form `(foreign-symbol-sap ',initial-value + ,datap)))) `((symbol-macrolet ((,symbol (%heap-alien ',info))) ,@body)))) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index ac59674..8291da9 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1454,15 +1454,15 @@ (defknown sb!vm::pop-words-from-c-stack (index) (values) ()) #!+linkage-table -(defknown foreign-symbol-dataref-address (simple-string) +(defknown foreign-symbol-dataref-sap (simple-string) system-area-pointer (movable flushable)) -(defknown foreign-symbol-address (simple-string &optional boolean) +(defknown foreign-symbol-sap (simple-string &optional boolean) system-area-pointer (movable flushable)) -(defknown foreign-symbol-address-as-integer (simple-string &optional boolean) +(defknown foreign-symbol-address (simple-string &optional boolean) (values integer boolean) (movable flushable)) diff --git a/src/compiler/generic/core.lisp b/src/compiler/generic/core.lisp index e135136..f5b58ef 100644 --- a/src/compiler/generic/core.lisp +++ b/src/compiler/generic/core.lisp @@ -57,13 +57,13 @@ (error "undefined assembler routine: ~S" name))) (:foreign (aver (stringp name)) - ;; FOREIGN-SYMBOL-ADDRESS-AS-INTEGER signals an error + ;; FOREIGN-SYMBOL-ADDRESS signals an error ;; if the symbol isn't found. - (foreign-symbol-address-as-integer name)) + (foreign-symbol-address name)) #!+linkage-table (:foreign-dataref (aver (stringp name)) - (foreign-symbol-address-as-integer name t)) + (foreign-symbol-address name t)) #!+(or x86 x86-64) (:code-object (aver (null name)) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 2befcac..6e3ab05 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1490,8 +1490,7 @@ core and return a descriptor to it." (write-wordindexed fdefn sb!vm:fdefn-raw-addr-slot (make-random-descriptor - (cold-foreign-symbol-address-as-integer - "undefined_tramp")))) + (cold-foreign-symbol-address "undefined_tramp")))) fdefn)))) ;;; Handle the at-cold-init-time, fset-for-static-linkage operation @@ -1517,8 +1516,7 @@ core and return a descriptor to it." (#.sb!vm:closure-header-widetag (/show0 "/static-fset (closure)") (make-random-descriptor - (cold-foreign-symbol-address-as-integer - "closure_tramp"))))) + (cold-foreign-symbol-address "closure_tramp"))))) fdefn)) (defun initialize-static-fns () @@ -1599,7 +1597,7 @@ core and return a descriptor to it." (setf (gethash name *cold-foreign-symbol-table*) value)))))) (values)) ;; PROGN -(defun cold-foreign-symbol-address-as-integer (name) +(defun cold-foreign-symbol-address (name) (or (find-foreign-symbol-in-table name *cold-foreign-symbol-table*) *foreign-symbol-placeholder-value* (progn @@ -2513,7 +2511,7 @@ core and return a descriptor to it." (sym (make-string len))) (read-string-as-bytes *fasl-input-stream* sym) (let ((offset (read-word-arg)) - (value (cold-foreign-symbol-address-as-integer sym))) + (value (cold-foreign-symbol-address sym))) (do-cold-fixup code-object offset value kind)) code-object)) diff --git a/src/compiler/hppa/c-call.lisp b/src/compiler/hppa/c-call.lisp index 9f3cb93..489fec0 100644 --- a/src/compiler/hppa/c-call.lisp +++ b/src/compiler/hppa/c-call.lisp @@ -112,8 +112,8 @@ :result-tn (alien-fun-type-result-type type))))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) diff --git a/src/compiler/mips/c-call.lisp b/src/compiler/mips/c-call.lisp index 6b9eece..2eea599 100644 --- a/src/compiler/mips/c-call.lisp +++ b/src/compiler/mips/c-call.lisp @@ -225,8 +225,8 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp index fa4df33..a8fedc8 100644 --- a/src/compiler/ppc/c-call.lisp +++ b/src/compiler/ppc/c-call.lisp @@ -299,8 +299,8 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -311,8 +311,8 @@ (inst lr res (make-fixup foreign-symbol :foreign)))) #!+linkage-table -(define-vop (foreign-symbol-dataref-address) - (:translate foreign-symbol-dataref-address) +(define-vop (foreign-symbol-dataref-sap) + (:translate foreign-symbol-dataref-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -485,7 +485,7 @@ (inst stw r0 sp (* 2 n-word-bytes)) ; FIXME: magic constant (inst stwu sp sp (- frame-size)) ;; Make the call - (load-address-into r0 (foreign-symbol-address-as-integer "funcall3")) + (load-address-into r0 (foreign-symbol-address "funcall3")) (inst mtlr r0) (inst blrl)) ;; We're back! Restore sp and lr, load the return value from just diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index f709cea..178e61e 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -14,18 +14,17 @@ ;;;; DEFKNOWNs #!+linkage-table -(deftransform foreign-symbol-address-as-integer ((symbol &optional datap) - (simple-string boolean)) +(deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean)) (if (and (constant-lvar-p symbol) (constant-lvar-p datap)) - `(sap-int (foreign-symbol-address symbol datap)) + `(sap-int (foreign-symbol-sap symbol datap)) (give-up-ir1-transform))) -(deftransform foreign-symbol-address ((symbol &optional datap) +(deftransform foreign-symbol-sap ((symbol &optional datap) (simple-string &optional boolean)) #!-linkage-table (if (null datap) (give-up-ir1-transform) - `(foreign-symbol-address symbol)) + `(foreign-symbol-sap symbol)) #!+linkage-table (if (and (constant-lvar-p symbol) (constant-lvar-p datap)) (let ((name (lvar-value symbol)) @@ -33,8 +32,8 @@ (if (or #+sb-xc-host t ; only static symbols on host (not datap) (find-foreign-symbol-in-table name *static-foreign-symbols*)) - `(foreign-symbol-address ,name) ; VOP - `(foreign-symbol-dataref-address ,name))) ; VOP + `(foreign-symbol-sap ,name) ; VOP + `(foreign-symbol-dataref-sap ,name))) ; VOP (give-up-ir1-transform))) (defknown (sap< sap<= sap= sap>= sap>) diff --git a/src/compiler/sparc/c-call.lisp b/src/compiler/sparc/c-call.lisp index 5932c66..e5dc808 100644 --- a/src/compiler/sparc/c-call.lisp +++ b/src/compiler/sparc/c-call.lisp @@ -183,8 +183,8 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -195,8 +195,8 @@ (inst li res (make-fixup foreign-symbol :foreign)))) #!+linkage-table -(define-vop (foreign-symbol-dataref-address) - (:translate foreign-symbol-dataref-address) +(define-vop (foreign-symbol-dataref-sap) + (:translate foreign-symbol-dataref-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index e89b02c..35b405b 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -1950,7 +1950,7 @@ (return-from maybe-note-assembler-routine nil)) (let ((name (or #!+linkage-table - (sb!sys:foreign-symbol-in-address (sb!sys:int-sap address)) + (sb!sys:sap-foreign-symbol (sb!sys:int-sap address)) (find-assembler-routine address)))) (unless (null name) (note (lambda (stream) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 1d9fcaf..2fa84d0 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -210,8 +210,8 @@ (dpb x (byte 32 0) -1) (ldb (byte 32 0) x))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -222,8 +222,8 @@ (inst lea res (make-fixup foreign-symbol :foreign)))) #!+linkage-table -(define-vop (foreign-symbol-dataref-address) - (:translate foreign-symbol-dataref-address) +(define-vop (foreign-symbol-dataref-sap) + (:translate foreign-symbol-dataref-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 479c9f1..f2bd52a 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -181,8 +181,8 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) -(define-vop (foreign-symbol-address) - (:translate foreign-symbol-address) +(define-vop (foreign-symbol-sap) + (:translate foreign-symbol-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -193,8 +193,8 @@ (inst lea res (make-fixup foreign-symbol :foreign)))) #!+linkage-table -(define-vop (foreign-symbol-dataref-address) - (:translate foreign-symbol-dataref-address) +(define-vop (foreign-symbol-dataref-sap) + (:translate foreign-symbol-dataref-sap) (:policy :fast-safe) (:args) (:arg-types (:constant simple-string)) @@ -381,7 +381,7 @@ pointer to the arguments." (inst push eax) ; arg1 (inst push (ash index 2)) ; arg0 (inst push (get-lisp-obj-address #'enter-alien-callback)) ; function - (inst mov eax (foreign-symbol-address-as-integer "funcall3")) + (inst mov eax (foreign-symbol-address "funcall3")) (inst call eax) ;; now put the result into the right register (cond diff --git a/version.lisp-expr b/version.lisp-expr index 9622ec5..f8760ee 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.9.2.25" +"0.9.2.26" -- 1.7.10.4