From: Nikodemus S. <de...@us...> - 2008-09-17 15:32:03
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv15170/tests Modified Files: compare-and-swap.impure.lisp Log Message: 1.0.20.8: ATOMIC-INCF implementation * Modular arithmetic on word-sized unsigned structure slots. * Uses XADD on x86 and x86-64, a simple lisp-level implementation elsewhere. Index: compare-and-swap.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compare-and-swap.impure.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- compare-and-swap.impure.lisp 17 Sep 2008 20:24:22 -0000 1.2 +++ compare-and-swap.impure.lisp 17 Sep 2008 22:31:59 -0000 1.3 @@ -104,3 +104,36 @@ (handler-case (sb-ext:compare-and-swap (symbol-value name) t 42) (error () :error))))) + +;;;; ATOMIC-INCF (we should probably rename this file atomic-ops...) + +(defstruct box + (word 0 :type sb-vm:word)) + +(defun inc-box (box n) + (declare (fixnum n) (box box)) + (loop repeat n + do (sb-ext:atomic-incf (box-word box)))) + +(defun dec-box (box n) + (declare (fixnum n) (box box)) + (loop repeat n + do (sb-ext:atomic-incf (box-word box) -1))) + +(let ((box (make-box))) + (inc-box box 10000) + (assert (= 10000 (box-word box))) + (dec-box box 10000) + (assert (= 0 (box-word box)))) + +#+sb-thread +(let* ((box (make-box)) + (threads (loop repeat 64 + collect (sb-thread:make-thread (lambda () + (inc-box box 1000) + (dec-box box 10000) + (inc-box box 10000) + (dec-box box 1000)) + :name "inc/dec thread")))) + (mapc #'sb-thread:join-thread threads) + (assert (= 0 (box-word box)))) |