[cl-stm-devel] Example code

[Hoan Ton-That]

Hey again,

Here is a little example of CL-STM in action.

;; This is just like `defclass', but the slots are transactional.
;; Reading and writing will be done to the transaction log, to be
;; commited later.
STM> (deftransactional-class counter ()
       ((count :accessor count-of
	       :initarg :count
	       :initform 0)))
COUNTER
STM> (defvar *counter* (new 'counter))
#<COUNTER #x8687EDE>
;; Notice, that the slot value is actually a transactional variable.
STM> (count-of *counter*)
#<STANDARD-TVAR #x8687C6E>
;; This is the real value of it, which corresponds to the initform.
STM> (value-of (count-of *counter*))
0
;; `deftransaction' is just like `defun', but when passed arguments,
;; it returns a transaction to be executed by atomic.
STM> (deftransaction increment (counter)
       (incf (count-of counter)))
INCREMENT
;; Here is the transaction.  Transactions can be composed sequentially
;; and alternatively.
STM> (increment *counter*)
#<STANDARD-TRANSACTION #x85ED356>
;; But, we'll just run it for now in a separate thread.
STM> (atomic (increment *counter*))
#<PROCESS Anonymous(11) [Active] #x86070CE>
;; When commiting, we try to lock each transactional variable.  Then
;; we check to see if the variables read in the transaction are the
;; same as the real ones.  Then we update the real value.  Any threads
;; that are waiting for the variable to change are woken up.
;; Regardless of what happens, the acquired locks are always released.
--TIME MARK 2006-06-14--
17:34 STM-LOGGER/+DRIBBLE+: Committing transaction
17:34 STM-LOGGER/+DRIBBLE+: Acquired lock #<RECURSIVE-LOCK [ptr @
#x302700] #x85A84EE>
17:34 STM-LOGGER/+DRIBBLE+: Version 0 is valid
17:34 STM-LOGGER/+DRIBBLE+: Value updated to 1
17:34 STM-LOGGER/+DRIBBLE+: Version updated to 1
17:34 STM-LOGGER/+DRIBBLE+: Notified threads waiting on
#<STANDARD-TVAR #x85A8526>
17:34 STM-LOGGER/+DRIBBLE+: Transaction log committed
17:34 STM-LOGGER/+DRIBBLE+: Released lock #<RECURSIVE-LOCK [ptr @
#x302700] #x85A84EE>
;; We'll acquire the lock of the variable
STM> (acquire-lock (lock-of (count-of *counter*)))
T
;; And we'll run the transaction again.  This time you can see that
;; the lock couldn't be acquired and so the transaction wasn't
;; committed.  However, the thread is still running, waiting for the
;; variable to change and have another go committing.
STM> (atomic (increment *counter*))
#<PROCESS Anonymous(12) [Active] #x860031E>
17:34 STM-LOGGER/+DRIBBLE+: Committing transaction
17:34 STM-LOGGER/+DRIBBLE+: Couldn't acquire lock #<RECURSIVE-LOCK
[ptr @ #x302700] #x85A84EE>
17:34 STM-LOGGER/+DRIBBLE+: Transaction log not commited
;; Now we release the lock
STM> (release-lock (lock-of (count-of *counter*)))
NIL
;; These are the current transaction logs waiting for the
;; variable/slot `count'.
STM> (waiting-for (count-of *counter*))
(#<STANDARD-TLOG #x86005A6>)
;; Now we wake them up!  As you can see the previous transaction that
;; failed is rerun again, and this time it succeeds!
STM> (mapc #'unwait (waiting-for (count-of *counter*)))
(#<STANDARD-TLOG #x86005A6>)
17:34 STM-LOGGER/+DRIBBLE+: Committing transaction
17:34 STM-LOGGER/+DRIBBLE+: Acquired lock #<RECURSIVE-LOCK [ptr @
#x302700] #x85A84EE>
17:34 STM-LOGGER/+DRIBBLE+: Version 1 is valid
17:34 STM-LOGGER/+DRIBBLE+: Value updated to 2
17:34 STM-LOGGER/+DRIBBLE+: Version updated to 2
17:34 STM-LOGGER/+DRIBBLE+: Notified threads waiting on
#<STANDARD-TVAR #x85A8526>
17:34 STM-LOGGER/+DRIBBLE+: Transaction log committed
17:34 STM-LOGGER/+DRIBBLE+: Released lock #<RECURSIVE-LOCK [ptr @
#x302700] #x85A84EE>
;; And now we've atomically incremented the counter twice.  Phew!
STM> (value-of (count-of *counter*))
2

Hoan