cffi-posix/cffi-kqueue/cffi-epoll.lisp

• Show log

  Commit

• Hash : 9dea6016
  Author : Thomas de Grivel
  Date : 2017-06-28T02:38:30
  

  move struct and union definitions to grovel-epoll

Download

• cffi-epoll.lisp

• ;;
  ;;  cffi-epoll  -  Common Lisp wrapper for Linux epoll syscall
  ;;
  ;;  Copyright 2017 Thomas de Grivel <thoxdg@gmail.com>
  ;;
  ;;  Permission to use, copy, modify, and distribute this software for any
  ;;  purpose with or without fee is hereby granted, provided that the above
  ;;  copyright notice and this permission notice appear in all copies.
  ;;
  ;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  ;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  ;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  ;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  ;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  ;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  ;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  ;;
  
  (in-package :cffi-epoll)
  
  (defcfun ("epoll_create" c-epoll-create) :int
    (size :int))
  
  (defun create (&optional (size 10))
    (let ((fd (c-epoll-create size)))
      (when (< fd 0)
        (error-errno "epoll_create"))
      fd))
  
  (defmacro with ((fdvar &optional (size 10)) &body body)
    (let ((fd (gensym "FD-")))
      `(let ((,fd (create ,size)))
         (unwind-protect (let ((,fdvar ,fd)) ,@body)
           (unistd:close ,fd)))))
  
  (defcfun ("epoll_ctl" c-epoll-ctl) :int
    (epfd :int)
    (op :int)
    (fd :int)
    (event (:pointer (:struct epoll-event))))
  
  (defun ctl (epfd op fd events &key data-ptr data-fd data-u32 data-u64)
    (with-foreign-object (evt '(:struct epoll-event))
      (setf (foreign-slot-value evt '(:struct epoll-event) 'events) events)
      (let ((data (foreign-slot-value evt '(:struct epoll-event) 'data)))
        (with-foreign-slots ((ptr fd u32 u64) data (:union epoll-data))
          (cond (data-ptr (setf ptr data-ptr))
                (data-fd  (setf fd  data-fd))
                (data-u32 (setf u32 data-u32))
                (data-u64 (setf u64 data-u64)))))
      (let ((r (c-epoll-ctl epfd op fd evt)))
        (when (< r 0)
          (error-errno "epoll_ctl"))
        r)))
  
  (defun add (epfd fd events &key data-ptr data-fd data-u32 data-u64)
    (ctl epfd +ctl-add+ fd events
         :data-ptr data-ptr
         :data-fd  data-fd
         :data-u32 data-u32
         :data-u64 data-u64))
  
  (defun mod (epfd fd events &key data-ptr data-fd data-u32 data-u64)
    (ctl epfd +ctl-mod+ fd events
         :data-ptr data-ptr
         :data-fd  data-fd
         :data-u32 data-u32
         :data-u64 data-u64))
  
  (defun del (epfd fd)
    (ctl epfd +ctl-del+ fd 0))
  
  (defcfun ("epoll_wait" c-epoll-wait) :int
    (epfd :int)
    (events (:pointer (:struct epoll-event)))
    (maxevents :int)
    (timeout :int))
  
  (defmacro wait ((events-var fd-var epfd &optional
                              (maxevents 1024)
                              (timeout -1))
                  &body body)
    (let ((events (gensym "EVENTS-"))
          (e (gensym "E-"))
          (e-data (gensym "E-DATA-"))
          (i (gensym "I-"))
          (m (gensym "M-")))
      `(let ((,m ,maxevents))
         (with-foreign-object (,events '(:struct epoll-event) ,m)
           (let ((,i (c-epoll-wait ,epfd ,events ,m ,timeout)))
             (when (< ,i 0)
               (error-errno "epoll_wait"))
             (dotimes (,i ,i)
               (let* ((,e (mem-aref ,events '(:struct epoll-event) ,i))
                      (,events-var (foreign-slot-value ,e '(:struct epoll-event) 'events))
                      (,e-data (foreign-slot-value ,e '(:struct epoll-event) 'data))
                      (,fd-var (foreign-slot-value ,e-data '(:union epoll-data) 'fd)))
                 ,@body)))))))
  

Download