io-multiplex/epoll.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;   Copyright (C) 2006,2007 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 (defconstant +epoll-priority+ 1)
  28
  29 (define-multiplexer epoll-multiplexer +epoll-priority+
  30   (multiplexer)
  31   ((epoll-fd :reader epoll-fd)))
  32
  33 (defconstant +epoll-default-size-hint+ 25)
  34 (eval-when (:compile-toplevel :load-toplevel :execute)
  35   (defvar *epoll-max-events* 200))
  36
  37 (defmethod initialize-instance :after ((mux epoll-multiplexer)
  38                                        &key (size +epoll-default-size-hint+))
  39   (let ((epoll-fd (et:epoll-create size)))
  40     (setf (slot-value mux 'epoll-fd) epoll-fd)
  41     (finalize-object-closing-fd mux epoll-fd)))
  42
  43 (defun calc-epoll-flags (fd-entry)
  44   (logior (if (fd-entry-read-handlers fd-entry) et:epollin 0)
  45           (if (fd-entry-write-handlers fd-entry) et:epollout 0)
  46           (if (fd-entry-except-handlers fd-entry) et:epollpri 0)))
  47
  48 (defmethod monitor-fd progn ((mux epoll-multiplexer) fd-entry)
  49   (assert fd-entry)
  50   (let ((flags (calc-epoll-flags fd-entry))
  51         (fd (fd-entry-fd fd-entry)))
  52     (with-foreign-object (ev 'et:epoll-event)
  53       (et:memset ev 0 #.(foreign-type-size 'et:epoll-event))
  54       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  55       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  56                                 'et:epoll-data 'et:fd)
  57             fd)
  58       (et:epoll-ctl (epoll-fd mux) et:epoll-ctl-add fd ev))
  59     (values fd)))
  60
  61 (defmethod update-fd progn ((mux epoll-multiplexer) fd-entry)
  62   (assert fd-entry)
  63   (let ((flags (calc-epoll-flags fd-entry))
  64         (fd (fd-entry-fd fd-entry)))
  65     (with-foreign-object (ev 'et:epoll-event)
  66       (et:memset ev 0 #.(foreign-type-size 'et:epoll-event))
  67       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  68       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  69                                 'et:epoll-data 'et:fd)
  70             fd)
  71       (et:epoll-ctl (epoll-fd mux) et:epoll-ctl-mod fd ev))
  72     (values fd-entry)))
  73
  74 (defmethod unmonitor-fd progn ((mux epoll-multiplexer) fd)
  75   (et:epoll-ctl (epoll-fd mux)
  76                 et:epoll-ctl-del
  77                 fd
  78                 (null-pointer))
  79   (values fd))
  80
  81 (defun epoll-serve-single-fd (fd-entry events)
  82   (assert fd-entry)
  83   (let ((error-handlers (handler-error-handlers fd-entry))
  84         (except-handlers (handler-except-handlers fd-entry))
  85         (read-handlers (handler-read-handlers fd-entry))
  86         (write-handlers (handler-write-handlers fd-entry))
  87         (fd (fd-entry-fd fd-entry)))
  88     (when (and error-handlers (logtest et:epollerr events))
  89       (dolist (error-handler error-handlers)
  90         (funcall (handler-function error-handler) fd :error)))
  91     (when (and except-handlers (logtest et:epollpri events))
  92       (dolist (except-handler (fd-entry-except-handlers fd-entry))
  93         (funcall (handler-function except-handler) fd :except)))
  94     (when (and read-handlers (logtest et:epollin events))
  95       (dolist (read-handler (fd-entry-read-handlers fd-entry))
  96         (funcall (handler-function read-handler) fd :read)))
  97     (when (and write-handlers (logtest et:epollout events))
  98       (dolist (write-handler (fd-entry-write-handlers fd-entry))
  99         (funcall (handler-function write-handler) fd :write)))))
 100
 101 (defmethod serve-fd-events ((mux epoll-multiplexer)
 102                             &key timeout)
 103   (with-foreign-object (events 'et:epoll-event #.*epoll-max-events*)
 104     (et:memset events 0 #.(* *epoll-max-events* (foreign-type-size 'et:epoll-event)))
 105     (if timeout
 106         (multiple-value-bind
 107               (to-sec to-usec) (decode-timeout timeout)
 108           (setf timeout (+ to-sec (* to-usec 1000))))
 109         (setf timeout -1))
 110     (let ((ready-fds
 111            (et:epoll-wait (epoll-fd mux) events
 112                           #.*epoll-max-events* timeout)))
 113       (loop
 114          :for i :below ready-fds
 115          :for fd := (foreign-slot-value (foreign-slot-value (mem-aref events 'et:epoll-event i)
 116                                                             'et:epoll-event 'et:data)
 117                                         'et:epoll-data 'et:fd)
 118          :for event-mask := (foreign-slot-value (mem-aref events 'et:epoll-event i)
 119                                                 'et:epoll-event 'et:events)
 120          :do (epoll-serve-single-fd (fd-entry mux fd)
 121                                     event-mask))
 122       (return-from serve-fd-events ready-fds))))
 123
 124 (defmethod close-multiplexer ((mux epoll-multiplexer))
 125   (cancel-finalization mux)
 126   (et:close (epoll-fd mux)))