atomic-invoke doesn't reset ar-sema-cell if its thunk throws an error: arc> (errsafe (atomic (/ 1 0)))
nil
arc> ^C
> (thread-cell-ref ar-sema-cell)
#t
After an error has been thrown from the thunk in one non-nested call to atomic, further calls to atomic execute its thunk immediately without being guarded by the semaphore.One fix is to use dynamic-wind: (xdef 'atomic-invoke
(lambda (f)
(if (thread-cell-ref ar-sema-cell)
(ar-apply f '())
(dynamic-wind
(lambda () (thread-cell-set! ar-sema-cell #t))
(lambda ()
(call-with-semaphore ar-the-sema
(lambda () (ar-apply f '()))))
(lambda () (thread-cell-set! ar-sema-cell #f))))))
...though full continuation jumps are blocked across call-with-semaphore, so dynamic-wind might be heavier than you need. |