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

[Frode Vatvedt Fjeld]

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

Modified Files:
	procfs-image.lisp 
Log Message:
Add a *print-lengt* value in procfs backtrace.

Date: Mon Aug 23 06:46:19 2004
Author: ffjeld

Index: movitz/procfs-image.lisp
diff -u movitz/procfs-image.lisp:1.16 movitz/procfs-image.lisp:1.17
--- movitz/procfs-image.lisp:1.16	Mon Aug 16 01:25:28 2004
+++ movitz/procfs-image.lisp	Mon Aug 23 06:46:18 2004
@@ -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.16 2004/08/16 08:25:28 ffjeld Exp $
+;;;; $Id: procfs-image.lisp,v 1.17 2004/08/23 13:46:18 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -187,39 +187,40 @@
   ;; (search-image-funobj (image-register32 *image* :eip))
   (format t "~&Current ESI: #x~X.~%"
 	  (image-register32 *image* :esi))
-  (loop for stack-frame = (current-stack-frame) then (previous-stack-frame stack-frame)
-      unless (zerop (mod stack-frame 4))
-      do (format t "[frame #x~8,'0x]" stack-frame)
-	 (loop-finish)
-      do (let ((movitz-name (funobj-name (stack-frame-funobj stack-frame))))
-	   (typecase movitz-name
-	     (null
-	      (write-string "?")
-	      (let* ((eax (get-word (+ (* 4 (interrupt-frame-index :eax)) stack-frame)))
-		     (ecx (get-word (+ (* 4 (interrupt-frame-index :ecx)) stack-frame)))
-		     (edx (get-word (+ (* 4 (interrupt-frame-index :edx)) stack-frame)))
-		     (edi (get-word (+ (* 4 (interrupt-frame-index :edi)) stack-frame)))
-		     (eip (get-word (+ (* 4 (interrupt-frame-index :eip)) stack-frame)))
-		     (esi (get-word (+ (* 4 (interrupt-frame-index :esi)) stack-frame)))
-		     (exception (get-word (+ (* 4 (interrupt-frame-index :exception)) stack-frame))))
-		(format t "#x~X {EAX: #x~X, ECX: #x~X, EDX: #x~X, EDI: #x~X, ESI: #x~X, EIP: #x~X, exception ~D}"
-			stack-frame
-			eax ecx edx edi esi eip exception)))
-	     (movitz-symbol
-	      (let ((name (movitz-print movitz-name)))
-		(when print-frames
-		  (format t "~S " stack-frame))
-		(when (string= name 'toplevel-function)
-		  (loop-finish))
-		(when reqs
-		  (format t "(~A ~S ~S)"
-			  (symbol-name name)
-			  (debug-get-object (get-word (+ stack-frame -8)) spartan)
-			  (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)))))
-      do (format t "~& => "))
+  (let ((*print-length* 20))
+    (loop for stack-frame = (current-stack-frame) then (previous-stack-frame stack-frame)
+	unless (zerop (mod stack-frame 4))
+	do (format t "[frame #x~8,'0x]" stack-frame)
+	   (loop-finish)
+	do (let ((movitz-name (funobj-name (stack-frame-funobj stack-frame))))
+	     (typecase movitz-name
+	       (null
+		(write-string "?")
+		(let* ((eax (get-word (+ (* 4 (interrupt-frame-index :eax)) stack-frame)))
+		       (ecx (get-word (+ (* 4 (interrupt-frame-index :ecx)) stack-frame)))
+		       (edx (get-word (+ (* 4 (interrupt-frame-index :edx)) stack-frame)))
+		       (edi (get-word (+ (* 4 (interrupt-frame-index :edi)) stack-frame)))
+		       (eip (get-word (+ (* 4 (interrupt-frame-index :eip)) stack-frame)))
+		       (esi (get-word (+ (* 4 (interrupt-frame-index :esi)) stack-frame)))
+		       (exception (get-word (+ (* 4 (interrupt-frame-index :exception)) stack-frame))))
+		  (format t "#x~X {EAX: #x~X, ECX: #x~X, EDX: #x~X, EDI: #x~X, ESI: #x~X, EIP: #x~X, exception ~D}"
+			  stack-frame
+			  eax ecx edx edi esi eip exception)))
+	       (movitz-symbol
+		(let ((name (movitz-print movitz-name)))
+		  (when print-frames
+		    (format t "~S " stack-frame))
+		  (when (string= name 'toplevel-function)
+		    (loop-finish))
+		  (when reqs
+		    (format t "(~A ~S ~S)"
+			    (symbol-name name)
+			    (debug-get-object (get-word (+ stack-frame -8)) spartan)
+			    (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)))))
+	do (format t "~& => ")))
   (values))
 
 (defun funobj-name (x)