Make sure port locks get released after I/O errors.
This commit is contained in:
parent
5f7ed5befe
commit
12ced00589
|
@ -84,7 +84,7 @@
|
||||||
interrupts ; {en|dis}able-interrupts!
|
interrupts ; {en|dis}able-interrupts!
|
||||||
number-i/o ; number->string for debugging
|
number-i/o ; number->string for debugging
|
||||||
exceptions ; wrong-number-of-args stuff
|
exceptions ; wrong-number-of-args stuff
|
||||||
handle) ; report-errors-as-warnings
|
handle) ; report-errors-as-warnings with-handler
|
||||||
(files (rts port)
|
(files (rts port)
|
||||||
(rts current-port))
|
(rts current-port))
|
||||||
(optimize auto-integrate))
|
(optimize auto-integrate))
|
||||||
|
|
|
@ -206,7 +206,14 @@
|
||||||
(begin
|
(begin
|
||||||
(obtain-port-lock ?port) ; lock the port
|
(obtain-port-lock ?port) ; lock the port
|
||||||
(if (open-port? ?port) ; check that it's open
|
(if (open-port? ?port) ; check that it's open
|
||||||
(let ((value ?body)) ; do the work
|
(let ((value ; do the work
|
||||||
|
(with-handler
|
||||||
|
(lambda (condition punt)
|
||||||
|
|
||||||
|
(release-port-lock ?port)
|
||||||
|
(punt))
|
||||||
|
(lambda ()
|
||||||
|
?body))))
|
||||||
(release-port-lock ?port) ; release the lock
|
(release-port-lock ?port) ; release the lock
|
||||||
value) ; return
|
value) ; return
|
||||||
(begin
|
(begin
|
||||||
|
|
Loading…
Reference in New Issue