X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug-int.lisp;h=d839476360d4a4fce98ebd30ec320e1fe68b4d99;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=352f968f7e3deea69bba6a2d0de5957aa41cc3ca;hpb=bcb7a9c9d1cc1566d449efdfd40476d16477a2c9;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 352f968..d839476 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -780,10 +780,10 @@
 	  (#.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)
+(defun foreign-function-backtrace-name (sap)
+  (let ((name (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: ~A" name)
 	(format nil "foreign function: #x~X" (sap-int sap)))))
 
 ;;; This returns a frame for the one existing in time immediately
@@ -832,7 +832,8 @@
 			   "undefined function"))
 			 (:foreign-function
 			  (make-bogus-debug-fun
-			   (foreign-function-debug-name (int-sap (get-lisp-obj-address lra)))))
+			   (foreign-function-backtrace-name
+			    (int-sap (get-lisp-obj-address lra)))))
 			 ((nil)
 			  (make-bogus-debug-fun
 			   "bogus stack frame"))
@@ -877,7 +878,8 @@
 		      (make-bogus-debug-fun
 		       "undefined function"))
 		     (:foreign-function
-		      (make-bogus-debug-fun (foreign-function-debug-name ra)))
+		      (make-bogus-debug-fun
+		       (foreign-function-backtrace-name ra)))
 		     ((nil)
 		      (make-bogus-debug-fun
 		       "bogus stack frame"))
@@ -1002,20 +1004,13 @@
   "Finds the PC for the return from an assembly routine properly.
 For some architectures (such as PPC) this will not be the $LRA
 register."
-  (let ((return-machine-address
-         ;; This conditional logic should probably go into
-         ;; architecture specific files somehow.
-         #!+ppc (sap-int (sb!vm::context-lr scp))
-         #!+sparc (+ (sb!vm:context-register scp sb!vm::lip-offset) 8)
-         #!-(or ppc sparc) (- (sb!vm:context-register scp sb!vm::lra-offset)
-                              sb!vm:other-pointer-lowtag))
-        (code-header-len (* (get-header-data code)
-                            sb!vm:n-word-bytes)))
-  (values (- return-machine-address
-             (- (get-lisp-obj-address code)
-                sb!vm:other-pointer-lowtag) 
-             code-header-len)
-          return-machine-address)))
+  (let ((return-machine-address (sb!vm::return-machine-address scp))
+        (code-header-len (* (get-header-data code) sb!vm:n-word-bytes)))
+    (values (- return-machine-address
+	       (- (get-lisp-obj-address code)
+		  sb!vm:other-pointer-lowtag) 
+	       code-header-len)
+	    return-machine-address)))
 
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
@@ -3272,6 +3267,8 @@ register."
 ;;; instruction.
 (defun make-bogus-lra (real-lra &optional known-return-p)
   (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"))