src/multiplex/scheduler.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Controlling the queue of scheduled events and running expired timers.
   4 ;;;
   5 ;;; Copyright (C) 2003 Zach Beane <xach@xach.com>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person obtaining
   8 ;;; a copy of this software and associated documentation files (the
   9 ;;; "Software"), to deal in the Software without restriction, including
  10 ;;; without limitation the rights to use, copy, modify, merge,publish,
  11 ;;; distribute, sublicense, and/or sell copies of the Software, and to
  12 ;;; permit persons to whom the Software is furnished to do so, subject to
  13 ;;; the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  22 ;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  23 ;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  24 ;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  25
  26 (in-package :iolib/multiplex)
  27
  28 ;;;
  29 ;;; Public interface
  30 ;;;
  31
  32 (defun schedule-timer (schedule timer)
  33   (priority-queue-insert schedule timer)
  34   (values timer))
  35
  36 (defun unschedule-timer (schedule timer)
  37   (priority-queue-remove schedule timer)
  38   (values timer))
  39
  40 (defun reschedule-timer (schedule timer)
  41   (incf (%timer-expire-time timer) (%timer-relative-time timer))
  42   (priority-queue-insert schedule timer))
  43
  44 (defun reschedule-timer-relative-to-now (timer now)
  45   (setf (%timer-expire-time timer)
  46         (+ now (%timer-relative-time timer))))
  47 \f
  48 ;;;
  49 ;;; The scheduler
  50 ;;;
  51
  52 (defun peek-schedule (schedule)
  53   (priority-queue-maximum schedule))
  54
  55 (defun time-to-next-timer (schedule)
  56   (when-let ((timer (peek-schedule schedule)))
  57     (%timer-expire-time timer)))
  58 \f
  59 ;;;
  60 ;;; Expiring timers
  61 ;;;
  62
  63 (defun dispatch-timer (timer)
  64   (funcall (%timer-function timer)))
  65
  66 (defun timer-reschedulable-p (timer)
  67   (symbol-macrolet ((relative-time (%timer-relative-time timer))
  68                     (one-shot (%timer-one-shot timer)))
  69     (and relative-time (not one-shot))))
  70
  71 (defun expire-pending-timers (schedule now)
  72   (let ((expired-p nil)
  73         (timers-to-reschedule ()))
  74     (flet ((handle-expired-timer (timer)
  75              (when (timer-reschedulable-p timer)
  76                (push timer timers-to-reschedule))
  77              (dispatch-timer timer))
  78            (%return ()
  79              (dolist (timer timers-to-reschedule)
  80                (reschedule-timer schedule timer))
  81              (return* expired-p)))
  82       (loop
  83          (let ((next-timer (peek-schedule schedule)))
  84            (unless next-timer (%return))
  85            (cond ((timer-expired-p next-timer now)
  86                   (setf expired-p t)
  87                   (handle-expired-timer (priority-queue-extract-maximum schedule)))
  88                  (t
  89                   (%return))))))))