Better error when calling an undefined alien function on x86-64.

(sb-alien:alien-funcall
 (sb-alien:extern-alien "nnnn" (function sb-alien:void)))
now says "The alien function "nnnn" is undefined." instead of
"Attempt to call an undefined alien function."

This is achieved by storing the address of the linkage table entry in
RBX before the call. Should be trivial to port to other platforms.

diff --git a/NEWS b/NEWS
index cd406a0..062aa90 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.1.12:
     values.  (lp#309443)
   * other improvements to SXHASH:
     ** use the whole of the positive-fixnum range for SXHASH of fixnums
+  * enhancement: The error message when calling an undefined alien function
+    includes the name of the function on x86-64.
 
 changes in sbcl-1.1.12 relative to sbcl-1.1.11:
   * enhancement: Add sb-bsd-sockets:socket-shutdown, for calling

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 8ebecda..9d63016 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1763,7 +1763,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "TYPE-SINGLE-VALUE-P" "TYPE-SPECIFIER" "TYPE-UNION"
                "TYPE/=" "TYPE=" "TYPES-EQUAL-OR-INTERSECT"
                "UNBOUND-SYMBOL-ERROR" "UNBOXED-ARRAY"
-               "UNDEFINED-FUN-ERROR" "UNION-TYPE" "UNION-TYPE-P"
+               "UNDEFINED-FUN-ERROR" "UNDEFINED-ALIEN-FUN-ERROR"
+               "UNION-TYPE" "UNION-TYPE-P"
                "UNION-TYPE-TYPES" "UNKNOWN-ERROR"
                "UNKNOWN-KEY-ARG-ERROR" "UNKNOWN-TYPE" "UNKNOWN-TYPE-P"
                "UNKNOWN-TYPE-SPECIFIER" "UNSEEN-THROW-TAG-ERROR"

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 0c4d22d..5fe0833 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1053,8 +1053,11 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 (define-condition undefined-alien-function-error (undefined-alien-error) ()
   (:report
    (lambda (condition stream)
-     (declare (ignore condition))
-     (format stream "Attempt to call an undefined alien function."))))
+     (if (and (slot-boundp condition 'name)
+              (cell-error-name condition))
+         (format stream "The alien function ~s is undefined."
+                 (cell-error-name condition))
+         (format stream "Attempt to call an undefined alien function.")))))
 
 \f
 ;;;; various other (not specified by ANSI) CONDITIONs

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index fb16a77..f6b1692 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -183,6 +183,17 @@
                  (symbol fdefn-or-symbol)
                  (fdefn (fdefn-name fdefn-or-symbol)))))
 
