Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv16653

Modified Files: procfs-image.lisp Log Message: Some backtrace tweaks.

Date: Sun Apr 24 22:36:44 2005 Author: ffjeld

Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.22 movitz/procfs-image.lisp:1.23 --- movitz/procfs-image.lisp:1.22 Tue Jan 4 17:56:44 2005 +++ movitz/procfs-image.lisp Sun Apr 24 22:36:44 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.22 2005/01/04 16:56:44 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.23 2005/04/24 20:36:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -165,7 +165,8 @@ (get-word stack-frame))

(defun stack-frame-funobj (stack-frame) - (when (zerop (ldb (byte 2 0) stack-frame)) + (when (and (plusp stack-frame) + (zerop (ldb (byte 2 0) stack-frame))) (let ((x (movitz-word (get-word (- stack-frame 4))))) (and (typep x 'movitz-funobj) x))))

@@ -196,6 +197,7 @@ (image-register32 *image* :esi)) (let ((*print-length* 20)) (loop for stack-frame = (current-stack-frame) then (previous-stack-frame stack-frame) + while (plusp stack-frame) unless (zerop (mod stack-frame 4)) do (format t "[frame #x~8,'0x]" stack-frame) (loop-finish) @@ -228,7 +230,9 @@ (debug-get-object (get-word (+ stack-frame -12)) spartan))) (when print-returns (format t " (#x~X)" (stack-frame-return-address stack-frame))))) - (t (write (movitz-print movitz-name))))) + (t (when print-frames + (format t "~S " (truncate stack-frame 4))) + (write (movitz-print movitz-name))))) do (format t "~& => "))) (values))