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