Add support for Posix interval timers

diff --git a/posix/packages.lisp b/posix/packages.lisp
index ea1647c..c1dcfce 100644 (file)
--- a/posix/packages.lisp
+++ b/posix/packages.lisp
@@ -159,6 +159,11 @@
    #:syslog
    #:telldir
    #:time
+   #:timer-create
+   #:timer-delete
+   #:timer-getoverrun
+   #:timer-gettime
+   #:timer-settime
    #:truncate
    #:umask
    #:uname
@@ -225,6 +230,8 @@
    #:sigxfsz #:sigvtalrm #:sigprof #:sigwinch #:siginfo #:sigusr1 #:sigusr2
    #:sigrtmin #:sigrtmax
 
+   #:sigev-none #:sigev-signal #:sigev-thread #+linux #:sigev-thread-id
+
    #:o-rdonly #:o-wronly #:o-rdwr #:o-creat #:o-excl #:o-noctty #:o-trunc
    #:o-append #:o-nonblock #:o-ndelay #:o-sync #:o-nofollow #:o-direct
    #:o-async #:o-directory #:o-largefile #:o-dsync #:o-rsync
@@ -296,7 +303,8 @@
 
    #:iov-max
 
-   #:clock-monotonic #:clock-realtime
+   #:clock-monotonic #:clock-realtime #:clock-process-cputime-id
+   #:clock-thread-cputime-id #:timer-abstime
 
    #:log-cons #:log-ndelay #:log-perror #:log-pid
 

