From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 21 Oct 1993 14:52:45 +0000 (+0000)
Subject: * New port operation WRITE-SELF is like PRINT-SELF except that it uses
X-Git-Tag: 20090517-FFI~7713
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4206e2e29e390421a44c88f787ce2f7a19838f99;p=mit-scheme.git

* New port operation WRITE-SELF is like PRINT-SELF except that it uses
  STANDARD-UNPARSER-METHOD rather than UNPARSER/STANDARD-METHOD.

* Rewrite instances of PRINT-SELF using WRITE-SELF.  Rewrite instances
  of UNPARSER/STANDARD-METHOD using STANDARD-UNPARSER-METHOD.
---

diff --git a/v7/src/runtime/defstr.scm b/v7/src/runtime/defstr.scm
index 55d486ed6..fc062dd47 100644
--- a/v7/src/runtime/defstr.scm
+++ b/v7/src/runtime/defstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: defstr.scm,v 14.24 1993/03/17 04:04:25 cph Exp $
+$Id: defstr.scm,v 14.25 1993/10/21 14:52:32 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -299,8 +299,9 @@ differences:
 				   ((eq? type 'RECORD)
 				    false)
 				   (else
-				    `(,(absolute 'UNPARSER/STANDARD-METHOD)
-				      ',name))))
+				    `(,(absolute 'STANDARD-UNPARSER-METHOD)
+				      ',name
+				      #F))))
 			type
 			named?
 			(and named? type-name)
diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm
index fea92c68c..be2460d9a 100644
--- a/v7/src/runtime/emacs.scm
+++ b/v7/src/runtime/emacs.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: emacs.scm,v 14.18 1993/10/18 22:50:03 cph Exp $
+$Id: emacs.scm,v 14.19 1993/10/21 14:52:34 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -169,10 +169,6 @@ MIT in each case. |#
 (define (emacs/read-finish port)
   (port/read-finish the-console-port)
   (transmit-signal port #\f))
-
-(define (emacs/print-self state port)
-  port
-  (unparse-string state "for emacs"))
 
 ;;;; Protocol Encoding
 
diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index fb5129369..28d8b823d 100644
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.37 1993/10/21 12:14:16 cph Exp $
+$Id: error.scm,v 14.38 1993/10/21 14:52:34 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -44,9 +44,10 @@ MIT in each case. |#
 		   (constructor %make-condition-type
 				(name field-indexes number-of-fields reporter))
 		   (print-procedure
-		    (unparser/standard-method 'CONDITION-TYPE
-		      (lambda (state type)
-			(unparse-string state (%condition-type/name type))))))
+		    (standard-unparser-method 'CONDITION-TYPE
+		      (lambda (type port)
+			(write-char #\space port)
+			(write-string (%condition-type/name type) port)))))
   (name false read-only true)
   generalizations
   (field-indexes false read-only true)
@@ -152,11 +153,12 @@ MIT in each case. |#
 		   (conc-name %condition/)
 		   (constructor %make-condition (type continuation restarts))
 		   (print-procedure
-		    (unparser/standard-method 'CONDITION
-		      (lambda (state condition)
-			(unparse-string state
-					(%condition-type/name
-					 (%condition/type condition)))))))
+		    (standard-unparser-method 'CONDITION
+		      (lambda (condition port)
+			(write-char #\space port)
+			(write-string
+			 (%condition-type/name (%condition/type condition))
+			 port)))))
   (type false read-only true)
   (continuation false read-only true)
   (restarts false read-only true)
@@ -290,12 +292,13 @@ MIT in each case. |#
 		   (conc-name %restart/)
 		   (constructor %make-restart (name reporter effector))
 		   (print-procedure
-		    (unparser/standard-method 'RESTART
-		      (lambda (state restart)
+		    (standard-unparser-method 'RESTART
+		      (lambda (restart port)
+			(write-char #\space port)
 			(let ((name (%restart/name restart)))
 			  (if name
-			      (unparse-object state name)
-			      (unparse-string state "(anonymous)")))))))
+			      (write name port)
+			      (write-string "(anonymous)" port)))))))
   (name false read-only true)
   (reporter false read-only true)
   (effector false read-only true)
diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm
index 54761b652..ce3b2e301 100644
--- a/v7/src/runtime/fileio.scm
+++ b/v7/src/runtime/fileio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fileio.scm,v 1.6 1993/10/21 11:49:43 cph Exp $
+$Id: fileio.scm,v 1.7 1993/10/21 14:52:36 cph Exp $
 
 Copyright (c) 1991-1993 Massachusetts Institute of Technology
 
@@ -75,7 +75,7 @@ MIT in each case. |#
 	(other-operations
 	 `((CLOSE ,operation/close)
 	   (PATHNAME ,operation/pathname)
-	   (PRINT-SELF ,operation/print-self)
+	   (WRITE-SELF ,operation/write-self)
 	   (TRUENAME ,operation/truename))))
     (set! input-file-template
 	  (make-input-port (append input-operations
@@ -269,9 +269,9 @@ MIT in each case. |#
   ;; determine the truename.
   operation/pathname)
 
-(define (operation/print-self unparser-state port)
-  (unparse-string unparser-state "for file: ")
-  (unparse-object unparser-state (operation/truename port)))
+(define (operation/write-self port output-port)
+  (write-string " for file: " output-port)
+  (write (operation/truename port) output-port))
 
 (define (operation/rest->string port)
   ;; This operation's intended purpose is to snarf an entire file in
diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index a6aefbdf9..c3ba6ee9d 100644
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/genio.scm,v 1.2 1991/11/26 07:06:12 cph Exp $
+$Id: genio.scm,v 1.3 1993/10/21 14:52:37 cph Exp $
 
-Copyright (c) 1991 Massachusetts Institute of Technology
+Copyright (c) 1991-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -72,7 +72,7 @@ MIT in each case. |#
 	   (WRITE-SUBSTRING ,operation/write-substring)))
 	(other-operations
 	 `((CLOSE ,operation/close)
-	   (PRINT-SELF ,operation/print-self))))
+	   (WRITE-SELF ,operation/write-self))))
     (set! generic-input-template
 	  (make-input-port (append input-operations
 				   other-operations)
@@ -122,20 +122,20 @@ MIT in each case. |#
 (define-integrable (port/output-buffer port)
   (vector-ref (port/state port) 1))
 
-(define (operation/print-self unparser-state port)
+(define (operation/write-self port output-port)
   (cond ((i/o-port? port)
-	 (unparse-string unparser-state "for channels: ")
-	 (unparse-object unparser-state (operation/input-channel port))
-	 (unparse-string unparser-state " ")
-	 (unparse-object unparser-state (operation/output-channel port)))
+	 (write-string " for channels: " output-port)
+	 (write (operation/input-channel port) output-port)
+	 (write-string " " output-port)
+	 (write (operation/output-channel port) output-port))
 	((input-port? port)
-	 (unparse-string unparser-state "for channel: ")
-	 (unparse-object unparser-state (operation/input-channel port)))
+	 (write-string " for channel: " output-port)
+	 (write (operation/input-channel port) output-port))
 	((output-port? port)
-	 (unparse-string unparser-state "for channel: ")
-	 (unparse-object unparser-state (operation/output-channel port)))
+	 (write-string " for channel: " output-port)
+	 (write (operation/output-channel port) output-port))
 	(else
-	 (unparse-string unparser-state "for channel"))))
+	 (write-string " for channel" output-port))))
 
 (define (operation/char-ready? port interval)
   (input-buffer/char-ready? (port/input-buffer port) interval))
diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm
index 9ff8e2a8b..b87dd9208 100644
--- a/v7/src/runtime/packag.scm
+++ b/v7/src/runtime/packag.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: packag.scm,v 14.17 1993/10/21 11:49:48 cph Exp $
+$Id: packag.scm,v 14.18 1993/10/21 14:52:37 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -77,9 +77,10 @@ MIT in each case. |#
       (for-each loop (package/children package)))
     (set-record-type-unparser-method!
      rtd
-     (unparser/standard-method 'PACKAGE
-       (lambda (state package)
-	 (unparse-object state (package/name package)))))))
+     (standard-unparser-method 'PACKAGE
+       (lambda (package port)
+	 (write-char #\space port)
+	 (write (package/name package) port))))))
 
 (define (package/child package name)
   (let loop ((children (package/children package)))
diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index 64c8557a2..4761a8324 100644
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pathnm.scm,v 14.26 1993/01/29 00:07:22 adams Exp $
+$Id: pathnm.scm,v 14.27 1993/10/21 14:52:38 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -112,9 +112,10 @@ these rules:
 		   (constructor %make-pathname)
 		   (conc-name %pathname-)
 		   (print-procedure
-		    (unparser/standard-method 'PATHNAME
-		      (lambda (state pathname)
-			(unparse-object state (->namestring pathname))))))
+		    (standard-unparser-method 'PATHNAME
+		      (lambda (pathname port)
+			(write-char #\space port)
+			(write (->namestring pathname) port)))))
   (host false read-only true)
   (device false read-only true)
   (directory false read-only true)
