diff --git a/core/threads/threads-docs.factor b/core/threads/threads-docs.factor index fa79906cdf..d157907cc2 100755 --- a/core/threads/threads-docs.factor +++ b/core/threads/threads-docs.factor @@ -19,8 +19,7 @@ ARTICLE: "threads-yield" "Yielding and suspending threads" { $subsection yield } "Sleeping for a period of time:" { $subsection sleep } -"Interruptible sleep:" -{ $subsection nap } +"Interrupting sleep:" { $subsection interrupt } "Threads can be suspended and woken up at some point in the future when a condition is satisfied:" { $subsection suspend } @@ -106,14 +105,17 @@ HELP: stop HELP: yield { $description "Adds the current thread to the end of the run queue, and switches to the next runnable thread." } ; +HELP: sleep-until +{ $values { "time/f" "a non-negative integer or " { $link f } } } +{ $description "Suspends the current thread until the given time, or indefinitely if a value of " { $link f } " is passed in." +$nl +"Other threads may interrupt the sleep by calling " { $link interrupt } "." } ; + HELP: sleep { $values { "ms" "a non-negative integer" } } -{ $description "Suspends the current thread for " { $snippet "ms" } " milliseconds." } -{ $errors "Throws an error if another thread interrupted the sleep with " { $link interrupt } "." } ; - -HELP: nap -{ $values { "ms/f" "a non-negative integer or " { $link f } } { "?" "a boolean indicating whether the thread was interrupted" } } -{ $description "Suspends the current thread until another thread interrupts it with " { $link interrupt } ". If the input parameter is not " { $link f } ", then the thread will also wake up if the timeout expires before an interrupt is received." } ; +{ $description "Suspends the current thread for " { $snippet "ms" } " milliseconds." +$nl +"Other threads may interrupt the sleep by calling " { $link interrupt } "." } ; HELP: interrupt { $values { "thread" thread } } diff --git a/core/threads/threads.factor b/core/threads/threads.factor index 70ed44e539..490c8dc740 100755 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -75,12 +75,15 @@ PRIVATE> : sleep-queue 43 getenv ; : resume ( thread -- ) + f over set-thread-state check-registered run-queue push-front ; : resume-now ( thread -- ) + f over set-thread-state check-registered run-queue push-back ; : resume-with ( obj thread -- ) + f over set-thread-state check-registered 2array run-queue push-front ; self swap call next ] callcc1 2nip ; inline -: yield ( -- ) [ resume ] "yield" suspend drop ; +: yield ( -- ) [ resume ] f suspend drop ; -GENERIC: nap-until ( time -- ? ) +GENERIC: sleep-until ( time/f -- ) -M: integer nap-until [ schedule-sleep ] curry "sleep" suspend ; +M: integer sleep-until + [ schedule-sleep ] curry "sleep" suspend drop ; -M: f nap-until drop [ drop ] "interrupt" suspend ; +M: f sleep-until + drop [ drop ] "interrupt" suspend drop ; -GENERIC: nap ( time -- ? ) +GENERIC: sleep ( ms -- ) -M: real nap millis + >integer nap-until ; - -M: f nap nap-until ; - -: sleep-until ( time -- ) - nap-until [ "Sleep interrupted" throw ] when ; - -: sleep ( time -- ) - nap [ "Sleep interrupted" throw ] when ; +M: real sleep + millis + >integer sleep-until ; : interrupt ( thread -- ) - dup self eq? [ - drop - ] [ + dup thread-state [ dup thread-sleep-entry [ sleep-queue heap-delete ] when* f over set-thread-sleep-entry - t swap resume-with - ] if ; + dup resume + ] when drop ; : (spawn) ( thread -- ) [ @@ -204,6 +200,7 @@ M: f nap nap-until ; initial-thread global [ drop f "Initial" [ die ] ] cache over set-thread-continuation + f over set-thread-state dup register-thread set-self ; diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index 92a7c488ef..7f43dbd612 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -62,7 +62,7 @@ SYMBOL: alarm-thread : alarm-thread-loop ( -- ) alarms get-global - dup next-alarm nap-until drop + dup next-alarm sleep-until dup trigger-alarms alarm-thread-loop ; diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index d1d7246a58..d834698d08 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -473,9 +473,9 @@ M: timestamp year. ( timestamp -- ) : seconds-since-midnight ( timestamp -- x ) dup beginning-of-day timestamp- ; -M: timestamp nap-until timestamp>millis nap-until ; +M: timestamp sleep-until timestamp>millis sleep-until ; -M: dt nap from-now nap-until ; +M: dt sleep from-now sleep-until ; { { [ unix? ] [ "calendar.unix" ] } diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 58e3c0ba69..708dc1dc38 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -146,8 +146,8 @@ M: windows-io kill-process* ( handle -- ) : wait-loop ( -- ) processes get dup assoc-empty? - [ drop f nap drop ] - [ wait-for-processes [ 100 nap drop ] when ] if ; + [ drop f sleep-until ] + [ wait-for-processes [ 100 sleep ] when ] if ; SYMBOL: wait-thread diff --git a/extra/tools/threads/threads.factor b/extra/tools/threads/threads.factor index 3313a56964..552247e2c4 100755 --- a/extra/tools/threads/threads.factor +++ b/extra/tools/threads/threads.factor @@ -8,7 +8,10 @@ heaps.private system math math.parser ; : thread. ( thread -- ) dup thread-id pprint-cell dup thread-name over [ write-object ] with-cell - dup thread-state "running" or [ write ] with-cell + dup thread-state [ + [ dup self eq? "running" "yield" ? ] unless* + write + ] with-cell [ thread-sleep-entry [ entry-key millis [-] number>string write