CL-STM

Transactional variables 

(defclass standard-tvar (tvar)
  ((lock :accessor lock-of
         :initarg :lock
         :initform (make-lock "TVAR"))
   (value :accessor value-of
          :initarg :value)
   (version :accessor version-of
            :initarg :version
            :initform 0
            :type integer)
   (waiting :accessor waiting-for
            :initarg :waiting
            :initform (new 'queue :element-type 'standard-tlog)
            :type queue)
   (waiting-lock :accessor waiting-lock-of
                 :initarg :waiting-lock
                 :initform (make-lock "WAITING-LOCK"))))

Printing 

(defprint-object (obj standard-tvar)
  (princ (if (slot-boundp obj 'value)
             (value-of obj)
             "<unbound>")))

Reading and Writing 

(defmethod read-tvar ((var standard-tvar) (log standard-tlog))
  (aif2 (gethash var (writes-of log))
        it
        (progn (setf (gethash var (reads-of log))
                     (version-of var))
               (value-of var))))

(defmethod write-tvar ((var standard-tvar) (log standard-tlog) val)
  (setf (gethash var (writes-of log)) val))

Waiting 

(defmethod unwait ((var standard-tvar))
  (with-slots (waiting waiting-lock) var
    (with-lock-held (waiting-lock)
      (until (queue-empty-p waiting)
        (unwait (dequeue waiting))))))