X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=d05a3dab8a10234ffdc0eeebc138915fce58ace7;hb=240b0db303764545c982e9362a986243b535f7f4;hp=a7ce184fff7a3ace4e0e8d8c3f10dfa457fa70b3;hpb=9c1a7443146bba92c2430689981bd46c66551c35;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index a7ce184..d05a3da 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -507,7 +507,7 @@
 ;;;; frames
 
 ;;; This is used in FIND-ESCAPED-FRAME and with the bogus components
-;;; and LRAs used for :FUN-END breakpoints. When a components
+;;; and LRAs used for :FUN-END breakpoints. When a component's
 ;;; debug-info slot is :BOGUS-LRA, then the REAL-LRA-SLOT contains the
 ;;; real component to continue executing, as opposed to the bogus
 ;;; component which appeared in some frame's LRA location.
@@ -828,7 +828,7 @@
 			   "undefined function"))
 			 (:foreign-function
 			  (make-bogus-debug-fun
-			   "foreign function call land"))
+			   (format nil "foreign function call land:")))
 			 ((nil)
 			  (make-bogus-debug-fun
 			   "bogus stack frame"))
@@ -874,7 +874,8 @@
 		       "undefined function"))
 		     (:foreign-function
 		      (make-bogus-debug-fun
-		       "foreign function call land"))
+		       (format nil "foreign function call land: ra=#x~X"
+				   (sap-int ra))))
 		     ((nil)
 		      (make-bogus-debug-fun
 		       "bogus stack frame"))
@@ -1189,8 +1190,7 @@
      (fun-debug-fun (%closure-fun fun)))
     (#.sb!vm:funcallable-instance-header-widetag
      (fun-debug-fun (funcallable-instance-fun fun)))
-    ((#.sb!vm:simple-fun-header-widetag
-      #.sb!vm:closure-fun-header-widetag)
+    (#.sb!vm:simple-fun-header-widetag
       (let* ((name (%simple-fun-name fun))
 	     (component (fun-code-header fun))
 	     (res (find-if
@@ -3290,14 +3290,3 @@
     ;; (There used to be more cases back before sbcl-0.7.0, when
     ;; we did special tricks to debug the IR1 interpreter.)
     ))
-
-(defun print-code-locations (function)
-  (let ((debug-fun (fun-debug-fun function)))
-    (do-debug-fun-blocks (block debug-fun)
-      (do-debug-block-locations (loc block)
-	(fill-in-code-location loc)
-	(format t "~S code location at ~W"
-		(compiled-code-location-kind loc)
-		(compiled-code-location-pc loc))
-	(sb!debug::print-code-location-source-form loc 0)
-	(terpri)))))