0.8.13.10: I don't think we're in lisp-land anymore...

           * Display foreign function names in backtraces on platforms
              with dladdr. Essentially a port of Helmut Eller's patch
              for CMUCL. Works fine on x86 and Sparc at least.
           * Clean up some spurious sb-alien package prefixes from
              foreign.lisp while at it.

diff --git a/NEWS b/NEWS
index bd89023..4f52e72 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,7 @@
 changes in sbcl-0.8.14 relative to sbcl-0.8.13:
+  * new feature: on platforms where "dladdr" is available foreign
+    function names now appear in backtraces.  (based on Helmut Eller's
+    work for CMUCL)
   * bug fix: backtraces involving undefined functions or assembly
     routines are more informative.  (thanks to Brian Downing)
   * bug fix: mutually referent alien structures now work correctly.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index f41aa60..44bd7d8 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1792,6 +1792,7 @@ SB-KERNEL) have been undone, but probably more remain."
                                      "ENABLE-INTERRUPT" "ENUMERATION"
                                      "FD-STREAM-FD" "FD-STREAM-P" 
                                      "FOREIGN-SYMBOL-ADDRESS" "FOREIGN-SYMBOL-ADDRESS-AS-INTEGER"
+                                     "FOREIGN-SYMBOL-IN-ADDRESS"
                                      "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
                                      "IGNORE-INTERRUPT"
                                      "INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index d58a2c2..352f968 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -780,6 +780,12 @@
          (#.lra-save-offset
           (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
 
+(defun foreign-function-debug-name (sap)
+  (multiple-value-bind (name file base offset) (foreign-symbol-in-address sap)
+    (if name
+       (format nil "foreign function: ~A [~A: #x~X + #x~X]" name file base offset)
+       (format nil "foreign function: #x~X" (sap-int sap)))))
+
 ;;; This returns a frame for the one existing in time immediately
 ;;; prior to the frame referenced by current-fp. This is current-fp's
 ;;; caller or the next frame down the control stack. If there is no
@@ -826,7 +832,7 @@
                           "undefined function"))
                         (:foreign-function
                          (make-bogus-debug-fun
-                          (format nil "foreign function call land:")))
+                          (foreign-function-debug-name (int-sap (get-lisp-obj-address lra)))))
                         ((nil)
                          (make-bogus-debug-fun
                           "bogus stack frame"))
@@ -871,9 +877,7 @@
                      (make-bogus-debug-fun
                       "undefined function"))
                     (:foreign-function
-                     (make-bogus-debug-fun
-                      (format nil "foreign function call land: ra=#x~X"
-                                  (sap-int ra))))
+                     (make-bogus-debug-fun (foreign-function-debug-name ra)))
                     ((nil)
                      (make-bogus-debug-fun
                       "bogus stack frame"))

diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp
index fc4a3b8..5e1fc57 100644 (file)
--- a/src/code/foreign.lisp
+++ b/src/code/foreign.lisp
@@ -67,13 +67,14 @@
     (push (lambda () (setq *handles-from-dlopen* nil))
          *after-save-initializations*)
 
-    (sb-alien:define-alien-routine dlopen system-area-pointer
-      (file sb-alien:c-string) (mode sb-alien:int))
-    (sb-alien:define-alien-routine dlsym system-area-pointer
-      (lib system-area-pointer)
-      (name sb-alien:c-string))
-    (sb-alien:define-alien-routine dlerror sb-alien:c-string)
-
+    (define-alien-routine dlopen system-area-pointer
+      (file c-string) (mode int))
+    
+    (define-alien-routine dlsym system-area-pointer
+      (lib system-area-pointer) (name c-string))
+    
+    (define-alien-routine dlerror c-string)
+    
 ;;; Ensure that we've opened our own binary so we can dynamically resolve 
 ;;; symbols in the C runtime.  
 ;;;
@@ -135,4 +136,32 @@
          (unless (zerop possible-result)
            (return possible-result)))))
 
+    (defun foreign-symbol-in-address (sap)
+      (declare (ignore sap)))
+
+    (when (ignore-errors (foreign-symbol-address "dladdr"))
+      (setf (symbol-function 'foreign-symbol-in-address)
+           ;; KLUDGE: This COMPILE trick is to avoid trying to
+           ;; compile a reference to dladdr on platforms without it.
+           (compile nil
+            '(lambda (sap)
+              (let ((addr (sap-int sap)))
+                (with-alien ((info
+                              (struct dl-info
+                                      (filename c-string)
+                                      (base unsigned)
+                                      (symbol c-string)
+                                      (symbol-address unsigned)))
+                             (dladdr
+                              (function unsigned
+                                        unsigned (* (struct dl-info)))
+                              :extern "dladdr"))
+                  (let ((err (alien-funcall dladdr addr (addr info))))
+                    (if (zerop err)
+                        nil
+                        (values (slot info 'symbol)
+                                (slot info 'filename)
+                                addr
+                                (- addr (slot info 'symbol-address)))))))))))
+    
     ))                                 ; PROGN, MACROLET

diff --git a/version.lisp-expr b/version.lisp-expr
index e3a00ac..8eebb8e 100644 (file)
--- 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.8.13.9"
+"0.8.13.10"