[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-serv24399

Modified Files:
	interrupt.lisp 
Log Message:
Various tweaks. Removed the stack-top and stack-bottom operators; use
the %run-time-context-slot accessor instead.

Date: Thu Sep  2 11:45:27 2004
Author: ffjeld

Index: movitz/losp/muerte/interrupt.lisp
diff -u movitz/losp/muerte/interrupt.lisp:1.21 movitz/losp/muerte/interrupt.lisp:1.22
--- movitz/losp/muerte/interrupt.lisp:1.21	Thu Aug 19 00:37:56 2004
+++ movitz/losp/muerte/interrupt.lisp	Thu Sep  2 11:45:26 2004
@@ -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.21 2004/08/18 22:37:56 ffjeld Exp $
+;;;; $Id: interrupt.lisp,v 1.22 2004/09/02 09:45:26 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -118,8 +118,8 @@
 	    (:call (:pc+ 0))		; push EIP.
 	    ;; Now add a few bytes to the on-stack EIP so the iret goes to
 	    ;; *DEST* below.
-	    ((4) :addl 5 (:esp))	; 4 bytes
-	    ((1) :iretd)		; 1 byte
+	    (((:size 4)) :addl 5 (:esp)) ; 4 bytes
+	    (((:size 1)) :iretd)	; 1 byte
     
 	    ;; *DEST* iret branches to here.
 	    ;; we're now in the context of the interruptee.
@@ -321,11 +321,12 @@
 		(with-inline-assembly (:returns :nothing) (:nop))))
 	  (70 (error "Unaligned memref access."))
 	  ((5 55)
-	   (let* ((old-bottom (prog1 (stack-bottom)
-				(setf (stack-bottom) 0)))
+	   (let* ((old-bottom (prog1 (%run-time-context-slot 'stack-bottom)
+				(setf (%run-time-context-slot 'stack-bottom) 0)))
 		  (stack (%run-time-context-slot 'movitz::stack-vector))
 		  (real-bottom (- (object-location stack) 2))
 		  (stack-left (- old-bottom real-bottom))
+		  (old-dynamic-env (%run-time-context-slot 'dynamic-env))
 		  (new-bottom (cond
 			       ((< stack-left 10)
 				(princ "Halting CPU due to stack exhaustion.")
@@ -334,20 +335,23 @@
 				(format *debug-io*
 					"~&This is your LAST chance to pop off stack.~%")
 				real-bottom)
-			       (t (+ real-bottom (truncate stack-left 2)))))) ; Cushion the fall..
+			       (t (+ real-bottom (truncate stack-left 4)))))) ; Cushion the fall..
 	     (unwind-protect
 		 (progn
-		   (setf (stack-bottom) new-bottom)
-		   (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X.~%"
+		   (setf (%run-time-context-slot 'stack-bottom) new-bottom
+			 (%run-time-context-slot 'dynamic-env) 0)
+		   (format *debug-io* "~&Stack-warning: Bumped stack-bottom by ~D to #x~X. Reset ENV.~%"
 			   (- old-bottom new-bottom)
 			   new-bottom)
-		   (break "Stack overload exception ~D at EIP=~@Z, ESI=~@Z, ESP=~@Z, bottom=#x~X."
-			  vector $eip $esi
-			  (+ dit-frame (dit-frame-index :ebp))
-			  old-bottom))
+		   (break "Stack overload exception ~D at EIP=~@Z, ESP=~@Z, bottom=#x~X, ENV=#x~X."
+			  vector $eip
+			  (dit-frame-esp dit-frame)
+			  old-bottom
+			  old-dynamic-env))
 	       (format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%"
 		       old-bottom)
-	       (setf (stack-bottom) old-bottom))))
+	       (setf (%run-time-context-slot 'stack-bottom) old-bottom
+		     (%run-time-context-slot 'dynamic-env) old-dynamic-env))))
 	  (69
 	   (error "Not a function: ~S" (dereference $edx)))
 	  (70