diff --git a/clx/dependent.lisp b/clx/dependent.lisp
index b8e5a3d752c2a2c5636a1986310e1aaa3870030d..fd61272a9517cdcc53db9891ce416f146848aed5 100644
--- a/clx/dependent.lisp
+++ b/clx/dependent.lisp
@@ -1,4 +1,4 @@
-;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
+;;; -*- Mode: Lisp; Package: Xlib; Log: clx.log -*-
 
 ;; This file contains some of the system dependent code for CLX
 
@@ -32,7 +32,7 @@
 	  char->card8
 	  card8->char
 	  default-error-handler
-	  #-ansi-common-lisp define-condition))
+	  #-(ansi-common-lisp CMU) define-condition))
 
 #+explorer
 (zwei:define-indentation event-case (1 1))
@@ -832,11 +832,28 @@
 
 ;; If you're not sharing DISPLAY objects within a multi-processing
 ;; shared-memory environment, this is sufficient
-#-(or lispm excl lcl3.0)
+#-(or lispm excl lcl3.0 CMU)
 (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
   (declare (ignore locator display whostate timeout))
   `(progn ,@body))
 
+;;; HOLDING-LOCK for CMU Common Lisp.
+;;;
+;;; We are not multi-processing, but we use this macro to try to protect
+;;; against re-entering request functions.  This can happen if an interrupt
+;;; occurs and the handler attempts to use X over the same display connection.
+;;; This can happen if the GC hooks are used to notify the user over the same
+;;; display connection.  We lock out GC's just as a dummy check for our users.
+;;; Locking out interrupts has the problem that CLX always waits for replies
+;;; within this dynamic scope, so if the server cannot reply for some reason,
+;;; we potentially dead-lock without interrupts.
+;;;
+#+CMU
+(defmacro holding-lock ((locator display &optional whostate &key timeout)
+			&body body)
+  (declare (ignore locator display whostate timeout))
+  `(lisp::without-gcing (system:without-interrupts (progn ,@body))))
+
 #+Genera
 (defmacro holding-lock ((locator display &optional whostate &key timeout)
 			&body body)
@@ -1129,7 +1146,7 @@
 ;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
 ;;; server
 
-#-(or explorer Genera lucid kcl ibcl excl)
+#-(or explorer Genera lucid kcl ibcl excl CMU)
 (defun open-x-stream (host display protocol)
   host display protocol ;; unused
   (error "OPEN-X-STREAM not implemented yet."))
@@ -1230,6 +1247,20 @@
       (error "Failed to connect to server: ~A ~D" host display))
     fd))
 
+;;; OPEN-X-STREAM -- for CMU Common Lisp.
+;;;
+;;; The file descriptor here just gets tossed into the stream slot of the
+;;; display object instead of a stream.
+;;;
+#+CMU
+(defun open-x-stream (host display protocol)
+  (declare (ignore protocol))
+  (let ((server-fd (connect-to-server host display)))
+    (unless (plusp server-fd)
+      (error "Failed to connect to X11 server: ~A (display ~D)" host display))
+    server-fd))
+
+
 ;;; BUFFER-READ-DEFAULT - read data from the X stream
 
 #+(or Genera explorer)
@@ -1311,6 +1342,136 @@
 		  (return t)
 		  (setf (aref vector index) (the card8 c)))))))))
 
