From e524a78a90437b0c406baf623f8ab9b96425cc00 Mon Sep 17 00:00:00 2001
From: jimb <jimb>
Date: Thu, 16 Dec 2004 21:23:13 +0000
Subject: [PATCH] * read.scm (debug-repl): Temporarily redirect input and
 output to /dev/tty while we debug, so we don't interfere with whatever CGEN
 is reading or writing. * utils.scm (setter-getter-fluid-let,
 with-input-and-output-to): New functions.

---
 cgen/ChangeLog |  8 ++++++++
 cgen/read.scm  | 28 +++++++++++++++++++++-------
 cgen/utils.scm | 29 +++++++++++++++++++++++++++++
 3 files changed, 58 insertions(+), 7 deletions(-)

diff --git a/cgen/ChangeLog b/cgen/ChangeLog
index 71b397defa..7db756c6c0 100644
--- a/cgen/ChangeLog
+++ b/cgen/ChangeLog
@@ -1,3 +1,11 @@
+2004-12-16  Jim Blandy  <jimb@redhat.com>
+
+	* read.scm (debug-repl): Temporarily redirect input and output to
+	/dev/tty while we debug, so we don't interfere with whatever CGEN
+	is reading or writing.
+	* utils.scm (setter-getter-fluid-let, with-input-and-output-to):
+	New functions.
+
 2004-11-15  Michael K. Lechner <mike.lechner@gmail.com>
 
 	* cpu/iq2000.cpu: Added quotes around macro arguments so that they
diff --git a/cgen/read.scm b/cgen/read.scm
index d6521e1b83..ee07c22932 100644
--- a/cgen/read.scm
+++ b/cgen/read.scm
@@ -952,6 +952,17 @@ Define a preprocessor-style macro.
 
 (define (debug-var name) (assq-ref debug-env name))
 
+; A handle on /dev/tty, so we can be sure we're talking with the user.
+; We open this the first time we actually need it.
+(define debug-tty #f)
+
+; Return the port we should use for interacting with the user,
+; opening it if necessary.
+(define (debug-tty-port)
+  (if (not debug-tty)
+      (set! debug-tty (open-file "/dev/tty" "r+")))
+  debug-tty)
+
 ; Enter a repl loop for debugging purposes.
 ; Use (quit) to exit cgen completely.
 ; Use (debug-quit) or (quit 0) to exit the debugging session and
@@ -964,13 +975,16 @@ Define a preprocessor-style macro.
 ; FIXME: Move to utils.scm.
 
 (define (debug-repl env-alist)
-  (set! debug-env env-alist)
-  (let loop ()
-    (let ((rc (top-repl)))
-      (if (null? rc)
-	  (quit 1)) ; indicate error to `make'
-      (if (not (equal? rc '(0)))
-	  (loop))))
+  (with-input-and-output-to
+   (debug-tty-port)
+   (lambda ()
+     (set! debug-env env-alist)
+     (let loop ()
+       (let ((rc (top-repl)))
+	 (if (null? rc)
+	     (quit 1))			; indicate error to `make'
+	 (if (not (equal? rc '(0)))
+	     (loop))))))
 )
 
 ; Utility for debug-repl.
diff --git a/cgen/utils.scm b/cgen/utils.scm
index 0859e3f477..43988e6fd0 100644
--- a/cgen/utils.scm
+++ b/cgen/utils.scm
@@ -305,6 +305,35 @@
 
 ; Output routines.
 
+;; Given some state that has a setter function (SETTER NEW-VALUE) and
+;; a getter function (GETTER), call THUNK with the state set to VALUE,
+;; and restore the original value when THUNK returns.  Ensure that the
+;; original value is restored whether THUNK returns normally, throws
+;; an exception, or invokes a continuation that leaves the call's
+;; dynamic scope.
+(define (setter-getter-fluid-let setter getter value thunk)
+  (let ((swap (lambda ()
+		(let ((temp (getter)))
+		  (setter value)
+		  (set! value temp)))))
+    (dynamic-wind swap thunk swap)))
+      
+
+;; Call THUNK with the current input and output ports set to PORT, and
+;; then restore the current ports to their original values.
+;; 
+;; This ensures the current ports get restored whether THUNK exits
+;; normally, throws an exception, or leaves the call's dynamic scope
+;; by applying a continuation.
+(define (with-input-and-output-to port thunk)
+  (setter-getter-fluid-let
+   set-current-input-port current-input-port port
+   (lambda ()
+     (setter-getter-fluid-let
+      set-current-output-port current-output-port port
+      thunk))))
+
+
 ; Extension to the current-output-port.
 ; Only valid inside string-write.
 
-- 
2.11.0