;;; 
;;; Alternative implementation of locking primitives.
;;;

(in-package :cl-user)                   ;Err...

(defstruct spin-lock
  (spin 0))

(declaim (inline current-thread-id))
(defun current-thread-id ()
  (sb-thread::current-thread-id))

(defun acquire-spin-lock (spin-lock)
  (declare (optimize (speed 3) (safety 0)))
  (loop until
      (eql (sb-vm::%instance-set-conditional
            spin-lock 
            #|offset|#    1
            #|old value|# 0
            #|new value|# (current-thread-id))
           0)))

(defun release-spin-lock (spin-lock)
  (setf (spin-lock-spin spin-lock) 0))

(defmacro with-spin-lock ((lock-form) &body body)
  (let ((lock (gensym ".LOCK.")))
    `(let ((,lock ,lock-form))
      (unwind-protect
           (progn
             (acquire-spin-lock ,lock)
             (locally ,@body))
        (release-spin-lock ,lock)))))

;;;; waiting and wakeup

(defun prepare-wait ()
  (sb-thread::block-sigcont))

(defun wait ()
  (sb-thread::unblock-sigcont-and-sleep))

(defun wakeup (pid)
  (sb-unix:unix-kill pid :sigcont))

;;;; regular locks

;; our locks are always recursive.

(defstruct (lock (:include spin-lock))
  name
  (lock-count 0)                        ;how many times this was acquired
  (holder nil)                          ;id of the thread holding this lock
  (queue nil))                          ;a list of thread ids waiting for this lock

(defun acquire-lock (lock)
  (loop
      (acquire-spin-lock lock)
      (cond ((null (lock-holder lock))
             ;; this one is free, just acquire it.
             (incf (lock-lock-count lock))
             (setf (lock-holder lock) (current-thread-id))
             (release-spin-lock lock)
             (return))
            ((eql (lock-holder lock) (current-thread-id))
             ;; Uh, we are already holding this lock, just increment
             ;; the lock count.
             (incf (lock-lock-count lock))
             (release-spin-lock lock)
             (return))
            (t
             ;; Holded by somebody else, just put us on the queue
             (prepare-wait)
             (push (current-thread-id) (lock-queue lock))
             (release-spin-lock lock)
             (wait)))))

(defun release-lock (lock)
  ;; Note: The order WAKEUP, RELEASE-SPIN-LOCK perhaps in unfortunate,
  ;; as when we do WAKEUP we make a system call, giving the kernel an
  ;; opportunity to actually schedule to that other thread, which then
  ;; would just spinning waiting for us to release the spin lock.
  (acquire-spin-lock lock)
  (decf (lock-lock-count lock))
  (when (zerop (lock-lock-count lock))
    (setf (lock-holder lock) nil)     ;it's free now
    (let ((p (pop (lock-queue lock))))
      (when p
        ;; somebody is waiting
        (wakeup p))))
  (release-spin-lock lock))

(defmacro with-lock-held ((lock-form) &body body)
  (let ((lock (gensym ".LOCK.")))
    `(let ((,lock ,lock-form))
      (unwind-protect
           (progn
             (acquire-lock ,lock)
             (locally ,@body))
        (release-lock ,lock)))))

(defmacro with-recursive-lock-held ((lock-form) &body body)
  `(with-lock-held (,lock-form) ,@body))

(defun make-recursive-lock (&key name)
  (make-lock :name name))

;;;; condition variables

(defstruct (condition-variable)
  queue)

(defun condition-notify (cv)
  (let ((p (pop (condition-variable-queue cv))))
    (cond ((null p)
           (warn "~S without somebody waiting, Eh?"
                 'CONDITION-NOTIFY))
          (t
           (wakeup p)))))

(defun condition-wait (cv lock)
  ;; no locks in here, as cv is supposed to be protected by 'lock'.
  (push (current-thread-id) (condition-variable-queue cv))
  (prepare-wait)
  (release-lock lock)
  (wait)
  ;; We should probably at this point have a means to verify that this
  ;; condition really was signaled, so that spurious SIGCONT won't do
  ;; harm.
  (acquire-lock lock))

;;;; test

(defvar *lock* (make-lock))
(defvar *cv* (make-condition-variable))

(defun thread-a ()
  (with-lock-held (*lock*)
    (format *trace-output* ";; locked~%")
    (sleep 5)
    (format *trace-output* ";; wait~%")
    (condition-wait *cv* *lock*)
    (format *trace-output* ";; wait done~%")))

(defun thread-b ()
  (sleep 1)
  (with-lock-held (*lock*)
    (sleep 2)
    (format *trace-output* "-- signal~%")
    (condition-notify *cv*)))

(defun foo ()
  (sb-thread:make-thread #'thread-a)
  (thread-b))