diff --git a/code/serve-event.lisp b/code/serve-event.lisp
index 624b7a8c8ad885c6d031d6018f4d0b8bb189a3ab..3b99df00d5896b0cc41eedc09854cfab1723a93c 100644
--- a/code/serve-event.lisp
+++ b/code/serve-event.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.7 1991/02/08 13:35:36 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.8 1991/05/22 00:19:39 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -92,10 +92,10 @@
 (defstruct (handler
 	    (:print-function %print-handler)
 	    (:constructor make-handler (direction descriptor function)))
-  direction		      ; Either :input or :output
-  descriptor		      ; File descriptor this handler is tied to.
+  (direction nil :type (member :input :output)) ; Either :input or :output
+  (descriptor 0 :type (mod 32)) ; File descriptor this handler is tied to.
   active		      ; T iff this handler is running.
-  function		      ; Function to call.
+  (function nil :type function) ; Function to call.
   bogus			      ; T if this descriptor is bogus. 
   )
 
@@ -175,58 +175,36 @@
   "Wait until FD is usable for DIRECTION. DIRECTION should be either :INPUT or
   :OUTPUT. TIMEOUT, if supplied, is the number of seconds to wait before giving
   up."
-  (let (usable
-	(stop-at (if timeout
-		   (multiple-value-bind (okay sec usec)
-					(mach:unix-gettimeofday)
-		     (declare (ignore okay))
-		     (+ (* 1000000 timeout sec) usec)))))
-    (with-fd-handler (fd direction #'(lambda (fd)
-				       (declare (ignore fd))
-				       (setf usable t)))
-      (loop
-	(serve-event timeout)
-	
-	(when usable
-	  (return t))
-	
-	(when timeout
-	  (multiple-value-bind (okay sec usec)
-			       (mach:unix-gettimeofday)
-	    (declare (ignore okay))
-	    (let ((now (+ (* sec 1000000) usec)))
-	      (if (> now stop-at)
-		(return nil)
-		(setq timeout
-		      (/ (- stop-at now)
-			 1000000))))))))))
+  (declare (type (or index null) timeout))
+  (let (usable)
+    (multiple-value-bind
+	(stop-sec stop-usec)
+	(if timeout
+	    (multiple-value-bind (okay sec usec)
+				 (mach:unix-gettimeofday)
+	      (declare (ignore okay))
+	      (values (the (unsigned-byte 32) (+ sec timeout))
+		      usec))
+	    (values 0 0))
+      (declare (type (unsigned-byte 32) stop-sec stop-usec))
+      (with-fd-handler (fd direction #'(lambda (fd)
+					 (declare (ignore fd))
+					 (setf usable t)))
+	(loop
+	  (serve-event timeout)
+	  
+	  (when usable
+	    (return t))
+	  
+	  (when timeout
+	    (multiple-value-bind (okay sec usec)
+				 (mach:unix-gettimeofday)
+	      (declare (ignore okay))
+	      (when (or (> sec stop-sec)
+			(and (= sec stop-sec) (>= usec stop-usec)))
+		(return nil))
+	      (setq timeout (- stop-sec sec)))))))))
 
-;;; CALC-MASKS -- Internal.
-;;;
-;;; Return the correct masks to use for UNIX-SELECT.  The four return values
-;;; are: fd count, read mask, write mask, and exception mask.  The exception
-;;; mask is currently unused.
-;;;
-(defun calc-masks ()
-  (let ((count 0)
-	(read-mask 0)
-	(write-mask 0)
-	(except-mask 0))
-    (dolist (handler *descriptor-handlers*)
-      (unless (or (handler-active handler)
-		  (handler-bogus handler))
-	(let ((fd (handler-descriptor handler)))
-	  (ecase (handler-direction handler)
-	    (:input
-	     (setf read-mask (logior read-mask (ash 1 fd))))
-	    (:output
-	     (setf write-mask (logior write-mask (ash 1 fd)))))
-	  (if (> fd count)
-	    (setf count fd)))))
-    (values (1+ count)
-	    read-mask
-	    write-mask
-	    except-mask)))
 
 ;;; HANDLER-DESCRIPTORS-ERROR -- Internal.
 ;;;
@@ -254,6 +232,8 @@
 
 ;;;; Serve-all-events, serve-event, and friends.
 
