Change the sleep-queue to use a min-heap to get better performance

release
Doug Coleman 2007-10-31 16:00:59 -05:00
parent 7758070def
commit 7563e4b61e
1 changed files with 10 additions and 10 deletions

View File

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