From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 May 1996 07:33:41 +0000 (+0000)
Subject: Fix bug: don't enqueue a process in the process-input-queue if it is
X-Git-Tag: 20090517-FFI~5498
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1fb6ae4dd9ef354f74bc2dec6daa25687dd10792;p=mit-scheme.git

Fix bug: don't enqueue a process in the process-input-queue if it is
already in the queue.  Otherwise, it can easily get entered very many
times: if there is input waiting, and the editor is busy, the process
will be queued as often as the select code can run.
---

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index 8c1b8165e..01369b956 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: process.scm,v 1.50 1996/05/15 20:05:50 cph Exp $
+;;;	$Id: process.scm,v 1.51 1996/05/24 07:33:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991-96 Massachusetts Institute of Technology
 ;;;
@@ -244,12 +244,13 @@ Initialized from the SHELL environment variable."
     (channel-descriptor-for-select channel)
     (current-thread)
     (lambda ()
-      (let ((queue process-input-queue)
-	    (tail (list process)))
-	(if (null? (cdr queue))
-	    (set-car! queue tail)
-	    (set-cdr! (cdr queue) tail))
-	(set-cdr! queue tail))))))
+      (let ((queue process-input-queue))
+	(if (not (memq process (car queue)))
+	    (let ((tail (list process)))
+	      (if (null? (cdr queue))
+		  (set-car! queue tail)
+		  (set-cdr! (cdr queue) tail))
+	      (set-cdr! queue tail))))))))
 
 (define (process-output-available?)
   (not (null? (car process-input-queue))))