(defdfun create-semaphore (&key name)
  "Create a semaphore with the supplied NAME."
  (list :lock (make-lock name)
        :cv (make-condition-variable :name name)
        :counter 0))

(defdfun semaphore-count (semaphore)
  "Returns the current count of the semaphore."
  (getf semaphore :counter))

(defdfun signal-semaphore (semaphore &optional (count 1))
    "Increment the count of SEMAPHORE by COUNT. If there are threads waiting on
this semaphore, then COUNT of them is woken up."
  (with-lock-held ((getf semaphore :lock))
    (incf (getf semaphore :counter) count)
    (dotimes (v count) (condition-notify (getf semaphore :cv))))
  (values))

(defdfun wait-on-semaphore (semaphore &key timeout)
  "Decrement the count of SEMAPHORE by 1 if the count would not be negative.

Else blocks until the semaphore can be decremented. Returns the new count of
SEMAPHORE on success.

If TIMEOUT is given, it is the maximum number of seconds to wait. If the count
cannot be decremented in that time, returns NIL without decrementing the count."
  (with-lock-held ((getf semaphore :lock))
    (if (>= (getf semaphore :counter) 1)
        (decf (getf semaphore :counter))
        (let ((deadline (+ (get-universal-time) timeout)))
          ;; we need this loop because of possible a spurious wakeup
          (loop until (>= (getf semaphore :counter) 1)
             do (let ((retval (condition-wait (getf semaphore :cv)
                                              (getf semaphore :lock)
                                              :timeout timeout)))
                  (when (or (null retval)
                            ;; unfortunately cv-wait may return T on timeout
                            (and deadline (>= (get-universal-time) deadline)))
                    (return-from wait-on-semaphore))))
          (decf (getf semaphore :counter))))))