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(a)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)