Make sure port locks get released after I/O errors.

This commit is contained in:
sperber 2002-02-26 14:40:21 +00:00
parent 5f7ed5befe
commit 12ced00589
2 changed files with 9 additions and 2 deletions

View File

@ -84,7 +84,7 @@
interrupts ; {en|dis}able-interrupts!
number-i/o ; number->string for debugging
exceptions ; wrong-number-of-args stuff
handle) ; report-errors-as-warnings
handle) ; report-errors-as-warnings with-handler
(files (rts port)
(rts current-port))
(optimize auto-integrate))

View File

@ -206,7 +206,14 @@
(begin
(obtain-port-lock ?port) ; lock the port
(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
value) ; return
(begin