[movitz-cvs] CVS update: movitz/procfs-image.lisp

[Frode Vatvedt Fjeld]

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 at 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))