timeouts can be either time objects or seconds

lib/srfi/18/interface.scm

@@ -1,10 +1,22 @@
 
+(define current-time get-time-of-day)
+(define time? timeval?)
+
+(define (time->seconds x)
+  (timeval-seconds (if (pair? x) (car x) x)))
+
+(define (seconds->time x)
+  (make-timeval (if (inexact? x) (inexact->exact (round x)) x) 0))
+
+(define (timeout->seconds x)
+  (if (time? x) (- (time->seconds x) (time->seconds (current-time))) x))
+
 (define thread-yield! yield!)
 
 (define (thread-join! thread . o)
   (let ((timeout (if (pair? o) (car o) #f)))
     (cond
-     ((%thread-join! thread timeout))
+     ((%thread-join! thread (timeout->seconds timeout)))
      (else
       (thread-yield!)
       (if (thread-timeout?)
@@ -18,13 +30,13 @@
       (thread-yield!)))
 
 (define (thread-sleep! timeout)
-  (%thread-sleep! timeout)
+  (%thread-sleep! (timeout->seconds timeout))
   (thread-yield!))
 
 (define (mutex-lock! mutex . o)
   (let ((timeout (and (pair? o) (car o)))
         (thread (if (and (pair? o) (pair? (cdr o))) (cadr o) #t)))
-    (cond ((%mutex-lock! mutex timeout thread))
+    (cond ((%mutex-lock! mutex (timeout->seconds timeout) thread))
 	  (else
 	   (thread-yield!)
 	   (not (thread-timeout?))))))
@@ -32,20 +44,11 @@
 (define (mutex-unlock! mutex . o)
   (let ((condvar (and (pair? o) (car o)))
         (timeout (if (and (pair? o) (pair? (cdr o))) (cadr o) #f)))
-    (cond ((%mutex-unlock! mutex condvar timeout))
+    (cond ((%mutex-unlock! mutex condvar (timeout->seconds timeout)))
 	  (else
 	   (thread-yield!)
 	   (not (thread-timeout?))))))
 
-(define current-time get-time-of-day)
-(define time? timeval?)
-
-(define (time->seconds x)
-  (timeval-seconds (if (pair? x) (car x) x)))
-
-(define (seconds->time x)
-  (make-timeval (if (inexact? x) (inexact->exact x) x) 0))
-
 (define (join-timeout-exception? x)
   (and (exception? x)
        (equal? (exception-message x) "timed out waiting for thread")))