+#!+x86-64
+(deferr undefined-alien-fun-error (address)
+  (error 'undefined-alien-function-error
+         :name
+         (and (integerp address)
+              (sap-foreign-symbol (int-sap address)))))
+
+#!-x86-64
+(defun undefined-alien-fun-error ()
+  (error 'undefined-alien-function-error))
+
 (deferr invalid-arg-count-error (nargs)
   (error 'simple-program-error
          :format-control "invalid number of arguments: ~S"
@@ -524,9 +535,6 @@
 (defun undefined-alien-variable-error ()
   (error 'undefined-alien-variable-error))
 
-(defun undefined-alien-function-error ()
-  (error 'undefined-alien-function-error))
-
 #!-win32
 (define-alien-variable current-memory-fault-address unsigned)
 

diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp
index 9ff81d3..8c14ed9 100644 (file)
--- a/src/compiler/generic/interr.lisp
+++ b/src/compiler/generic/interr.lisp
@@ -88,6 +88,9 @@
    ;; FIXME: Isn't this used for calls to unbound (SETF FOO) too? If so, revise
    ;; the name.
    "An attempt was made to use an undefined FDEFINITION.")
+  #!+x86-64
+  (undefined-alien-fun
+   "An attempt was made to use an undefined alien function")
   (invalid-arg-count
    "invalid argument count")
   (bogus-arg-to-values-list

diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp
index 4661321..ea32247 100644 (file)
--- a/src/compiler/generic/parms.lisp
+++ b/src/compiler/generic/parms.lisp
@@ -116,9 +116,10 @@
     sb!kernel::alien-stack-exhausted-error
     sb!kernel::heap-exhausted-error
     sb!kernel::undefined-alien-variable-error
-    sb!kernel::undefined-alien-function-error
     sb!kernel::memory-fault-error
     sb!kernel::unhandled-trap-error
+    ;; On x86-64 it's called through the internal errors mechanism
+    #!-x86-64 undefined-alien-fun-error
     sb!di::handle-breakpoint
     sb!di::handle-single-step-trap
     fdefinition-object

diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index 192de22..1eb55ee 100644 (file)
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -258,9 +258,13 @@
    (inst mov res (make-fixup foreign-symbol :foreign-dataref))))
 
 (define-vop (call-out)
-  (:args (function :scs (sap-reg))
+  (:args (function :scs (sap-reg)
+                   :target rbx)
          (args :more t))
   (:results (results :more t))
+  ;; RBX is used to first load the address, allowing the debugger to
+  ;; determine which alien was accessed in case it's undefined.
+  (:temporary (:sc sap-reg :offset rbx-offset) rbx)
   (:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax)
   ;; For safepoint builds: Force values of non-volatiles to the stack.
   ;; These are the callee-saved registers in the native ABI, but
@@ -300,16 +304,17 @@
     ;; 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)))
-    #!+win32 (inst sub rsp-tn #x20)     ;MS_ABI: shadow zone
+                          while tn-ref
+                          count (eq (sb-name (sc-sb (tn-sc (tn-ref-tn tn-ref))))
+                                    'float-registers)))
+    #!+win32 (inst sub rsp-tn #x20) ;MS_ABI: shadow zone
     #!+sb-safepoint
-    (progn                              ;Store SP and PC in thread struct
+    (progn                 ;Store SP and PC in thread struct
       (storew rsp-tn thread-base-tn thread-saved-csp-offset)
       (storew r14 thread-base-tn thread-pc-around-foreign-call-slot))
-    (inst call function)
-    #!+win32 (inst add rsp-tn #x20)     ;MS_ABI: remove shadow space
+    (move rbx function)
+    (inst call rbx)
+    #!+win32 (inst add rsp-tn #x20) ;MS_ABI: remove shadow space
     #!+sb-safepoint
     (progn
       ;; Zeroing out

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index bdfaef2..be105e5 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -1574,6 +1574,8 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 #endif
 }
 
+// x86-64 has an undefined_alien_function tramp in x86-64-assem.S
+#ifndef LISP_FEATURE_X86_64
 /* KLUDGE: Theoretically the approach we use for undefined alien
  * variables should work for functions as well, but on PPC/Darwin
  * we get bus error at bogus addresses instead, hence this workaround,
@@ -1583,8 +1585,9 @@ arrange_return_to_lisp_function(os_context_t *context, lispobj function)
 void
 undefined_alien_function(void)
 {
-    funcall0(StaticSymbolFunction(UNDEFINED_ALIEN_FUNCTION_ERROR));
+    funcall0(StaticSymbolFunction(UNDEFINED_ALIEN_FUN_ERROR));
 }
+#endif
 
 void lower_thread_control_stack_guard_page(struct thread *th)
 {

diff --git a/src/runtime/os-common.c b/src/runtime/os-common.c
index f57b643..d5c2d14 100644 (file)
--- a/src/runtime/os-common.c
+++ b/src/runtime/os-common.c
@@ -168,8 +168,6 @@ static inline lispobj cdr(lispobj conscell)
     return FOLLOW(conscell,LIST_POINTER,cons).cdr;
 }
 
-extern void undefined_alien_function(); /* see interrupt.c */
-
 #ifndef LISP_FEATURE_WIN32
 void *
 os_dlsym_default(char *name)

diff --git a/src/runtime/x86-64-assem.S b/src/runtime/x86-64-assem.S
index b85639e..d808476 100644 (file)
--- a/src/runtime/x86-64-assem.S
+++ b/src/runtime/x86-64-assem.S
@@ -301,6 +301,24 @@ GNAME(undefined_tramp):
        ret
        SIZE(GNAME(undefined_tramp))
 
+       .text
+       .align  align_16byte,0x90
+       .globl  GNAME(undefined_alien_function)
+       TYPE(GNAME(undefined_alien_function))
+GNAME(undefined_alien_function):
+       pop     8(%rbp)         # Save return PC for backtrace.
+       TRAP
+       .byte   trap_Error
+        .byte   4
+        .byte   UNDEFINED_ALIEN_FUN_ERROR
+        /* Encode RBX
+           FIXME: make independt of the encoding changes. */
+        .byte   0xFE 
+        .byte   0x9F
+        .byte   0x01
+       ret
+       SIZE(GNAME(undefined_alien_function))
+
 /* KLUDGE: FIND-ESCAPED-FRAME (SYS:SRC;CODE;DEBUG-INT.LISP) needs
  * to know the name of the function immediately following the
  * undefined-function trampoline. */