Thread-sleep allow fractional seconds

CHANGELOG.md

@@ -8,6 +8,10 @@ Features
 - Allow a program to have macros expand into a top-level `import` expression.
 - Added continuous integration support thanks to Alex Arslan.
 
+Bug Fixes
+
+- Incorporated a patch from @0-8-15 to pass seconds to `thread-sleep!` instead of milliseconds. Fractional seconds are accepted as well for high-resolution timers.
+
 ## 0.6.3 - September 16, 2017
 
 Features

docs/api/srfi/18.md

@@ -74,17 +74,17 @@ Makes thread runnable. The thread must be a new thread. thread-start! returns th
 
     (thread-sleep! timeout)
 
-Block the current thread for `timeout` milliseconds.
+Block the current thread for `timeout` seconds. Fractional seconds may be provided to sleep for less than one second.
 
 # thread-yield!
 
-    (thread-yield!) (thread-sleep! 1))
+    (thread-yield!)
 
 The current thread exits the running state as if its quantum had expired.
 
 # thread-terminate!
 
-    (thread-terminate!
+    (thread-terminate!)
 
 Immediately abort the current thread.
 

examples/long-running-process.scm

@@ -19,10 +19,10 @@
            (write "consumer sleeping")
            (set! sleep? #t)))
         (mutex-unlock! *lock*)
-        (if sleep? (thread-sleep! 1000))
+        (if sleep? (thread-sleep! 1))
         (loop)))) 
    '())
 
   (write `(,i))
-  (thread-sleep! 5)
+  (thread-sleep! 0.005)
   (loop (+ i 1)))

examples/threading/benchmarks/bv2string-integration.scm

@@ -176,7 +176,7 @@
     (thread-start! t)))
 
 (define (wait-for-all-async)
-  (thread-sleep! 1) ;; TODO: not good enough, figure out a better solution
+  (thread-sleep! 0) ;; TODO: not good enough, figure out a better solution
   (let loop ()
     (define t #f)
     (mutex-lock! m)

examples/threading/benchmarks/bv2string.scm

@@ -197,7 +197,7 @@
     (thread-start! t)))
 
 (define (wait-for-all-async)
-  (thread-sleep! 1) ;; TODO: not good enough, figure out a better solution
+  (thread-sleep! 0) ;; TODO: not good enough, figure out a better solution
   (let loop ()
     (define t #f)
     (mutex-lock! m)

examples/threading/cv-broadcast.scm

@@ -16,7 +16,7 @@
 (thread-start!
   (make-thread
     (lambda ()
-      (thread-sleep! 3000)
+      (thread-sleep! 3)
       (set! *done* #t)
       (condition-variable-broadcast! cv)
       (trace "broadcast thread done"))))
@@ -42,7 +42,7 @@
   (cond
     (*done*
       (mutex-unlock! m)
-      (thread-sleep! 500)
+      (thread-sleep! 0.5)
       (trace "main thread done"))
     (else
       (mutex-unlock! m cv) ;; Wait on cv

examples/threading/parameters.scm

@@ -12,20 +12,20 @@
 (thread-start!
   (make-thread
     (lambda ()
-      (thread-sleep! 1200)
+      (thread-sleep! 1.2)
       (display "started thread, this should be written to console")
       (newline)
       (display "thread done")
       (newline)
       (flush-output-port (current-output-port)))))
 
-(thread-sleep! 1000) ;; Prevent race condition replacing stdout before thread is spawned
+(thread-sleep! 1) ;; Prevent race condition replacing stdout before thread is spawned
 (write `(1 2 3))
 (define fp (open-output-file "tmp.txt"))
 (parameterize
   ((current-output-port fp))
   (write `(4 5 6))
-  (thread-sleep! 3000)
+  (thread-sleep! 3)
 )
 (close-port fp)
 (write `(7 8 9))

examples/threading/producer-consumer.scm

@@ -43,7 +43,7 @@
        (newline)
        (set! sleep? #t)))
     (mutex-unlock! *lock*)
-    (if sleep? (thread-sleep! 1000))
+    (if sleep? (thread-sleep! 1))
     (loop)))
 
 (thread-start! (make-thread producer))

examples/threading/thread-join.scm

@@ -13,7 +13,7 @@
     (lambda ()
       (display "started thread")
       (newline)
-      (thread-sleep! 3000)
+      (thread-sleep! 3)
       (display "thread done")
       (newline)
       (condition-variable-broadcast! cv))))
@@ -23,7 +23,7 @@
 (mutex-unlock! m cv) ;; Wait on cv
 (display "main thread done")
 (newline)
-(thread-sleep! 500)
+(thread-sleep! 0.5)
 
 ;(display "thread join")
 ;(newline)
@@ -31,12 +31,12 @@
 ;            (lambda ()
 ;              (display "started second thread")
 ;              (newline)
-;              (thread-sleep! 3000)
+;              (thread-sleep! 3)
 ;              (display "thread done")
 ;              (newline)
 ;              1))))
 ;  (thread-start! t)
-;  (thread-sleep! 1)
+;  (thread-sleep! 0)
 ;  (display (thread-join! t))
 ;  (display "main thread done again")
 ;  (newline))

runtime.c

@@ -5692,11 +5692,11 @@ void Cyc_exit_thread(gc_thread_data * thd)
 object Cyc_thread_sleep(void *data, object timeout)
 {
   struct timespec tim;
-  long value;
+  double value;
   Cyc_check_num(data, timeout);
   value = unbox_number(timeout);
-  tim.tv_sec = value;
-  tim.tv_nsec = (value % 1000000) * NANOSECONDS_PER_MILLISECOND;
+  tim.tv_sec = (long)value;
+  tim.tv_nsec = (long)((value - tim.tv_sec) * 1000 * NANOSECONDS_PER_MILLISECOND);
   nanosleep(&tim, NULL);
   return boolean_t;
 }