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@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."