+;;;
+;;; BUFFER-READ-DEFAULT for CMU Common Lisp.
+;;;
+
+;;; Jim Healy comments:
+;;;
+;;; I don't know if all this buffering is necessary, but I think that other CLX
+;;; code and buffer-read-default should be redefined so that it can return the
+;;; actual number read.  Then we could read into the passed array directly
+;;; without fear (assuming the higher-level routines are used appropriately).
+;;; Although I guess there wouldn't be a problem if BSD 4.3 let you see how
+;;; many characters were on a socket without reading.
+;;;
+;;; I believe that the vector we write into expects numbers for the bytes.
+;;;
+;;; The BUFFER defstruct in depdefs.lisp was changed to include an internal
+;;; buffer.  (used here only).  It's not circular; byte 0 is in byte 0.
+;;;
+;;; Timeout, when non-nil, is in seconds. (can it be a float?)  Null timeout
+;;; means don't come back until you're done.  Returns non-nil if EOF
+;;; encountered Returns :TIMEOUT when timeout exceeeded.
+
+;;; Bill Chiles comments:
+;;;
+;;; I think we can do away with the alien stuff and read into an array of
+;;; unsigned-byte eight.  We might even be able to read directly into the
+;;; CLX buffer.  I don't know why Healy is going to all this trouble, but
+;;; I'll save worrying about this until we get this stuff up under the new
+;;; compiler.
+;;;
+
+#+CMU
+(extensions::def-c-array clx-buff (unsigned-byte 8))
+
+#+CMU
+(defun buffer-to-byte-array (display array start length)
+  (system::alien-bind ((buffer (display-internal-buffer display) clx-buff t))
+    (let ((ilength (display-internal-buffer-length display)))
+      (dotimes (i length)
+	(setf (aref (the buffer-bytes array) (+ i start))
+	      (system::alien-access (clx-buff-ref (system::alien-value buffer)
+						  i))))
+      (setf (display-internal-buffer-length display)
+	    (- ilength length))
+      (dotimes (i (- ilength length))
+	(setf (system::alien-access (clx-buff-ref (system::alien-value buffer)
+						  (+ i length)))
+	      (system::alien-access (clx-buff-ref (system::alien-value buffer) 
+						  i)))))))
+#+CMU
+(defun verify-internal-buffer-size (display size)
+  (let ((length (display-internal-buffer-length display))
+	(buffer (display-internal-buffer display)))
+    (cond ((null buffer)
+	   (setf (display-internal-buffer display)
+		 (setq buffer (make-clx-buff (max size 4096)))))
+	  ((< (system::alien-size buffer) size)
+	   (system::alien-bind ((new (make-clx-buff size) clx-buff t)
+				(buffer buffer clx-buff))
+	     (dotimes (i length)
+	       (setf (system::alien-access 
+		       (clx-buff-ref (system::alien-value new) i))
+		     (system::alien-access 
+		       (clx-buff-ref (system::alien-value buffer) i))))
+	     (system:dispose-alien buffer)
+	     (setf (display-internal-buffer display)
+		   (system::alien-value new)))))))
+ 
+#+CMU   
+(defun read-into-ibuff (display number)
+  (lisp::alien-bind ((ibuff (display-internal-buffer display) clx-buff t))
+    (let ((ilength (display-internal-buffer-length display)))
+      (multiple-value-bind (length err)
+	  (mach:unix-read (display-input-stream display) 
+			  (system::alien-sap 
+			    (clx-buff-ref (system::alien-value ibuff) ilength))
+			  number)
+	(when length
+	  (setf (display-internal-buffer-length display)
+		(setq ilength (+ ilength length))))
+	(values length err)))))
+
+#+CMU
+(defun buffer-read-default (display vector start end timeout)
+  (declare (type display display)
+	   (type buffer-bytes vector)
+	   (type array-index start end)
+	   (type (or null number) timeout))
+  #.(declare-buffun)
+  (let* ((fd (display-input-stream display))
+	 (wanted (- end start)))
+    (verify-internal-buffer-size display wanted)
+    (let ((saved (display-internal-buffer-length display)))
+      (when (>= saved wanted)
+	(buffer-to-byte-array display vector start wanted)
+	(return-from buffer-read-default nil))
+      (let ((endtime (when (and timeout (not (zerop timeout)))
+		       (+ (get-internal-real-time)
+			  (truncate (* timeout
+				       internal-time-units-per-second)))))
+	    (needed (- wanted saved)))
+	(loop
+	  (let ((available-p
+		  (cond ((and timeout (zerop timeout))
+			 (mach::unix-select (1+ fd) (ash 1 fd) 0 0 0))
+			(timeout
+			  (let ((remaining (- endtime (get-internal-real-time))))
+			    (when (minusp remaining) (return :TIMEOUT))
+			    (multiple-value-bind (secs rem)
+				(truncate remaining
+					  internal-time-units-per-second)
+			      (let ((msecs (truncate (* 1000000 rem))))
+				(mach::unix-select (1+ fd) (ash 1 fd) 0 0
+						   secs msecs)))))
+			(t (mach::unix-select (1+ fd) (ash 1 fd) 0 0 nil)))))
+	    
+	    (when (not (zerop available-p))
+	      (multiple-value-bind (length err) (read-into-ibuff display needed)
+		(cond ((null length)
+		       (error "CLX read err: ~A" (mach:get-unix-error-msg err)))
+		      ((zerop length) 
+		       (return :EOF))
+		      (t (cond ((= length needed)
+				(buffer-to-byte-array display vector
+						      start wanted)
+				(return nil))
+			       (t (setq needed (- needed length))))))))
+	    (when (and timeout (zerop timeout))
+	      (return :timeout))))))))
+
 
 
 ;;; WARNING:
