[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	los0-gc.lisp 
Log Message:
Added concept of "thread-atomical" code, which allows some small
section of code to run atomically with respect to the same thread
(i.e. should the thread be interrupted for whatever reason).
"Atomically" is here used in the sense all-or-nothing. Such
code-blocks can still be interrupted, but if so, it will be re-started
from some declared starting-point.

Date: Tue Jun  1 06:42:14 2004
Author: ffjeld

Index: movitz/losp/los0-gc.lisp
diff -u movitz/losp/los0-gc.lisp:1.12 movitz/losp/los0-gc.lisp:1.13
--- movitz/losp/los0-gc.lisp:1.12	Mon May 24 12:32:46 2004
+++ movitz/losp/los0-gc.lisp	Tue Jun  1 06:42:14 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sat Feb 21 17:48:32 2004
 ;;;;                
-;;;; $Id: los0-gc.lisp,v 1.12 2004/05/24 19:32:46 ffjeld Exp $
+;;;; $Id: los0-gc.lisp,v 1.13 2004/06/01 13:42:14 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -56,21 +56,33 @@
 
 (define-primitive-function los0-fast-cons ()
   "Allocate a cons cell from nursery-space."
-  (with-inline-assembly (:returns :eax)
-   retry-cons
-    (:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
-    (:movl (:edx 2) :ecx)
-    (:cmpl #x3fff4 :ecx)
-    (:jge '(:sub-program ()
-	    (:int 113)
-	    ;; This interrupt can be retried.
-	    (:jmp 'retry-cons)))
-    (:movl :eax (:edx :ecx 2))
-    (:movl :ebx (:edx :ecx 6))
-    (:leal (:edx :ecx 3) :eax)
-    (:addl 8 :ecx)
-    (:movl :ecx (:edx 2))
-    (:ret)))
+  (macrolet
+      ((do-it ()
+	 `(with-inline-assembly (:returns :eax)
+	   retry-cons
+	    ;; Set up thread-atomical execution
+	    (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons)
+			     (:edi (:edi-offset atomically-status))))
+	    (:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
+	    (:movl (:edx 2) :ecx)
+	    (:cmpl #x3fff4 :ecx)
+	    (:jge '(:sub-program (allocation-failed)
+		    ;; Exit thread-atomical
+;;;		    (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
+;;;			       (:edi (:edi-offset atomically-status))))
+		    (:int 113)
+		    ;; This interrupt can be retried.
+		    (:jmp 'retry-cons)))
+	    (:movl :eax (:edx :ecx 2))
+	    (:movl :ebx (:edx :ecx 6))
+	    (:addl 8 :ecx)
+	    (:movl :ecx (:edx 2))	; Commit allocation
+	    ;; Exit thread-atomical
+	    (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
+			     (:edi (:edi-offset atomically-status))))
+	    (:leal (:edx :ecx -5) :eax)
+	    (:ret))))
+    (do-it)))
 
 (define-primitive-function los0-box-u32-ecx ()
   "Make u32 in ECX into a fixnum or bignum."