1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Controlling the queue of scheduled events and running expired timers.
5 ;;; Copyright (C) 2003 Zach Beane <xach@xach.com>
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:
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
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.
26 (in-package :io.multiplex
)
32 (defun schedule-timer (schedule timer
)
33 (priority-queue-insert schedule timer
)
36 (defun unschedule-timer (schedule timer
)
37 (priority-queue-remove schedule timer
)
40 (defun reschedule-timer (schedule timer
)
41 (incf (%timer-expire-time timer
) (%timer-relative-time timer
))
42 (priority-queue-insert schedule timer
))
44 (defun reschedule-timer-relative-to-now (timer now
)
45 (setf (%timer-expire-time timer
)
46 (+ now
(%timer-relative-time timer
))))
52 (defun peek-schedule (schedule)
53 (priority-queue-minimum schedule
))
55 (defun time-to-next-timer (schedule)
56 (let ((timer (peek-schedule schedule
)))
57 (and timer
(%timer-expire-time timer
))))
63 (defun dispatch-timer (timer)
64 (funcall (%timer-function timer
)))
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
))))
71 (defun expire-pending-timers (schedule now
)
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
))
79 (dolist (timer timers-to-reschedule
)
80 (reschedule-timer schedule timer
))
83 (let ((next-timer (peek-schedule schedule
)))
84 (unless next-timer
(%return
))
85 (cond ((timer-expired-p next-timer now
)
87 (handle-expired-timer (priority-queue-extract-minimum schedule
)))