Merge pull request #61 from jd/master

Low-level fd listening support

cl-async.asd

@@ -16,6 +16,7 @@
   :components
   ((:file "package")
    (:file "base" :depends-on ("package"))
+   (:file "fd" :depends-on ("base"))
    (:file "timer" :depends-on ("base"))
    (:file "dns" :depends-on ("base"))
    (:file "tcp" :depends-on ("dns"))

fd.lisp

@@ -0,0 +1,46 @@
+(in-package :cl-async)
+
+(cffi:defcallback fd-cb :void ((fd :int) (what :short) (data-pointer :pointer))
+  (declare (ignore fd))
+  (let* ((ev (deref-data-from-pointer data-pointer))
+         (callbacks (get-callbacks data-pointer))
+         (timeout-cb (getf callbacks :timeout-cb))
+         (read-cb (getf callbacks :read-cb))
+         (write-cb (getf callbacks :write-cb))
+         (event-cb (getf callbacks :event-cb)))
+    (catch-app-errors event-cb
+      (when (and (< 0 (logand what le:+ev-read+))
+                 read-cb)
+         (funcall read-cb))
+      (when (and (< 0 (logand what le:+ev-write+))
+                 write-cb)
+        (funcall write-cb))
+      (when (and (< 0 (logand what le:+ev-timeout+))
+                 timeout-cb)
+         (funcall timeout-cb)))))
+
+(defun fd-add (fd &key event-cb read-cb write-cb timeout-cb timeout)
+  "Run a function, asynchronously, when the specified file descriptor is
+   ready for write or read operations. An event loop must be running for
+   this to work."
+  (check-event-loop-running)
+  (let* ((data-pointer (create-data-pointer))
+         (ev (le:event-new *event-base*
+                           fd
+                           ;; listen to read/timeout events, and keep listening
+                           (logior
+                            (if timeout-cb le:+ev-timeout+ 0)
+                            (if read-cb le:+ev-read+ 0)
+                            (if write-cb le:+ev-write+ 0)
+                            le:+ev-persist+)
+                           (cffi:callback fd-cb)
+                           data-pointer)))
+    (save-callbacks data-pointer (list :read-cb read-cb
+                                       :write-cb write-cb
+                                       :timeout-cb timeout-cb
+                                       :event-cb event-cb))
+    (attach-data-to-pointer data-pointer ev)
+    (if (numberp timeout)
+        (with-struct-timeval time-c timeout
+          (le:event-add ev time-c))
+        (le:event-add ev (cffi:null-pointer)))))

package.lisp

@@ -39,6 +39,9 @@
            ;; timer functions
            #:delay
 
+           ;; fd functions
+           #:fd-add
+
            ;; signal numbers
            #:+sighup+
            #:+sigint+

timer.lisp

@@ -30,11 +30,8 @@
     (if (numberp time)
         ;; time is not bogus, make a timeval struct and add the event to the
         ;; loop for delayed processing.
-        (multiple-value-bind (time-sec time-usec) (split-usec-time time)
-          (make-foreign-type (time-c (le::cffi-type le::timeval))
-                             (('le::tv-sec time-sec)
-                              ('le::tv-usec time-usec))
-            (le:event-add ev time-c)))
+        (with-struct-timeval time-c time
+          (le:event-add ev time-c))
         ;; there was no time specified (or it wasn't a number), so fire up the
         ;; event to be processed with no delay
         (le:event-active ev 0 0))))

util.lisp

@@ -47,6 +47,7 @@
            #:clear-pointer-data
            #:free-pointer-data
 
+           #:with-struct-timeval
            #:split-usec-time
 
            #:append-array
@@ -234,6 +235,14 @@
         (when (cffi:pointerp pointer)
           (cffi:foreign-free pointer))))))
 
+(defmacro with-struct-timeval (var seconds &rest body)
+  "Convert seconds to a valid struct timeval C data type."
+  `(multiple-value-bind (time-sec time-usec) (split-usec-time ,seconds)
+     (make-foreign-type (,var (le::cffi-type le::timeval))
+                        (('le::tv-sec time-sec)
+                         ('le::tv-usec time-usec))
+       ,@body)))
+
 (defun split-usec-time (time-s)
   "Given a second value, ie 3.67, return the number of seconds as the first
    value and the number of usecs for the second value."