From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 11 Jan 2017 06:32:51 +0000 (-0800)
Subject: Another round of cleanups and renames designed to simplify ports.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~159
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=93ef7fb79ef6660b878b842298b18ff43e5a21ff;p=mit-scheme.git

Another round of cleanups and renames designed to simplify ports.
---

diff --git a/src/runtime/input.scm b/src/runtime/input.scm
index 3a940c229..ad7f795b4 100644
--- a/src/runtime/input.scm
+++ b/src/runtime/input.scm
@@ -33,35 +33,29 @@ USA.
 ;;;; Low level
 
 (define (input-port/char-ready? port)
-  ((port/operation/char-ready? port) port))
-
-(define-integrable (input-port/%read-char port)
-  ((port/%operation/read-char port) port))
+  ((textual-port-operation/char-ready? port) port))
 
 (define (input-port/read-char port)
-  ((port/operation/read-char port) port))
+  ((textual-port-operation/read-char port) port))
 
 (define (input-port/unread-char port char)
-  ((port/operation/unread-char port) port char))
-
-(define-integrable (input-port/%peek-char port)
-  ((port/%operation/peek-char port) port))
+  ((textual-port-operation/unread-char port) port char))
 
 (define (input-port/peek-char port)
-  ((port/operation/peek-char port) port))
+  ((textual-port-operation/peek-char port) port))
 
 (define (input-port/read-string! port string)
   (input-port/read-substring! port string 0 (xstring-length string)))
 
 (define (input-port/read-substring! port string start end)
   (if (< start end)
-      ((port/operation/read-substring port) port string start end)
+      ((textual-port-operation/read-substring port) port string start end)
       0))
