factor/library/threads.factor

50 lines
1.3 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2005 Slava Pestov.
2005-02-07 18:27:55 -05:00
! Copyright (C) 2005 Mackenzie Straight.
! See http://factor.sf.net/license.txt for BSD license.
2004-08-20 21:26:25 -04:00
IN: threads
2005-08-23 15:50:32 -04:00
USING: errors hashtables io-internals kernel lists math
namespaces queues sequences vectors ;
2004-08-20 21:26:25 -04:00
2005-08-23 15:50:32 -04:00
! Co-operative multitasker.
: run-queue ( -- queue ) \ run-queue global hash ;
: schedule-thread ( continuation -- ) run-queue enque ;
2005-08-23 15:50:32 -04:00
: sleep-queue ( -- vec ) \ sleep-queue global hash ;
: sleep-queue* ( -- vec )
sleep-queue dup [ 2car swap - ] nsort ;
: sleep-time ( sorted-queue -- ms )
2005-09-24 15:21:17 -04:00
dup empty? [ drop -1 ] [ peek car millis - 0 max ] if ;
2005-08-23 15:50:32 -04:00
DEFER: next-thread
: do-sleep ( -- continuation )
2006-01-28 15:49:31 -05:00
sleep-queue* dup sleep-time dup zero?
2005-09-24 15:21:17 -04:00
[ drop pop cdr ] [ nip io-multiplex next-thread ] if ;
2005-02-07 18:04:49 -05:00
: next-thread ( -- continuation )
2005-09-24 15:21:17 -04:00
run-queue dup queue-empty? [ drop do-sleep ] [ deque ] if ;
2005-08-23 15:50:32 -04:00
2005-09-14 00:37:50 -04:00
: stop ( -- ) next-thread continue ;
2005-08-23 15:50:32 -04:00
2005-09-18 01:37:28 -04:00
: yield ( -- ) [ schedule-thread stop ] callcc0 ;
2005-08-23 15:50:32 -04:00
: sleep ( ms -- )
millis + [ cons sleep-queue push stop ] callcc0 drop ;
2005-08-23 15:50:32 -04:00
: in-thread ( quot -- )
[
schedule-thread
V{ } set-catchstack V{ } set-callstack
2005-08-23 15:50:32 -04:00
try stop
2005-09-18 01:37:28 -04:00
] callcc0 drop ;
2005-08-23 15:50:32 -04:00
2005-08-24 00:30:07 -04:00
: init-threads ( -- )
global [
<queue> \ run-queue set
V{ } clone \ sleep-queue set
2005-08-24 00:30:07 -04:00
] bind ;