Merge branch 'master' of git://factorcode.org/git/factor
commit
e8c5187088
|
@ -17,14 +17,18 @@ TUPLE: select-mx read-fdset write-fdset ;
|
||||||
FD_SETSIZE 8 * <bit-array> over set-select-mx-read-fdset
|
FD_SETSIZE 8 * <bit-array> over set-select-mx-read-fdset
|
||||||
FD_SETSIZE 8 * <bit-array> over set-select-mx-write-fdset ;
|
FD_SETSIZE 8 * <bit-array> over set-select-mx-write-fdset ;
|
||||||
|
|
||||||
|
: clear-nth ( n seq -- ? )
|
||||||
|
[ nth ] 2keep f -rot set-nth ;
|
||||||
|
|
||||||
: handle-fd ( fd task fdset mx -- )
|
: handle-fd ( fd task fdset mx -- )
|
||||||
roll munge rot nth [ swap handle-io-task ] [ 2drop ] if ;
|
roll munge rot clear-nth
|
||||||
|
[ swap handle-io-task ] [ 2drop ] if ;
|
||||||
|
|
||||||
: handle-fdset ( tasks fdset mx -- )
|
: handle-fdset ( tasks fdset mx -- )
|
||||||
[ handle-fd ] 2curry assoc-each ;
|
[ handle-fd ] 2curry assoc-each ;
|
||||||
|
|
||||||
: init-fdset ( tasks fdset -- )
|
: init-fdset ( tasks fdset -- )
|
||||||
dup clear-bits
|
! dup clear-bits
|
||||||
[ >r drop t swap munge r> set-nth ] curry assoc-each ;
|
[ >r drop t swap munge r> set-nth ] curry assoc-each ;
|
||||||
|
|
||||||
: read-fdset/tasks
|
: read-fdset/tasks
|
||||||
|
@ -33,13 +37,19 @@ TUPLE: select-mx read-fdset write-fdset ;
|
||||||
: write-fdset/tasks
|
: write-fdset/tasks
|
||||||
{ mx-writes select-mx-write-fdset } get-slots ;
|
{ mx-writes select-mx-write-fdset } get-slots ;
|
||||||
|
|
||||||
: init-fdsets ( mx -- read write except )
|
: max-fd dup assoc-empty? [ drop 0 ] [ keys supremum ] if ;
|
||||||
|
|
||||||
|
: num-fds ( mx -- n )
|
||||||
|
dup mx-reads max-fd swap mx-writes max-fd max 1+ ;
|
||||||
|
|
||||||
|
: init-fdsets ( mx -- nfds read write except )
|
||||||
|
[ num-fds ] keep
|
||||||
[ read-fdset/tasks tuck init-fdset ] keep
|
[ read-fdset/tasks tuck init-fdset ] keep
|
||||||
write-fdset/tasks tuck init-fdset
|
write-fdset/tasks tuck init-fdset
|
||||||
f ;
|
f ;
|
||||||
|
|
||||||
M: select-mx wait-for-events ( ms mx -- )
|
M: select-mx wait-for-events ( ms mx -- )
|
||||||
swap >r FD_SETSIZE over init-fdsets r> make-timeval
|
swap >r dup init-fdsets r> make-timeval
|
||||||
select multiplexer-error
|
select multiplexer-error
|
||||||
dup read-fdset/tasks pick handle-fdset
|
dup read-fdset/tasks pick handle-fdset
|
||||||
dup write-fdset/tasks rot handle-fdset ;
|
dup write-fdset/tasks rot handle-fdset ;
|
||||||
|
|
|
@ -59,5 +59,7 @@ M: string (profile.)
|
||||||
: vocabs-profile. ( -- )
|
: vocabs-profile. ( -- )
|
||||||
"Call counts for all vocabularies:" print
|
"Call counts for all vocabularies:" print
|
||||||
vocabs [
|
vocabs [
|
||||||
dup words [ profile-counter ] map sum
|
dup words
|
||||||
|
[ "predicating" word-prop not ] subset
|
||||||
|
[ profile-counter ] map sum
|
||||||
] { } map>assoc counters. ;
|
] { } map>assoc counters. ;
|
||||||
|
|
Loading…
Reference in New Issue