[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-serv7579/losp/x86-pc

Modified Files:
	debugger.lisp 
Log Message:
many cleanup regarding stack and register discipline.
Date: Wed Sep 15 12:23:12 2004
Author: ffjeld

Index: movitz/losp/x86-pc/debugger.lisp
diff -u movitz/losp/x86-pc/debugger.lisp:1.23 movitz/losp/x86-pc/debugger.lisp:1.24
--- movitz/losp/x86-pc/debugger.lisp:1.23	Thu Sep  2 11:41:18 2004
+++ movitz/losp/x86-pc/debugger.lisp	Wed Sep 15 12:23:09 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.23 2004/09/02 09:41:18 ffjeld Exp $
+;;;; $Id: debugger.lisp,v 1.24 2004/09/15 10:23:09 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -118,6 +118,8 @@
       (0 . (#xb1 #x00 #xff #x56		; movb 0 :cl
 	    #.(cl:ldb (cl:byte 8 0)
 	       (bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector))))
+      (2 . (#xff #x57
+	    #.(movitz:global-constant-offset 'fast-compare-two-reals)))
       (:ecx . (#xff #x56 #.(cl:ldb (cl:byte 8 0)
 			    (bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector))))))
 
@@ -227,6 +229,7 @@
 		(:* 1 ((:or (#xb1 (:cl-numargs))))) ; (:movb x :cl)
 		(:* 1 ((:or (#x8b #x55 (:edx :ebp))
 			    (#x8b #x56 (:edx :esi)))))
+		(:* 4 (#x90))		; (:nop)
 		#xff #x56 (:code-vector)))) ; (:call (:esi x))
       ;; APPLY 3 args
       ((20 20 . (#x8b #x5d (:ebx :ebp)	; #<asm MOVL [#x-c+%EBP] => %EBX>
@@ -455,15 +458,17 @@
 	(*standard-output* *debug-io*)
 	(*print-length* *backtrace-print-length*)
 	(*print-level* *backtrace-print-level*))
-    (loop with conflate-count = 0 with count = 0
+    (loop with conflate-count = 0 with count = 0 with next-frame = nil
 	for frame = initial-stack-frame-index
-	then (let ((uplink (stack-frame-uplink stack frame)))
-	       (assert (> uplink frame) ()
-		 "Backtracing uplink ~S from frame index ~S." uplink frame)
-	       uplink)
+	then (or next-frame
+		 (let ((uplink (stack-frame-uplink stack frame)))
+		   (assert (> uplink frame) ()
+		     "Backtracing uplink ~S from frame index ~S." uplink frame)
+		   uplink))
 	     ;; as xxx = (warn "frame: ~S" frame)
 	as funobj = (stack-frame-funobj stack frame)
-	do (flet ((print-leadin (stack frame count conflate-count)
+	do (setf next-frame nil)
+	   (flet ((print-leadin (stack frame count conflate-count)
 		    (when *backtrace-do-fresh-lines*
 		      (fresh-line))
 		    (cond
@@ -480,8 +485,9 @@
 		      (format t "#x~X " frame))))
 	     (typecase funobj
 	       ((eql 0)
-		(let* ((dit-frame (if (null stack) frame (+ frame 2 (object-location stack))))
-		       (funobj (dit-frame-ref :esi :lisp 0 dit-frame)))
+		(let* (#+ignore (dit-frame (if (null stack) frame (+ frame 2 (object-location stack))))
+		       (funobj (dit-frame-ref stack frame :esi)))
+		  (setf next-frame (dit-frame-casf stack frame))
 		  (if (and conflate-interrupts conflate
 			   ;; When the interrupted function has a stack-frame, conflate it.
 			   (typep funobj 'function)
@@ -491,10 +497,8 @@
 		      (incf count)
 		      (print-leadin stack frame count conflate-count)
 		      (setf conflate-count 0)
-		      (let ((exception (dit-frame-ref :exception-vector :unsigned-byte32
-						      0 dit-frame))
-			    (eip (dit-frame-ref :eip :unsigned-byte32
-						      0 dit-frame)))
+		      (let ((exception (dit-frame-ref stack frame :exception-vector :unsigned-byte32))
+			    (eip (dit-frame-ref stack frame :eip :unsigned-byte32)))
 			(typecase funobj
 			  (function
 			   (let ((delta (code-vector-offset (funobj-code-vector funobj) eip)))
@@ -546,6 +550,7 @@
 				 (string= name 'toplevel-function))
 			(write-char #\.)
 			(return))))))
-	       (t (format t "~&?: ~Z" funobj))))))
+	       (t (print-leadin stack frame count conflate-count)
+		  (format t "?: ~Z" funobj))))))		  
   (values))