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! 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))

View File

@ -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