From 7fb19130bae5f1ff10e9455288d6e37c4a2d7b4a Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 16 Jun 1993 15:00:21 +0000 Subject: [PATCH] Fix bug in translated output where by doing a newline when the output buffer is full would cause an infinite loop. --- v7/src/runtime/io.scm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm index 0c50790ee..4e482acdd 100644 --- a/v7/src/runtime/io.scm +++ b/v7/src/runtime/io.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: io.scm,v 14.34 1993/04/27 09:14:07 cph Exp $ +$Id: io.scm,v 14.35 1993/06/16 15:00:21 gjr Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -667,14 +667,17 @@ MIT in each case. |# (define (output-buffer/write-translated-newline) (let ((translation (output-buffer/line-translation buffer)) - (string (output-buffer/string buffer)) - (posn (output-buffer/position buffer))) + (string (output-buffer/string buffer))) (let ((tlen (string-length translation))) - (and (fix:<= tlen (fix:- (string-length string) posn)) - (begin - (substring-move-left! translation 0 tlen string posn) - (set-output-buffer/position! buffer (fix:+ posn tlen)) - true))))) + (let loop ((posn (output-buffer/position buffer))) + (if (fix:<= tlen (fix:- (string-length string) posn)) + (begin + (substring-move-left! translation 0 tlen string posn) + (set-output-buffer/position! buffer (fix:+ posn tlen)) + true) + (and (output-buffer/drain buffer) + (loop (output-buffer/position buffer)))))))) + (define (find-next-newline posn) (and (fix:< posn end) -- 2.25.1