[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	inspect.lisp 
Log Message:
Fixed keyword typo.

Date: Mon Aug 30 17:16:59 2004
Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp
diff -u movitz/losp/muerte/inspect.lisp:1.35 movitz/losp/muerte/inspect.lisp:1.36
--- movitz/losp/muerte/inspect.lisp:1.35	Mon Aug 23 15:58:25 2004
+++ movitz/losp/muerte/inspect.lisp	Mon Aug 30 17:16:59 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 24 09:50:41 2003
 ;;;;                
-;;;; $Id: inspect.lisp,v 1.35 2004/08/23 13:58:25 ffjeld Exp $
+;;;; $Id: inspect.lisp,v 1.36 2004/08/30 15:16:59 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -84,14 +84,14 @@
    (t (memref frame 0 index type))))
 
 (defun current-dynamic-context ()
-  (with-inline-assembly (:returns :untagged-fixnum-ecx)
-    (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx))))
+  (with-inline-assembly (:returns :eax)
+    (:locally (:movl (:edi (:edi-offset dynamic-env)) :eax))))
 
 (defun dynamic-context-uplink (dynamic-context)
-  (stack-ref dynamic-context 12 0 :unsigned-byte32))
+  (stack-frame-ref nil dynamic-context 3 :lisp))
 
 (defun dynamic-context-tag (dynamic-context)
-  (stack-ref dynamic-context 4 0 :lisp))
+  (stack-frame-ref nil dynamic-context 1 :lisp))
 
 (defmacro with-each-dynamic-context ((&optional start-context result) &rest clauses)
   "Only use this if you know what you're doing. See run-time.lisp."
@@ -103,15 +103,15 @@
 	(basic-restart-clause (find :basic-restart clauses :key #'caar)))
     `(do ((,context ,(if start-context start-context '(current-dynamic-context))
 		    (dynamic-context-uplink ,context)))
-	 ((not (stack-ref-p ,context)) ,result)
+	 ((not (plusp ,context)) ,result)
        (let ((,tag (dynamic-context-tag ,context)))
 	 (cond
 	  ,@(when bind-clause
 	      `(((eq ,tag (load-global-constant unbound-value))
 		 (multiple-value-bind ,(cdar bind-clause)
 		     (values ,context
-			     (stack-ref ,context 0 0 :lisp)
-			     (stack-ref ,context 8 0 :lisp))
+			     (stack-frame-ref nil ,context 0 :lisp)
+			     (stack-frame-ref nil ,context 2 :lisp))
 		   ,@(rest bind-clause)))))
 	  ,@(when up-clause
 	      `(((eq ,tag (load-global-constant unwind-protect-tag))
@@ -120,14 +120,14 @@
 		   ,@(rest up-clause)))))
 	  ,@(when basic-restart-clause
 	      `(((eq ,tag (load-global-constant restart-tag))
-		 (macrolet ((rc-function (c) `(stack-ref ,c 0 -2 :lisp))
-			    (rc-interactive (c) `(stack-ref ,c 0 -3 :lisp))
-			    (rc-test (c) `(stack-ref ,c 0 -4 :lisp))
-			    (rc-format (c) `(stack-ref ,c 0 -5 :lisp))
-			    (rc-args (c) `(stack-ref ,c 0 -6 :lisp)))
+		 (macrolet ((rc-function (c) `(stack-frame-ref nil ,c -2 :lisp))
+			    (rc-interactive (c) `(stack-frame-ref nil ,c -3 :lisp))
+			    (rc-test (c) `(stack-frame-ref nil ,c -4 :lisp))
+			    (rc-format (c) `(stack-frame-ref nil ,c -5 :lisp))
+			    (rc-args (c) `(stack-frame-ref nil ,c -6 :lisp)))
 		   (multiple-value-bind ,(cdar basic-restart-clause)
 		       (values ,@(subseq `(,context
-					   (stack-ref ,context 0 -1 :lisp)) ; name
+					   (stack-frame-ref nil ,context -1 :lisp)) ; name
 					 0 (length (cdar basic-restart-clause))))
 		     ,@(rest basic-restart-clause))))))
 	  ,@(when catch-clause
@@ -135,13 +135,12 @@
 		       (values ,context ,tag)
 		     ,@(rest catch-clause))))))))))
 
-#+ignore
 (defun pdc (&rest types)
   (declare (dynamic-extent types))
   (let ((types (or types '(:restarts :bindings :catch))))
     (with-each-dynamic-context ()
       ((:basic-restart context name)
-       (when (member :restart types)
+       (when (member :restarts types)
 	 (format t "~&restart: ~S fmt: ~S/~S [#x~X]" name
 		 (rc-format context)
 		 (rc-args context)