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

Modified Files: interrupt.lisp Log Message: Changed dit-frame-casf to support atomically mode. Fixed small bug in dit-frame-ref.

Date: Wed Feb 2 11:48:49 2005 Author: ffjeld

Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.38 movitz/losp/muerte/interrupt.lisp:1.39 --- movitz/losp/muerte/interrupt.lisp:1.38 Wed Feb 2 08:50:25 2005 +++ movitz/losp/muerte/interrupt.lisp Wed Feb 2 11:48:49 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.38 2005/02/02 07:50:25 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.39 2005/02/02 10:48:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -64,7 +64,7 @@ `(memref ,frame (dit-frame-offset ,reg) :type ,type)))

(defun dit-frame-ref (stack frame reg &optional (type :lisp)) - (stack-frame-ref stack frame (dit-frame-index reg) type)) + (stack-frame-ref stack (+ frame (dit-frame-index reg)) 0 type))

(define-compiler-macro (setf dit-frame-ref) (&whole form value stack frame reg &optional (type :lisp) @@ -74,14 +74,15 @@ form `(setf (memref ,frame (dit-frame-offset ,reg) :type ,type) ,value)))

-;;;(defun (setf dit-frame-ref) (x reg type &optional (frame *last-dit-frame*)) -;;; (setf (memref frame (dit-frame-offset reg) 0 type) x)) - (defun dit-frame-casf (stack dit-frame) "Compute the `currently active stack-frame' when the interrupt occurred." - (let ((ebp (dit-frame-ref stack dit-frame :ebp)) + (let ((atomically-location (dit-frame-ref stack dit-frame :atomically-continuation :location)) + (ebp (dit-frame-ref stack dit-frame :ebp)) (esp (dit-frame-esp stack dit-frame))) (cond + ((and (not (= 0 atomically-location)) + (= 0 (ldb (byte 2 0) (dit-frame-ref stack dit-frame :atomically-continuation :unsigned-byte8)))) + (stack-frame-ref stack atomically-location 0)) ((null ebp) ; special dynamic control-transfer mode (stack-frame-ref stack (dit-frame-ref stack dit-frame :dynamic-env) 0)) ((< esp ebp)