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

[Frode Vatvedt Fjeld]

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

Modified Files:
	interrupt.lisp 
Log Message:
Fixed dit-frame-casf according to the (newish) stack discipline.

Date: Fri Jan 28 00:49:07 2005
Author: ffjeld

Index: movitz/losp/muerte/interrupt.lisp
diff -u movitz/losp/muerte/interrupt.lisp:1.36 movitz/losp/muerte/interrupt.lisp:1.37
--- movitz/losp/muerte/interrupt.lisp:1.36	Tue Jan 25 05:50:16 2005
+++ movitz/losp/muerte/interrupt.lisp	Fri Jan 28 00:49:07 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Apr  7 01:50:03 2004
 ;;;;                
-;;;; $Id: interrupt.lisp,v 1.36 2005/01/25 13:50:16 ffjeld Exp $
+;;;; $Id: interrupt.lisp,v 1.37 2005/01/28 08:49:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -82,20 +82,17 @@
   (let ((ebp (dit-frame-ref stack dit-frame :ebp))
 	(esp (dit-frame-esp stack dit-frame)))
     (cond
-     ((null ebp)			; special mode
+     ((null ebp)			; special dynamic control-transfer mode
       (stack-frame-ref stack (dit-frame-ref stack dit-frame :dynamic-env) 0))
      ((< esp ebp)
       ebp)
-     ((> esp ebp)
-      ;; A throw situation
+     ((eq esp ebp)
       (let ((next-ebp (stack-frame-ref stack esp 0)))
 	(check-type next-ebp fixnum)
 	(assert (< esp next-ebp))
 	next-ebp))
-     (t (let ((next-ebp (stack-frame-ref stack esp 0)))
-	  (check-type next-ebp fixnum)
-	  (assert (< esp next-ebp))
-	  next-ebp)))))
+     (t (error "Undefined CASF for dit-frame ~S with EBP #x~X and ESP #x~X."
+	       dit-frame ebp esp)))))
 
 (define-primitive-function (default-interrupt-trampoline :symtab-property t) ()
   "Default first-stage/trampoline interrupt handler. Assumes the IF flag in EFLAGS