@@ -167,7 +168,7 @@ these rules:
   (let ((pathname (->pathname pathname)))
     ((host-operation/end-of-file-marker/output (%pathname-host pathname))
      pathname)))
-
+
 (define (pathname=? x y)
   (let ((x (->pathname x))
 	(y (->pathname y)))
@@ -190,7 +191,7 @@ these rules:
 (define (pathname-simplify pathname)
   (let ((pathname (->pathname pathname)))
     ((host-operation/pathname-simplify (%pathname-host pathname)) pathname)))
-
+
 (define (directory-pathname pathname)
   (let ((pathname (->pathname pathname)))
     (%make-pathname (%pathname-host pathname)
@@ -218,7 +219,7 @@ these rules:
   (let ((pathname (->pathname pathname)))
     ((host-operation/directory-pathname-as-file (%pathname-host pathname))
      pathname)))
-
+
 (define (pathname-new-device pathname device)
   (let ((pathname (->pathname pathname)))
     (%make-pathname (%pathname-host pathname)
@@ -484,7 +485,7 @@ these rules:
 (define (guarantee-host host operation)
   (if (not (host? host)) (error:wrong-type-argument host "host" operation))
   host)
-
+
 (define (host-operation/parse-namestring host)
   (host-type/operation/parse-namestring (host/type host)))
 
diff --git a/v7/src/runtime/poplat.scm b/v7/src/runtime/poplat.scm
index b5d376e94..92d06c7eb 100644
--- a/v7/src/runtime/poplat.scm
+++ b/v7/src/runtime/poplat.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/poplat.scm,v 14.2 1988/06/13 11:49:48 cph Rel $
+$Id: poplat.scm,v 14.3 1993/10/21 14:52:39 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -47,7 +47,7 @@ MIT in each case. |#
 
 (define (initialize-unparser!)
   (unparser/set-tagged-pair-method! population-tag
-				    (unparser/standard-method 'POPULATION)))
+				    (standard-unparser-method 'POPULATION #f)))
 
 (define bogus-false '(BOGUS-FALSE))
 (define population-tag '(POPULATION))
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index 6afb9dd17..8810036de 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.6 1993/10/21 12:14:18 cph Exp $
+$Id: port.scm,v 1.7 1993/10/21 14:52:40 cph Exp $
 
 Copyright (c) 1991-93 Massachusetts Institute of Technology
 
@@ -101,12 +101,19 @@ MIT in each case. |#
 
 (set-record-type-unparser-method! port-rtd
   (lambda (state port)
-    ((unparser/standard-method
-      (cond ((i/o-port? port) 'I/O-PORT)
-	    ((input-port? port) 'INPUT-PORT)
-	    ((output-port? port) 'OUTPUT-PORT)
-	    (else 'PORT))
-      (port/operation port 'PRINT-SELF))
+    ((let ((name
+	    (cond ((i/o-port? port) 'I/O-PORT)
+		  ((input-port? port) 'INPUT-PORT)
+		  ((output-port? port) 'OUTPUT-PORT)
+		  (else 'PORT))))
+       (cond ((port/operation port 'WRITE-SELF)
+	      => (lambda (operation)
+		   (standard-unparser-method name operation)))
+	     ((port/operation port 'PRINT-SELF)
+	      => (lambda (operation)
+		   (unparser/standard-method name operation)))
+	     (else
+	      (standard-unparser-method name #f))))
      state
      port)))
 
diff --git a/v7/src/runtime/prop1d.scm b/v7/src/runtime/prop1d.scm
index 7f3260437..722414a47 100644
--- a/v7/src/runtime/prop1d.scm
+++ b/v7/src/runtime/prop1d.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/prop1d.scm,v 14.4 1989/09/15 17:16:35 jinx Rel $
+$Id: prop1d.scm,v 14.5 1993/10/21 14:52:41 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -43,7 +43,7 @@ MIT in each case. |#
 
 (define (initialize-unparser!)
   (unparser/set-tagged-pair-method! 1d-table-tag
-				    (unparser/standard-method '1D-TABLE)))
+				    (standard-unparser-method '1D-TABLE #f)))
 
 (define population-of-1d-tables)
 
diff --git a/v7/src/runtime/strnin.scm b/v7/src/runtime/strnin.scm
index dab66dc5c..9a19ed24a 100644
--- a/v7/src/runtime/strnin.scm
+++ b/v7/src/runtime/strnin.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strnin.scm,v 14.3 1990/11/09 08:44:34 cph Rel $
+$Id: strnin.scm,v 14.4 1993/10/21 14:52:41 cph Exp $
 
-Copyright (c) 1988, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -43,7 +43,7 @@ MIT in each case. |#
 			   (DISCARD-CHAR ,operation/discard-char)
 			   (DISCARD-CHARS ,operation/discard-chars)
 			   (PEEK-CHAR ,operation/peek-char)
-			   (PRINT-SELF ,operation/print-self)
+			   (WRITE-SELF ,operation/write-self)
 			   (READ-CHAR ,operation/read-char)
 			   (READ-STRING ,operation/read-string))
 			 false)))
@@ -52,11 +52,24 @@ MIT in each case. |#
   (with-input-from-port (string->input-port string) thunk))
 
 (define (string->input-port string #!optional start end)
-  (input-port/copy input-string-template
-		   (make-input-string-state
-		    string
-		    (if (default-object? start) 0 start)
-		    (if (default-object? end) (string-length string) end))))
+  (let ((end
+	 (if (default-object? end)
+	     (string-length string)
+	     (check-index end (string-length string) 'STRING->INPUT-PORT))))
+    (input-port/copy
+     input-string-template
+     (make-input-string-state string
+			      (if (default-object? start)
+				  0
+				  (check-index start end 'STRING->INPUT-PORT))
+			      end))))
+
+(define (check-index index limit procedure)
+  (if (not (exact-nonnegative-integer? index))
+      (error:wrong-type-argument index "exact non-negative integer" procedure))
+  (if (not (<= index limit))
+      (error:bad-range-argument index procedure))
+  index)
 
 (define input-string-template)
 
@@ -80,28 +93,28 @@ MIT in each case. |#
 
 (define (operation/char-ready? port interval)
   interval
-  (< (input-port/start port) (input-port/end port)))
+  (fix:< (input-port/start port) (input-port/end port)))
 
 (define (operation/peek-char port)
-  (if (< (input-port/start port) (input-port/end port))
+  (if (fix:< (input-port/start port) (input-port/end port))
       (string-ref (input-port/string port) (input-port/start port))
       (make-eof-object port)))
 
 (define (operation/discard-char port)
-  (set-input-port/start! port (1+ (input-port/start port))))
+  (set-input-port/start! port (fix:+ (input-port/start port) 1)))
 
 (define (operation/read-char port)
   (let ((start (input-port/start port)))
-    (if (< start (input-port/end port))
+    (if (fix:< start (input-port/end port))
 	(begin
-	  (set-input-port/start! port (1+ start))
+	  (set-input-port/start! port (fix:+ start 1))
 	  (string-ref (input-port/string port) start))
 	(make-eof-object port))))
 
 (define (operation/read-string port delimiters)
   (let ((start (input-port/start port))
 	(end (input-port/end port)))
-    (if (< start end)
+    (if (fix:< start end)
 	(let ((string (input-port/string port)))
 	  (let ((index
 		 (or (substring-find-next-char-in-set string
@@ -116,7 +129,7 @@ MIT in each case. |#
 (define (operation/discard-chars port delimiters)
   (let ((start (input-port/start port))
 	(end (input-port/end port)))
-    (if (< start end)
+    (if (fix:< start end)
 	(set-input-port/start!
 	 port
 	 (or (substring-find-next-char-in-set (input-port/string port)
@@ -125,6 +138,6 @@ MIT in each case. |#
 					      delimiters)
 	     end)))))
 
-(define (operation/print-self state port)
+(define (operation/write-self port output-port)
   port
-  (unparse-string state "from string"))
\ No newline at end of file
+  (write-string " from string" output-port))
\ No newline at end of file
diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm
index 3a396db92..953a3752b 100644
--- a/v7/src/runtime/strott.scm
+++ b/v7/src/runtime/strott.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strott.scm,v 14.3 1988/10/15 17:19:21 cph Rel $
+$Id: strott.scm,v 14.4 1993/10/21 14:52:42 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,7 +39,7 @@ MIT in each case. |#
 
 (define (initialize-package!)
   (set! output-string-template
-	(make-output-port `((PRINT-SELF ,operation/print-self)
+	(make-output-port `((WRITE-SELF ,operation/write-self)
 			    (WRITE-CHAR ,operation/write-char)
 			    (WRITE-STRING ,operation/write-string))
 			  false)))
@@ -94,6 +94,6 @@ MIT in each case. |#
 	    (set-output-string-state/accumulator! state accumulator)
 	    (set-output-string-state/counter! state counter))))))
 
-(define (operation/print-self state port)
+(define (operation/write-self port output-port)
   port
-  (unparse-string state "to string (truncating)"))
\ No newline at end of file
+  (write-string " to string (truncating)" output-port))
\ No newline at end of file
diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm
index 92fa88ec4..3daa9ce36 100644
--- a/v7/src/runtime/strout.scm
+++ b/v7/src/runtime/strout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.7 1993/01/19 05:33:49 cph Exp $
+$Id: strout.scm,v 14.8 1993/10/21 14:52:43 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -39,7 +39,7 @@ MIT in each case. |#
 
 (define (initialize-package!)
   (set! output-string-template
-	(make-output-port `((PRINT-SELF ,operation/print-self)
+	(make-output-port `((WRITE-SELF ,operation/write-self)
 			    (WRITE-CHAR ,operation/write-char)
 			    (WRITE-SUBSTRING ,operation/write-substring))
 			  false))
@@ -101,6 +101,6 @@ MIT in each case. |#
 			     (output-string-state/accumulator state) n)
        (set-output-string-state/counter! state n*)))))
 
-(define (operation/print-self state port)
+(define (operation/write-self port output-port)
   port
-  (unparse-string state "to string"))
\ No newline at end of file
+  (write-string " to string" output-port))
\ No newline at end of file
diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm
index e0528cd14..80856ee75 100644
--- a/v7/src/runtime/ttyio.scm
+++ b/v7/src/runtime/ttyio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/ttyio.scm,v 1.3 1993/08/16 09:50:12 jawilson Exp $
+$Id: ttyio.scm,v 1.4 1993/10/21 14:52:43 cph Exp $
 
 Copyright (c) 1991-93 Massachusetts Institute of Technology
 
@@ -64,7 +64,7 @@ MIT in each case. |#
 	     (OUTPUT-CHANNEL ,operation/output-channel)
 	     (OUTPUT-TERMINAL-MODE ,operation/output-terminal-mode)
 	     (PEEK-CHAR ,(lambda (port) (hook/peek-char port)))
-	     (PRINT-SELF ,operation/print-self)
+	     (WRITE-SELF ,operation/write-self)
 	     (READ-CHAR ,(lambda (port) (hook/read-char port)))
 	     (READ-FINISH ,operation/read-finish)
 	     (SET-INPUT-BLOCKING-MODE ,operation/set-input-blocking-mode)
@@ -214,6 +214,6 @@ MIT in each case. |#
   port
   ((ucode-primitive tty-y-size 0)))
 
-(define (operation/print-self state port)
+(define (operation/write-self port output-port)
   port
-  (unparse-string state "for console"))
\ No newline at end of file
+  (write-string " for console" output-port))
\ No newline at end of file
diff --git a/v7/src/runtime/urtrap.scm b/v7/src/runtime/urtrap.scm
index f54b87174..d41396293 100644
--- a/v7/src/runtime/urtrap.scm
+++ b/v7/src/runtime/urtrap.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/urtrap.scm,v 14.2 1988/06/13 11:59:56 cph Rel $
+$Id: urtrap.scm,v 14.3 1993/10/21 14:52:44 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,9 +39,10 @@ MIT in each case. |#
 
 (define-structure (reference-trap
 		   (print-procedure
-		    (unparser/standard-method 'REFERENCE-TRAP
-		      (lambda (state trap)
-			(unparse-object state (reference-trap-kind trap))))))
+		    (standard-unparser-method 'REFERENCE-TRAP
+		      (lambda (trap port)
+			(write-char #\space port)
+			(write (reference-trap-kind trap) port)))))
   (kind false read-only true)
   (extra false read-only true))
 
diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index 12fcb95bd..e9938357b 100644
--- a/v7/src/runtime/x11graph.scm
+++ b/v7/src/runtime/x11graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: x11graph.scm,v 1.34 1993/09/15 20:55:26 adams Exp $
+$Id: x11graph.scm,v 1.35 1993/10/21 14:52:45 cph Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -39,7 +39,6 @@ MIT in each case. |#
 (declare (integrate-external "graphics"))
 
 (define-primitives
-  (x-debug 1)
   (x-open-display 1)
   (x-close-display 1)
   (x-close-all-displays 0)
@@ -52,6 +51,7 @@ MIT in each case. |#
 
   (x-window-beep 1)
   (x-window-clear 1)
+  (x-window-colormap 1)
   (x-window-event-mask 1)
   (x-window-flush 1)
   (x-window-iconify 1)
@@ -76,6 +76,7 @@ MIT in each case. |#
   (x-window-set-position 3)
   (x-window-set-size 3)
   (x-window-starbase-filename 1)
+  (x-window-visual 1)
   (x-window-withdraw 1)
   (x-window-x-size 1)
   (x-window-y-size 1)
@@ -85,6 +86,7 @@ MIT in each case. |#
   (x-graphics-draw-line 5)
   (x-graphics-draw-point 3)
   (x-graphics-draw-string 4)
+  (x-graphics-fill-polygon 2)
   (x-graphics-map-x-coordinate 2)
   (x-graphics-map-y-coordinate 2)
   (x-graphics-move-cursor 3)
@@ -99,8 +101,6 @@ MIT in each case. |#
   (x-graphics-set-vdc-extent 5)
   (x-graphics-vdc-extent 1)
 
-  (x-graphics-fill-polygon 2)
-
   (x-bytes-into-image 2)
   (x-create-image 3)
   (x-destroy-image 1)
@@ -115,11 +115,8 @@ MIT in each case. |#
   (x-set-window-colormap 2)
   (x-store-color 5)
   (x-store-colors 2)
-  (x-window-colormap 1)
-
-  (x-window-visual 1)
   (x-visual-deallocate 1))
-
+
 ;; These constants must match "microcode/x11base.c"
 (define-integrable event-type:button-down 0)
 (define-integrable event-type:button-up 1)
@@ -281,9 +278,10 @@ MIT in each case. |#
 		   (conc-name x-display/)
 		   (constructor make-x-display (name xd))
 		   (print-procedure
-		    (unparser/standard-method 'X-DISPLAY
-		      (lambda (state display)
-			(unparse-object state (x-display/name display))))))
+		    (standard-unparser-method 'X-DISPLAY
+		      (lambda (display port)
+			(write-char #\space port)
+			(write (x-display/name display) port)))))
   (name false read-only true)
   xd
   (window-list (make-protection-list) read-only true)
@@ -886,7 +884,7 @@ MIT in each case. |#
 
 (define (x-image/fill-from-byte-vector image byte-vector)
   (x-bytes-into-image byte-vector (x-image/descriptor image)))
-
+
 ;; Abstraction layer for generic images
 
 (define (x-graphics/create-image device width height)
@@ -971,4 +969,4 @@ MIT in each case. |#
   (x-store-color (colormap/descriptor colormap) position r g b))
 
 (define (x-colormap/store-colors colormap color-vector)
-  (x-store-colors (colormap/descriptor colormap) color-vector))
+  (x-store-colors (colormap/descriptor colormap) color-vector))
\ No newline at end of file