diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp
index 875e6a126d5e483ec8fc579820badabacec452b5..8b8749c242c3b3bbd4b5745ea6fa5467688b2c80 100644
--- a/code/multi-proc.lisp
+++ b/code/multi-proc.lisp
@@ -3,7 +3,7 @@
 ;;; This code was written by Douglas T. Crosher and has been placed in
 ;;; the Public domain, and is provided 'as is'.
 ;;;
-;;; $Id: multi-proc.lisp,v 1.22 1998/01/13 19:20:10 dtc Exp $
+;;; $Id: multi-proc.lisp,v 1.23 1998/01/15 14:36:25 dtc Exp $
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -217,9 +217,10 @@
 		(declare (type stack-group stack-group)
 			 (stream stream)
 			 (ignore depth))
-		(format stream "#<Stack-group ~a, ~a>"
-			(stack-group-name stack-group)
-			(stack-group-state stack-group)))))
+		(print-unreadable-object (stack-group stream :identity t)
+		 (format stream "Stack-group ~a, ~a"
+			 (stack-group-name stack-group)
+			 (stack-group-state stack-group))))))
   ;; Must have a name.
   (name "Anonymous" :type simple-base-string)
   ;; State: :active or :inactive.
@@ -709,10 +710,9 @@
 	     (:predicate processp)
 	     (:print-function
 	      (lambda (process stream depth)
-		(declare (type process process)
-			 (stream stream)
-			 (ignore depth))
-		(format stream "#<Process ~a>" (process-name process)))))
+		(declare (type process process) (stream stream) (ignore depth))
+		(print-unreadable-object (process stream :identity t)
+		 (format stream "Process ~a" (process-name process))))))
   (name "Anonymous" :type simple-base-string)
   (state :killed :type (member :killed :active :inactive))
   (%whostate nil :type (or null simple-base-string))
@@ -1474,101 +1474,113 @@
 ;;; Create a process to listen for connections on a TCP port and start
 ;;; a new top-level process for each connection.
 ;;;
