From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sun, 7 Aug 2016 21:43:02 +0000 (-0700)
Subject: Add register-time-event, deregister-time-event.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~4
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b0f9dfa9bb301c46af136ff30101633b80ab863e;p=mit-scheme.git

Add register-time-event, deregister-time-event.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 54feee00b..9cd171fc8 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -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!
diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 5fafca424..51a27f9e8 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -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)))))
 
-(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)