[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/x86-pc
In directory common-lisp.net:/tmp/cvs-serv22464

Modified Files:
	debugger.lisp 
Log Message:
*** empty log message ***
Date: Mon Apr 25 00:13:54 2005
Author: ffjeld

Index: movitz/losp/x86-pc/debugger.lisp
diff -u movitz/losp/x86-pc/debugger.lisp:1.38 movitz/losp/x86-pc/debugger.lisp:1.39
--- movitz/losp/x86-pc/debugger.lisp:1.38	Wed Apr 20 08:54:07 2005
+++ movitz/losp/x86-pc/debugger.lisp	Mon Apr 25 00:13:54 2005
@@ -6,11 +6,11 @@
 ;;;;    For distribution policy, see the accompanying file COPYING.
 ;;;; 
 ;;;; Filename:      debugger.lisp
-;;;; Description:   
+;;;; Description:   Debugging functionality.
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 22 10:09:18 2002
 ;;;;                
-;;;; $Id: debugger.lisp,v 1.38 2005/04/20 06:54:07 ffjeld Exp $
+;;;; $Id: debugger.lisp,v 1.39 2005/04/24 22:13:54 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -38,7 +38,8 @@
       muerte::do-slow-method-lookup
       muerte::initial-discriminating-function
       muerte::discriminating-function-max
-      muerte::discriminating-function-max-step2))
+      muerte::discriminating-function-max-step2
+      invoke-debugger-on-designator))
 
 (defconstant +backtrace-gf-discriminatior-functions+
     '(muerte::discriminating-function-max
@@ -132,12 +133,12 @@
 	(stack-frame-call-site stack frame)
       (when (and call-site code)
 	(dolist (map +call-site-numargs-maps+
-		  (warn "no match at ~D for ~S frame ~S [~S]."
-			call-site
-			(stack-frame-funobj stack (stack-frame-uplink stack frame))
-			frame funobj))
+		  #+ignore (warn "no match at ~D for ~S frame ~S [~S]."
+				 call-site
+				 (stack-frame-funobj stack (stack-frame-uplink stack frame))
+				 frame funobj))
 	  (when (not (mismatch code (cdr map)
-			       :start1 (- call-site (length (cdr map)))
+			       :start1 (max 0 (- call-site (length (cdr map))))
 			       :end1 call-site))
 	    (return
 	      (cond
@@ -600,10 +601,11 @@
 		      (format t "?: ~Z" funobj)))
 	       (serious-condition (c)
 		 (let ((*print-safely* t))
-		   (format t " - Error at ~S funobj ~S: ~A"
+		   (format t " - Backtracing error at ~S funobj ~S: ~A"
 			   frame
 			   (stack-frame-funobj nil frame)
-			   c)))))))
+			   c)))))
+	until (zerop (stack-frame-uplink stack frame))))
   (values))
 
 (defun locate-function (instruction-location)