+(declaim (start-block serve-event serve-all-events))
+
 (defvar *display-event-handlers* nil
   "This is an alist mapping displays to user functions to be called when
    SYSTEM:SERVE-EVENT notices input on a display connection.  Do not modify
@@ -299,21 +279,22 @@
   (multiple-value-bind
       (value readable writeable)
       (wait-for-event timeout)
+    (declare (type (unsigned-byte 32) readable writeable))
     ;; Now see what it was (if anything)
     (cond #+nil
 	  ((eq value server-unique-object)
 	   ;; The interrupt handler fired.
 	   (grab-message-loop)
 	   t)
-	  ((numberp value)
+	  ((fixnump value)
 	   (unless (zerop value)
 	     ;; Check the descriptors.
 	     (let ((result nil))
 	       (dolist (handler *descriptor-handlers*)
-		 (when (not (zerop (logand (ash 1 (handler-descriptor handler))
-					   (ecase (handler-direction handler)
-					     (:input readable)
-					     (:output writeable)))))
+		 (when (logbitp (handler-descriptor handler)
+				(ecase (handler-direction handler)
+				  (:input readable)
+				  (:output writeable)))
 		   (unwind-protect
 		       (progn
 			 ;; Doesn't work -- ACK
@@ -323,9 +304,10 @@
 		     (setf (handler-active handler) nil))
 		   (macrolet ((frob (var)
 				`(setf ,var
-				       (logand (lognot (ash 1
-							    (handler-descriptor
-							     handler)))
+				       (logand (32bit-logical-not
+						(ash 1
+						     (handler-descriptor
+						      handler)))
 					       ,var))))
 		     (ecase (handler-direction handler)
 		       (:input (frob readable))
@@ -340,6 +322,40 @@
 	   (handler-descriptors-error)
 	   nil))))
 
+
+;;; CALC-MASKS -- Internal.
+;;;
+;;; Return the correct masks to use for UNIX-SELECT.  The four return values
+;;; are: fd count, read mask, write mask, and exception mask.  The exception
+;;; mask is currently unused.
+;;;
+(defun calc-masks ()
+  (let ((count 0)
+	(read-mask 0)
+	(write-mask 0)
+	(except-mask 0))
+    (declare (type index count)
+	     (type (unsigned-byte 32) read-mask write-mask except-mask))
+    (dolist (handler *descriptor-handlers*)
+      (unless (or (handler-active handler)
+		  (handler-bogus handler))
+	(let ((fd (handler-descriptor handler)))
+	  (ecase (handler-direction handler)
+	    (:input
+	     (setf read-mask
+		   (logior read-mask
+			   (the (unsigned-byte 32) (ash 1 fd)))))
+	    (:output
+	     (setf write-mask
+		   (logior write-mask
+			   (the (unsigned-byte 32) (ash 1 fd))))))
+	  (when (> fd count)
+	    (setf count fd)))))
+    (values (1+ count)
+	    read-mask
+	    write-mask
+	    except-mask)))
+
 ;;; WAIT-FOR-EVENT -- internal
 ;;;
 ;;;   Wait for something to happen. 
@@ -347,38 +363,18 @@
 (defun wait-for-event (&optional timeout)
   "Wait for an something to show up on one of the file descriptors or a message
   interupt to fire. Timeout is in seconds."
-  (let (old-mask)
-    (multiple-value-bind (timeout-sec timeout-usec)
-			 (if timeout
-			   (truncate (round (* timeout 1000000)) 1000000)
-			   (values nil 0))
-      (multiple-value-bind (count read-mask write-mask except-mask)
-			   (calc-masks)
-	(catch 'server-catch
-	  (unwind-protect
-	      (progn
-		;; Block message interrupts.
-		(setf old-mask (mach:unix-sigblock (mach:sigmask :sigmsg)))
-		;; Check for any pending messages, because we are only signaled
-		;; for newly arived messages. This must be done after the
-		;; unix-sigsetmask.
-		#+nil
-		(when (grab-message-loop)
-		  (return-from wait-for-event t))
-		;; Indicate that we are in the server.
-		(let ((*in-server* t))
-		  ;; Establish the interrupt handlers.
-		  #+nil
-		  (enable-interrupt mach:sigmsg #'ih-sigmsg)
-		  ;; Enable all interrupts.
-		  (mach:unix-sigsetmask 0)
-		  ;; Do the select.
-		  (mach:unix-select count read-mask write-mask except-mask
-				    timeout-sec timeout-usec)))
-	    ;; Restore interrupt handler state.
-	    #+nil
-	    (mach:unix-sigblock (mach:sigmask :sigmsg))
-	    #+nil
-	    (default-interrupt mach:sigmsg)
-	    (when old-mask
-	      (mach:unix-sigsetmask old-mask))))))))
+  (multiple-value-bind (timeout-sec timeout-usec)
+		       (typecase timeout
+			 (integer (values timeout 0))
+			 (null (values nil 0))
+			 (t
+			  (multiple-value-bind (q r)
+					       (truncate timeout)
+			    (values q (* r 1000000)))))
+    (declare (type index timeout-usec)
+	     (type (or index null) timeout-sec))
+    (multiple-value-bind (count read-mask write-mask except-mask)
+			 (calc-masks)
+      ;; Do the select.
+      (mach:unix-select count read-mask write-mask except-mask
+			timeout-sec timeout-usec))))