Eliminate cross-file dependency on gstate structure. Generic I/O port

now provides abstraction for managing additional state elements.

diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm
index 293752b96f763681334491295d99b190bb1d7516..81102e9d708287aa4ed8c2fe4ecf0d6941c45600 100644 (file)
--- a/v7/src/runtime/fileio.scm
+++ b/v7/src/runtime/fileio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fileio.scm,v 1.36 2008/02/02 02:07:56 cph Exp $
+$Id: fileio.scm,v 1.37 2008/02/02 04:28:43 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,12 +31,13 @@ USA.
 (declare (usual-integrations))
 \f
 (define (initialize-package!)
+  (set! operation/pathname (generic-i/o-port-accessor 0))
   (let ((other-operations
         `((LENGTH ,operation/length)
           (PATHNAME ,operation/pathname)
           (POSITION ,operation/position)
           (SET-POSITION! ,operation/set-position!)
-          (TRUENAME ,operation/truename)
+          (TRUENAME ,operation/pathname)
           (WRITE-SELF ,operation/write-self))))
     (let ((make-type
           (lambda (source sink)
@@ -50,29 +51,16 @@ USA.
 (define input-file-type)
 (define output-file-type)
 (define i/o-file-type)
-
-(define-structure (fstate (type vector)
-                         (initial-offset 4) ;must match "genio.scm"
-                         (constructor #f))
-  (pathname #f read-only #t))
+(define operation/pathname)
 
 (define (operation/length port)
   (channel-file-length
    (or (port/input-channel port)
        (port/output-channel port))))
 
-(define (operation/pathname port)
-  (fstate-pathname (port/state port)))
-
-(define operation/truename
-  ;; This works for unix because truename and pathname are the same.
-  ;; On operating system where they differ, there must be support to
-  ;; determine the truename.
-  operation/pathname)
-
 (define (operation/write-self port output-port)
   (write-string " for file: " output-port)
-  (write (->namestring (operation/truename port)) output-port))
+  (write (->namestring (operation/pathname port)) output-port))
 \f
 (define (operation/position port)
   (guarantee-positionable-port port 'OPERATION/POSITION)

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index f9c3940da8aa6858119c4c4ad0042a4d3b370b77..8e82b3ff822f9329cb23a5b67fcf3d7a012f79b3 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.60 2008/02/02 02:08:48 cph Exp $
+$Id: genio.scm,v 1.61 2008/02/02 04:28:44 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -74,34 +74,48 @@ USA.
        ((#F) generic-type10)
        ((CHANNEL) generic-type12)
        (else generic-type11)))))
-
-(define-structure (gstate (type vector) (constructor #f))
-  ;; Changes to this structure must be copied to "fileio.scm",
-  ;; "ttyio.scm", "strout.scm", and "strott.scm".
+\f
+(define-structure (gstate (constructor %make-gstate))
   (input-buffer #f read-only #t)
   (output-buffer #f read-only #t)
   coding
-  line-ending)
+  line-ending
+  (extra #f read-only #t))
 
 (define (make-gstate source sink coder-name normalizer-name . extra)
-  (list->vector
-   (cons* (and source
-              (make-input-buffer (->source source 'MAKE-GSTATE)
-                                 coder-name
-                                 normalizer-name))
-         (and sink
-              (make-output-buffer (->sink sink 'MAKE-GSTATE)
-                                  coder-name
-                                  normalizer-name))
-         coder-name
-         normalizer-name
-         extra)))
+  (%make-gstate (and source
+                    (make-input-buffer (->source source 'MAKE-GSTATE)
+                                       coder-name
+                                       normalizer-name))
+               (and sink
+                    (make-output-buffer (->sink sink 'MAKE-GSTATE)
+                                        coder-name
+                                        normalizer-name))
+               coder-name
+               normalizer-name
+               (list->vector extra)))
 
 (define-integrable (port-input-buffer port)
   (gstate-input-buffer (port/state port)))
 
 (define-integrable (port-output-buffer port)
   (gstate-output-buffer (port/state port)))
+
+(define (generic-i/o-port-accessor index)
+  (guarantee-index-fixnum index 'GENERIC-I/O-PORT-ACCESSOR)
+  (lambda (port)
+    (let ((extra (gstate-extra (port/state port))))
+      (if (not (fix:< index (vector-length extra)))
+         (error "Accessor index out of range:" index))
+      (vector-ref extra index))))
+
+(define (generic-i/o-port-modifier index)
+  (guarantee-index-fixnum index 'GENERIC-I/O-PORT-MODIFIER)
+  (lambda (port object)
+    (let ((extra (gstate-extra (port/state port))))
+      (if (not (fix:< index (vector-length extra)))
+         (error "Accessor index out of range:" index))
+      (vector-set! extra index object))))
 \f
 (define (initialize-package!)
   (let ((ops:in1

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 9442419334407d29c2a4e06039a0532e9c14d999..41d11566249fef46f57de7eb058099c2cb52d9c0 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.635 2008/02/02 03:44:52 cph Exp $
+$Id: runtime.pkg,v 14.636 2008/02/02 04:28:45 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1748,6 +1748,8 @@ USA.
   (files "genio")
   (parent (runtime))
   (export ()
+         generic-i/o-port-accessor
+         generic-i/o-port-modifier
          generic-i/o-port-type
          generic-io/char-ready?
          generic-io/close-input
@@ -1755,8 +1757,8 @@ USA.
          generic-io/flush-output
          generic-io/read-char
          make-generic-i/o-port
-         make-non-channel-port-source
-         make-non-channel-port-sink)
+         make-non-channel-port-sink
+         make-non-channel-port-source)
   (export (runtime console-i/o-port)
          input-buffer-contents
          make-gstate
@@ -4289,13 +4291,13 @@ USA.
   (files "usrint")
   (parent (runtime))
   (export ()
+         (write-notification-line with-notification)
          prompt-for-command-char
          prompt-for-command-expression
          prompt-for-confirmation
          prompt-for-evaluated-expression
          prompt-for-expression
-         with-notification
-         write-notification-line)
+         with-notification)
   (export (runtime rep)
          port/set-default-environment
          port/write-result)

diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm
index 05e7920e1cf639c37235a8a5c962f9a9f9fd32aa..cb902907cbcca114746fd8a7697bf90f4787566e 100644 (file)
--- a/v7/src/runtime/strott.scm
+++ b/v7/src/runtime/strott.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strott.scm,v 14.20 2008/02/02 02:02:52 cph Exp $
+$Id: strott.scm,v 14.21 2008/02/02 04:28:47 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -50,24 +50,23 @@ USA.
     (lambda (port)
       (with-output-to-port port thunk))))
 
-(define-structure (astate (type vector)
-                         (initial-offset 4) ;must match "genio.scm"
-                         (constructor #f))
-  extract
-  extract!)
-
+(define port/extract)
+(define port/extract!)
 (define output-string-port-type)
+
 (define (initialize-package!)
+  (set! port/extract (generic-i/o-port-accessor 0))
+  (set! port/extract! (generic-i/o-port-accessor 1))
   (set! output-string-port-type
        (make-port-type
         `((EXTRACT-OUTPUT
            ,(lambda (port)
               (output-port/flush-output port)
-              ((astate-extract (port/state port)))))
+              ((port/extract port))))
           (EXTRACT-OUTPUT!
            ,(lambda (port)
               (output-port/flush-output port)
-              ((astate-extract! (port/state port)))))
+              ((port/extract! port))))
           (WRITE-SELF
            ,(lambda (port output-port)
               port

diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm
index cf860d644a31793f335ce22979d9f1b22d7d7d73..d23f8a697ca85cc701be80de6fdea158eccc9964 100644 (file)
--- a/v7/src/runtime/strout.scm
+++ b/v7/src/runtime/strout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.31 2008/02/02 02:02:53 cph Exp $
+$Id: strout.scm,v 14.32 2008/02/02 04:28: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,
@@ -59,29 +59,29 @@ USA.
     (lambda (port)
       (with-output-to-port port thunk))))
 
-(define-structure (astate (type vector)
-                         (initial-offset 4) ;must match "genio.scm"
-                         (constructor #f))
-  extract
-  extract!
-  position)
-
+(define port/extract)
+(define port/extract!)
+(define port/position)
 (define accumulator-output-port-type)
+
 (define (initialize-package!)
+  (set! port/extract (generic-i/o-port-accessor 0))
+  (set! port/extract! (generic-i/o-port-accessor 1))
+  (set! port/position (generic-i/o-port-accessor 2))
   (set! accumulator-output-port-type
        (make-port-type
         `((EXTRACT-OUTPUT
            ,(lambda (port)
               (output-port/flush-output port)
-              ((astate-extract (port/state port)))))
+              ((port/extract port))))
           (EXTRACT-OUTPUT!
            ,(lambda (port)
               (output-port/flush-output port)
-              ((astate-extract! (port/state port)))))
+              ((port/extract! port))))
           (POSITION
            ,(lambda (port)
               (output-port/flush-output port)
-              ((astate-position (port/state port)))))
+              ((port/position port))))
           (WRITE-SELF
            ,(lambda (port output-port)
               port

diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm
index e78a94ec5e2989b166c4366d8392c4cfca26869e..aee4b755e57804136dd11eeb39d0ee05f12d0e11 100644 (file)
--- a/v7/src/runtime/ttyio.scm
+++ b/v7/src/runtime/ttyio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ttyio.scm,v 1.28 2008/01/30 20:02:36 cph Exp $
+$Id: ttyio.scm,v 1.29 2008/02/02 04:28: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,
@@ -54,13 +54,11 @@ USA.
        (set-console-i/o-port! port)
        (set-current-input-port! port)
        (set-current-output-port! port))))
+  (set! port/echo-input? (generic-i/o-port-accessor 0))
   (add-event-receiver! event:before-exit save-console-input)
   (add-event-receiver! event:after-restore reset-console))
 
-(define-structure (cstate (type vector)
-                         (initial-offset 4) ;must match "genio.scm"
-                         (constructor #f))
-  (echo-input? #f read-only #t))
+(define port/echo-input?)
 
 (define (save-console-input)
   ((ucode-primitive reload-save-string 1)
@@ -127,7 +125,7 @@ USA.
   (output-port/discretionary-flush port))
 
 (define (operation/discretionary-write-char char port)
-  (if (and (cstate-echo-input? (port/state port))
+  (if (and (port/echo-input? port)
           (not (nearest-cmdl/batch-mode?)))
       (output-port/write-char port char)))