Commit bcdd3f2f authored by Robert Brown's avatar Robert Brown Committed by Nikodemus Siivola
Browse files

Add support for Posix interval timers

parent 1318e136
Loading
Loading
Loading
Loading
+9 −1
Original line number Diff line number Diff line
@@ -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

+87 −1
Original line number Diff line number Diff line
@@ -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

+35 −1
Original line number Diff line number Diff line
@@ -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"