[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

2 Feb 2005

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)

    