weblocks-prevalence recursive lock

32 views
Skip to first unread message

Vibhu Mohindra

unread,
May 15, 2016, 6:19:25 AM5/15/16
to webl...@googlegroups.com
Looking through an archived project, I found a change I had made to make
CLISP work with weblocks-prevalence.

bordeaux-threads has ordinary locks and recursive locks. You lock them
the same way:
(with-lock-held (lck) ...)
but recursive locks can be locked again within the "...".

The weblocks-prevalence method #'open-store creates an ordinary lock:

https://github.com/html/weblocks-stores/blob/master/src/store/prevalence/prevalence.lisp#L23

I don't remember why I needed to recursively lock it. However, I don't
think I was trying to do anything fancy. It might have just been trying
to snapshot from within a web request. But I think it was something simpler.

So I needed to change that line to say "make-recursive-lock" instead of
"make-lock".

SBCL and CCL happen to let you can recursively lock an ordinary lock.
But not CLISP. That's where I noticed the problem. My code used to work
on SBCL and CCL, but stopped working when I tried it on CLISP.

With the change above, CLISP programmers will be able to do what SBCL
and CCL programmers can already do today: acquire this particular lock
recursively.

----
For completeness, these are my notes:

(in-package weblocks-prevalence)

;override original impl to make recursive locks
;in sbcl and ccl you can recursively lock ordinary locks
;but in clisp the lock must have also been created as a recursive one
;this isn't so much a workaround for clisp as the correct thing,
;which ccl and sbcl happen not to require

(defmethod open-store ((store-type (eql :prevalence)) &rest args)
(let* ((store (apply #'make-instance 'guarded-prevalence-system
:directory (car args) (cdr args)))
(lock-name (format nil "Prevalence lock for store ~S" store))
(lock (bordeaux-threads:make-recursive-lock lock-name)))
(setf (gethash store *locks*) lock)
(setf (get-guard store) (lambda (thunk)
(bordeaux-threads:with-lock-held (lock)
(funcall thunk))))
(setf *default-store* store)))
Reply all
Reply to author
Forward
0 new messages