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

Modified Files: debugger.lisp Log Message: Take pains not to have backtrace do any consing. It used to cons up the print-leadin flet, because it closed over a couple of variables and the compiler isn't too smart about such closures (yet).

Date: Wed Mar 24 08:34:53 2004 Author: ffjeld

Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.3 movitz/losp/x86-pc/debugger.lisp:1.4 --- movitz/losp/x86-pc/debugger.lisp:1.3 Fri Feb 13 17:11:38 2004 +++ movitz/losp/x86-pc/debugger.lisp Wed Mar 24 08:34:53 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.3 2004/02/13 22:11:38 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.4 2004/03/24 13:34:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -69,6 +69,7 @@ (defvar *backtrace-do-fresh-lines* t) (defvar *backtrace-print-length* 3) (defvar *backtrace-print-level* 2) +(defvar *backtrace-print-frames* nil)

(defun pointer-in-range (x) (with-inline-assembly (:returns :boolean-cf=1) @@ -443,16 +444,17 @@ (or *debugger-invoked-stack-frame* (current-stack-frame))) ((:spartan *backtrace-be-spartan-p*)) + ((:fresh-lines *backtrace-do-fresh-lines*) *backtrace-do-fresh-lines*) (conflate *backtrace-do-conflate*) (length *backtrace-length*) - print-frames) + ((:print-frames *backtrace-print-frames*) *backtrace-print-frames*)) (let ((*standard-output* *debug-io*) (*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) as funobj = (stack-frame-funobj stack-frame t) - do (flet ((print-leadin (count conflate-count) + do (flet ((print-leadin (stack-frame count conflate-count) (when *backtrace-do-fresh-lines* (fresh-line)) (cond @@ -463,8 +465,8 @@ (write-string "=")) (write-char #\space)) (t (format t "~& |= "))) - (when print-frames - (format t "#x~X " stack-frame)))) + (when *backtrace-print-frames* + (format t "#x~X " stack-frame)))) (typecase funobj (integer (let* ((int-frame funobj) @@ -476,7 +478,7 @@ (incf conflate-count) (progn (incf count) - (print-leadin count conflate-count) + (print-leadin stack-frame count conflate-count) (setf conflate-count 0) (let ((exception (int-frame-ref int-frame :exception :unsigned-byte32)) (eip (int-frame-ref int-frame :eip :unsigned-byte32))) @@ -504,7 +506,7 @@ (< count length)) (write-string " ...") (return)) - (print-leadin count conflate-count) + (print-leadin stack-frame count conflate-count) (setf conflate-count 0) (write-char #() (let* ((numargs (stack-frame-numargs stack-frame))