From 5180112f38672c124e175f2c88a5ebb67ed8f831 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Thu, 1 Feb 2018 16:44:26 +0300 Subject: [PATCH] Restore undefined-alien-fun name reporting on x86-64. The function address is no longer loaded through RBX, encode the name in the debug info. --- src/code/interr.lisp | 6 ++- src/compiler/x86-64/c-call.lisp | 89 +++++++++++++++++++++-------------------- tests/alien.impure.lisp | 10 +++++ 3 files changed, 60 insertions(+), 45 deletions(-) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 0388d3782..4329899f3 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -154,8 +154,10 @@ (deferr undefined-alien-fun-error (address) (error 'undefined-alien-function-error :name - (and (integerp address) - (sap-foreign-symbol (int-sap address))))) + (or (sb!di:error-context + (sb!di:frame-down sb!debug:*stack-top-hint*)) + (and (integerp address) + (sap-foreign-symbol (int-sap address)))))) #!-(or arm arm64 x86-64) (defun undefined-alien-fun-error () diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 0926b0066..db53810b8 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -289,50 +289,53 @@ (emit-c-call vop rax c-symbol args #!+sb-safepoint pc-save))) (defun emit-c-call (vop rax fun args #!+sb-safepoint pc-save) - ;; Current PC - don't rely on function to keep it in a form that - ;; GC understands - #!+sb-safepoint - (let ((label (gen-label))) - (inst lea (reg-in-size rax :immobile-code-pc) (make-fixup nil :code-object label)) - (emit-label label) - (move-dword-if-immobile-code pc-save rax)) - (when sb!c::*msan-compatible-stack-unpoison* - (inst mov rax (static-symbol-value-ea 'msan-param-tls)) - ;; Unpoison parameters - (do ((n 0 (+ n n-word-bytes)) - (arg args (tn-ref-across arg))) - ((null arg)) - ;; KLUDGE: assume all parameters are 8 bytes or less - (inst fs) - (inst mov (make-ea :qword :base rax :disp n) 0))) - #!-win32 - ;; ABI: AL contains amount of arguments passed in XMM registers - ;; for vararg calls. - (move-immediate rax - (loop for tn-ref = args then (tn-ref-across tn-ref) - while tn-ref - count (eq (sb-name (sc-sb (tn-sc (tn-ref-tn tn-ref)))) - 'float-registers))) - #!+sb-safepoint - ;; Store SP in thread struct - (storew rsp-tn thread-base-tn thread-saved-csp-offset) - #!+win32 (inst sub rsp-tn #x20) ;MS_ABI: shadow zone - ;; From immobile space we use the "CALL rel32" format to the linkage - ;; table jump, and from dynamic space we use "CALL [ea]" format - ;; where ea is the address of the linkage table entry's operand. - ;; So while the former is a jump to a jump, we can optimize out - ;; one jump in a statically linked executable. - (inst call (cond ((tn-p fun) fun) - ((sb!c::code-immobile-p (sb!c::vop-node vop)) - (make-fixup fun :foreign)) - (t (make-ea :qword :disp (make-fixup fun :foreign 8))))) - #!+win32 (inst add rsp-tn #x20) ;MS_ABI: remove shadow space - #!+sb-safepoint - ;; Zero the saved CSP - (inst xor (make-ea-for-object-slot thread-base-tn thread-saved-csp-offset 0) - rsp-tn) - ;; To give the debugger a clue. XX not really internal-error? + ;; Current PC - don't rely on function to keep it in a form that + ;; GC understands + #!+sb-safepoint + (let ((label (gen-label))) + (inst lea (reg-in-size rax :immobile-code-pc) (make-fixup nil :code-object label)) + (emit-label label) + (move-dword-if-immobile-code pc-save rax)) + (when sb!c::*msan-compatible-stack-unpoison* + (inst mov rax (static-symbol-value-ea 'msan-param-tls)) + ;; Unpoison parameters + (do ((n 0 (+ n n-word-bytes)) + (arg args (tn-ref-across arg))) + ((null arg)) + ;; KLUDGE: assume all parameters are 8 bytes or less + (inst fs) + (inst mov (make-ea :qword :base rax :disp n) 0))) + #!-win32 + ;; ABI: AL contains amount of arguments passed in XMM registers + ;; for vararg calls. + (move-immediate rax + (loop for tn-ref = args then (tn-ref-across tn-ref) + while tn-ref + count (eq (sb-name (sc-sb (tn-sc (tn-ref-tn tn-ref)))) + 'float-registers))) + #!+sb-safepoint + ;; Store SP in thread struct + (storew rsp-tn thread-base-tn thread-saved-csp-offset) + #!+win32 (inst sub rsp-tn #x20) ;MS_ABI: shadow zone + ;; From immobile space we use the "CALL rel32" format to the linkage + ;; table jump, and from dynamic space we use "CALL [ea]" format + ;; where ea is the address of the linkage table entry's operand. + ;; So while the former is a jump to a jump, we can optimize out + ;; one jump in a statically linked executable. + + (inst call (cond ((tn-p fun) fun) + ((sb!c::code-immobile-p (sb!c::vop-node vop)) + (make-fixup fun :foreign)) + (t (make-ea :qword :disp (make-fixup fun :foreign 8))))) + (let ((*location-context* (and (stringp fun) + fun))) + ;; For the undefined alien error (note-this-location vop :internal-error)) + #!+win32 (inst add rsp-tn #x20) ;MS_ABI: remove shadow space + #!+sb-safepoint + ;; Zero the saved CSP + (inst xor (make-ea-for-object-slot thread-base-tn thread-saved-csp-offset 0) + rsp-tn)) (define-vop (alloc-number-stack-space) (:info amount) diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index dec389518..613fcc674 100644 --- a/tests/alien.impure.lisp +++ b/tests/alien.impure.lisp @@ -525,3 +525,13 @@ (form2 (copy-tree form1))) (assert (eq (sb-alien::coerce-to-interpreted-function form1) (sb-alien::coerce-to-interpreted-function form2))))) + +(with-test (:name :undefined-alien-name + :skipped-on (not (and :linkage-table + (or :x86-64 :arm :arm64)))) + (handler-case (funcall (checked-compile `(lambda () + (alien-funcall (extern-alien "bar" (function (values))))) + :allow-style-warnings t)) + (t (c) + (assert (typep c 'sb-kernel::undefined-alien-function-error)) + (assert (equal (cell-error-name c) "bar"))))) -- 2.11.4.GIT