From: Chris Hanson Date: Sat, 2 Feb 2008 04:28:49 +0000 (+0000) Subject: Eliminate cross-file dependency on gstate structure. Generic I/O port X-Git-Tag: 20090517-FFI~359 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d27fd51d0b7cf1076b32ff708c1956238707c4cb;p=mit-scheme.git 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 293752b96..81102e9d7 100644 --- 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)) (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)) (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 f9c3940da..8e82b3ff8 100644 --- 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". + +(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)))) (define (initialize-package!) (let ((ops:in1 diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 944241933..41d115662 100644 --- 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 05e7920e1..cb902907c 100644 --- 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 cf860d644..d23f8a697 100644 --- 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 e78a94ec5..aee4b755e 100644 --- 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)))