From 1e54b789bfd4e628a8e185b9a98c280e07f7b764 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 Jan 1992 00:32:40 +0000
Subject: [PATCH] Change RUN-SYNCHRONOUS-PROCESS to be a little more aggressive
about writing data down to a subprocess.
---
v7/src/edwin/process.scm | 42 +++++++++++++++++++++-------------------
1 file changed, 22 insertions(+), 20 deletions(-)
diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index 70d8fdf00..3bce7ec7e 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,8 +1,8 @@
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.13 1991/11/04 20:51:36 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.14 1992/01/24 00:32:40 cph Exp $
;;;
-;;; Copyright (c) 1991 Massachusetts Institute of Technology
+;;; Copyright (c) 1991-92 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
@@ -557,24 +557,26 @@ after the listing is made.)"
(continuation (subprocess-wait process))))
(lambda ()
(receiver
- (lambda ()
- (if (< start-index end-index)
- (let ((index (min (+ start-index 512) end-index)))
- (let ((buffer
- (group-extract-string group
- start-index
- index)))
- (let ((n
- (channel-write input-channel
- buffer
- 0
- (string-length buffer))))
- (if n
- (begin
- (set! start-index (+ start-index n))
- (if (= start-index end-index)
- (channel-close input-channel)))))))
- (channel-close input-channel)))))))))
+ (letrec
+ ((loop
+ (lambda ()
+ (if (< start-index end-index)
+ (let ((index (min (+ start-index 512) end-index)))
+ (let ((buffer
+ (group-extract-string group
+ start-index
+ index)))
+ (let ((n
+ (channel-write input-channel
+ buffer
+ 0
+ (string-length buffer))))
+ (if n
+ (begin
+ (set! start-index (+ start-index n))
+ (loop))))))
+ (channel-close input-channel)))))
+ loop)))))))
(begin
(channel-close (subprocess-output-channel process))
(receiver (lambda () unspecific)))))
--
2.25.1