@@ -1318,7 +1479,7 @@
 ;;;	receiving all data from the X Window System server.
 ;;;	You are encouraged to write a specialized version of
 ;;;	buffer-read-default that does block transfers.
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defun buffer-read-default (display vector start end timeout)
   (declare (type display display)
 	   (type buffer-bytes vector)
@@ -1386,7 +1547,7 @@
 ;;;	You are STRONGLY encouraged to write a specialized version
 ;;;	of buffer-write-default that does block transfers.
 
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defun buffer-write-default (vector display start end)
   ;; The default buffer write function for use with common-lisp streams
   (declare (type buffer-bytes vector)
@@ -1402,6 +1563,22 @@
 	  (declare (type array-index index))
 	  (write-byte (aref vector index) stream))))))
 
+#+CMU
+(defun buffer-write-default (vector display start end)
+  (declare (type buffer-bytes vector)
+	   (type display display)
+	   (type array-index start end))
+  #.(declare-buffun)
+  (multiple-value-bind (length error-number)
+		       (mach:unix-write (display-output-stream display)
+					vector start end)
+    (cond ((null length)
+	   ;; This error possibly should go through the CLX error system.
+	   (error "Can't write to server: ~A"
+		  (mach:get-unix-error-msg error-number)))
+	  (t nil))))
+
+
 ;;; buffer-force-output-default - force output to the X stream
 
 #+excl
@@ -1409,7 +1586,12 @@
   ;; buffer-write-default does the actual writing.
   (declare (ignore display)))
 
-#-excl
+#+CMU
+(defun buffer-force-output-default (display)
+  (declare (type display display))
+  (mach:unix-ioctl (display-output-stream display) mach:tiocflush 0))
+
+#-(or excl CMU)
 (defun buffer-force-output-default (display)
   ;; The default buffer force-output function for use with common-lisp streams
   (declare (type display display))
@@ -1428,7 +1610,14 @@
   #.(declare-buffun)
   (excl::filesys-checking-close (display-output-stream display)))
 
-#-excl
+#+CMU
+(defun buffer-close-default (display &key abort)
+  (declare (type display display) (ignore abort))
+  #.(declare-buffun)
+  (mach:unix-ioctl (display-output-stream display) mach:tiocflush 0)
+  (mach:unix-close (display-output-stream display)))
+
+#-(or excl CMU)
 (defun buffer-close-default (display &key abort)
   ;; The default buffer close function for use with common-lisp streams
   (declare (type display display))
@@ -1446,10 +1635,10 @@
 ;;; The default implementation
 
 ;; Poll for input every *buffer-read-polling-time* SECONDS.
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defparameter *buffer-read-polling-time* 0.5)
 
-#-(or Genera explorer excl lcl3.0)
+#-(or Genera explorer excl lcl3.0 CMU)
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
 	   (type (or null number) timeout))
@@ -1473,6 +1662,24 @@
 		 (return-from buffer-input-wait-default nil)))
 	     :timeout)))))
 
