Eliminate direct use of make-gstate in string I/O ports, by extending

MAKE-GENERIC-I/O-PORT to take extra arguments.

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index 72e4fb67c1fbce0c278b7545867f52c34ca3d929..2cdbd4f4a5eaaab0bcbf314ce329e35c0548a1cc 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.58 2008/02/02 01:48:51 cph Exp $
+$Id: genio.scm,v 1.59 2008/02/02 02:02:48 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -30,7 +30,7 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define (make-generic-i/o-port source sink #!optional type)
+(define (make-generic-i/o-port source sink #!optional type . extra-state)
   (if (not (or source sink))
       (error "Missing arguments."))
   (let ((port
@@ -38,7 +38,7 @@ USA.
                        (generic-i/o-port-type (source-type source)
                                               (sink-type sink))
                        type)
-                   (make-gstate source sink 'TEXT 'TEXT))))
+                   (apply make-gstate source sink 'TEXT 'TEXT extra-state))))
     (let ((ib (port-input-buffer port)))
       (if ib
          ((source/set-port (input-buffer-source ib)) port)))

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 891d25260f7c1bbfd4ce2952fb69be1136d0d34a..476289b5f2feb15705dd5a523649069782877665 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.632 2008/02/02 01:48:52 cph Exp $
+$Id: runtime.pkg,v 14.633 2008/02/02 02:02:49 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1769,12 +1769,6 @@ USA.
          output-buffer-using-binary-denormalizer?
          port-input-buffer
          port-output-buffer)
-  (export (runtime string-input)
-         make-gstate)
-  (export (runtime string-output)
-         make-gstate)
-  (export (runtime truncated-string-output)
-         make-gstate)
   (initialization (initialize-package!)))
 
 (define-package (runtime gensym)

diff --git a/v7/src/runtime/strnin.scm b/v7/src/runtime/strnin.scm
index 71ae4f405d6034234018a2064adeab27ec933540..053708a8f56b38d158b219761b9439a738854024 100644 (file)
--- a/v7/src/runtime/strnin.scm
+++ b/v7/src/runtime/strnin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strnin.scm,v 14.22 2008/02/02 01:48:54 cph Exp $
+$Id: strnin.scm,v 14.23 2008/02/02 02:02:51 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -35,20 +35,23 @@ USA.
 
 (define (open-input-string string #!optional start end)
   (guarantee-string string 'OPEN-INPUT-STRING)
-  (let* ((end
-         (if (or (default-object? end) (not end))
-             (string-length string)
-             (guarantee-substring-end-index end (string-length string)
-                                            'OPEN-INPUT-STRING)))
-        (start
-         (if (or (default-object? start) (not start))
-             0
-             (guarantee-substring-start-index start end 'OPEN-INPUT-STRING))))
-    (make-port input-string-port-type
-              (make-gstate (make-string-source string start end)
-                           #f
-                           'ISO-8859-1
-                           'NEWLINE))))
+  (let ((port
+        (let* ((end
+                (if (or (default-object? end) (not end))
+                    (string-length string)
+                    (guarantee-substring-end-index end (string-length string)
+                                                   'OPEN-INPUT-STRING)))
+               (start
+                (if (or (default-object? start) (not start))
+                    0
+                    (guarantee-substring-start-index start end
+                                                     'OPEN-INPUT-STRING))))
+          (make-generic-i/o-port (make-string-source string start end)
+                                 #f
+                                 input-string-port-type))))
+    (port/set-coding port 'ISO-8859-1)
+    (port/set-line-ending port 'NEWLINE)
+    port))
 
 (define (call-with-input-string string procedure)
   (let ((port (open-input-string string)))

diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm
index 8e8df4e5652e49c5383aa29c82d406ea3899e549..05e7920e1cf639c37235a8a5c962f9a9f9fd32aa 100644 (file)
--- a/v7/src/runtime/strott.scm
+++ b/v7/src/runtime/strott.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strott.scm,v 14.19 2008/02/02 01:48:55 cph Exp $
+$Id: strott.scm,v 14.20 2008/02/02 02:02:52 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -34,15 +34,14 @@ USA.
   (call-with-current-continuation
    (lambda (k)
      (let ((port
-           (make-port output-string-port-type
-                      (receive (sink extract extract!)
-                          (make-accumulator-sink limit k)
-                        (make-gstate #f
-                                     sink
-                                     'ISO-8859-1
-                                     'NEWLINE
-                                     extract
-                                     extract!)))))
+           (receive (sink extract extract!) (make-accumulator-sink limit k)
+             (make-generic-i/o-port #f
+                                    sink
+                                    output-string-port-type
+                                    extract
+                                    extract!))))
+       (port/set-coding port 'ISO-8859-1)
+       (port/set-line-ending port 'NEWLINE)
        (generator port)
        (cons #f (get-output-string port))))))
 

diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm
index 89ae4a89454ca0db1f3ad3277909e9f1153dd3ed..cf860d644a31793f335ce22979d9f1b22d7d7d73 100644 (file)
--- a/v7/src/runtime/strout.scm
+++ b/v7/src/runtime/strout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.30 2008/02/02 01:48:56 cph Exp $
+$Id: strout.scm,v 14.31 2008/02/02 02:02:53 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -31,15 +31,17 @@ USA.
 (declare (usual-integrations))
 \f
 (define (open-output-string)
-  (make-port accumulator-output-port-type
-            (receive (sink extract extract! position) (make-accumulator-sink)
-              (make-gstate #f
-                           sink
-                           'ISO-8859-1
-                           'NEWLINE
-                           extract
-                           extract!
-                           position))))
+  (let ((port
+        (receive (sink extract extract! position) (make-accumulator-sink)
+          (make-generic-i/o-port #f
+                                 sink
+                                 accumulator-output-port-type
+                                 extract
+                                 extract!
+                                 position))))
+    (port/set-coding port 'ISO-8859-1)
+    (port/set-line-ending port 'NEWLINE)
+    port))
 
 (define (get-output-string port)
   ((port/operation port 'EXTRACT-OUTPUT) port))