Simplify threads; remove nap word, its now just sleep
parent
c01c527cb9
commit
fbaf6386b2
|
@ -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 } }
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
@ -131,34 +134,27 @@ PRIVATE>
|
|||
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 ] <thread> ] cache
|
||||
<box> over set-thread-continuation
|
||||
f over set-thread-state
|
||||
dup register-thread
|
||||
set-self ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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" ] }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue