(xdef 'atomic-invoke (lambda (f)
                       (if (thread-cell-ref ar-sema-cell)
                           (ar-apply f '())
                           (begin
                             (thread-cell-set! ar-sema-cell #t)
                             (let ((ret 
                                    (call-with-semaphore
                                     ar-the-sema
                                     (lambda () (ar-apply f '())))))
                               (thread-cell-set! ar-sema-cell #f)
                               ret)))))

From ac.scm ©