This is intended to be a simple locking protocol for systems that need to be usable on both serve-event-only systems, like CMUCL on PPC, and more ordinary multi-processing systems. I'm currently using it as part of PSILISP, my webapp framework.
This seems to work, and people I've run it by agree that it seems to work, but there could be some serious problem with it, so use at your own risk. I am only an egg.
(defmacro enqueue (queue) "Appends a unique ID to a queue." (let ((id (gensym))) `(let ((,id (gensym))) (setf ,queue (append ,queue (list ,id))) ,id)))
(defmacro lock (queue) "Waits in turn in the activity queue until all previous members have exited." (let ((id (gensym))) `(let* ((,id (enqueue ,queue))) #+(and acl-compat (not allegro) (not cmu)) ; CMUCL on PPC doesn't have MP, so we have to use serve-event (ACL-COMPAT.MP:process-wait "waiting for lock" #'eq ,id (car ,queue)) #+allegro (MP:process-wait "waiting for lock" #'eq ,id (car ,queue)) #+cmu (do () ((eq ,id (car ,queue))) (sys:serve-event 0)) ,id)))
(defmacro unlock (queue) `(pop ,queue))
Use example, which assumes a WIDGET structure or class, with a MYWIDGET instance, and a WIDGET-LOCK accessor.
(defmacro with-locked-widget ((lock-id-var queue) &body body) "Provides a method of locking a widget while in use, if everyone uses this." `(let ((,lock-id-var (lock ,queue))) (unwind-protect (progn ,@body) (unlock ,queue))))
(with-locked-widget (l-id (widget-lock mywidget)) ; do stuff )
-- Randall Randall randall@randallsquared.com Property law should use #'EQ , not #'EQUAL .