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

21 Sep 2004

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv17883
Modified Files:
    bignums.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:46 2004
Author: ffjeld
Index: movitz/losp/muerte/bignums.lisp
diff -u movitz/losp/muerte/bignums.lisp:1.7 movitz/losp/muerte/bignums.lisp:1.8

--- movitz/losp/muerte/bignums.lisp:1.7	Wed Sep 15 12:22:59 2004
+++ movitz/losp/muerte/bignums.lisp	Tue Sep 21 15:06:45 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld frodef@acm.org
 ;;;; Created at:    Sat Jul 17 19:42:57 2004
 ;;;;                
-;;;; $Id: bignums.lisp,v 1.7 2004/09/15 10:22:59 ffjeld Exp $
+;;;; $Id: bignums.lisp,v 1.8 2004/09/21 13:06:45 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -102,8 +102,7 @@
   (check-type delta fixnum)
   (macrolet
       ((do-it ()
-	 `(with-inline-assembly (:returns :eax :labels (retry-not-size1
-							not-size1
+	 `(with-inline-assembly (:returns :eax :labels (not-size1
    						copy-bignum-loop
    						add-bignum-loop
    						add-bignum-done
@@ -111,25 +110,33 @@
    						pfix-pbig-done))
        (:compile-two-forms (:eax :ebx) bignum delta)
        (:testl :ebx :ebx)
-	    (:jz 'pfix-pbig-done)
+	    (:jz 'pfix-pbig-done)	; EBX=0 => nothing to do.
        (:movzxw (:eax (:offset movitz-bignum length)) :ecx)
        (:cmpl ,movitz:+movitz-fixnum-factor+ :ecx)
        (:jne 'not-size1)
        (:compile-form (:result-mode :ecx) delta)
        (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
        (:addl (:eax (:offset movitz-bignum bigit0)) :ecx)
-	    (:jc 'retry-not-size1)
+	    (:jc 'not-size1)
        (:call-local-pf box-u32-ecx)
        (:jmp 'pfix-pbig-done)
-	   retry-not-size1
+
+	   not-size1
+	    ;; Set up atomically continuation.
+	    (:declare-label-set restart-jumper (restart-addition))
+	    (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+	    (:pushl 'restart-jumper)
+	    ;; ..this allows us to detect recursive atomicallies.
+	    (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+	    (:pushl :ebp)
+	   restart-addition
+
+	    (:movl (:esp) :ebp)
        (:compile-form (:result-mode :eax) bignum)
        (:movzxw (:eax (:offset movitz-bignum length)) :ecx)
-	   not-size1
-	    (:declare-label-set retry-jumper (retry-not-size1))
-	    (: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))))
+
+	    (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+	    ;; Now inside atomically section.
        (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+))
    	   :eax)		; Number of words
        (:call-local-pf get-cons-pointer)
@@ -162,9 +169,10 @@
        (:addl ,movitz:+movitz-fixnum-factor+ :ecx)
       no-expansion
        (:call-local-pf cons-commit)
-	    (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
-			     (:edi (:edi-offset atomically-status))))
-		   
+	    ;; Exit atomically block.
+	    (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+	    (:leal (:esp 16) :esp)
+	    
       pfix-pbig-done)))
     (do-it)))

    