io-multiplex/epoll.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;   Copyright (C) 2006 by Stelian Ionescu                                 ;
   5 ;                                                                         ;
   6 ;   This program is free software; you can redistribute it and/or modify  ;
   7 ;   it under the terms of the GNU General Public License as published by  ;
   8 ;   the Free Software Foundation; either version 2 of the License, or     ;
   9 ;   (at your option) any later version.                                   ;
  10 ;                                                                         ;
  11 ;   This program is distributed in the hope that it will be useful,       ;
  12 ;   but WITHOUT ANY WARRANTY; without even the implied warranty of        ;
  13 ;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         ;
  14 ;   GNU General Public License for more details.                          ;
  15 ;                                                                         ;
  16 ;   You should have received a copy of the GNU General Public License     ;
  17 ;   along with this program; if not, write to the                         ;
  18 ;   Free Software Foundation, Inc.,                                       ;
  19 ;   51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA              ;
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21
  22 ;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2)))
  23 (declaim (optimize (speed 0) (safety 2) (space 0) (debug 2)))
  24
  25 (in-package :io.multiplex)
  26
  27 (defclass epoll-multiplex-interface (multiplex-interface)
  28   ((epoll-fd :reader epoll-fd)))
  29
  30 (defconstant +epoll-priority+ 1)
  31
  32 (define-iomux-interface epoll-multiplex-interface +epoll-priority+)
  33
  34 (defconstant +epoll-default-size-hint+ 25)
  35 (eval-when (:compile-toplevel :load-toplevel :execute)
  36   (defvar *epoll-max-events* 200))
  37
  38 (defmethod initialize-instance :after ((interface epoll-multiplex-interface)
  39                                        &key (size +epoll-default-size-hint+))
  40   (let ((epoll-fd (et:epoll-create size)))
  41     (setf (slot-value interface 'epoll-fd) epoll-fd)
  42     (finalize-object-closing-fd interface epoll-fd)))
  43
  44 (defmethod monitor-fd progn ((interface epoll-multiplex-interface) handler)
  45   (let ((flags (logior (if (handler-read-func handler) et:epollin 0)
  46                        (if (handler-write-func handler) et:epollout 0)
  47                        (if (handler-except-func handler) et:epollpri 0)))
  48         (fd (handler-fd handler)))
  49     (with-foreign-object (ev 'et:epoll-event)
  50       (et:memset ev 0 #.(foreign-type-size 'et:epoll-event))
  51       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  52       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  53                                 'et:epoll-data 'et:fd)
  54             fd)
  55       (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-add fd ev))
  56     (values interface)))
  57
  58 (defmethod modify-fd progn ((interface epoll-multiplex-interface) fd
  59                             &key read-handler write-handler except-handler)
  60   (let ((flags (logior (if read-handler et:epollin 0)
  61                        (if write-handler et:epollout 0)
  62                        (if except-handler et:epollpri 0))))
  63     (with-foreign-object (ev 'et:epoll-event)
  64       (et:memset ev 0 #.(foreign-type-size 'et:epoll-event))
  65       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  66       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  67                                 'et:epoll-data 'et:fd)
  68             fd)
  69       (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-mod fd ev))
  70     (values interface)))
  71
  72 (defmethod unmonitor-fd progn ((interface epoll-multiplex-interface) handler)
  73   (et:epoll-ctl (epoll-fd interface)
  74                 et:epoll-ctl-del
  75                 (handler-fd handler)
  76                 (null-pointer))
  77   (values interface))
  78
  79 (defun epoll-serve-single-fd (handler events)
  80   (let ((except-func (handler-except-func handler))
  81         (read-func (handler-read-func handler))
  82         (write-func (handler-write-func handler))
  83         (fd (handler-fd handler)))
  84     (when (and except-func (plusp (logand et:epollerr events)))
  85       (funcall except-func fd :error))
  86     (when (and except-func (plusp (logand et:epollpri events)))
  87       (funcall except-func fd :except))
  88     (when (and read-func (plusp (logand et:epollin events)))
  89       (funcall read-func fd :read))
  90     (when (and write-func (plusp (logand et:epollout events)))
  91       (funcall write-func fd :write))))
  92
  93 (defmethod serve-fd-events ((interface epoll-multiplex-interface) &key)
  94   (with-foreign-object (events 'et:epoll-event #.*epoll-max-events*)
  95     (et:memset events 0 #.(* *epoll-max-events* (foreign-type-size 'et:epoll-event)))
  96     (let ((ready-fds
  97            (et:epoll-wait (epoll-fd interface) events
  98                           #.*epoll-max-events* -1)))
  99       (loop
 100          :for i :below ready-fds
 101          :for fd := (foreign-slot-value (foreign-slot-value (mem-aref events 'et:epoll-event i)
 102                                                             'et:epoll-event 'et:data)
 103                                         'et:epoll-data 'et:fd)
 104          :for event-mask := (foreign-slot-value (mem-aref events 'et:epoll-event i)
 105                                                 'et:epoll-event 'et:events)
 106          :do (epoll-serve-single-fd (fd-handler interface fd)
 107                                     event-mask))))
 108   (values interface))
 109
 110 (defmethod close-multiplex-interface ((interface epoll-multiplex-interface))
 111   (cancel-finalization interface)
 112   (et:close (epoll-fd interface)))