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     (sb-alien:with-alien ((ev et:epoll-event))
  50       (et:memset (sb-alien:addr ev) 0 et::size-of-epoll-event)
  51       (setf (sb-alien:slot ev 'et:events) flags)
  52       (setf (sb-alien:slot (sb-alien:slot ev 'et:data) 'et:fd) fd)
  53       (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-add fd (sb-alien:addr ev)))
  54     (values interface)))
  55
  56 (defmethod modify-fd progn ((interface epoll-multiplex-interface) fd
  57                             &key read-handler write-handler except-handler)
  58   (let ((flags (logior (if read-handler et:epollin 0)
  59                        (if write-handler et:epollout 0)
  60                        (if except-handler et:epollpri 0))))
  61     (sb-alien:with-alien ((ev et:epoll-event))
  62       (et:memset (sb-alien:addr ev) 0 et::size-of-epoll-event)
  63       (setf (sb-alien:slot ev 'et:events) flags)
  64       (setf (sb-alien:slot (sb-alien:slot ev 'et:data) 'et:fd) fd)
  65       (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-mod fd (sb-alien:addr ev)))
  66     (values interface)))
  67
  68 (defmethod unmonitor-fd progn ((interface epoll-multiplex-interface) handler)
  69   (et:epoll-ctl (epoll-fd interface)
  70                 et:epoll-ctl-del
  71                 (handler-fd handler)
  72                 nil)
  73   (values interface))
  74
  75 (defun epoll-serve-single-fd (handler events)
  76   (let ((except-func (handler-except-func handler))
  77         (read-func (handler-read-func handler))
  78         (write-func (handler-write-func handler))
  79         (fd (handler-fd handler)))
  80     (when (and except-func (plusp (logand et:epollerr events)))
  81       (funcall except-func fd :error))
  82     (when (and except-func (plusp (logand et:epollpri events)))
  83       (funcall except-func fd :except))
  84     (when (and read-func (plusp (logand et:epollin events)))
  85       (funcall read-func fd :read))
  86     (when (and write-func (plusp (logand et:epollout events)))
  87       (funcall write-func fd :write))))
  88
  89 (defmethod serve-fd-events ((interface epoll-multiplex-interface) &key)
  90   (sb-alien:with-alien ((events (sb-alien:array et:epoll-event #.*epoll-max-events*)))
  91     (et:memset (sb-alien:addr events) 0 (* #.*epoll-max-events* #.et::size-of-epoll-event))
  92     (let ((ready-fds
  93            (et:epoll-wait (epoll-fd interface) (sb-alien:alien-sap events)
  94                           #.*epoll-max-events* -1)))
  95       (loop
  96          :for i :below ready-fds
  97          :for fd := (sb-alien:slot (sb-alien:slot (sb-alien:deref events i) 'et:data) 'et:fd)
  98          :for event-mask := (sb-alien:slot (sb-alien:deref events i) 'et:events)
  99          :do (epoll-serve-single-fd (fd-handler interface fd)
 100                                     event-mask))))
 101   (values interface))
 102
 103 (defmethod close-multiplex-interface ((interface epoll-multiplex-interface))
 104   (sb-ext:cancel-finalization interface)
 105   (et:close (epoll-fd interface)))