gettimeofday.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       gettimeofday.lisp (3778B)
       ---
            1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
            2 ;;;
            3 ;;; gettimeofday.lisp --- Example CFFI binding to gettimeofday(2)
            4 ;;;
            5 ;;; Copyright (C) 2005-2006, James Bielman  <jamesjb@jamesjb.com>
            6 ;;;
            7 ;;; Permission is hereby granted, free of charge, to any person
            8 ;;; obtaining a copy of this software and associated documentation
            9 ;;; files (the "Software"), to deal in the Software without
           10 ;;; restriction, including without limitation the rights to use, copy,
           11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
           12 ;;; of the Software, and to permit persons to whom the Software is
           13 ;;; furnished to do so, subject to 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
           22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
           23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
           24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
           25 ;;; DEALINGS IN THE SOFTWARE.
           26 ;;;
           27 
           28 ;;;# CFFI Example: gettimeofday binding
           29 ;;;
           30 ;;; This example illustrates the use of foreign structures, typedefs,
           31 ;;; and using type translators to do checking of input and output
           32 ;;; arguments to a foreign function.
           33 
           34 (defpackage #:cffi-example-gettimeofday
           35   (:use #:common-lisp #:cffi)
           36   (:export #:gettimeofday))
           37 
           38 (in-package #:cffi-example-gettimeofday)
           39 
           40 ;;; Define the TIMEVAL structure used by 'gettimeofday'.  This assumes
           41 ;;; that 'time_t' is a 'long' --- it would be nice if CFFI could
           42 ;;; provide a proper :TIME-T type to help make this portable.
           43 (defcstruct timeval
           44   (tv-sec :long)
           45   (tv-usec :long))
           46 
           47 ;;; A NULL-POINTER is a foreign :POINTER that must always be NULL.
           48 ;;; Both a NULL pointer and NIL are legal values---any others will
           49 ;;; result in a runtime error.
           50 (define-foreign-type null-pointer-type ()
           51   ()
           52   (:actual-type :pointer)
           53   (:simple-parser null-pointer))
           54 
           55 ;;; This type translator is used to ensure that a NULL-POINTER has a
           56 ;;; null value.  It also converts NIL to a null pointer.
           57 (defmethod translate-to-foreign (value (type null-pointer-type))
           58   (cond
           59     ((null value) (null-pointer))
           60     ((null-pointer-p value) value)
           61     (t (error "~A is not a null pointer." value))))
           62 
           63 ;;; The SYSCALL-RESULT type is an integer type used for the return
           64 ;;; value of C functions that return -1 and set errno on errors.
           65 ;;; Someday when CFFI has a portable interface for dealing with
           66 ;;; 'errno', this error reporting can be more useful.
           67 (define-foreign-type syscall-result-type ()
           68   ()
           69   (:actual-type :int)
           70   (:simple-parser syscall-result))
           71 
           72 ;;; Type translator to check a SYSCALL-RESULT and signal a Lisp error
           73 ;;; if the value is negative.
           74 (defmethod translate-from-foreign (value (type syscall-result-type))
           75   (if (minusp value)
           76       (error "System call failed with return value ~D." value)
           77       value))
           78 
           79 ;;; Define the Lisp function %GETTIMEOFDAY to call the C function
           80 ;;; 'gettimeofday', passing a pointer to the TIMEVAL structure to fill
           81 ;;; in.  The TZP parameter is deprecated and should be NULL --- we can
           82 ;;; enforce this by using our NULL-POINTER type defined above.
           83 (defcfun ("gettimeofday" %gettimeofday) syscall-result
           84   (tp :pointer)
           85   (tzp null-pointer))
           86 
           87 ;;; Define a Lispy interface to 'gettimeofday' that returns the
           88 ;;; seconds and microseconds as multiple values.
           89 (defun gettimeofday ()
           90   (with-foreign-object (tv 'timeval)
           91     (%gettimeofday tv nil)
           92     (with-foreign-slots ((tv-sec tv-usec) tv timeval)
           93       (values tv-sec tv-usec))))