Simplify console port exports.

* Eliminate console-input-port, console-output-port, and set-console-i/o-port!.
* Change console-i/o-port to be a thunk that returns the port.

diff --git a/src/edwin/bios.scm b/src/edwin/bios.scm
index 8ddce9577643c6afb3bd1a79074b6fb51cf49d8f..7bc1a492eb3dc9c5c89ce2f3adb990d1d4c1439b 100644 (file)
--- a/src/edwin/bios.scm
+++ b/src/edwin/bios.scm
@@ -31,9 +31,9 @@ USA.
 \f
 (define (make-bios-screen)
   ;; What is the baud rate needed for?  It's not even meaningful.
-  (let ((baud-rate (output-port/baud-rate console-output-port))
-       (x-size (output-port/x-size console-output-port))
-       (y-size (output-port/y-size console-output-port)))
+  (let ((baud-rate (output-port/baud-rate (console-i/o-port)))
+       (x-size (output-port/x-size (console-i/o-port)))
+       (y-size (output-port/y-size (console-i/o-port))))
     (make-screen (cons (fix:-1+ y-size) (fix:-1+ x-size))
                 bios-console-beep
                 bios-console-clear-line!

diff --git a/src/edwin/termcap.scm b/src/edwin/termcap.scm
index bec84e5e3f1c1e8d97d7ec94d9e26911ddd7e345..727da19510328713821b806d38af028e221cbfb7 100644 (file)
--- a/src/edwin/termcap.scm
+++ b/src/edwin/termcap.scm
@@ -129,8 +129,8 @@ USA.
 \f
 (define (make-termcap-description terminal-type-name)
   (if (string-ci=? terminal-type-name "ansi.sys")
-      (let ((x-size (output-port/x-size console-output-port))
-           (y-size (output-port/y-size console-output-port)))
+      (let ((x-size (output-port/x-size (console-i/o-port)))
+           (y-size (output-port/y-size (console-i/o-port))))
        (make-ansi-terminal-description x-size y-size))
       (and (implemented-primitive-procedure?
            (ucode-primitive termcap-initialize 1))

diff --git a/src/edwin/tterm.scm b/src/edwin/tterm.scm
index dcc01c3bfa0402be5f10a62e21b40aa845a48fc2..296bce796f9c6ed860d18562161ecbf4b49b0cc3 100644 (file)
--- a/src/edwin/tterm.scm
+++ b/src/edwin/tterm.scm
@@ -30,7 +30,7 @@ USA.
 \f
 (define (make-console-screen)
   (let ((description (console-termcap-description)))
-    (cond ((not (output-port/baud-rate console-i/o-port))
+    (cond ((not (output-port/baud-rate (console-i/o-port)))
           (error "standard output not a terminal"))
          ((not description)
           (error "terminal type not set"))
@@ -42,9 +42,9 @@ USA.
          ((not (no-undesirable-characteristics? description))
           (error "terminal type has undesirable characteristics"
                  (terminal-type-name description))))
-    (let ((baud-rate (output-port/baud-rate console-i/o-port))
-         (x-size (output-port/x-size console-i/o-port))
-         (y-size (output-port/y-size console-i/o-port)))
+    (let ((baud-rate (output-port/baud-rate (console-i/o-port)))
+         (x-size (output-port/x-size (console-i/o-port)))
+         (y-size (output-port/y-size (console-i/o-port))))
       (make-screen (with-values
                       (lambda ()
                         (compute-scrolling-costs description
@@ -113,7 +113,7 @@ USA.
       (set! console-description
            (let ((term (get-environment-variable "TERM")))
              (and term
-                  (or (and (output-port/baud-rate console-i/o-port)
+                  (or (and (output-port/baud-rate (console-i/o-port))
                            (make-termcap-description term))
                       term)))))
   console-description)
@@ -168,7 +168,7 @@ USA.
   ;; terminal's special key sequences against the buffer.  They wait a
   ;; little-while for incomplete sequences, then yield the individual
   ;; characters.
-  (let ((channel (port/input-channel console-i/o-port))
+  (let ((channel (port/input-channel (console-i/o-port)))
         (buffer  (make-string (* 3 input-buffer-size)))
         (start   0)
         (end     0)
@@ -398,10 +398,10 @@ USA.
   (bind-console-state false
     (lambda (get-outside-state)
       (terminal-operation terminal-raw-input
-                         (port/input-channel console-i/o-port))
-      (channel-nonblocking (port/input-channel console-i/o-port))
+                         (port/input-channel (console-i/o-port)))
+      (channel-nonblocking (port/input-channel (console-i/o-port)))
       (terminal-operation terminal-raw-output
-                         (port/output-channel console-i/o-port))
+                         (port/output-channel (console-i/o-port)))
       (tty-set-interrupt-enables 2)
       (receiver
        (lambda (thunk)
@@ -424,14 +424,14 @@ USA.
                    (set-console-state! outside-state)))))
 
 (define (console-state)
-  (vector (channel-state (port/input-channel console-i/o-port))
-         (channel-state (port/output-channel console-i/o-port))
+  (vector (channel-state (port/input-channel (console-i/o-port)))
+         (channel-state (port/output-channel (console-i/o-port)))
          (tty-get-interrupt-enables)))
 
 (define (set-console-state! state)
-  (set-channel-state! (port/input-channel console-i/o-port)
+  (set-channel-state! (port/input-channel (console-i/o-port))
                      (vector-ref state 0))
-  (set-channel-state! (port/output-channel console-i/o-port)
+  (set-channel-state! (port/output-channel (console-i/o-port))
                      (vector-ref state 1))
   (tty-set-interrupt-enables (vector-ref state 2)))
 
@@ -551,7 +551,7 @@ USA.
     (exit-insert-mode screen)
     (maybe-output screen (ts-exit-keypad-mode description))
     (maybe-output screen (ts-exit-termcap-mode description)))
-  (output-port/flush-output console-i/o-port))
+  (output-port/flush-output (console-i/o-port)))
 
 (define (console-modeline-event! screen window type)
   screen window type
@@ -560,14 +560,14 @@ USA.
 (define (console-wrap-update! screen thunk)
   (let ((finished? (thunk)))
     (window-direct-output-cursor! (screen-cursor-window screen))
-    (output-port/flush-output console-i/o-port)
+    (output-port/flush-output (console-i/o-port))
     finished?))
 
 (define (console-discretionary-flush screen)
-  (let ((n (output-port/buffered-bytes console-i/o-port)))
+  (let ((n (output-port/buffered-bytes (console-i/o-port))))
     (if (fix:< 20 n)
        (begin
-         (output-port/flush-output console-i/o-port)
+         (output-port/flush-output (console-i/o-port))
          (let ((baud-rate (screen-baud-rate screen)))
            (if (fix:< baud-rate 2400)
                (let ((msec (quotient (* n 10000) baud-rate)))
@@ -582,7 +582,7 @@ USA.
 
 (define (console-flush! screen)
   screen
-  (output-port/flush-output console-i/o-port))
+  (output-port/flush-output (console-i/o-port)))
 \f
 (define (console-write-cursor! screen x y)
   (move-cursor screen x y))
@@ -596,7 +596,7 @@ USA.
        (exit-insert-mode screen)
        (move-cursor screen x y)
        (highlight-if-desired screen highlight)
-       (output-port/write-char console-i/o-port char)
+       (output-port/write-char (console-i/o-port) char)
        (record-cursor-after-output screen (fix:1+ x)))))
 
 (define (console-write-substring! screen x y string start end highlight)
@@ -613,7 +613,7 @@ USA.
                                 (screen-x-size screen))))
                   (fix:-1+ end)
                   end)))
-         (output-port/write-substring console-i/o-port string start end)
+         (output-port/write-substring (console-i/o-port) string start end)
          (record-cursor-after-output screen (fix:+ x (fix:- end start)))))))
 
 (define (console-clear-line! screen x y first-unused-x)
@@ -745,7 +745,7 @@ USA.
                       first-unused-x)))
              (do ((x (screen-cursor-x screen) (fix:1+ x)))
                  ((fix:= x first-unused-x))
-               (output-port/write-char console-i/o-port #\space))
+               (output-port/write-char (console-i/o-port) #\space))
              (record-cursor-after-output screen first-unused-x)))))))
 
 (define (clear-multi-char screen n)
@@ -770,7 +770,7 @@ USA.
                           x-end))))
                (do ((x cursor-x (fix:1+ x)))
                    ((fix:= x x-end))
-                 (output-port/write-char console-i/o-port #\space))
+                 (output-port/write-char (console-i/o-port) #\space))
                (record-cursor-after-output screen x-end))))))))
 \f
 (define (insert-lines screen yl yu n)
@@ -1091,7 +1091,7 @@ USA.
   (output-n screen command 1))
 
 (define-integrable (output-n screen command n-lines)
-  (output-port/write-string console-i/o-port
+  (output-port/write-string (console-i/o-port)
                            (pad-string screen command n-lines)))
 
 (define (maybe-output screen command)
@@ -1223,7 +1223,7 @@ Note that the multiply factors are in tenths of characters.  |#
         (state (screen-state screen)))
     (if (not (terminal-state? state))
        (editor-error "Not a terminal screen")
-       (let ((port console-i/o-port)
+       (let ((port (console-i/o-port))
              (desc (terminal-state/description state)))
          (let ((x-size (output-port/x-size port))
                (y-size (output-port/y-size port)))

diff --git a/src/edwin/win32.scm b/src/edwin/win32.scm
index 47a662aa3da8f2385aef52632e6421a579ae4089..8327b28df75f632e54d9bbe5233e3c4a97649333 100644 (file)
--- a/src/edwin/win32.scm
+++ b/src/edwin/win32.scm
@@ -48,7 +48,7 @@ USA.
   (win32-screen-write-substring! 7))
 
 ;;(define (debug . details)
-;;  (pp details console-output-port))
+;;  (pp details (console-i/o-port)))
 
 (define-structure (win32-screen-state
                   (constructor make-win32-screen-state (handle))

diff --git a/src/runtime/console-io.scm b/src/runtime/console-io.scm
index e323339708d9be763ed7d0fc05785601d827513b..ac56b24cce9b25344faa285b2bc8a8e0efe8f47d 100644 (file)
--- a/src/runtime/console-io.scm
+++ b/src/runtime/console-io.scm
@@ -54,7 +54,6 @@ USA.
        (set-channel-port! input-channel port)
        (set-channel-port! output-channel port)
        (set! the-console-port port)
-       (set-console-i/o-port! port)
        (current-input-port port)
        (current-output-port port))))
   (set! port/echo-input? (generic-i/o-port-accessor 0))
@@ -65,7 +64,7 @@ USA.
 
 (define (save-console-input)
   ((ucode-primitive reload-save-string 1)
-   (generic-io/buffer-contents console-input-port)))
+   (generic-io/buffer-contents the-console-port)))
 
 (define (reset-console)
   (let ((input-channel (tty-input-channel))
@@ -86,21 +85,13 @@ USA.
               (default-object)
               (channel-type=file? input-channel)))
 
-(define (set-console-i/o-port! port)
-  (if (not (i/o-port? port))
-      (error:wrong-type-argument port "I/O port" 'set-console-i/o-port!))
-  (set! console-i/o-port port)
-  (set! console-input-port port)
-  (set! console-output-port port)
-  unspecific)
+(define (console-i/o-port)
+  the-console-port)
 
 (define (console-i/o-port? port)
-  (eqv? port console-i/o-port))
+  (eqv? port the-console-port))
 
 (define the-console-port)
-(define console-i/o-port)
-(define console-input-port)
-(define console-output-port)
 \f
 (define (operation/read-char port)
   (let ((char (generic-io/read-char port)))

diff --git a/src/runtime/gcstat.scm b/src/runtime/gcstat.scm
index 0e0035cb8e4dcfccb55f75ae993dbb7461c9db7f..0f7e2333ce798860c952e1c1adc67078c1f5737e 100644 (file)
--- a/src/runtime/gcstat.scm
+++ b/src/runtime/gcstat.scm
@@ -43,7 +43,7 @@ USA.
   unspecific)
 
 (define (recorder/gc-start)
-  (port/gc-start console-i/o-port)
+  (port/gc-start (console-i/o-port))
   (set! this-gc-start-uctime (get-universal-time))
   (set! this-gc-start-clock (real-time-clock))
   (set! this-gc-start (process-time-clock))
@@ -58,7 +58,7 @@ USA.
                     space-remaining
                     this-gc-start-uctime
                     this-gc-start-clock end-time-clock))
-  (port/gc-finish console-i/o-port))
+  (port/gc-finish (console-i/o-port)))
 \f
 (define timestamp)
 (define total-gc-time)

diff --git a/src/runtime/interrupt.scm b/src/runtime/interrupt.scm
index dfca0db5e155c9038ca115baa08cb0f153bc5f95..052b780eb37997a5e5ac881d53f2454e4f06bc63 100644 (file)
--- a/src/runtime/interrupt.scm
+++ b/src/runtime/interrupt.scm
@@ -191,7 +191,7 @@ USA.
 
 (define (signal-interrupt hook/interrupt hook/clean-input char interrupt)
   (let ((thread
-        (thread-mutex-owner (textual-port-thread-mutex console-i/o-port))))
+        (thread-mutex-owner (textual-port-thread-mutex (console-i/o-port)))))
     (if thread
        (signal-thread-event thread
          (lambda ()

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index ec83273d95640d9adcffa187208dcfcead399725..f298d2c450bf5164a03edafbaffb972d5be73c4e 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -599,13 +599,13 @@ USA.
                      'gc-boot-loading?
                      #f)
   (set! fasload-purification-queue)
-  (newline console-output-port)
-  (write-string "purifying..." console-output-port)
+  (newline (console-i/o-port))
+  (write-string "purifying..." (console-i/o-port))
   ;; First, flush whatever we can.
   (gc-clean)
   ;; Then, really purify the rest.
   (purify roots #t #f)
-  (write-string "done" console-output-port))
+  (write-string "done" (console-i/o-port)))
 
 )
 

diff --git a/src/runtime/rep.scm b/src/runtime/rep.scm
index 9699abc67eb553e76619ec891e8d9b3bd141a7e7..9a830159153518079d2294a71262a1db1976050c 100644 (file)
--- a/src/runtime/rep.scm
+++ b/src/runtime/rep.scm
@@ -46,7 +46,7 @@ USA.
    (lambda (continuation)
      (set! root-continuation continuation)
      (repl/start (make-repl #f
-                           console-i/o-port
+                           (console-i/o-port)
                            user-initial-environment
                            #f
                            `((set-default-directory
@@ -215,7 +215,7 @@ USA.
   (let ((cmdl (param:nearest-cmdl)))
     (if cmdl
        (cmdl/port cmdl)
-       console-i/o-port)))
+       (console-i/o-port))))
 
 (define (nearest-cmdl/level)
   (let ((cmdl (param:nearest-cmdl)))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 13fb600c71c1c46ef9776bafe9a5793bc087cfae..787bcdbad72557babefd3fdfde5c7259379c93bf 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1552,10 +1552,7 @@ USA.
          tty-output-channel)
   (export ()
          console-i/o-port
-         console-i/o-port?
-         console-input-port
-         console-output-port
-         set-console-i/o-port!)
+         console-i/o-port?)
   (export (runtime emacs-interface)
          the-console-port)
   (initialization (initialize-package!)))

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 3f6f82672d0995c1b60f93b03e8e95d5f696246b..1f034636ee45edf38b97f70ce60a7d6dadd937f6 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -264,7 +264,7 @@ USA.
          ((not return?) (run-first-thread)))))
 
 (define (console-thread)
-  (thread-mutex-owner (textual-port-thread-mutex console-i/o-port)))
+  (thread-mutex-owner (textual-port-thread-mutex (console-i/o-port))))
 
 (define (other-running-threads?)
   (thread/next (current-thread)))