From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 9 May 2018 04:50:15 +0000 (-0700)
Subject: Simplify console port exports.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~72
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3c875a4dfbc7907615f59fd679be8dba2b7a8640;p=mit-scheme.git

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 8ddce9577..7bc1a492e 100644
--- a/src/edwin/bios.scm
+++ b/src/edwin/bios.scm
@@ -31,9 +31,9 @@ USA.
 
 (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 bec84e5e3..727da1951 100644
--- a/src/edwin/termcap.scm
+++ b/src/edwin/termcap.scm
@@ -129,8 +129,8 @@ USA.
 
 (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 dcc01c3bf..296bce796 100644
--- a/src/edwin/tterm.scm
+++ b/src/edwin/tterm.scm
@@ -30,7 +30,7 @@ USA.
 
 (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)))
 
 (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))))))))
 
 (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 47a662aa3..8327b28df 100644
--- 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 e32333970..ac56b24cc 100644
--- 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)
 
 (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 0e0035cb8..0f7e2333c 100644
--- 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)))
 
 (define timestamp)
 (define total-gc-time)
diff --git a/src/runtime/interrupt.scm b/src/runtime/interrupt.scm
index dfca0db5e..052b780eb 100644
--- 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 ec83273d9..f298d2c45 100644
--- 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 9699abc67..9a8301591 100644
--- 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 13fb600c7..787bcdbad 100644
--- 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 3f6f82672..1f034636e 100644
--- 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)))