[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] CVS: sbcl/src/code serve-event.lisp,1.19,1.20
From: Nikodemus Siivola <demoss () users ! sourceforge ! net>
Date: 2008-02-29 11:04:47
Message-ID: E1JV32l-0001Gb-VY () sc8-pr-cvs8 ! sourceforge ! net
[Download RAW message or body]
Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv4848/src/code
Modified Files:
serve-event.lisp
Log Message:
1.0.15.6: split main part of SUB-SERVE-EVENT into SUB-SUB-SERVE-EVENT
* Easier to understand, fixes periodic polling. Patch by Espen S
Johnsen.
* NEWS entry for 1.0.15.5. as well.
Index: serve-event.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/serve-event.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- serve-event.lisp 12 Jan 2008 15:29:04 -0000 1.19
+++ serve-event.lisp 29 Feb 2008 11:04:44 -0000 1.20
@@ -215,85 +215,81 @@
at maximum, before calling the *PERIODIC-POLLING-FUNCTION* \(if any.)
Shared between all threads, unless locally bound. EXPERIMENTAL.")
-;;; Takes timeout broken into seconds and microseconds.
+;;; Takes timeout broken into seconds and microseconds, NIL timeout means
+;;; to wait as long as needed.
(defun sub-serve-event (to-sec to-usec deadlinep)
- ;; Figure out our peridic polling needs. MORE-SEC/USEC is the amount
- ;; of actual waiting left after we poll (assuming we are polling.)
- (multiple-value-bind (poll more-sec more-usec)
- (when *periodic-polling-function*
- (multiple-value-bind (p-sec p-usec)
- (decode-internal-time
- (seconds-to-internal-time *periodic-polling-period*))
- (when (or (not to-sec) (> to-sec p-sec)
- (and (= to-sec p-sec) (> to-usec p-usec)))
- (multiple-value-prog1
- (values *periodic-polling-function*
- (when to-sec (- to-sec p-sec))
- (when to-sec (- to-usec p-usec)))
- (setf to-sec p-sec
- to-usec p-sec)))))
+ (or
+ (if *periodic-polling-function*
+ (multiple-value-bind (p-sec p-usec)
+ (decode-internal-time
+ (seconds-to-internal-time *periodic-polling-period*))
+ (if to-sec
+ (loop repeat (/ (+ to-sec (/ to-usec 1e6))
+ *periodic-polling-period*)
+ thereis (sub-sub-serve-event p-sec p-usec)
+ do (funcall *periodic-polling-function*))
+ (loop thereis (sub-sub-serve-event p-sec p-usec)
+ do (funcall *periodic-polling-function*))))
+ (sub-sub-serve-event to-sec to-usec))
+ (when deadlinep
+ (signal-deadline))))
- ;; Next, wait for something to happen.
- (sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set))
- (write-fds (sb!alien:struct sb!unix:fd-set)))
- (sb!unix:fd-zero read-fds)
- (sb!unix:fd-zero write-fds)
- (let ((count 0))
- (declare (type index count))
+;;; Handles the work of the above, except for periodic polling. Returns
+;;; true if something of interest happened.
+(defun sub-sub-serve-event (to-sec to-usec)
+ (sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set))
+ (write-fds (sb!alien:struct sb!unix:fd-set)))
+ (sb!unix:fd-zero read-fds)
+ (sb!unix:fd-zero write-fds)
+ (let ((count 0))
+ (declare (type index count))
- ;; Initialize the fd-sets for UNIX-SELECT and return the active
- ;; descriptor count.
- (map-descriptor-handlers
- (lambda (handler)
- ;; FIXME: If HANDLER-ACTIVE ever is reinstanted, it needs
- ;; to be checked here in addition to HANDLER-BOGUS
- (unless (handler-bogus handler)
- (let ((fd (handler-descriptor handler)))
- (ecase (handler-direction handler)
- (:input (sb!unix:fd-set fd read-fds))
- (:output (sb!unix:fd-set fd write-fds)))
- (when (> fd count)
- (setf count fd))))))
- (incf count)
+ ;; Initialize the fd-sets for UNIX-SELECT and return the active
+ ;; descriptor count.
+ (map-descriptor-handlers
+ (lambda (handler)
+ ;; FIXME: If HANDLER-ACTIVE ever is reinstanted, it needs
+ ;; to be checked here in addition to HANDLER-BOGUS
+ (unless (handler-bogus handler)
+ (let ((fd (handler-descriptor handler)))
+ (ecase (handler-direction handler)
+ (:input (sb!unix:fd-set fd read-fds))
+ (:output (sb!unix:fd-set fd write-fds)))
+ (when (> fd count)
+ (setf count fd))))))
+ (incf count)
- ;; Next, wait for something to happen.
- (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)
- #!+win32
- (declare (ignore err))
- ;; Now see what it was (if anything)
- (cond ((not value)
- ;; Interrupted or one of the file descriptors is bad.
- ;; FIXME: Check for other errnos. Why do we return true
- ;; when interrupted?
- #!-win32
- (if (eql err sb!unix:eintr)
- t
- (handler-descriptors-error))
- #!+win32
- (handler-descriptors-error))
- ((plusp value)
- ;; Got something. Call file descriptor handlers
- ;; according to the readable and writable masks
- ;; returned by select.
- (dolist (handler
- (select-descriptor-handlers
- (lambda (handler)
- (let ((fd (handler-descriptor handler)))
- (ecase (handler-direction handler)
- (:input (sb!unix:fd-isset fd read-fds))
- (:output (sb!unix:fd-isset fd write-fds)))))))
- (funcall (handler-function handler)
- (handler-descriptor handler)))
- t)
- ((zerop value)
- ;; Timeout.
- (cond (poll
- (funcall poll)
- (sub-serve-event more-sec more-usec deadlinep))
- (deadlinep
- (signal-deadline))))))))))
+ ;; Next, wait for something to happen.
+ (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)
+ #!+win32
+ (declare (ignore err))
+ ;; Now see what it was (if anything)
+ (cond ((not value)
+ ;; Interrupted or one of the file descriptors is bad.
+ ;; FIXME: Check for other errnos. Why do we return true
+ ;; when interrupted?
+ #!-win32
+ (if (eql err sb!unix:eintr)
+ t
+ (handler-descriptors-error))
+ #!+win32
+ (handler-descriptors-error))
+ ((plusp value)
+ ;; Got something. Call file descriptor handlers
+ ;; according to the readable and writable masks
+ ;; returned by select.
+ (dolist (handler
+ (select-descriptor-handlers
+ (lambda (handler)
+ (let ((fd (handler-descriptor handler)))
+ (ecase (handler-direction handler)
+ (:input (sb!unix:fd-isset fd read-fds))
+ (:output (sb!unix:fd-isset fd write-fds)))))))
+ (funcall (handler-function handler)
+ (handler-descriptor handler)))
+ t))))))
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic