io.multiplex/time.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Various time-related functions.
   4 ;;;
   5
   6 (in-package :io.multiplex)
   7
   8 ;;;; Timeouts
   9
  10 (deftype timeout ()
  11   'double-float)
  12
  13 ;;; Break a real timeout into seconds and microseconds.
  14 (defun decode-timeout (timeout)
  15   (assert (or (not timeout)
  16               (and (typep timeout 'real)
  17                    (not (minusp timeout))))
  18           (timeout)
  19           "The timeout must be a non-negative real or NIL: ~S" timeout)
  20   (typecase timeout
  21     (null nil)
  22     (integer (values timeout 0))
  23     (real
  24      (multiple-value-bind (q r) (truncate (coerce timeout 'timeout))
  25        (declare (type unsigned-byte q)
  26                 (type timeout r))
  27        (values q (the (values unsigned-byte t) (truncate (* r 1d6))))))))
  28
  29 (defun normalize-timeout (timeout)
  30   (assert (and (typep timeout 'real)
  31                (not (minusp timeout)))
  32           (timeout)
  33           "The timeout must be non-negative: ~A" timeout)
  34   (coerce timeout 'timeout))
  35
  36 (defun abs-timeout (timeout)
  37   (+ (osicat:get-monotonic-time) (normalize-timeout timeout)))
  38
  39 (defun min-timeout (&rest timeouts)
  40   (collect-min (choose-if #'identity (scan timeouts))))