Simplify threads; remove nap word, its now just sleep

db4
Slava Pestov 2008-02-25 06:31:18 -06:00
parent c01c527cb9
commit fbaf6386b2
6 changed files with 35 additions and 33 deletions

View File

@ -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 } }

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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" ] }

View File

@ -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

View File

@ -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