Change interface to string output ports: rename to accumulator output

port and provide separate operation to extract contents.  Port is
reset when contents are extracted; previously contents remained in the
port.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 1ec1a529b134bee1e909e14ce650775ccb45e7e4..d44696be9331bb0bedeae0bb7d742788412d5adf 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.335 2000/01/04 05:14:26 cph Exp $
+$Id: runtime.pkg,v 14.336 2000/01/04 17:24:06 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -3033,6 +3033,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "strout")
   (parent ())
   (export ()
+         get-output-from-accumulator
+         make-accumulator-output-port
          with-string-output-port
          with-output-to-string)
   (initialization (initialize-package!)))

diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm
index 0ead6a0ac3549858e4810996384c49d8a406d4be..bf140d1153b540519807ab573aa5335b31443582 100644 (file)
--- a/v7/src/runtime/strout.scm
+++ b/v7/src/runtime/strout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.12 1999/02/24 21:36:29 cph Exp $
+$Id: strout.scm,v 14.13 2000/01/04 17:24:00 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -24,70 +24,81 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (declare (usual-integrations))
 \f
+(define (make-accumulator-output-port)
+  (make-port accumulator-output-port-type
+            (make-accumulator-state (make-string 16) 0)))
+
+(define (get-output-from-accumulator port)
+  ((port/operation port 'EXTRACT-OUTPUT!) port))
+
+(define (with-output-to-string thunk)
+  (with-string-output-port (lambda (port) (with-output-to-port port thunk))))
+
+(define (with-string-output-port generator)
+  (let ((port (make-accumulator-output-port)))
+    (generator port)
+    (operation/extract-output! port)))
+
+(define accumulator-output-port-type)
 (define (initialize-package!)
-  (set! output-string-port-type
+  (set! accumulator-output-port-type
        (make-port-type `((WRITE-SELF ,operation/write-self)
                          (WRITE-CHAR ,operation/write-char)
-                         (WRITE-SUBSTRING ,operation/write-substring))
+                         (WRITE-SUBSTRING ,operation/write-substring)
+                         (EXTRACT-OUTPUT! ,operation/extract-output!))
                        #f))
   unspecific)
 
-(define (with-output-to-string thunk)
-  (with-string-output-port
-   (lambda (port)
-     (with-output-to-port port thunk))))
-
-(define (with-string-output-port generator)
-  (let ((state (make-output-string-state (make-string 16) 0)))
-    (let ((port (make-port output-string-port-type state)))
-      (generator port)
-      (without-interrupts
-       (lambda ()
-        (string-head (output-string-state/accumulator state)
-                     (output-string-state/counter state)))))))
-
-(define output-string-port-type)
-
-(define-structure (output-string-state (type vector)
-                                      (conc-name output-string-state/))
-  accumulator
-  counter)
-
-(define (grow-accumulator! state min-size)
-  (let* ((old (output-string-state/accumulator state))
-        (n (string-length old))
-        (new
-         (make-string
-          (let loop ((n (fix:+ n n)))
-            (if (fix:>= n min-size)
-                n
-                (loop (fix:+ n n)))))))
-    (substring-move-left! old 0 n new 0)
-    (set-output-string-state/accumulator! state new)))
+(define (operation/write-self port output-port)
+  port
+  (write-string " to string" output-port))
 
 (define (operation/write-char port char)
   (without-interrupts
    (lambda ()
      (let* ((state (port/state port))
-           (n (output-string-state/counter state))
+           (n (accumulator-state-counter state))
            (n* (fix:+ n 1)))
-       (if (fix:= (string-length (output-string-state/accumulator state)) n)
+       (if (fix:= n (string-length (accumulator-state-accumulator state)))
           (grow-accumulator! state n*))
-       (string-set! (output-string-state/accumulator state) n char)
-       (set-output-string-state/counter! state n*)))))
+       (string-set! (accumulator-state-accumulator state) n char)
+       (set-accumulator-state-counter! state n*)))))
 
 (define (operation/write-substring port string start end)
   (without-interrupts
    (lambda ()
      (let* ((state (port/state port))
-           (n (output-string-state/counter state))
+           (n (accumulator-state-counter state))
            (n* (fix:+ n (fix:- end start))))
-       (if (fix:> n* (string-length (output-string-state/accumulator state)))
+       (if (fix:> n* (string-length (accumulator-state-accumulator state)))
           (grow-accumulator! state n*))
        (substring-move-left! string start end
-                            (output-string-state/accumulator state) n)
-       (set-output-string-state/counter! state n*)))))
+                            (accumulator-state-accumulator state) n)
+       (set-accumulator-state-counter! state n*)))))
 
-(define (operation/write-self port output-port)
-  port
-  (write-string " to string" output-port))
\ No newline at end of file
+(define (operation/extract-output! port)
+  (without-interrupts
+   (lambda ()
+     (let ((state (port/state port)))
+       (let ((result
+             (string-head (accumulator-state-accumulator state)
+                          (accumulator-state-counter state))))
+        (set-accumulator-state-accumulator! state (make-string 16))
+        (set-accumulator-state-counter! state 0)
+        result)))))
+
+(define-structure (accumulator-state (type vector))
+  accumulator
+  counter)
+
+(define (grow-accumulator! state min-size)
+  (let* ((old (accumulator-state-accumulator state))
+        (n (string-length old))
+        (new
+         (make-string
+          (let loop ((n (fix:+ n n)))
+            (if (fix:>= n min-size)
+                n
+                (loop (fix:+ n n)))))))
+    (substring-move-left! old 0 n new 0)
+    (set-accumulator-state-accumulator! state new)))
\ No newline at end of file