'UI already running' check was being done too late
parent
4b48581234
commit
740c245a7d
|
@ -9,7 +9,7 @@ namespaces queues sequences vectors ;
|
||||||
|
|
||||||
: run-queue ( -- queue ) \ run-queue global hash ;
|
: run-queue ( -- queue ) \ run-queue global hash ;
|
||||||
|
|
||||||
: schedule-thread ( quot -- ) run-queue enque ;
|
: schedule-thread ( continuation -- ) run-queue enque ;
|
||||||
|
|
||||||
: sleep-queue ( -- vec ) \ sleep-queue global hash ;
|
: sleep-queue ( -- vec ) \ sleep-queue global hash ;
|
||||||
|
|
||||||
|
@ -21,11 +21,11 @@ namespaces queues sequences vectors ;
|
||||||
|
|
||||||
DEFER: next-thread
|
DEFER: next-thread
|
||||||
|
|
||||||
: do-sleep ( -- quot )
|
: do-sleep ( -- continuation )
|
||||||
sleep-queue* dup sleep-time dup 0 =
|
sleep-queue* dup sleep-time dup 0 =
|
||||||
[ drop pop cdr ] [ nip io-multiplex next-thread ] if ;
|
[ drop pop cdr ] [ nip io-multiplex next-thread ] if ;
|
||||||
|
|
||||||
: next-thread ( -- quot )
|
: next-thread ( -- continuation )
|
||||||
run-queue dup queue-empty? [ drop do-sleep ] [ deque ] if ;
|
run-queue dup queue-empty? [ drop do-sleep ] [ deque ] if ;
|
||||||
|
|
||||||
: stop ( -- ) next-thread continue ;
|
: stop ( -- ) next-thread continue ;
|
||||||
|
@ -33,8 +33,7 @@ DEFER: next-thread
|
||||||
: yield ( -- ) [ schedule-thread stop ] callcc0 ;
|
: yield ( -- ) [ schedule-thread stop ] callcc0 ;
|
||||||
|
|
||||||
: sleep ( ms -- )
|
: sleep ( ms -- )
|
||||||
millis +
|
millis + [ cons sleep-queue push stop ] callcc0 drop ;
|
||||||
[ cons sleep-queue push stop ] callcc0 drop ;
|
|
||||||
|
|
||||||
: in-thread ( quot -- )
|
: in-thread ( quot -- )
|
||||||
[
|
[
|
||||||
|
|
|
@ -0,0 +1,39 @@
|
||||||
|
USING: help threads ;
|
||||||
|
|
||||||
|
HELP: run-queue "( -- queue )"
|
||||||
|
{ $values { "queue" "a queue" } }
|
||||||
|
{ $description "Outputs the runnable thread queue." } ;
|
||||||
|
|
||||||
|
HELP: schedule-thread "( continuation -- )"
|
||||||
|
{ $values { "continuation" "a continuation" } }
|
||||||
|
{ $description "Adds a runnable thread to the end of the run queue." } ;
|
||||||
|
|
||||||
|
HELP: sleep-queue "( -- vector )"
|
||||||
|
{ $values { "vector" "a vector" } }
|
||||||
|
{ $description "Outputs the sleeping thread queue. This is not actually a queue, but a vector of cons cells, where each cons cell consists of a wakeup time and a continuation." } ;
|
||||||
|
|
||||||
|
HELP: sleep-queue* "( -- vector )"
|
||||||
|
{ $values { "vector" "a vector" } }
|
||||||
|
{ $description "Outputs the sleeping thread queue, sorted by wakeup time." } ;
|
||||||
|
|
||||||
|
HELP: sleep-time "( vector -- ms )"
|
||||||
|
{ $values { "vector" "a sorted sleep queue" } { "ms" "a non-negative integer" } }
|
||||||
|
{ $description "Outputs the time until the next sleeping thread is scheduled to wake up, or -1 if there are no sleeping threads. The input must be a sorted sleep queue output by " { $link sleep-queue* } "." } ;
|
||||||
|
|
||||||
|
HELP: next-thread "( -- continuation )"
|
||||||
|
{ $values { "continuation" "a continuation" } }
|
||||||
|
{ $description "Outputs the next runnable thread. If there are no runnable threads, waits for a sleeping thread to wake up." } ;
|
||||||
|
|
||||||
|
HELP: stop "( -- )"
|
||||||
|
{ $description "Stops the current thread." } ;
|
||||||
|
|
||||||
|
HELP: yield "( -- )"
|
||||||
|
{ $description "Adds the current thread to the end of the run queue, and switches to the next runnable thread." } ;
|
||||||
|
|
||||||
|
HELP: sleep "( ms -- )"
|
||||||
|
{ $values { "ms" "a non-negative integer" } }
|
||||||
|
{ $description "Suspends the current thread for " { $snippet "ms" } " milliseconds. It will not get woken up before this time period elapses, but since the multitasker is co-operative, the precise wakeup time is dependent on when other threads yield." } ;
|
||||||
|
|
||||||
|
HELP: in-thread "( quot -- )"
|
||||||
|
{ $values { "quot" "a quotation" } }
|
||||||
|
{ $description "Spawns a new thread. The new thread begins running immediately. If an unhandled error occurs in the thread, the error is logged to the default stream in the dynamic extent of the caller of this word." } ;
|
|
@ -22,16 +22,17 @@ global [ first-time on ] bind
|
||||||
] bind ;
|
] bind ;
|
||||||
|
|
||||||
: check-running
|
: check-running
|
||||||
world get world-running?
|
world get [
|
||||||
[ "The UI is already running" throw ] when ;
|
world-running?
|
||||||
|
[ "The UI is already running" throw ] when
|
||||||
|
] when* ;
|
||||||
|
|
||||||
IN: shells
|
IN: shells
|
||||||
|
|
||||||
: ui ( -- )
|
: ui ( -- )
|
||||||
#! Start the Factor graphics subsystem with the given screen
|
#! Start the Factor graphics subsystem with the given screen
|
||||||
#! dimensions.
|
#! dimensions.
|
||||||
[
|
check-running [
|
||||||
init-world check-running
|
init-world world get rect-dim first2
|
||||||
world get rect-dim first2
|
|
||||||
[ listener-application run-world ] with-gl-screen
|
[ listener-application run-world ] with-gl-screen
|
||||||
] with-freetype ;
|
] with-freetype ;
|
||||||
|
|
Loading…
Reference in New Issue