factor/library/threads.factor

58 lines
1.6 KiB
Factor
Raw Normal View History

! Copyright (C) 2004, 2006 Slava Pestov.
2005-02-07 18:27:55 -05:00
! Copyright (C) 2005 Mackenzie Straight.
! See http://factorcode.org/license.txt for BSD license.
2004-08-20 21:26:25 -04:00
IN: threads
USING: arrays errors hashtables io-internals kernel math
2005-08-23 15:50:32 -04:00
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 get-global ;
2005-08-23 15:50:32 -04:00
2006-07-31 16:49:26 -04:00
: schedule-thread ( continuation0 -- ) run-queue enque ;
: schedule-thread-with ( obj continuation1 -- )
2array schedule-thread ;
2005-08-23 15:50:32 -04:00
: sleep-queue ( -- vec ) \ sleep-queue get-global ;
2005-08-23 15:50:32 -04:00
: sleep-queue* ( -- vec )
sleep-queue dup [ [ first ] 2apply swap - ] nsort ;
2005-08-23 15:50:32 -04:00
: sleep-time ( sorted-queue -- ms )
dup empty? [ drop 1000 ] [ peek first millis [-] ] if ;
2005-08-23 15:50:32 -04:00
2006-07-31 16:49:26 -04:00
: stop ( -- )
run-queue deque dup array?
[ first2 continue-with ] [ continue ] if ;
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 + [ 2array sleep-queue push stop ] callcc0 drop ;
2005-08-23 15:50:32 -04:00
: in-thread ( quot -- )
[
schedule-thread
2006-05-14 23:09:47 -04:00
V{ } set-catchstack
V{ } set-callstack
V{ } set-retainstack
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
2006-06-14 22:58:17 -04:00
: (idle-thread) ( fast? -- )
#! If fast, then we don't sleep, just select()
sleep-queue* dup sleep-time dup zero?
2006-06-15 01:21:16 -04:00
[ drop pop second schedule-thread drop ]
2006-06-14 22:58:17 -04:00
[ nip 0 ? io-multiplex ] if ;
: idle-thread ( -- )
#! This thread is always running.
#! If run queue is not empty, we don't sleep.
run-queue queue-empty? (idle-thread) yield idle-thread ;
2005-08-24 00:30:07 -04:00
: init-threads ( -- )
2006-06-14 22:58:17 -04:00
<queue> \ run-queue set-global
2006-07-17 15:08:38 -04:00
V{ } clone \ sleep-queue set-global
[ idle-thread ] in-thread ;