From e465f811f5ce686cd088d789d0bb089788dab457 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 13 Nov 2017 18:41:10 -0500 Subject: [PATCH] Thread-sleep allow fractional seconds --- CHANGELOG.md | 4 ++++ docs/api/srfi/18.md | 6 +++--- examples/long-running-process.scm | 4 ++-- examples/threading/benchmarks/bv2string-integration.scm | 2 +- examples/threading/benchmarks/bv2string.scm | 2 +- examples/threading/cv-broadcast.scm | 4 ++-- examples/threading/parameters.scm | 6 +++--- examples/threading/producer-consumer.scm | 2 +- examples/threading/thread-join.scm | 8 ++++---- runtime.c | 6 +++--- 10 files changed, 24 insertions(+), 20 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a8de96ed..27ca2c75 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/docs/api/srfi/18.md b/docs/api/srfi/18.md index 1de8d556..4a48fec2 100644 --- a/docs/api/srfi/18.md +++ b/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. diff --git a/examples/long-running-process.scm b/examples/long-running-process.scm index ba67284b..53938991 100644 --- a/examples/long-running-process.scm +++ b/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))) diff --git a/examples/threading/benchmarks/bv2string-integration.scm b/examples/threading/benchmarks/bv2string-integration.scm index 46b75c31..9c428d0b 100644 --- a/examples/threading/benchmarks/bv2string-integration.scm +++ b/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) diff --git a/examples/threading/benchmarks/bv2string.scm b/examples/threading/benchmarks/bv2string.scm index 116d2ef6..0815ea79 100644 --- a/examples/threading/benchmarks/bv2string.scm +++ b/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) diff --git a/examples/threading/cv-broadcast.scm b/examples/threading/cv-broadcast.scm index 05db2114..6d652bbf 100644 --- a/examples/threading/cv-broadcast.scm +++ b/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 diff --git a/examples/threading/parameters.scm b/examples/threading/parameters.scm index 0fc9ed71..d1ae62f3 100644 --- a/examples/threading/parameters.scm +++ b/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)) diff --git a/examples/threading/producer-consumer.scm b/examples/threading/producer-consumer.scm index 26240fd4..107c0172 100644 --- a/examples/threading/producer-consumer.scm +++ b/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)) diff --git a/examples/threading/thread-join.scm b/examples/threading/thread-join.scm index b4b478c8..100e8f4d 100644 --- a/examples/threading/thread-join.scm +++ b/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)) diff --git a/runtime.c b/runtime.c index dff3fade..c2d379cb 100644 --- a/runtime.c +++ b/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; }