io-multiplex/timers.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; timers.lisp --- Creating and manipulating timer structures.
   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 :io.multiplex)
  27
  28 ;;;
  29 ;;; Timer
  30 ;;;
  31
  32 (defstruct (timer
  33              (:conc-name %timer-)
  34              (:constructor %make-timer (name function expire-time
  35                                         relative-time one-shot new-thread-p))
  36              (:print-function %print-timer))
  37   name
  38   ;; to call when the timer expires
  39   function
  40   ;; absolute expiry time
  41   expire-time
  42   ;; relative expiry time
  43   relative-time
  44   ;; when NIL, the timer is automatically rescheduled
  45   ;; when triggered
  46   one-shot
  47   ;; when not NIL, call FUNCTION in a new thread
  48   new-thread-p)
  49
  50 (defun %print-timer (object stream print-level)
  51   (declare (ignore print-level))
  52   (print-unreadable-object (object stream)
  53     (format stream "TIMER ~S, Timeout: [ ~A , ~A ], ~:[persistent~;one-shot~], to run in ~:[same~;new~] thread"
  54             (or (%timer-name object)
  55                 "(unnamed)")
  56             (%timer-relative-time object)
  57             (%timer-expire-time object)
  58             (%timer-one-shot object)
  59             (%timer-new-thread-p object))))
  60
  61 (defun make-timer (function delay &key (name "A timer") one-shot thread)
  62   (%make-timer name function (abs-timeout delay) delay one-shot thread))
  63
  64 (defun timer-name (timer)
  65   (%timer-name timer))
  66
  67 (defun timer-expired-p (timer now &optional (delta 0.0d0))
  68   (assert (%timer-expire-time timer) ((%timer-expire-time timer))
  69            "Timer ~A must have an expiry time set." timer)
  70   (let ((compare-time (+ now delta)))
  71     (> compare-time (%timer-expire-time timer))))
  72
  73 (defun reset-timer (timer)
  74   (setf (%timer-expire-time timer) 0))