steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Ring benchmark optimization

db4
Slava Pestov 2008-02-21 01:25:08 -06:00
parent 2342169d87
commit 6e4ba7af14
3 changed files with 9 additions and 3 deletions
core/threads
extra
benchmark/ring
concurrency/conditions

3
core/threads/threads.factor
View File

@ -77,6 +77,9 @@ PRIVATE>
: resume ( thread -- ) : resume ( thread -- )
check-registered run-queue push-front ; check-registered run-queue push-front ;
: resume-now ( thread -- )
check-registered run-queue push-back ;
: resume-with ( obj thread -- ) : resume-with ( obj thread -- )
check-registered 2array run-queue push-front ; check-registered 2array run-queue push-front ;

4
extra/benchmark/ring/ring.factor
View File

@ -8,7 +8,9 @@ SYMBOL: done
receive 2dup swap send done eq? [ tunnel ] unless ; receive 2dup swap send done eq? [ tunnel ] unless ;
: create-ring ( processes -- target ) : create-ring ( processes -- target )
self swap [ [ tunnel ] "Tunnel" spawn nip ] times ; self swap [
dup [ tunnel ] curry "Tunnel" spawn nip
] times ;
: send-messages ( messages target -- ) : send-messages ( messages target -- )
dupd [ send ] curry each [ receive drop ] times ; dupd [ send ] curry each [ receive drop ] times ;

5
extra/concurrency/conditions/conditions.factor
View File

@ -4,10 +4,11 @@ USING: dlists threads kernel arrays sequences ;
IN: concurrency.conditions IN: concurrency.conditions
: notify-1 ( dlist -- ) : notify-1 ( dlist -- )
dup dlist-empty? [ drop ] [ pop-back second resume ] if ; dup dlist-empty?
[ drop ] [ pop-back second resume-now ] if ;
: notify-all ( dlist -- ) : notify-all ( dlist -- )
[ second resume ] dlist-slurp yield ; [ second resume-now ] dlist-slurp yield ;
: wait ( queue timeout status -- ) : wait ( queue timeout status -- )
>r [ 2array swap push-front ] r> suspend 3drop ; inline >r [ 2array swap push-front ] r> suspend 3drop ; inline