-
+
 (define (input-port/read-line port)
   (port/with-input-blocking-mode port 'BLOCKING
     (lambda ()
-      (let ((read-char (port/operation/read-char port)))
+      (let ((read-char (textual-port-operation/read-char port)))
 	(let loop ((a (make-accum 128)))
 	  (let ((char (read-char port)))
 	    (cond ((eof-object? char)
@@ -74,7 +68,7 @@ USA.
 (define (input-port/read-string port delimiters)
   (port/with-input-blocking-mode port 'BLOCKING
     (lambda ()
-      (let ((read-char (port/operation/read-char port)))
+      (let ((read-char (textual-port-operation/read-char port)))
 	(let loop ((a (make-accum 128)))
 	  (let ((char (read-char port)))
 	    (cond ((eof-object? char)
@@ -86,11 +80,11 @@ USA.
 		   (accum->string a))
 		  (else
 		   (loop (accum char a))))))))))
-
+
 (define (input-port/discard-chars port delimiters)
   (port/with-input-blocking-mode port 'BLOCKING
     (lambda ()
-      (let ((read-char (port/operation/read-char port)))
+      (let ((read-char (textual-port-operation/read-char port)))
 	(let loop ()
 	  (let ((char (read-char port)))
 	    (cond ((eof-object? char)
@@ -129,12 +123,12 @@ USA.
   (eq? object (eof-object)))
 
 (define (input-port/eof? port)
-  (let ((eof? (port/operation port 'EOF?)))
+  (let ((eof? (textual-port-operation port 'EOF?)))
     (and eof?
 	 (eof? port))))
 
 (define (input-port/line port)
-  (let ((operation (port/operation port 'INPUT-LINE)))
+  (let ((operation (textual-port-operation port 'INPUT-LINE)))
     (and operation
 	 (operation port))))
 
@@ -156,26 +150,22 @@ USA.
 		  (else #f))))
 	(input-port/char-ready? port))))
 
-(define (%read-char port)
-  (let loop ()
-    (or (input-port/%read-char port)
-	(loop))))
-
 (define (read-char #!optional port)
-  (%read-char (optional-input-port port 'READ-CHAR)))
+  (let ((port (optional-input-port port 'READ-CHAR)))
+    (let loop ()
+      (or (input-port/read-char port)
+	  (loop)))))
 
 (define (unread-char char #!optional port)
   (guarantee-char char 'UNREAD-CHAR)
   (input-port/unread-char (optional-input-port port 'UNREAD-CHAR) char))
 
-(define (%peek-char port)
-  (let loop ()
-    (or (input-port/%peek-char port)
-	(loop))))
-
 (define (peek-char #!optional port)
-  (%peek-char (optional-input-port port 'PEEK-CHAR)))
-
+  (let ((port (optional-input-port port 'READ-CHAR)))
+    (let loop ()
+      (or (input-port/peek-char port)
+	  (loop)))))
+
 (define (read-char-no-hang #!optional port)
   (let ((port (optional-input-port port 'READ-CHAR-NO-HANG)))
     (and (input-port/char-ready? port)
@@ -213,6 +203,8 @@ USA.
 			      string start end))
 
 (define (optional-input-port port caller)
-  (if (default-object? port)
-      (current-input-port)
-      (guarantee-input-port port caller)))
\ No newline at end of file
+  (let ((port (if (default-object? port) (current-input-port) port)))
+    (guarantee textual-input-port? port caller)
+    (if (not (textual-input-port-open? port))
+	(error:bad-range-argument port caller))
+    port))
\ No newline at end of file
diff --git a/src/runtime/output.scm b/src/runtime/output.scm
index d7d7769de..da3f34820 100644
--- a/src/runtime/output.scm
+++ b/src/runtime/output.scm
@@ -31,116 +31,104 @@ USA.
 
 ;;;; Low level
 
-(define-integrable (output-port/%write-char port char)
-  ((port/operation/write-char port) port char))
-
 (define (output-port/write-char port char)
-  ((port/operation/write-char port) port char))
+  ((textual-port-operation/write-char port) port char))
 
 (define (output-port/write-string port string)
   (output-port/write-substring port string 0 (xstring-length string)))
 
 (define (output-port/write-substring port string start end)
-  ((port/operation/write-substring port) port string start end))
+  ((textual-port-operation/write-substring port) port string start end))
 
 (define (output-port/fresh-line port)
-  ((port/operation/fresh-line port) port))
+  ((textual-port-operation/fresh-line port) port))
 
 (define (output-port/line-start? port)
-  ((port/operation/line-start? port) port))
+  ((textual-port-operation/line-start? port) port))
 
 (define (output-port/flush-output port)
-  ((port/operation/flush-output port) port))
-
-(define-integrable (output-port/%discretionary-flush port)
-  ((port/operation/discretionary-flush-output port) port))
+  ((textual-port-operation/flush-output port) port))
 
 (define (output-port/discretionary-flush port)
-  ((port/operation/discretionary-flush-output port) port))
+  ((textual-port-operation/discretionary-flush-output port) port))
 
 (define (output-port/write-object port object environment)
   (unparse-object/top-level object port #t environment))
 
 (define (output-port/x-size port)
-  (or (let ((operation (port/operation port 'X-SIZE)))
+  (or (let ((operation (textual-port-operation port 'X-SIZE)))
 	(and operation
 	     (operation port)))
       80))
 
 (define (output-port/y-size port)
-  (let ((operation (port/operation port 'Y-SIZE)))
+  (let ((operation (textual-port-operation port 'Y-SIZE)))
     (and operation
 	 (operation port))))
 
 (define (output-port/column port)
-  (let ((operation (port/operation port 'OUTPUT-COLUMN)))
+  (let ((operation (textual-port-operation port 'OUTPUT-COLUMN)))
     (and operation
 	 (operation port))))
 
 (define (output-port/bytes-written port)
-  (let ((operation (port/operation port 'BYTES-WRITTEN)))
+  (let ((operation (textual-port-operation port 'BYTES-WRITTEN)))
     (and operation
 	 (operation port))))
 
 (define (output-port/synchronize-output port)
-  (let ((operation (port/operation port 'SYNCHRONIZE-OUTPUT)))
+  (let ((operation (textual-port-operation port 'SYNCHRONIZE-OUTPUT)))
     (if operation
 	(operation port))))
 
 ;;;; High level
 
-(define (%write-char char port)
-  (if (let ((n (output-port/%write-char port char)))
-	(and n
-	     (fix:> n 0)))
-      (output-port/%discretionary-flush port)))
-
 (define (write-char char #!optional port)
-  (%write-char char (optional-output-port port 'WRITE-CHAR)))
+  (let ((port (optional-output-port port 'WRITE-CHAR)))
+    (if (let ((n (output-port/write-char port char)))
+	  (and n
+	       (fix:> n 0)))
+	(output-port/discretionary-flush port))))
 
 (define (write-string string #!optional port)
   (let ((port (optional-output-port port 'WRITE-STRING)))
     (if (let ((n (output-port/write-string port string)))
 	  (and n
-	       (> n 0)))
+	       (fix:> n 0)))
 	(output-port/discretionary-flush port))))
 
 (define (write-substring string start end #!optional port)
   (let ((port (optional-output-port port 'WRITE-SUBSTRING)))
     (if (let ((n (output-port/write-substring port string start end)))
 	  (and n
-	       (> n 0)))
+	       (fix:> n 0)))
 	(output-port/discretionary-flush port))))
 
 (define (newline #!optional port)
-  (let ((port (optional-output-port port 'NEWLINE)))
-    (if (let ((n (output-port/%write-char port #\newline)))
-	  (and n
-	       (fix:> n 0)))
-	(output-port/%discretionary-flush port))))
+  (write-char #\newline port))
 
 (define (fresh-line #!optional port)
   (let ((port (optional-output-port port 'FRESH-LINE)))
     (if (let ((n (output-port/fresh-line port)))
 	  (and n
 	       (fix:> n 0)))
-	(output-port/%discretionary-flush port))))
-
+	(output-port/discretionary-flush port))))
+
 (define (display object #!optional port environment)
   (let ((port (optional-output-port port 'DISPLAY)))
     (unparse-object/top-level object port #f environment)
-    (output-port/%discretionary-flush port)))
+    (output-port/discretionary-flush port)))
 
 (define (write object #!optional port environment)
   (let ((port (optional-output-port port 'WRITE)))
     (output-port/write-object port object environment)
-    (output-port/%discretionary-flush port)))
+    (output-port/discretionary-flush port)))
 
 (define (write-line object #!optional port environment)
   (let ((port (optional-output-port port 'WRITE-LINE)))
     (output-port/write-object port object environment)
-    (output-port/%write-char port #\newline)
-    (output-port/%discretionary-flush port)))
+    (output-port/write-char port #\newline)
+    (output-port/discretionary-flush port)))
 
 (define (flush-output-port #!optional port)
   (let ((port (optional-output-port port 'flush-output-port)))
@@ -151,19 +139,21 @@ USA.
 (define (wrap-custom-operation-0 operation-name)
   (lambda (#!optional port)
     (let ((port (optional-output-port port operation-name)))
-      (let ((operation (port/operation port operation-name)))
+      (let ((operation (textual-port-operation port operation-name)))
 	(if operation
 	    (begin
 	      (operation port)
-	      (output-port/%discretionary-flush port)))))))
+	      (output-port/discretionary-flush port)))))))
 
 (define beep (wrap-custom-operation-0 'BEEP))
 (define clear (wrap-custom-operation-0 'CLEAR))
 
 (define (optional-output-port port caller)
-  (if (default-object? port)
-      (current-output-port)
-      (guarantee-output-port port caller)))
+  (let ((port (if (default-object? port) (current-output-port) port)))
+    (guarantee textual-output-port? port caller)
+    (if (not (textual-output-port-open? port))
+	(error:bad-range-argument port caller))
+    port))
 
 ;;;; Tabular output
 
diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index 9226c96cd..0b0395627 100644
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -577,23 +577,23 @@ USA.
 			   (if (char=? char #\|)
 			       (read-unquoted #t char (%peek))
 			       (begin
-				 (%write-char (if (char=? char #\\)
-						  (%read)
-						  char)
-					      port*)
+				 (write-char (if (char=? char #\\)
+						 (%read)
+						 char)
+					     port*)
 				 (read-quoted)))))
 		       (error:illegal-char char)))
 		  ((char=? char #\\)
 		   (if quoting?
 		       (begin
-			 (%write-char (%read) port*)
+			 (write-char (%read) port*)
 			 ;; Forget previous char so
 			 ;; that quoting a final colon will
 			 ;; suppress it from being a keyword.
 			 (read-unquoted #t #f (%peek)))
 		       (error:illegal-char char)))
 		  (else
-		   (%write-char (%canon char) port*)
+		   (write-char (%canon char) port*)
 		   (read-unquoted quoted? char (%peek)))))))))
 
 (define (handler:list port db ctx char)
@@ -756,10 +756,10 @@ USA.
 			    ((char-ci=? char #\a) #\bel)
 			    ((char->digit char 8) (octal->char char port db))
 			    (else char)))))
-	       (%write-char char port*)
+	       (write-char char port*)
 	       (loop)))
 	    (else
-	     (%write-char char port*)
+	     (write-char char port*)
 	     (loop))))))))
 
 (define (octal->char c1 port db)
@@ -822,9 +822,9 @@ USA.
 	(name->char
 	 (call-with-output-string
 	   (lambda (port*)
-	     (%write-char char port*)
+	     (write-char char port*)
 	     (let loop ()
-	       (%write-char (let ((char (%read-char/no-eof port db)))
+	       (write-char (let ((char (%read-char/no-eof port db)))
 			     (if (char=? char #\\)
 				 (%read-char/no-eof port db)
 				 char))
@@ -856,7 +856,7 @@ USA.
 	 (let ((char (%read-char/no-eof port db)))
 	   (if (not (char=? char #\>))
 	       (begin
-		 (%write-char char port*)
+		 (write-char char port*)
 		 (loop)))))))))
 
 (define (handler:special-arg port db ctx char1 char2)
diff --git a/src/runtime/port.scm b/src/runtime/port.scm
index 6d0939a25..85592b473 100644
--- a/src/runtime/port.scm
+++ b/src/runtime/port.scm
@@ -29,78 +29,6 @@ USA.
 
 (declare (usual-integrations))
 
-(define (port? object)
-  (or (textual-port? object)
-      (binary-port? object)))
-
-(define (input-port? object)
-  (or (textual-input-port? object)
-      (binary-input-port? object)))
-
-(define (output-port? object)
-  (or (textual-output-port? object)
-      (binary-output-port? object)))
-
-(define (i/o-port? object)
-  (or (textual-i/o-port? object)
-      (binary-i/o-port? object)))
-
-#;
-(add-boot-init!
- (lambda ()
-   (register-predicate! port? 'port)
-   (set-predicate<=! binary-port? port?)
-   (set-predicate<=! textual-port? port?)
-   (register-predicate! input-port? 'port)
-   (set-predicate<=! binary-input-port? input-port?)
-   (set-predicate<=! textual-input-port? input-port?)
-   (register-predicate! output-port? 'port)
-   (set-predicate<=! binary-output-port? output-port?)
-   (set-predicate<=! textual-output-port? output-port?)
-   (register-predicate! i/o-port? 'port)
-   (set-predicate<=! binary-i/o-port? i/o-port?)
-   (set-predicate<=! textual-i/o-port? i/o-port?)))
-
-(define-guarantee port "port")
-(define-guarantee input-port "input port")
-(define-guarantee output-port "output port")
-(define-guarantee i/o-port "I/O port")
-
-(define (input-port-open? port)
-  (cond ((binary-input-port? port) (binary-input-port-open? port))
-	((textual-input-port? port) (textual-input-port-open? port))
-	(else (error:not-a input-port? port 'input-port-open?))))
-
-(define (output-port-open? port)
-  (cond ((binary-output-port? port) (binary-output-port-open? port))
-	((textual-output-port? port) (textual-output-port-open? port))
-	(else (error:not-a output-port? port 'output-port-open?))))
-
-(define (close-port port)
-  (cond ((binary-port? port) (close-binary-port port))
-	((textual-port? port) (close-textual-port port))
-	(else (error:not-a port? port 'close-port))))
-
-(define (close-input-port port)
-  (cond ((binary-input-port? port) (close-binary-input-port port))
-	((textual-input-port? port) (close-textual-input-port port))
-	(else (error:not-a input-port? port 'close-input-port))))
-
-(define (close-output-port port)
-  (cond ((binary-output-port? port) (close-binary-output-port port))
-	((textual-output-port? port) (close-textual-output-port port))
-	(else (error:not-a output-port? port 'close-output-port))))
-
-(define (input-port-channel port)
-  (cond ((binary-input-port? port) (binary-input-port-channel port))
-	((textual-input-port? port) (textual-input-port-channel port))
-	(else (error:not-a input-port? port 'input-port-channel))))
-
-(define (output-port-channel port)
-  (cond ((binary-output-port? port) (binary-output-port-channel port))
-	((textual-output-port? port) (textual-output-port-channel port))
-	(else (error:not-a output-port? port 'output-port-channel))))
-
 ;;;; Port type
 
 (define-structure (port-type (type-descriptor <textual-port-type>)
@@ -304,8 +232,8 @@ USA.
 	(else (op name))))))
 
 (define (generic-port-operation:read-substring port string start end)
-  (let ((char-ready? (port/operation/char-ready? port))
-	(read-char (port/operation/read-char port)))
+  (let ((char-ready? (textual-port-operation/char-ready? port))
+	(read-char (textual-port-operation/read-char port)))
     (let ((char (read-char port)))
       (cond ((not char) #f)
 	    ((eof-object? char) 0)
@@ -345,7 +273,7 @@ USA.
   unspecific)
 
 (define (generic-port-operation:write-substring port string start end)
-  (let ((write-char (port/operation/write-char port)))
+  (let ((write-char (textual-port-operation/write-char port)))
     (let loop ((i start))
       (if (< i end)
 	  (let ((n (write-char port (xstring-ref string i))))
@@ -423,7 +351,8 @@ USA.
 	     (let ((n (defer port string start end)))
 	       (if (and n (> n 0))
 		   (let ((end (+ start n)))
-		     (set-textual-port-previous! port (xstring-ref string (- end 1)))
+		     (set-textual-port-previous! port
+						 (xstring-ref string (- end 1)))
 		     (transcribe-substring string start end port)))
 	       n))))
 	(flush-output
@@ -475,23 +404,49 @@ USA.
   (guarantee-port-type type 'MAKE-PORT)
   (%make-textual-port type state (make-thread-mutex) #f #f '() #f))
 
+(define (textual-input-port? object)
+  (and (textual-port? object)
+       (port-type/supports-input? (port/type object))
+       #t))
+
+(define (textual-output-port? object)
+  (and (textual-port? object)
+       (port-type/supports-output? (port/type object))
+       #t))
+
+(define (textual-i/o-port? object)
+  (and (textual-port? object)
+       (let ((type (port/type object)))
+	 (and (port-type/supports-input? type)
+	      (port-type/supports-output? type)
+	      #t))))
+
+(add-boot-init!
+ (lambda ()
+   (register-predicate! textual-input-port? 'textual-input-port
+			'<= textual-port?)
+   (register-predicate! textual-output-port? 'textual-output-port
+			'<= textual-port?)
+   (register-predicate! textual-i/o-port? 'textual-i/o-port
+			'<= textual-port?)))
+
 (define (port=? p1 p2)
   (guarantee-port p1 'PORT=?)
   (guarantee-port p2 'PORT=?)
   (eq? p1 p2))
 
-(define (port/operation-names port)
+(define (textual-port-operation-names port)
   (port-type/operation-names (port/type port)))
 
-(define (port/operation port name)
-  (guarantee-port port 'port/operation)
+(define (textual-port-operation port name)
+  (guarantee textual-port? port 'textual-port-operation)
   (port-type/%operation (port/type port) name))
-
+
 (define-syntax define-port-operation
   (sc-macro-transformer
    (lambda (form environment)
      (let ((name (cadr form)))
-       `(DEFINE (,(symbol-append 'PORT/OPERATION/ name) PORT)
+       `(DEFINE (,(symbol-append 'TEXTUAL-PORT-OPERATION/ name) PORT)
 	  (,(close-syntax (symbol-append 'PORT-TYPE/ name) environment)
 	   (PORT/TYPE PORT)))))))
 
@@ -506,16 +461,6 @@ USA.
 (define-port-operation line-start?)
 (define-port-operation flush-output)
 (define-port-operation discretionary-flush-output)
-
-(define (port-position port)
-  ((or (port/operation port 'POSITION)
-       (error:bad-range-argument port 'PORT-POSITION))
-   port))
-
-(define (set-port-position! port position)
-  ((or (port/operation port 'SET-POSITION!)
-       (error:bad-range-argument port 'SET-PORT-POSITION!))
-   port position))
 
 (set-record-type-unparser-method! <textual-port>
   (lambda (state port)
@@ -524,7 +469,7 @@ USA.
 		  ((textual-input-port? port) 'TEXTUAL-INPUT-PORT)
 		  ((textual-output-port? port) 'TEXTUAL-OUTPUT-PORT)
 		  (else 'TEXTUAL-PORT))))
-       (cond ((port/operation port 'WRITE-SELF)
+       (cond ((textual-port-operation port 'WRITE-SELF)
 	      => (lambda (operation)
 		   (standard-unparser-method name operation)))
 	     (else
@@ -539,7 +484,7 @@ USA.
     port))
 
 (define (close-textual-port port)
-  (let ((close (port/operation port 'CLOSE)))
+  (let ((close (textual-port-operation port 'CLOSE)))
     (if close
 	(close port)
 	(begin
@@ -547,17 +492,17 @@ USA.
 	  (close-input-port port)))))
 
 (define (close-textual-input-port port)
-  (let ((close-input (port/operation port 'CLOSE-INPUT)))
+  (let ((close-input (textual-port-operation port 'CLOSE-INPUT)))
     (if close-input
 	(close-input port))))
 
 (define (close-textual-output-port port)
-  (let ((close-output (port/operation port 'CLOSE-OUTPUT)))
+  (let ((close-output (textual-port-operation port 'CLOSE-OUTPUT)))
     (if close-output
 	(close-output port))))
 
 (define (port/open? port)
-  (let ((open? (port/operation port 'OPEN?)))
+  (let ((open? (textual-port-operation port 'OPEN?)))
     (if open?
 	(open? port)
 	(and (if (textual-input-port? port)
@@ -568,24 +513,24 @@ USA.
 		 #t)))))
 
 (define (textual-input-port-open? port)
-  (let ((open? (port/operation port 'INPUT-OPEN?)))
+  (let ((open? (textual-port-operation port 'INPUT-OPEN?)))
     (if open?
 	(open? port)
 	#t)))
 
 (define (textual-output-port-open? port)
-  (let ((open? (port/operation port 'OUTPUT-OPEN?)))
+  (let ((open? (textual-port-operation port 'OUTPUT-OPEN?)))
     (if open?
 	(open? port)
 	#t)))
 
-(define (textual-port-input-channel port)
-  (let ((operation (port/operation port 'input-port-channel)))
+(define (textual-input-port-channel port)
+  (let ((operation (textual-port-operation port 'input-port-channel)))
     (and operation
 	 (operation port))))
 
-(define (textual-port-output-channel port)
-  (let ((operation (port/operation port 'output-port-channel)))
+(define (textual-output-port-channel port)
+  (let ((operation (textual-port-operation port 'output-port-channel)))
     (and operation
 	 (operation port))))
 
@@ -616,12 +561,14 @@ USA.
 
 (define (port/remove-property! port name)
   (guarantee-symbol name 'PORT/REMOVE-PROPERTY!)
-  (set-textual-port-properties! port (del-assq! name (textual-port-properties port))))
+  (set-textual-port-properties! port
+				(del-assq! name
+					   (textual-port-properties port))))
 
 (define (transcribe-char char port)
   (let ((tport (textual-port-transcript port)))
     (if tport
-	(%write-char char tport))))
+	(write-char char tport))))
 
 (define (transcribe-substring string start end port)
   (let ((tport (textual-port-transcript port)))
@@ -637,131 +584,114 @@ USA.
   (let ((tport (textual-port-transcript port)))
     (if tport
 	(output-port/discretionary-flush tport))))
-
-(define (textual-input-port? object)
-  (and (textual-port? object)
-       (port-type/supports-input? (port/type object))
-       #t))
 
-(define (textual-output-port? object)
-  (and (textual-port? object)
-       (port-type/supports-output? (port/type object))
-       #t))
-
-(define (textual-i/o-port? object)
-  (and (textual-port? object)
-       (let ((type (port/type object)))
-	 (and (port-type/supports-input? type)
-	      (port-type/supports-output? type)
-	      #t))))
-
 (define (port/supports-coding? port)
-  (let ((operation (port/operation port 'SUPPORTS-CODING?)))
+  (let ((operation (textual-port-operation port 'SUPPORTS-CODING?)))
     (if operation
 	(operation port)
 	#f)))
 
 (define (port/coding port)
-  ((or (port/operation port 'CODING)
+  ((or (textual-port-operation port 'CODING)
        (error:bad-range-argument port 'PORT/CODING))
    port))
 
 (define (port/set-coding port name)
-  ((or (port/operation port 'SET-CODING)
+  ((or (textual-port-operation port 'SET-CODING)
        (error:bad-range-argument port 'PORT/SET-CODING))
    port name))
 
 (define (port/known-coding? port name)
-  ((or (port/operation port 'KNOWN-CODING?)
+  ((or (textual-port-operation port 'KNOWN-CODING?)
        (error:bad-range-argument port 'PORT/KNOWN-CODING?))
    port name))
 
 (define (port/known-codings port)
-  ((or (port/operation port 'KNOWN-CODINGS)
+  ((or (textual-port-operation port 'KNOWN-CODINGS)
        (error:bad-range-argument port 'PORT/KNOWN-CODINGS))
    port))
 
 (define (port/line-ending port)
-  ((or (port/operation port 'LINE-ENDING)
+  ((or (textual-port-operation port 'LINE-ENDING)
        (error:bad-range-argument port 'PORT/LINE-ENDING))
    port))
 
 (define (port/set-line-ending port name)
-  ((or (port/operation port 'SET-LINE-ENDING)
+  ((or (textual-port-operation port 'SET-LINE-ENDING)
        (error:bad-range-argument port 'PORT/SET-LINE-ENDING))
    port name))
 
 (define (port/known-line-ending? port name)
-  ((or (port/operation port 'KNOWN-LINE-ENDING?)
+  ((or (textual-port-operation port 'KNOWN-LINE-ENDING?)
        (error:bad-range-argument port 'PORT/KNOWN-LINE-ENDING?))
    port name))
 
 (define (port/known-line-endings port)
-  ((or (port/operation port 'KNOWN-LINE-ENDINGS)
+  ((or (textual-port-operation port 'KNOWN-LINE-ENDINGS)
        (error:bad-range-argument port 'PORT/KNOWN-LINE-ENDINGS))
    port))
 
 ;;;; Special Operations
 
-(define (port/input-blocking-mode port)
-  (let ((operation (port/operation port 'INPUT-BLOCKING-MODE)))
+(define (input-port-blocking-mode port)
+  (let ((operation (textual-port-operation port 'INPUT-BLOCKING-MODE)))
     (if operation
 	(operation port)
 	#f)))
 
-(define (port/set-input-blocking-mode port mode)
-  (let ((operation (port/operation port 'SET-INPUT-BLOCKING-MODE)))
+(define (set-input-port-blocking-mode! port mode)
+  (let ((operation (textual-port-operation port 'SET-INPUT-BLOCKING-MODE)))
     (if operation
 	(operation port mode))))
 
-(define (port/with-input-blocking-mode port mode thunk)
+(define (with-input-port-blocking-mode port mode thunk)
   (bind-mode port 'INPUT-BLOCKING-MODE 'SET-INPUT-BLOCKING-MODE mode thunk))
 
-(define (port/output-blocking-mode port)
-  (let ((operation (port/operation port 'OUTPUT-BLOCKING-MODE)))
+(define (output-port-blocking-mode port)
+  (let ((operation (textual-port-operation port 'OUTPUT-BLOCKING-MODE)))
     (if operation
 	(operation port)
 	#f)))
 
-(define (port/set-output-blocking-mode port mode)
-  (let ((operation (port/operation port 'SET-OUTPUT-BLOCKING-MODE)))
+(define (set-output-port-blocking-mode! port mode)
+  (let ((operation (textual-port-operation port 'SET-OUTPUT-BLOCKING-MODE)))
     (if operation
 	(operation port mode))))
 
-(define (port/with-output-blocking-mode port mode thunk)
+(define (with-output-port-blocking-mode port mode thunk)
   (bind-mode port 'OUTPUT-BLOCKING-MODE 'SET-OUTPUT-BLOCKING-MODE mode thunk))
 
-(define (port/input-terminal-mode port)
-  (let ((operation (port/operation port 'INPUT-TERMINAL-MODE)))
+(define (input-port-terminal-mode port)
+  (let ((operation (textual-port-operation port 'INPUT-TERMINAL-MODE)))
     (if operation
 	(operation port)
 	#f)))
 
-(define (port/set-input-terminal-mode port mode)
-  (let ((operation (port/operation port 'SET-INPUT-TERMINAL-MODE)))
+(define (set-input-port-terminal-mode! port mode)
+  (let ((operation (textual-port-operation port 'SET-INPUT-TERMINAL-MODE)))
     (if operation
 	(operation port mode))))
 
-(define (port/with-input-terminal-mode port mode thunk)
+(define (with-input-port-terminal-mode port mode thunk)
   (bind-mode port 'INPUT-TERMINAL-MODE 'SET-INPUT-TERMINAL-MODE mode thunk))
 
-(define (port/output-terminal-mode port)
-  (let ((operation (port/operation port 'OUTPUT-TERMINAL-MODE)))
+(define (output-port-terminal-mode port)
+  (let ((operation (textual-port-operation port 'OUTPUT-TERMINAL-MODE)))
     (if operation
 	(operation port)
 	#f)))
 
-(define (port/set-output-terminal-mode port mode)
-  (let ((operation (port/operation port 'SET-OUTPUT-TERMINAL-MODE)))
+(define (set-output-port-terminal-mode! port mode)
+  (let ((operation (textual-port-operation port 'SET-OUTPUT-TERMINAL-MODE)))
     (if operation
 	(operation port mode))))
 
-(define (port/with-output-terminal-mode port mode thunk)
+(define (with-output-port-terminal-mode port mode thunk)
   (bind-mode port 'OUTPUT-TERMINAL-MODE 'SET-OUTPUT-TERMINAL-MODE mode thunk))
 
 (define (bind-mode port read-mode write-mode mode thunk)
-  (let ((read-mode (port/operation port read-mode))
-	(write-mode (port/operation port write-mode)))
+  (let ((read-mode (textual-port-operation port read-mode))
+	(write-mode (textual-port-operation port write-mode)))
     (if (and read-mode write-mode (read-mode port))
 	(let ((outside-mode))
 	  (dynamic-wind (lambda ()
@@ -777,6 +707,93 @@ USA.
 				(write-mode port outside-mode))))))
 	(thunk))))
 
+;;;; Generic ports
+
+(define port?)
+(define input-port?)
+(define output-port?)
+(define i/o-port?)
+(add-boot-init!
+ (lambda ()
+   (set! port? (disjoin textual-port? binary-port?))
+   (set! input-port? (disjoin textual-input-port? binary-input-port?))
+   (set! output-port? (disjoin textual-output-port? binary-output-port?))
+   (set! i/o-port? (disjoin textual-i/o-port? binary-i/o-port?))
+   unspecific))
+
+#|
+(define (port? object)
+  (or (textual-port? object)
+      (binary-port? object)))
+
+(define (input-port? object)
+  (or (textual-input-port? object)
+      (binary-input-port? object)))
+
+(define (output-port? object)
+  (or (textual-output-port? object)
+      (binary-output-port? object)))
+
+(define (i/o-port? object)
+  (or (textual-i/o-port? object)
+      (binary-i/o-port? object)))
+
+(add-boot-init!
+ (lambda ()
+   (register-predicate! port? 'port)
+   (set-predicate<=! binary-port? port?)
+   (set-predicate<=! textual-port? port?)
+   (register-predicate! input-port? 'port)
+   (set-predicate<=! binary-input-port? input-port?)
+   (set-predicate<=! textual-input-port? input-port?)
+   (register-predicate! output-port? 'port)
+   (set-predicate<=! binary-output-port? output-port?)
+   (set-predicate<=! textual-output-port? output-port?)
+   (register-predicate! i/o-port? 'port)
+   (set-predicate<=! binary-i/o-port? i/o-port?)
+   (set-predicate<=! textual-i/o-port? i/o-port?)))
+|#
+
+(define-guarantee port "port")
+(define-guarantee input-port "input port")
+(define-guarantee output-port "output port")
+(define-guarantee i/o-port "I/O port")
+
+(define (input-port-open? port)
+  (cond ((binary-input-port? port) (binary-input-port-open? port))
+	((textual-input-port? port) (textual-input-port-open? port))
+	(else (error:not-a input-port? port 'input-port-open?))))
+
+(define (output-port-open? port)
+  (cond ((binary-output-port? port) (binary-output-port-open? port))
+	((textual-output-port? port) (textual-output-port-open? port))
+	(else (error:not-a output-port? port 'output-port-open?))))
+
+(define (close-port port)
+  (cond ((binary-port? port) (close-binary-port port))
+	((textual-port? port) (close-textual-port port))
+	(else (error:not-a port? port 'close-port))))
+
+(define (close-input-port port)
+  (cond ((binary-input-port? port) (close-binary-input-port port))
+	((textual-input-port? port) (close-textual-input-port port))
+	(else (error:not-a input-port? port 'close-input-port))))
+
+(define (close-output-port port)
+  (cond ((binary-output-port? port) (close-binary-output-port port))
+	((textual-output-port? port) (close-textual-output-port port))
+	(else (error:not-a output-port? port 'close-output-port))))
+
+(define (input-port-channel port)
+  (cond ((binary-input-port? port) (binary-input-port-channel port))
+	((textual-input-port? port) (textual-input-port-channel port))
+	(else (error:not-a input-port? port 'input-port-channel))))
+
+(define (output-port-channel port)
+  (cond ((binary-output-port? port) (binary-output-port-channel port))
+	((textual-output-port? port) (textual-output-port-channel port))
+	(else (error:not-a output-port? port 'output-port-channel))))
+
 ;;;; Standard Ports
 
 (define current-input-port)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index c06e68b6c..bd271647b 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2465,6 +2465,7 @@ USA.
 	  close-binary-output-port
 	  close-binary-port)
   (export (runtime output-port)
+	  binary-output-port?
 	  flush-binary-output-port))
 
 (define-package (runtime port)
@@ -2472,11 +2473,25 @@ USA.
   (parent (runtime))
   (export ()
 	  ;; BEGIN legacy bindings
+	  (port/input-blocking-mode input-port-blocking-mode)
 	  (port/input-channel input-port-channel)
+	  (port/input-terminal-mode input-port-terminal-mode)
+	  (port/operation textual-port-operation)
+	  (port/operation-names textual-port-operation-names)
+	  (port/output-blocking-mode output-port-blocking-mode)
 	  (port/output-channel output-port-channel)
+	  (port/output-terminal-mode output-port-terminal-mode)
+	  (port/set-input-blocking-mode set-input-port-blocking-mode!)
+	  (port/set-input-terminal-mode set-input-port-terminal-mode!)
+	  (port/set-output-blocking-mode set-output-port-blocking-mode!)
+	  (port/set-output-terminal-mode set-output-port-terminal-mode!)
 	  (port/state textual-port-state)
 	  (port/thread-mutex textual-port-thread-mutex)
 	  (port/type textual-port-type)
+	  (port/with-input-blocking-mode with-input-port-blocking-mode)
+	  (port/with-input-terminal-mode with-input-port-terminal-mode)
+	  (port/with-output-blocking-mode with-output-port-blocking-mode)
+	  (port/with-output-terminal-mode with-output-port-terminal-mode)
 	  (set-port/state! set-textual-port-state!)
 	  ;; END legacy bindings
 	  close-input-port
@@ -2489,20 +2504,21 @@ USA.
 	  guarantee-output-port
 	  guarantee-port
 	  i/o-port?
+	  input-port-blocking-mode
 	  input-port-channel
 	  input-port-open?
+	  input-port-terminal-mode
 	  input-port?
 	  interaction-i/o-port
 	  notification-output-port
+	  output-port-blocking-mode
 	  output-port-channel
 	  output-port-open?
+	  output-port-terminal-mode
 	  output-port?
-	  port-position
 	  port/coding
 	  port/copy
 	  port/get-property
-	  port/input-blocking-mode
-	  port/input-terminal-mode
 	  port/intern-property!
 	  port/known-coding?
 	  port/known-codings
@@ -2510,61 +2526,62 @@ USA.
 	  port/known-line-endings
 	  port/line-ending
 	  port/open?
-	  port/operation
-	  port/operation-names
-	  port/output-blocking-mode
-	  port/output-terminal-mode
+	  textual-port-operation
+	  textual-port-operation-names
 	  port/remove-property!
 	  port/set-coding
-	  port/set-input-blocking-mode
-	  port/set-input-terminal-mode
 	  port/set-line-ending
-	  port/set-output-blocking-mode
-	  port/set-output-terminal-mode
 	  port/set-property!
 	  port/supports-coding?
-	  port/with-input-blocking-mode
-	  port/with-input-terminal-mode
-	  port/with-output-blocking-mode
-	  port/with-output-terminal-mode
 	  port=?
 	  port?
 	  set-current-input-port!
 	  set-current-output-port!
+	  set-input-port-blocking-mode!
+	  set-input-port-terminal-mode!
 	  set-interaction-i/o-port!
 	  set-notification-output-port!
-	  set-port-position!
+	  set-output-port-blocking-mode!
+	  set-output-port-terminal-mode!
 	  set-trace-output-port!
 	  textual-port?
 	  trace-output-port
 	  with-input-from-port
+	  with-input-port-blocking-mode
+	  with-input-port-terminal-mode
 	  with-interaction-i/o-port
 	  with-notification-output-port
+	  with-output-port-blocking-mode
+	  with-output-port-terminal-mode
 	  with-output-to-port
 	  with-trace-output-port)
   (export (runtime)
+	  (port/input-channel textual-input-port-channel)
+	  (port/output-channel textual-output-port-channel)
 	  generic-port-operation:write-substring
 	  make-port
 	  make-port-type
-	  port/input-channel
-	  port/output-channel
 	  set-textual-port-state!
 	  textual-port-state)
   (export (runtime input-port)
-	  port/operation
-	  port/operation/char-ready?
-	  port/operation/peek-char
-	  port/operation/read-char
-	  port/operation/read-substring
-	  port/operation/unread-char)
+	  textual-input-port-open?
+	  textual-input-port?
+	  textual-port-operation
+	  textual-port-operation/char-ready?
+	  textual-port-operation/peek-char
+	  textual-port-operation/read-char
+	  textual-port-operation/read-substring
+	  textual-port-operation/unread-char)
   (export (runtime output-port)
-	  port/operation
-	  port/operation/discretionary-flush-output
-	  port/operation/flush-output
-	  port/operation/fresh-line
-	  port/operation/line-start?
-	  port/operation/write-char
-	  port/operation/write-substring)
+	  textual-output-port-open?
+	  textual-output-port?
+	  textual-port-operation
+	  textual-port-operation/discretionary-flush-output
+	  textual-port-operation/flush-output
+	  textual-port-operation/fresh-line
+	  textual-port-operation/line-start?
+	  textual-port-operation/write-char
+	  textual-port-operation/write-substring)
   (export (runtime transcript)
 	  set-textual-port-transcript!
 	  textual-port-transcript)
@@ -2580,16 +2597,10 @@ USA.
   (parent (runtime))
   (export ()
 	  (discard-char read-char)
-	  (%discard-char %read-char)
-	  (input-port/%discard-char input-port/%read-char)
 	  (input-port/discard-char input-port/read-char)
-	  %read-char
-	  %peek-char
 	  char-ready?
 	  eof-object
 	  eof-object?
-	  input-port/%read-char
-	  input-port/%peek-char
 	  input-port/char-ready?
 	  input-port/line
 	  input-port/discard-chars
@@ -2618,7 +2629,6 @@ USA.
   (parent (runtime))
   (export ()
 	  (flush-output flush-output-port)
-	  %write-char
 	  beep
 	  call-with-truncated-output-port
 	  clear
@@ -2626,8 +2636,6 @@ USA.
 	  flush-output-port
 	  fresh-line
 	  newline
-	  output-port/%write-char
-	  output-port/%discretionary-flush
 	  output-port/bytes-written
 	  output-port/column
 	  output-port/discretionary-flush
diff --git a/src/runtime/unicode.scm b/src/runtime/unicode.scm
index 305fa9102..ee9e63cc6 100644
--- a/src/runtime/unicode.scm
+++ b/src/runtime/unicode.scm
@@ -258,10 +258,10 @@ USA.
   (let ((input (open-input string start end))
 	(output (open-output)))
     (let loop ()
-      (let ((c (%read-char input)))
+      (let ((c (read-char input)))
 	(if (not (eof-object? c))
 	    (begin
-	      (%write-char c output)
+	      (write-char c output)
 	      (loop)))))
     (get-output-string! output)))
 
@@ -681,7 +681,7 @@ USA.
 (define (for-all-chars-in-string? predicate string #!optional start end coding)
   (let ((port (open-string string start end coding 'FOR-ALL-CHARS-IN-STRING?)))
     (let loop ()
-      (let ((char (%read-char port)))
+      (let ((char (read-char port)))
 	(cond ((eof-object? char) #t)
 	      ((predicate char) (loop))
 	      (else #f))))))
@@ -689,7 +689,7 @@ USA.
 (define (for-any-char-in-string? predicate string #!optional start end coding)
   (let ((port (open-string string start end coding 'FOR-ANY-CHAR-IN-STRING?)))
     (let loop ()
-      (let ((char (%read-char port)))
+      (let ((char (read-char port)))
 	(cond ((eof-object? char) #f)
 	      ((predicate char) #t)
 	      (else (loop)))))))