From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 21 Feb 1997 06:12:33 +0000 (+0000)
Subject: Guarantee that all input ports have a READ-SUBSTRING operation.
X-Git-Tag: 20090517-FFI~5255
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=417e205017522368e206e32d7ab8d6b6f93d6203;p=mit-scheme.git

Guarantee that all input ports have a READ-SUBSTRING operation.
Implement procedures READ-STRING! and READ-LINE.
---

diff --git a/v7/src/runtime/cpress.scm b/v7/src/runtime/cpress.scm
index c347e27e1..b1d46627a 100644
--- a/v7/src/runtime/cpress.scm
+++ b/v7/src/runtime/cpress.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: cpress.scm,v 1.7 1995/09/29 19:57:46 cph Exp $
+$Id: cpress.scm,v 1.8 1997/02/21 06:12:33 cph Exp $
 
-Copyright (c) 1992-95 Massachusetts Institute of Technology
+Copyright (c) 1992-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -555,24 +555,6 @@ MIT in each case. |#
 		(write-literal literal-max)
 		(loop (fix:- nb literal-max)))))))
   (compress-continuation unspecific))
-
-(define (input-port/read-substring port string start end)
-  ;; This should be in the runtime system.
-  (let ((operation (port/operation port 'READ-SUBSTRING)))
-    (if operation
-	(operation port string start end)
-	(let loop ((index start))
-	  (if (fix:< index end)
-	      (let ((char (input-port/read-char port)))
-		(cond ((not char)
-		       (and (fix:> index start)
-			    (fix:- index start)))
-		      ((eof-object? char)
-		       (fix:- index start))
-		      (else
-		       (string-set! string index char)
-		       (loop (fix:+ index 1)))))
-	      (fix:- index start))))))
 
 (define (guarantee-buffer-space nb)
   ;; Make sure that the byte buffer has enough space to hold NB bytes.
diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 8010ef1d0..ea6b33201 100644
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: input.scm,v 14.17 1997/02/21 05:42:32 cph Exp $
+$Id: input.scm,v 14.18 1997/02/21 06:08:15 cph Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -144,13 +144,13 @@ MIT in each case. |#
 			    (guarantee-input-port port))))
 
 (define (read-string! string #!optional start end port)
-  (input-port/read-substring! string
+  (input-port/read-substring! (if (default-object? port)
+				  (current-input-port)
+				  (guarantee-input-port port))
+			      string
 			      (if (default-object? start)
 				  0
 				  start)
 			      (if (default-object? end)
 				  (string-length string)
-				  end)
-			      (if (default-object? port)
-				  (current-input-port)
-				  (guarantee-input-port port))))
\ No newline at end of file
+				  end)))
\ No newline at end of file
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index aaa4ca414..477680354 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.9 1997/02/21 05:42:40 cph Exp $
+$Id: port.scm,v 1.10 1997/02/21 06:05:20 cph Exp $
 
 Copyright (c) 1991-97 Massachusetts Institute of Technology
 
@@ -140,6 +140,7 @@ MIT in each case. |#
 	  ((DISCARD-CHAR) (input-port/operation/discard-char port))
 	  ((READ-STRING) (input-port/operation/read-string port))
 	  ((DISCARD-CHARS) (input-port/operation/discard-chars port))
+	  ((READ-SUBSTRING) (input-port/operation/read-substring port))
 	  ((WRITE-CHAR) (output-port/operation/write-char port))
 	  ((WRITE-STRING) (output-port/operation/write-string port))
 	  ((WRITE-SUBSTRING) (output-port/operation/write-substring port))