-(defun start-lisp-connection-listener (&optional (port 1025))
+(defun start-lisp-connection-listener (&key (port 1025)
+					    (password (random (expt 2 24))))
   (declare (type (unsigned-byte 16) port))
-  "Create a Lisp connection listener on the given port."
-  (let ((listener-password nil))
-    (labels (;; The session top level read eval. loop.
-	     (start-top-level (fd)
-	       (let ((stream (sys:make-fd-stream fd :input t :output t)))
-		 (unwind-protect
-		     (let* ((*terminal-io* stream)
-			    (*standard-input*
-			     (make-synonym-stream '*terminal-io*))
-			    (*standard-output* *standard-input*)
-			    (*error-output* *standard-input*)
-			    (*debug-io* *standard-input*)
-			    (*query-io* *standard-input*)
-			    (*trace-output* *standard-input*))
-		       ;;
-		       (format t "Enter password: ")
-		       (finish-output)
-		       (unless (eql (read) listener-password)
-			 (return-from start-top-level))
-		       (ext:print-herald)
-		       ;;
-		       (top-level))
-		   (handler-case 
-		       (close stream)
-		     (error ())))))
-	     ;;
-	     ;; Turn internet address into string format
-	     (ip-address-string (address)
-	       (format nil "~D.~D.~D.~D"
-		       (ldb (byte 8 24) address)
-		       (ldb (byte 8 16) address)
-		       (ldb (byte 8 8)  address)
-		       (ldb (byte 8 0)  address)))
-	     ;;
-	     ;; The body of the connection listener.
-	     (listener ()
-	       (declare (optimize (speed 3)))
-	       (let ((fd nil))
-		 (unwind-protect
-		     (progn
-		       ;; Start the listener.
-		       (do ()
-			   (fd)
-			 (handler-case
-			     (setf fd (ext:create-inet-listener port))
-			   (error () (incf port))))
-
-		       (setf (process-name *current-process*)
-			 (format nil "Lisp connection listener on port ~d"
-				 port))
-
-		       (setf listener-password (random (expt 2 24)))
-		       (format t "~&;;; Started lisp connection listener on ~
+  "Create a Lisp connection listener, listening on a TCP port for new
+  connections and starting a new top-level loop form each."
+  (labels (;; The session top level read eval. loop.
+	   (start-top-level (fd)
+	     (let ((stream (sys:make-fd-stream fd :input t :output t)))
+	       (unwind-protect
+		    (let* ((*terminal-io* stream)
+			   (*standard-input*
+			    (make-synonym-stream '*terminal-io*))
+			   (*standard-output* *standard-input*)
+			   (*error-output* *standard-input*)
+			   (*debug-io* *standard-input*)
+			   (*query-io* *standard-input*)
+			   (*trace-output* *standard-input*))
+		      ;;
+		      (format t "Enter password: ")
+		      (finish-output)
+		      (let* ((*read-eval* nil)
+			     (read-password
+			      (handler-case 
+			       (read)
+			       (error () (return-from start-top-level)))))
+			(unless (equal read-password password)
+			  (return-from start-top-level)))
+		      (ext:print-herald)
+		      ;;
+		      (top-level))
+		 (handler-case 
+		  (close stream)
+		  (error ())))))
+	   ;;
+	   ;; Turn internet address into string format
+	   (ip-address-string (address)
+	     (format nil "~D.~D.~D.~D"
+		     (ldb (byte 8 24) address)
+		     (ldb (byte 8 16) address)
+		     (ldb (byte 8 8)  address)
+		     (ldb (byte 8 0)  address)))
+	   ;;
+	   ;; The body of the connection listener.
+	   (listener ()
+	     (declare (optimize (speed 3)))
+	     (let ((fd nil))
+	       (unwind-protect
+		    (progn
+		      ;; Start the listener.
+		      (do ()
+			  (fd)
+			(handler-case
+			 (setf fd (ext:create-inet-listener port))
+			 (error () (incf port))))
+
+		      (setf (process-name *current-process*)
+			    (format nil "Lisp connection listener on port ~d"
+				    port))
+
+		      (format t "~&;;; Started lisp connection listener on ~
  				  port ~d with password ~d~%"
-			       port listener-password)
-
-		       (loop
-			 ;; Wait until input ready.
-			 (process-wait-until-fd-usable fd :input)
-			 (multiple-value-bind (new-fd remote-host)
-			     (ext:accept-tcp-connection fd)
-			   (let ((host-entry (ext:lookup-host-entry
-					      remote-host)))
-			     (make-process
-			      #'(lambda ()
-				  (start-top-level new-fd))
-			      :name (format nil "Lisp session from ~A"
-					    (if host-entry
-						(ext:host-entry-name
-						 host-entry)
+			      port password)
+
+		      (loop
+		       ;; Wait for new connections.
+		       (process-wait-until-fd-usable fd :input)
+		       (multiple-value-bind (new-fd remote-host)
+			   (ext:accept-tcp-connection fd)
+			 (let ((host-entry (ext:lookup-host-entry
+					    remote-host)))
+			   (make-process
+			    #'(lambda ()
+				(start-top-level new-fd))
+			    :name (format nil "Lisp session from ~A"
+					  (if host-entry
+					      (ext:host-entry-name host-entry)
 					      (ip-address-string
 					       remote-host))))))))
-		   ;; Close the listener stream.
-		   (when fd
-		     (unix:unix-close fd))))))
+		 ;; Close the listener stream.
+		 (when fd
+		   (unix:unix-close fd))))))
 
-      ;; Make the listening thread.
-      (make-process #'listener))))
+    ;; Make the listening thread.
+    (make-process #'listener)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Simple Locking.
 
 (defstruct (lock
 	     (:constructor make-lock (&optional name))
-	     (:print-function
-	      (lambda (lock stream depth)
-		(declare (type lock lock)
-			 (stream stream)
-			 (ignore depth))
-		(format stream "#<Lock ~a>" (lock-name lock)))))
-  (name nil)
+	     (:print-function %print-lock))
+  (name nil :type (or null simple-base-string))
   (process nil :type (or null process)))
 
+(defun %print-lock (lock stream depth)
+  (declare (type lock lock) (stream stream) (ignore depth))
+  (print-unreadable-object (lock stream :identity t)
+    (write-string "Lock" stream)
+    (let ((name (lock-name lock)))
+      (when name
+	(format stream " ~a" name)))
+    (let ((process (lock-process lock)))
+      (cond (process
+	     (format stream ", held by process ~a" (process-name process)))
+	    (t
+	     (write-string ", free" stream))))))
+
 ;;; Lock-Wait
 ;;;
 ;;; Wait for the lock to be free and acquire it for the