From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 6864 invoked by alias); 16 Dec 2004 16:52:49 -0000 Mailing-List: contact cgen-help@sources.redhat.com; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: cgen-owner@sources.redhat.com Received: (qmail 5747 invoked from network); 16 Dec 2004 16:52:10 -0000 Received: from unknown (HELO mx1.redhat.com) (66.187.233.31) by sourceware.org with SMTP; 16 Dec 2004 16:52:10 -0000 Received: from int-mx1.corp.redhat.com (int-mx1.corp.redhat.com [172.16.52.254]) by mx1.redhat.com (8.12.11/8.12.11) with ESMTP id iBGGqAQ4016136 for ; Thu, 16 Dec 2004 11:52:10 -0500 Received: from zenia.home.redhat.com (sebastian-int.corp.redhat.com [172.16.52.221]) by int-mx1.corp.redhat.com (8.11.6/8.11.6) with ESMTP id iBGGq8r12060; Thu, 16 Dec 2004 11:52:09 -0500 To: cgen@sources.redhat.com Subject: RFA: use /dev/tty for debugging interaction From: Jim Blandy Date: Thu, 16 Dec 2004 16:52:00 -0000 Message-ID: User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3 MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-SW-Source: 2004-q4/txt/msg00024.txt.bz2 2004-12-13 Jim Blandy * 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. Index: cgen/read.scm =================================================================== RCS file: /cvs/cvsfiles/devo/cgen/read.scm,v retrieving revision 1.32 diff -c -p -r1.32 read.scm *** cgen/read.scm 20 Oct 2003 01:25:22 -0000 1.32 --- cgen/read.scm 16 Dec 2004 16:44:31 -0000 *************** Define a preprocessor-style macro. *** 963,968 **** --- 963,979 ---- (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 *************** Define a preprocessor-style macro. *** 975,987 **** ; 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)))) ) ; Utility for debug-repl. --- 986,1001 ---- ; FIXME: Move to utils.scm. (define (debug-repl env-alist) ! (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. Index: cgen/utils.scm =================================================================== RCS file: /cvs/cvsfiles/devo/cgen/utils.scm,v retrieving revision 1.81 diff -c -p -r1.81 utils.scm *** cgen/utils.scm 22 Mar 2004 22:05:20 -0000 1.81 --- cgen/utils.scm 16 Dec 2004 16:44:31 -0000 *************** *** 304,309 **** --- 310,344 ---- ) ; 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.