+#+CMU
+(defun buffer-input-wait-default (display timeout)
+  (declare (type display display)
+	   (type (or null number) timeout))
+  (declare (values timeout))
+  (let ((fd (display-input-stream display)))
+    (cond ((null fd))
+	  ((or (null timeout) (= timeout 0))
+	   (if (zerop (mach::unix-select (1+ fd) (ash 1 fd) 0 0 timeout))
+	       :timeout
+	       nil))
+	  (t
+	   (multiple-value-bind (secs rem) (truncate timeout)
+	     (let ((usecs (truncate (* 1000000 rem))))
+	       (if (zerop (mach::unix-select (1+ fd) (ash 1 fd) 0 0 secs usecs))
+		   :timeout
+		   nil)))))))
+
 #+Genera
 (defun buffer-input-wait-default (display timeout)
   (declare (type display display)
@@ -1596,7 +1803,7 @@
 ;;; buffer. This should never block, so it can be called from the scheduler.
 
 ;;; The default implementation is to just use listen.
-#-excl
+#-(or excl CMU)
 (defun buffer-listen-default (display)
   (declare (type display display))
   (let ((stream (display-input-stream display)))
@@ -1605,6 +1812,11 @@
 	t
       (listen stream))))
 
+#+CMU
+(defun buffer-listen-default (display)
+  (declare (type display display))
+  (not (buffer-input-wait-default display 0)))
+
 #+excl 
 (defun buffer-listen-default (display)
   (declare (type display display))
@@ -1899,12 +2111,40 @@
   (declare (dynamic-extent keyargs))
   (apply #'cerror proceed-format-string condition keyargs))
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+;;; X-ERROR for CMU Common Lisp
+;;;
+;;; We detect a couple condition types for which we disable event handling in
+;;; our system.  This prevents going into the debugger or returning to a
+;;; command prompt with CLX repeatedly seeing the same condition.  This occurs
+;;; because CMU Common Lisp provides for all events (that is, X, input on file
+;;; descriptors, Mach messages, etc.) to come through one routine anyone can
+;;; use to wait for input.
+;;;
+#+CMU
+(defun x-error (condition &rest keyargs)
+  (let ((condx (apply #'make-condition condition keyargs)))
+    #|This condition no longer exists.
+    (when (eq condition 'server-disconnect)
+      (let ((disp (server-disconnect-display condx)))
+	(warn "Disabled event handling on ~S." disp)
+	(ext::disable-clx-event-handling disp)))|#
+    (when (eq condition 'closed-display)
+      (let ((disp (closed-display-display condx)))
+	(warn "Disabled event handling on ~S." disp)
+	(ext::disable-clx-event-handling disp)))
+    (error condx)))
+
+#+CMU
+(defun x-cerror (proceed-format-string condition &rest keyargs)
+  (apply #'cerror proceed-format-string condition keyargs))
+
+
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defun x-error (condition &rest keyargs)
   (error "X-Error: ~a"
 	 (princ-to-string (apply #'make-condition condition keyargs))))
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defun x-cerror (proceed-format-string condition &rest keyargs)
   (cerror proceed-format-string "X-Error: ~a"
 	 (princ-to-string (apply #'make-condition condition keyargs))))
@@ -1971,18 +2211,18 @@
 (sys:defmethod (dbg:document-proceed-type x-error :continue) (stream)
   (format stream continue-format-string))
 
-#+(or ansi-common-lisp excl lcl3.0)
+#+(or ansi-common-lisp excl lcl3.0 CMU)
 (define-condition x-error (error))
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defstruct x-error
   report-function)
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defun reporter-for-condition (name)
   (xintern "." name '-reporter.))
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defmacro define-condition (name parents &body options)
   ;; Define a structure that when printed displays an error message
   (let ((slots (pop options))
@@ -2013,7 +2253,7 @@
 	     ,condition))
        ',name)))
 
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defun condition-print (condition stream depth)
   (declare (type x-error condition)
 	   (type stream stream)
@@ -2023,7 +2263,7 @@
     (funcall (x-error-report-function condition) condition stream))
   condition)
   
-#-(or lispm ansi-common-lisp excl lcl3.0)
+#-(or lispm ansi-common-lisp excl lcl3.0 CMU)
 (defun make-condition (type &rest slot-initializations)
   (declare (dynamic-extent slot-initializations))
   (let ((make-function (intern (concatenate 'string (string 'make-) (string type))
@@ -2166,7 +2406,8 @@
 ;;; a resource manager isn't running.
 
 (defun default-resources-pathname ()
-  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
+  (when #+(or unix mach) t
+        #-(or unix mach) (search "Unix" (software-type) :test #'char-equal)
     (merge-pathnames (user-homedir-pathname) (pathname ".Xdefaults"))))
 
 
@@ -2175,11 +2416,13 @@
 ;;; defaults have been loaded.
 
 (defun resources-pathname ()
-  (when #+unix t #-unix (search "Unix" (software-type) :test #'char-equal)
-    (or #+(or excl lcl3.0)
-	(let ((string (#+excl sys:getenv
-		       #+lcl3.0 lcl:environment-variable
-		       "XENVIRONMENT")))
+  (when #+(or unix mach) t
+        #-(or unix mach) (search "Unix" (software-type) :test #'char-equal)
+    (or #+(or excl lcl3.0 CMU)
+	(let ((string #-CMU (#+excl sys:getenv
+				    #+lcl3.0 lcl:environment-variable
+				    "XENVIRONMENT")
+		      #+CMU (cdr (assoc :xenvironment ext:*environment-list*))))
 	  (when string
 	    (pathname string)))
 	(merge-pathnames