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

[Frode Vatvedt Fjeld]

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

Modified Files:
	basic-macros.lisp 
Log Message:
Re-worked the atomically protocol. There is now one run-time-context
field, atomically-continuation, whose semantics is slightly different
from the old atomically-status and atomically-esp.

Date: Tue Sep 21 15:06:28 2004
Author: ffjeld

Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.39 movitz/losp/muerte/basic-macros.lisp:1.40
--- movitz/losp/muerte/basic-macros.lisp:1.39	Wed Sep 15 12:22:59 2004
+++ movitz/losp/muerte/basic-macros.lisp	Tue Sep 21 15:06:27 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: basic-macros.lisp,v 1.39 2004/09/15 10:22:59 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.40 2004/09/21 13:06:27 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1077,19 +1077,24 @@
     `(let ((,size-var ,size-form))
        (with-inline-assembly (:returns :eax :labels (retry-alloc retry-jumper , at labels))
 	 (:declare-label-set retry-jumper (retry-alloc))
+	 ;; Set up atomically continuation.
+	 (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+	 (:pushl 'retry-jumper)
+	 ;; ..this allows us to detect recursive atomicallies.
+	 (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+	 (:pushl :ebp)
 	retry-alloc
-	 (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
-	 (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
-			    'retry-jumper)
-			  (:edi (:edi-offset atomically-status))))
+	 (:movl (:esp) :ebp)
 	 (:load-lexical (:lexical-binding ,size-var) :eax)
+	 (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+	 ;; Now inside atomically section.
 	 (:call-local-pf get-cons-pointer)
 	 , at code
 	 ,@(when fixed-size-p
 	     `((:load-lexical (:lexical-binding ,size-var) :ecx)))
 	 (:call-local-pf cons-commit)
-	 (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
-			  (:edi (:edi-offset atomically-status))))))))
+	 (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+	 (:leal (:esp 16) :esp)))))
 
 (defmacro with-non-pointer-allocation-assembly
     ((size-form &key object-register size-register fixed-size-p labels) &body code)
@@ -1099,19 +1104,24 @@
     `(let ((,size-var ,size-form))
        (with-inline-assembly (:returns :eax :labels (retry-alloc retry-jumper , at labels))
 	 (:declare-label-set retry-jumper (retry-alloc))
+	 ;; Set up atomically continuation.
+	 (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+	 (:pushl 'retry-jumper)
+	 ;; ..this allows us to detect recursive atomicallies.
+	 (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+	 (:pushl :ebp)
 	retry-alloc
-	 (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
-	 (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
-			    'retry-jumper)
-			  (:edi (:edi-offset atomically-status))))
+	 (:movl (:esp) :ebp)
 	 (:load-lexical (:lexical-binding ,size-var) :eax)
+	 (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+	 ;; Now inside atomically section.
 	 (:call-local-pf get-cons-pointer-non-pointer)
 	 , at code
 	 ,@(when fixed-size-p
 	     `((:load-lexical (:lexical-binding ,size-var) :ecx)))
-	 (:call-local-pf cons-commit-non-pointer)
-	 (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
-			  (:edi (:edi-offset atomically-status))))))))
+	 (:call-local-pf cons-commit)
+	 (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+	 (:leal (:esp 16) :esp)))))
 
 (require :muerte/setf)