diff --git a/posix/unix.lisp b/posix/unix.lisp
index 69b8742..702d32d 100644 (file)
--- a/posix/unix.lisp
+++ b/posix/unix.lisp
@@ -394,7 +394,93 @@
     (with-foreign-object (ts 'timespec)
       (with-foreign-slots ((sec nsec) ts timespec)
         (%clock-settime clock-id ts)
-        (values sec nsec)))))
+        (values sec nsec))))
+
+  (defsyscall ("timer_create" %timer-create) :int
+    (clockid clockid)
+    (sigevent :pointer)
+    (timer :pointer))
+
+  (defun timer-create (clock-id notify-method
+                       &key signal notify-value function attributes
+                            #+linux thread-id)
+    "Creates a new per-process interval timer."
+    (with-foreign-object (se 'sigevent)
+      (with-foreign-slots ((notify signo value
+                            notify-function notify-attributes
+                            #+linux notify-thread-id)
+                           se sigevent)
+        (with-foreign-slots ((int) value sigval)
+          (setf notify notify-method)
+          (cond ((= notify-method sigev-none))
+                ((= notify-method sigev-signal)
+                 (setf signo signal
+                       int notify-value))
+                #+linux
+                ((= notify-method (logior sigev-signal sigev-thread-id))
+                 (setf signo signal
+                       notify-thread-id thread-id
+                       int notify-value))
+                ((= notify-method sigev-thread)
+                 (setf notify-function function
+                       notify-attributes attributes
+                       int notify-value))
+                (t (error "bad timer notification method")))
+          (with-foreign-object (timer 'timer)
+            (%timer-create clock-id se timer)
+            (mem-ref timer :int))))))
+
+  (defsyscall ("timer_delete" timer-delete) :int
+    "Deletes the timer identified by TIMER-ID."
+    (timer-id timer))
+
+  (defsyscall ("timer_getoverrun" timer-getoverrun) :int
+    "Returns the overrun count for the timer identified by TIMER-ID."
+    (timer-id timer))
+
+  (defsyscall ("timer_gettime" %timer-gettime) :int
+    (timer timer)
+    (itimerspec :pointer))
+
+  (defun deconstruct-itimerspec (its)
+    (with-foreign-slots ((interval value) its itimerspec)
+      (with-foreign-slots ((sec nsec) interval timespec)
+        (let ((interval-sec sec)
+              (interval-nsec nsec))
+          (with-foreign-slots ((sec nsec) value timespec)
+            (values interval-sec interval-nsec sec nsec))))))
+
+  (defun timer-gettime (timer-id)
+    "Returns the interval and the time until next expiration for the
+timer specified by TIMER-ID.  Both the interval and the time are returned
+as seconds and nanoseconds, so four values are returned."
+    (with-foreign-object (its 'itimerspec)
+      (%timer-gettime timer-id its)
+      (values-list (multiple-value-list (deconstruct-itimerspec its)))))
+
+  (defsyscall ("timer_settime" %timer-settime) :int
+    (timer timer)
+    (flags :int)
+    (new :pointer)
+    (old :pointer))
+
+  (defun timer-settime (timer-id flags interval-sec interval-nsec
+                        initial-sec initial-nsec
+                        &optional return-previous-p)
+    "Arms or disarms the timer identified by TIMER-ID."
+    (with-foreign-object (new 'itimerspec)
+      (with-foreign-slots ((interval value) new itimerspec)
+        (with-foreign-slots ((sec nsec) interval timespec)
+          (setf sec interval-sec
+                nsec interval-nsec)
+          (with-foreign-slots ((sec nsec) value timespec)
+            (setf sec initial-sec
+                  nsec initial-nsec)
+            (with-foreign-object (old 'itimerspec)
+              (let ((result (%timer-settime timer-id flags new old)))
+                (if return-previous-p
+                    (values-list (multiple-value-list (deconstruct-itimerspec old)))
+                    result)))))))))
 
 ;;;; sys/stat.h
 

diff --git a/posix/unixint.lisp b/posix/unixint.lisp
index e4d5a5a..694860c 100644 (file)
--- a/posix/unixint.lisp
+++ b/posix/unixint.lisp
@@ -90,6 +90,30 @@
   (constant (sigrtmax "SIGRTMAX")
             :documentation "Largest real-time signal number."))
 
+(constant (sigev-none "SIGEV_NONE")
+          :documentation "No notification when the event occurs.")
+(constant (sigev-signal "SIGEV_SIGNAL")
+          :documentation "Generate a signal when the event occurs.")
+(constant (sigev-thread "SIGEV_THREAD")
+          :documentation "Call a function when the event occurs.")
+#+linux
+(constant (sigev-thread-id "SIGEV_THREAD_ID")
+          :documentation
+          "Send a signal to a specific thread when the event occurs.")
+
+(cunion sigval "union sigval"
+  (int "sival_int" :type :int)
+  (ptr "sival_ptr" :type :pointer))
+
+(cstruct sigevent "struct sigevent"
+  (notify            "sigev_notify"            :type :int)
+  (signo             "sigev_signo"             :type :int)
+  (value             "sigev_value"             :type sigval)
+  (notify-function   "sigev_notify_function"   :type :pointer)
+  (notify-attributes "sigev_notify_attributes" :type :pointer)
+  #+linux
+  (notify-thread-id  "_sigev_un._tid"          :type pid))
+
 ;;;; fcntl()
 
 (constant (f-dupfd "F_DUPFD"))
@@ -308,14 +332,24 @@
 #-darwin
 (progn
   (ctype clockid "clockid_t")
+  (ctype timer "timer_t")
   (constant (clock-monotonic "CLOCK_MONOTONIC"))
-  (constant (clock-realtime "CLOCK_REALTIME")))
+  (constant (clock-realtime "CLOCK_REALTIME"))
+  (constant (clock-process-cputime-id "CLOCK_PROCESS_CPUTIME_ID"))
+  (constant (clock-thread-cputime-id "CLOCK_THREAD_CPUTIME_ID"))
+  (constant (timer-abstime "TIMER_ABSTIME")))
 
 (cstruct timespec "struct timespec"
   "UNIX time specification in seconds and nanoseconds."
   (sec  "tv_sec"  :type time)
   (nsec "tv_nsec" :type :long))
 
+#-darwin
+(cstruct itimerspec "struct itimerspec"
+  "UNIX timer interval and initial expiration."
+  (interval "it_interval" :type timespec)
+  (value    "it_value"    :type timespec))
+
 ;;;; from sys/select.h
 
 (cstruct timeval "struct timeval"