Add register-time-event, deregister-time-event.
authorMatt Birkholz <matt@birchwood-abbey.net>
Sun, 7 Aug 2016 21:43:02 +0000 (14:43 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Sun, 7 Aug 2016 21:43:02 +0000 (14:43 -0700)
src/runtime/runtime.pkg
src/runtime/thread.scm

index 54feee00b382dd7be9a37f77687a9332ff83ba6d..9cd171fc88e094982e49bc779d55aca77d650cab 100644 (file)
@@ -4682,6 +4682,7 @@ USA.
          deregister-all-events
          deregister-io-descriptor-events
          deregister-io-thread-event
+         deregister-time-event
          deregister-timer-event
          detach-thread
          exit-current-thread
@@ -4692,6 +4693,7 @@ USA.
          other-running-threads?
          permanently-register-io-thread-event
          register-io-thread-event
+         register-time-event
          register-timer-event
          restart-thread
          set-thread-timer-interval!
index 5fafca42455946f888322481727e70800bcefcf1..51a27f9e8aa64208c949f69247b26050ed998ecb 100644 (file)
@@ -1009,7 +1009,9 @@ USA.
   next)
 
 (define (register-timer-event interval event)
-  (let ((time (+ (real-time-clock) interval)))
+  (register-time-event (+ (real-time-clock) interval) event))
+
+(define (register-time-event time event)
     (let ((new-record (make-timer-record time (current-thread) event #f)))
       (without-interrupts
        (lambda ()
@@ -1046,7 +1048,7 @@ USA.
        (set-timer-record/event! record #f)
        (%signal-thread-event thread event)))))
 \f
-(define (deregister-timer-event registration)
+(define (deregister-time-event registration)
   (if (not (timer-record? registration))
       (error:wrong-type-argument registration "timer event registration"
                                 'DEREGISTER-TIMER-EVENT))
@@ -1062,6 +1064,9 @@ USA.
                 (loop next record)))))
      (%maybe-toggle-thread-timer))))
 
+(define-integrable (deregister-timer-event registration)
+  (deregister-time-event registration))
+
 (define-integrable (threads-pending-timer-events?)
   timer-records)