io-multiplex/utils.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :io.multiplex)
  23
  24 (defun timeout->timeval (timeout tv)
  25   (with-foreign-slots ((et:sec et:usec) tv et:timeval)
  26     (multiple-value-bind (sec usec) (decode-timeout timeout)
  27      (setf et:sec  sec
  28            et:usec usec))))
  29
  30
  31 (defun timeout->timespec (timeout ts)
  32   (with-foreign-slots ((et:sec et:nsec) ts et:timespec)
  33     (multiple-value-bind (sec usec) (decode-timeout timeout)
  34       (setf et:sec sec
  35             et:nsec (* 1000 usec)))))
  36
  37
  38 (defun timeout->milisec (timeout)
  39   (if timeout
  40       (multiple-value-bind (sec usec) (decode-timeout timeout)
  41         (+ (* sec 1000)
  42            (truncate usec 1000)))
  43       -1))
  44
  45
  46 (defmacro flags-case (mask &body clauses)
  47   (let ((newm (gensym "MASK")))
  48     `(let ((,newm ,mask))
  49        (progn ,@(loop :for clause :in clauses
  50                    :collect `(when (logtest ,(let ((flags (first clause)))
  51                                                   (if (listp flags)
  52                                                       `(logior ,@flags)
  53                                                       flags))
  54                                             ,newm)
  55                               ,(second clause)))))))
  56
  57
  58 (defmacro ignore-and-print-errors (&body body)
  59   `(handler-case (progn ,@body)
  60      (error (error)
  61        (warn "Caught a ~A: ~A, ignoring it."
  62              (type-of error) error))))