suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix nested atomic escape

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-24 11:15:10 -06:00
parent f57961fba4
commit 3294d3427a
1 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/ffi/unsafe/atomic.rkt
View File

@ -36,6 +36,8 @@
(define old-paramz #f)
(define old-break-paramz #f)
(define extra-atomic-depth 0)
(define exited-key (gensym 'as-exit))
(define lock-tag (make-continuation-prompt-tag 'lock))
@ -47,7 +49,13 @@
[(eq? monitor-owner (current-thread))
;; Increment atomicity level for cooperation with anything
;; that is sensitive to the current depth of atomicity.
(dynamic-wind start-atomic f end-atomic)]
(dynamic-wind (lambda ()
(start-breakable-atomic)
(set! extra-atomic-depth (add1 extra-atomic-depth)))
f
(lambda ()
(set! extra-atomic-depth (sub1 extra-atomic-depth))
(end-breakable-atomic)))]
[else
(with-continuation-mark
exited-key
@ -89,7 +97,8 @@
(unless (eq? monitor-owner (current-thread))
(error 'call-as-nonatomic "not in atomic area for ~e" f))
(let ([paramz old-paramz]
[break-paramz old-break-paramz])
[break-paramz old-break-paramz]
[extra-depth extra-atomic-depth])
(with-continuation-mark
exited-key
#t ; disables special exception handling
@ -101,11 +110,21 @@
(lambda ()
(dynamic-wind
(lambda ()
(set! monitor-owner #f)
(end-breakable-atomic))
(set! monitor-owner #f)
(set! extra-atomic-depth 0)
(end-breakable-atomic)
(let loop ([i extra-depth])
(unless (zero? i)
(end-breakable-atomic)
(loop (sub1 i)))))
f
(lambda ()
(set! old-paramz paramz)
(set! old-break-paramz break-paramz)
(start-breakable-atomic)
(let loop ([i extra-depth])
(unless (zero? i)
(start-breakable-atomic)
(loop (sub1 i))))
(set! extra-atomic-depth extra-depth)
(set! monitor-owner (current-thread)))))))))))