From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 24 Feb 2004 20:34:50 +0000 (+0000)
Subject: Don't read more characters than are needed.  The XML character-coding
X-Git-Tag: 20090517-FFI~1673
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ae083b71c29c9561267db0000e10c6b1044988b2;p=mit-scheme.git

Don't read more characters than are needed.  The XML character-coding
detection depends on this.
---

diff --git a/v7/src/runtime/parser-buffer.scm b/v7/src/runtime/parser-buffer.scm
index 339da4a03..10fd069db 100644
--- a/v7/src/runtime/parser-buffer.scm
+++ b/v7/src/runtime/parser-buffer.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parser-buffer.scm,v 1.13 2004/02/23 20:51:40 cph Exp $
+$Id: parser-buffer.scm,v 1.14 2004/02/24 20:34:50 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -358,6 +358,8 @@ USA.
       (guarantee-buffer-chars-1 buffer n)))
 
 (define (guarantee-buffer-chars-1 buffer n)
+  ;; Don't read more characters than are needed.  The XML parser
+  ;; depends on this when doing its character-code detection.
   (and (not (parser-buffer-at-end? buffer))
        (let ((min-end (fix:+ (parser-buffer-index buffer) n))
 	     (end (parser-buffer-end buffer)))
@@ -376,19 +378,20 @@ USA.
 		       ((not (fix:< i end)))
 		     (vector-set! v2 i (vector-ref v1 i))))
 		 (set-parser-buffer-string! buffer string*))))
-	 (let ((n-read
-		(let ((port (parser-buffer-port buffer))
-		      (string (parser-buffer-string buffer)))
-		  (let ((l (%wide-string-length string)))
-		    (or (input-port/read-wide-substring! port string end l)
-			(port/with-input-blocking-mode port 'BLOCKING
-			  (lambda ()
+	 (let ((port (parser-buffer-port buffer))
+	       (string (parser-buffer-string buffer)))
+	   (port/with-input-blocking-mode port 'BLOCKING
+	     (lambda ()
+	       (let loop ((end end))
+		 (if (fix:< end min-end)
+		     (let ((n-read
 			    (input-port/read-wide-substring!
-			     port string end l))))))))
-	   (if (fix:> n-read 0)
-	       (let ((end (fix:+ end n-read)))
-		 (set-parser-buffer-end! buffer end)
-		 (fix:<= min-end end))
-	       (begin
-		 (set-parser-buffer-at-end?! buffer #t)
-		 #f))))))
\ No newline at end of file
+			     port string end min-end)))
+		       (if (fix:> n-read 0)
+			   (let ((end (fix:+ end n-read)))
+			     (set-parser-buffer-end! buffer end)
+			     (loop end))
+			   (begin
+			     (set-parser-buffer-at-end?! buffer #t)
+			     #f)))
+		     #t))))))))
\ No newline at end of file