Change the sleep-queue to use a min-heap to get better performance
parent
7758070def
commit
7563e4b61e
|
@ -2,7 +2,7 @@
|
||||||
! Copyright (C) 2005 Mackenzie Straight.
|
! Copyright (C) 2005 Mackenzie Straight.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: threads
|
IN: threads
|
||||||
USING: arrays init hashtables io.backend kernel kernel.private
|
USING: arrays init hashtables heaps io.backend kernel kernel.private
|
||||||
math namespaces queues sequences vectors io system sorting
|
math namespaces queues sequences vectors io system sorting
|
||||||
continuations debugger ;
|
continuations debugger ;
|
||||||
|
|
||||||
|
@ -10,21 +10,22 @@ continuations debugger ;
|
||||||
|
|
||||||
SYMBOL: sleep-queue
|
SYMBOL: sleep-queue
|
||||||
|
|
||||||
|
TUPLE: sleeping ms continuation ;
|
||||||
|
|
||||||
|
M: sleeping <=> ( obj1 obj2 -- n )
|
||||||
|
[ sleeping-ms ] 2apply - ;
|
||||||
|
|
||||||
: sleep-time ( -- ms )
|
: sleep-time ( -- ms )
|
||||||
sleep-queue get-global
|
sleep-queue get-global
|
||||||
dup empty? [ drop 1000 ] [ first first millis [-] ] if ;
|
dup heap-empty? [ drop 1000 ] [ peek-heap sleeping-ms millis [-] ] if ;
|
||||||
|
|
||||||
: run-queue ( -- queue ) \ run-queue get-global ;
|
: run-queue ( -- queue ) \ run-queue get-global ;
|
||||||
|
|
||||||
: schedule-sleep ( ms continuation -- )
|
: schedule-sleep ( ms continuation -- )
|
||||||
2array global [
|
sleeping construct-boa sleep-queue get-global push-heap ;
|
||||||
sleep-queue [ swap add sort-keys ] change
|
|
||||||
] bind ;
|
|
||||||
|
|
||||||
: wake-up ( -- continuation )
|
: wake-up ( -- continuation )
|
||||||
global [
|
sleep-queue get-global pop-heap sleeping-continuation ;
|
||||||
sleep-queue [ unclip second swap ] change
|
|
||||||
] bind ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -67,9 +68,8 @@ PRIVATE>
|
||||||
|
|
||||||
: init-threads ( -- )
|
: init-threads ( -- )
|
||||||
<queue> \ run-queue set-global
|
<queue> \ run-queue set-global
|
||||||
f sleep-queue set-global
|
<min-heap> sleep-queue set-global
|
||||||
[ idle-thread ] in-thread ;
|
[ idle-thread ] in-thread ;
|
||||||
|
|
||||||
[ init-threads ] "threads" add-init-hook
|
[ init-threads ] "threads" add-init-hook
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
Loading…
Reference in New Issue