From 12ced0058939715a5f484c605a29142219425545 Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Tue, 26 Feb 2002 14:40:21 +0000
Subject: [PATCH] Make sure port locks get released after I/O errors.

---
 scheme/rts-packages.scm | 2 +-
 scheme/rts/port.scm     | 9 ++++++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/scheme/rts-packages.scm b/scheme/rts-packages.scm
index c0ebcc0..1305446 100644
--- a/scheme/rts-packages.scm
+++ b/scheme/rts-packages.scm
@@ -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))
diff --git a/scheme/rts/port.scm b/scheme/rts/port.scm
index 9d581a7..e334541 100644
--- a/scheme/rts/port.scm
+++ b/scheme/rts/port.scm
@@ -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