CLIM mail archive
[Prev][Next][Index][Thread]

Re: locks

Here's what I do for locks.

--David Gadbois

;;; The locking primitives here provide for simple exclusion locks.  To do
;;; anything fancier, you'll have to build up from here.  A basic no-op scheme
;;; is provided for implementations without multitasking.  We assume that the
;;; locks provided may be locked recursively -- locking a lock already held is a
;;; no-op.

;;; Any implementation that can meaningfully and usefully implement the
;;; following macros should add this feature.
#+(or Genera Lucid Allegro)
(pushnew :locks *features*)

;;; Lucid lets you use any old SETF location as a lock, sort of like the
;;; old-style Genera locks.
#+Lucid
(defstruct (lock (:constructor make-lock-internal (name)))
  (location nil)
  (name "No name"))

(defun make-lock (name)
  "Makes a lock called NAME, suitable for use with WITH-LOCK-HELD."
  #-(or Genera Allegro Lucid) (declare (ignore name))
  #-(or Genera Allegro Lucid) nil
  #+Genera  (process:make-lock name :recursive t)
  #+Allegro (mp:make-process-lock :name name)
  #+Lucid   (make-lock-internal name)
  )
	   
(defun lock-idle-p (lock)
  "Returns NIL unless LOCK has been seized by someone."
  #-(or Genera Allegro Lucid) (declare (ignore lock))
  #-(or Genera Allegro Lucid) t
  #+Genera  (process:lock-idle-p lock)
  #+Allegro (mp:process-lock-locker lock)
  #+Lucid   (lock-location lock)
)

(defmacro with-lock-held (lock &body body)
  "Waits for and then seizes LOCK.  Then executes BODY.  Releases the
   lock upon exit, unless the lock was already held by this process."
  #-(or Allegro Genera Lucid) (declare (ignore lock))
  #-(or Genera Allegro Lucid) `(progn ,@body)
  #+Genera  `(process:with-lock (,lock) ,@body)
  #+Allegro `(mp:with-process-lock (,lock) ,@body)
  #+Lucid   `(lcl:with-process-lock ((lock-location ,lock)) ,@body)
)


0,,
References:
Main Index | Thread Index