Ensure current-{input,output}-port are properly restored on exception.

Modify with-input-from-{file,pipe} and with-output-to-{file,pipe} to use
fluid-let on ##sys#standard-{input,output} to ensure they are restored
after an exception.  The ports were restored only if the exception bubbled
up to the REPL; if intercepted prior to that, the REPL would then read
further commands from (or write output to) that file or pipe.

Signed-off-by: felix <felix@call-with-current-continuation.org>
(cherry picked from commit 5ae71ec)

library.scm

@@ -1930,27 +1930,23 @@ EOF
   (let ((open-input-file open-input-file)
 	(close-input-port close-input-port) )
     (lambda (str thunk . mode)
-      (let ((old ##sys#standard-input)
-	    (file (apply open-input-file str mode)) )
-	(set! ##sys#standard-input file)
-	(##sys#call-with-values thunk
-	  (lambda results
-	    (close-input-port file)
-	    (set! ##sys#standard-input old)
-	    (apply ##sys#values results) ) ) ) ) ) )
+      (let ((file (apply open-input-file str mode)))
+	(fluid-let ((##sys#standard-input file))
+	  (##sys#call-with-values thunk
+	    (lambda results
+	      (close-input-port file)
+	      (apply ##sys#values results) ) ) ) ) ) ) )
 
 (define with-output-to-file 
   (let ((open-output-file open-output-file)
 	(close-output-port close-output-port) ) 
     (lambda (str thunk . mode)
-      (let ((old ##sys#standard-output)
-	    (file (apply open-output-file str mode)) )
-	(set! ##sys#standard-output file)
-	(##sys#call-with-values thunk
-	  (lambda results
-	    (close-output-port file)
-	    (set! ##sys#standard-output old)
-	    (apply ##sys#values results) ) ) ) ) ) )
+      (let ((file (apply open-output-file str mode)))
+	(fluid-let ((##sys#standard-output file))
+	  (##sys#call-with-values thunk
+	    (lambda results
+	      (close-output-port file)
+	      (apply ##sys#values results) ) ) ) ) ) ) )
 
 (define (file-exists? name)
   (##sys#check-string name 'file-exists?)

posixunix.scm

@@ -830,24 +830,20 @@ EOF
 
 (define with-input-from-pipe
   (lambda (cmd thunk . mode)
-    (let ([old ##sys#standard-input]
-	  [p (apply open-input-pipe cmd mode)] )
-      (set! ##sys#standard-input p)
-      (##sys#call-with-values thunk
-			      (lambda results
-				(close-input-pipe p)
-				(set! ##sys#standard-input old)
-				(apply values results) ) ) ) ) )
+    (let ([p (apply open-input-pipe cmd mode)])
+      (fluid-let ((##sys#standard-input p))
+	(##sys#call-with-values thunk
+				(lambda results
+				  (close-input-pipe p)
+				  (apply values results) ) ) ) ) ) )
 (define with-output-to-pipe
   (lambda (cmd thunk . mode)
-    (let ([old ##sys#standard-output]
-	  [p (apply open-output-pipe cmd mode)] )
-      (set! ##sys#standard-output p)
-      (##sys#call-with-values thunk
-			      (lambda results
-				(close-output-pipe p)
-				(set! ##sys#standard-output old)
-				(apply values results) ) ) ) ) )
+    (let ([p (apply open-output-pipe cmd mode)])
+      (fluid-let ((##sys#standard-output p))
+	(##sys#call-with-values thunk
+				(lambda results
+				  (close-output-pipe p)
+				  (apply values results) ) ) ) ) ) )
 
 (define-foreign-variable _pipefd0 int "C_pipefds[ 0 ]")
 (define-foreign-variable _pipefd1 int "C_pipefds[ 1 ]")

posixwin.scm

@@ -1190,27 +1190,23 @@ EOF
 
 (define with-input-from-pipe
   (lambda (cmd thunk . mode)
-    (let ([old ##sys#standard-input]
-	  [p (apply open-input-pipe cmd mode)] )
-      (set! ##sys#standard-input p)
-      (##sys#call-with-values
-       thunk
-       (lambda results
-	 (close-input-pipe p)
-	 (set! ##sys#standard-input old)
-	 (apply values results) ) ) ) ) )
+    (let ([p (apply open-input-pipe cmd mode)])
+      (fluid-let ((##sys#standard-input p))
+	(##sys#call-with-values
+	 thunk
+	 (lambda results
+	   (close-input-pipe p)
+	   (apply values results) ) ) ) ) ) )
 
 (define with-output-to-pipe
   (lambda (cmd thunk . mode)
-    (let ([old ##sys#standard-output]
-	  [p (apply open-output-pipe cmd mode)] )
-      (set! ##sys#standard-output p)
-      (##sys#call-with-values
-       thunk
-       (lambda results
-	 (close-output-pipe p)
-	 (set! ##sys#standard-output old)
-	 (apply values results) ) ) ) ) )
+    (let ([p (apply open-output-pipe cmd mode)])
+      (fluid-let ((##sys#standard-output p))
+	(##sys#call-with-values
+	 thunk
+	 (lambda results
+	   (close-output-pipe p)
+	   (apply values results) ) ) ) ) ) )
 
 
 ;;; Pipe primitive: