fix ffi/unsafe/try-atomic interaction with exns and prompt tags
This commit is contained in:
parent
8ece97219a
commit
9c0c42f24a
|
@ -25,16 +25,18 @@
|
|||
(let ([b (box null)])
|
||||
(begin0
|
||||
(parameterize ([freezer-box b])
|
||||
;; In atomic mode:
|
||||
(call-as-atomic thunk))
|
||||
;; In atomic mode (but not using call-as-atomic, because we
|
||||
;; don't want to change the exception handler, etc.)
|
||||
(start-atomic)
|
||||
(begin0
|
||||
(thunk)
|
||||
(end-atomic)))
|
||||
;; Retries out of atomic mode:
|
||||
(let ([l (unbox b)])
|
||||
(for ([k (in-list (reverse l))])
|
||||
(call-with-continuation-prompt ; to catch aborts
|
||||
(lambda ()
|
||||
(call-with-continuation-prompt
|
||||
k
|
||||
freeze-tag))))))))
|
||||
(call-with-continuation-prompt
|
||||
k
|
||||
freeze-tag))))))
|
||||
|
||||
(define (can-try-atomic?) (and (freezer-box) #t))
|
||||
|
||||
|
@ -67,23 +69,39 @@
|
|||
freeze-tag
|
||||
(lambda () default)))
|
||||
freeze-tag)
|
||||
(void)))])
|
||||
(void)))]
|
||||
[done? #f])
|
||||
(hash-set! saved-ptrs handler #t)
|
||||
(begin0
|
||||
(parameterize ([freezer-box #f])
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(call-with-continuation-prompt ; for composable continuation
|
||||
(lambda ()
|
||||
(call-with-continuation-prompt ; to catch aborts
|
||||
(lambda ()
|
||||
(when (scheme_set_on_atomic_timeout handler)
|
||||
(error 'try-atomic "internal error: nested handlers?!"))
|
||||
(set! ready? #t)
|
||||
(thunk))))
|
||||
freeze-tag))
|
||||
(lambda ()
|
||||
(scheme_restore_on_atomic_timeout #f))))
|
||||
(hash-remove! saved-ptrs handler)))])))
|
||||
(parameterize ([freezer-box #f])
|
||||
(let/ec esc ;; esc + dynamic-wind prevents escape via alternate prompt tags
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(call-with-continuation-prompt ; for composable continuation
|
||||
(lambda ()
|
||||
(call-with-continuation-prompt ; to catch aborts
|
||||
(lambda ()
|
||||
(when (scheme_set_on_atomic_timeout handler)
|
||||
(error 'try-atomic "internal error: nested handlers?!"))
|
||||
(set! ready? #t)
|
||||
(begin0
|
||||
(thunk)
|
||||
(set! done? #t)))
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda args
|
||||
(set! done? #t)
|
||||
;; re-abort later...
|
||||
(set-box! b (cons (lambda ()
|
||||
(apply abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
args))
|
||||
(unbox b))))))
|
||||
freeze-tag
|
||||
(lambda (thunk)
|
||||
(set! done? #t)
|
||||
(thunk))))
|
||||
(lambda ()
|
||||
(hash-remove! saved-ptrs handler)
|
||||
(scheme_restore_on_atomic_timeout #f)
|
||||
(unless done? (esc (void))))))))])))
|
||||
|
||||
|
|
|
@ -12,11 +12,11 @@ or if some external event causes the attempt to be abandoned.}
|
|||
|
||||
@defproc[(call-as-nonatomic-retry-point [thunk (-> any)]) any]{
|
||||
|
||||
Calls @racket[thunk] in atomic mode (see @racket[call-as-atomic])
|
||||
while allowing @racket[thunk] to use @racket[try-atomic]. Any
|
||||
incomplete computations started with @racket[try-atomic] are run
|
||||
non-atomically after @racket[thunk] returns. The result of
|
||||
@racket[thunk] is used as the result of
|
||||
Calls @racket[thunk] in atomic mode (see @racket[start-atomic] and
|
||||
@racket[end-atomic]) while allowing @racket[thunk] to use
|
||||
@racket[try-atomic]. Any incomplete computations started with
|
||||
@racket[try-atomic] are run non-atomically after @racket[thunk]
|
||||
returns. The result of @racket[thunk] is used as the result of
|
||||
@racket[call-as-nonatomic-retry-point].}
|
||||
|
||||
|
||||
|
@ -46,4 +46,12 @@ returned.
|
|||
The @racket[give-up-proc] callback is polled only at points where the
|
||||
level of atomic-mode nesting (see @racket[start-atomic],
|
||||
@racket[start-breakable-atomic], and @racket[call-as-atomic]) is the
|
||||
same as at the point of calling @racket[try-atomic].}
|
||||
same as at the point of calling @racket[try-atomic].
|
||||
|
||||
If @racket[thunk] aborts the current continuation using
|
||||
@racket[(default-continuation-prompt-tag)], the abort is suspended the
|
||||
resumed by the enclosing
|
||||
@racket[call-as-nonatomic-retry-point]. Escapes to the context of the
|
||||
call to @racket[thunk] using any other prompt tag or continuation are
|
||||
blocked (using @racket[dynamic-wind]) and simply return
|
||||
@racket[(void)] from @racket[thunk].}
|
||||
|
|
Loading…
Reference in New Issue
Block a user