X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fserve-event.lisp;h=1183d6ccf5990177d0c6d1a3c116a8fa5362c022;hb=670010e3f3dcd62efaf23f61abdc73950edb88c6;hp=299d4f71e90035bfd683591739498351115f7287;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git

diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp
index 299d4f7..1183d6c 100644
--- a/src/code/serve-event.lisp
+++ b/src/code/serve-event.lisp
@@ -42,14 +42,14 @@
   #!+sb-doc
   "Return the handler function in Object-Set for the operation specified by
    Message-ID, if none, NIL is returned."
-  (check-type object-set object-set)
-  (check-type message-id fixnum)
+  (enforce-type object-set object-set)
+  (enforce-type message-id fixnum)
   (values (gethash message-id (object-set-table object-set))))
 
 ;;; The setf inverse for Object-Set-Operation.
 (defun %set-object-set-operation (object-set message-id new-value)
-  (check-type object-set object-set)
-  (check-type message-id fixnum)
+  (enforce-type object-set object-set)
+  (enforce-type message-id fixnum)
   (setf (gethash message-id (object-set-table object-set)) new-value))
 
 |#
@@ -70,7 +70,7 @@
 (def!method print-object ((handler handler) stream)
   (print-unreadable-object (handler stream :type t)
     (format stream
-	    "~A on ~:[~;BOGUS ~]descriptor ~D: ~S"
+	    "~A on ~:[~;BOGUS ~]descriptor ~W: ~S"
 	    (handler-direction handler)
 	    (handler-bogus handler)
 	    (handler-descriptor handler)
@@ -155,7 +155,7 @@
     (real
      (multiple-value-bind (q r) (truncate (coerce timeout 'single-float))
        (declare (type index q) (single-float r))
-       (values q (the index (truncate (* r 1f6))))))
+       (values q (the (values index t) (truncate (* r 1f6))))))
     (t
      (error "Timeout is not a real number or NIL: ~S" timeout))))
 
@@ -185,9 +185,9 @@
 		      (values sec usec))))
 	      (values 0 0))
 	(declare (type (unsigned-byte 31) stop-sec stop-usec))
-	(with-fd-handler (fd direction #'(lambda (fd)
-					   (declare (ignore fd))
-					   (setf usable t)))
+	(with-fd-handler (fd direction (lambda (fd)
+					 (declare (ignore fd))
+					 (setf usable t)))
 	  (loop
 	    (sub-serve-event to-sec to-usec)
 
@@ -279,11 +279,9 @@
 
 ;;; When a *periodic-polling-function* is defined the server will not
 ;;; block for more than the maximum event timeout and will call the
-;;; polling function if it does time out. One important use of this
-;;; is to periodically call process-yield.
+;;; polling function if it does time out.
 (declaim (type (or null function) *periodic-polling-function*))
-(defvar *periodic-polling-function*
-  #!-mp nil #!+mp #'sb!mp:process-yield)
+(defvar *periodic-polling-function* nil)
 (declaim (type (unsigned-byte 29) *max-event-to-sec* *max-event-to-usec*))
 (defvar *max-event-to-sec* 1)
 (defvar *max-event-to-usec* 0)
@@ -307,10 +305,11 @@
     (sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set))
 			  (write-fds (sb!alien:struct sb!unix:fd-set)))
       (let ((count (calc-masks)))
-	(multiple-value-bind (value err) (sb!unix:unix-fast-select
-	     count
-	     (sb!alien:addr read-fds) (sb!alien:addr write-fds)
-	     nil to-sec to-usec)
+	(multiple-value-bind (value err)
+	    (sb!unix:unix-fast-select count
+				      (sb!alien:addr read-fds)
+				      (sb!alien:addr write-fds)
+				      nil to-sec to-usec)
 	
 	  ;; Now see what it was (if anything)
 	  (cond (value