[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-serv25217

Modified Files:
	debugger.lisp 
Log Message:
Some tweaks to backtrace.

Date: Tue Jul 20 16:53:48 2004
Author: ffjeld

Index: movitz/losp/x86-pc/debugger.lisp
diff -u movitz/losp/x86-pc/debugger.lisp:1.17 movitz/losp/x86-pc/debugger.lisp:1.18
--- movitz/losp/x86-pc/debugger.lisp:1.17	Tue Jul 20 05:40:48 2004
+++ movitz/losp/x86-pc/debugger.lisp	Tue Jul 20 16:53:48 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 22 10:09:18 2002
 ;;;;                
-;;;; $Id: debugger.lisp,v 1.17 2004/07/20 12:40:48 ffjeld Exp $
+;;;; $Id: debugger.lisp,v 1.18 2004/07/20 23:53:48 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -431,8 +431,10 @@
     (serious-condition (conditon)
       (write-string "#<error printing frame>"))))
 
-(defun backtrace (&key ((:frame initial-stack-frame)
-			(or *debugger-invoked-stack-frame*
+(defun backtrace (&key stack
+		       ((:frame initial-stack-frame)
+			(or (and stack (svref%unsafe stack 0))
+			    *debugger-invoked-stack-frame*
 			    (current-stack-frame)))
 		       ((:spartan *backtrace-be-spartan-p*))
 		       ((:fresh-lines *backtrace-do-fresh-lines*) *backtrace-do-fresh-lines*)
@@ -445,7 +447,10 @@
 	(*print-length* *backtrace-print-length*)
 	(*print-level* *backtrace-print-level*))
     (loop with conflate-count = 0 with count = 0
-	for stack-frame = initial-stack-frame then (stack-frame-uplink stack-frame)
+	for stack-frame = initial-stack-frame
+	then (let ((uplink (stack-frame-uplink stack-frame)))
+	       (assert (> uplink stack-frame))
+	       uplink)
 	as funobj = (stack-frame-funobj stack-frame t)
 	do (flet ((print-leadin (stack-frame count conflate-count)
 		    (when *backtrace-do-fresh-lines*