fix stack effects for nanosseconds, update io backends for nanos

db4
Doug Coleman 2009-11-19 04:51:47 -06:00
parent 987602235e
commit adcb0df0c4
8 changed files with 14 additions and 15 deletions

View File

@ -51,8 +51,8 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
[ EPOLLOUT do-epoll-del ] [ call-next-method ] 2bi
] [ 2drop f ] if ;
: wait-event ( mx us -- n )
[ [ fd>> ] [ events>> ] bi dup length ] [ 1000 /i ] bi*
: wait-event ( mx nanos -- n )
[ [ fd>> ] [ events>> ] bi dup length ] [ 1000000 /i ] bi*
epoll_wait multiplexer-error ;
: handle-event ( event mx -- )
@ -63,5 +63,5 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
: handle-events ( mx n -- )
[ dup events>> ] dip head-slice swap '[ _ handle-event ] each ;
M: epoll-mx wait-for-events ( us mx -- )
M: epoll-mx wait-for-events ( nanos mx -- )
swap 60000000 or dupd wait-event handle-events ;

View File

@ -73,6 +73,6 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
[ dup events>> ] dip head-slice
[ handle-kevent ] with each ;
M: kqueue-mx wait-for-events ( us mx -- )
M: kqueue-mx wait-for-events ( nanos mx -- )
swap dup [ make-timespec ] when
dupd wait-kevent handle-kevents ;

View File

@ -26,7 +26,7 @@ GENERIC: remove-output-callbacks ( fd mx -- callbacks )
M: mx remove-output-callbacks writes>> delete-at* drop ;
GENERIC: wait-for-events ( ms mx -- )
GENERIC: wait-for-events ( nanos mx -- )
: input-available ( fd mx -- )
reads>> delete-at* drop [ resume ] each ;

View File

@ -48,9 +48,9 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
[ write-fdset/tasks [ init-fdset ] keep ] tri
f ;
M:: select-mx wait-for-events ( us mx -- )
M:: select-mx wait-for-events ( nanos mx -- )
mx
[ init-fdsets us dup [ make-timeval ] when select multiplexer-error drop ]
[ init-fdsets nanos 1000 /i dup [ make-timeval ] when select multiplexer-error drop ]
[ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
[ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
tri ;

View File

@ -113,8 +113,8 @@ HELP: sleep-queue
{ $var-description "A " { $link min-heap } " storing the queue of sleeping threads." } ;
HELP: sleep-time
{ $values { "us/f" "a non-negative integer or " { $link f } } }
{ $description "Outputs the time until the next sleeping thread is scheduled to wake up, which could be zero if there are threads in the run queue, or threads which need to wake up right now. If there are no runnable or sleeping threads, outputs " { $link f } "." } ;
{ $values { "nanos/f" "a non-negative integer or " { $link f } } }
{ $description "Returns the time until the next sleeping thread is scheduled to wake up, which could be zero if there are threads in the run queue, or threads which need to wake up right now. If there are no runnable or sleeping threads, returns " { $link f } "." } ;
HELP: stop
{ $description "Stops the current thread. The thread may be started again from another thread using " { $link (spawn) } "." } ;

View File

@ -91,7 +91,7 @@ PRIVATE>
f >>state
check-registered 2array run-queue push-front ;
: sleep-time ( -- us/f )
: sleep-time ( -- nanos/f )
{
{ [ run-queue deque-empty? not ] [ 0 ] }
{ [ sleep-queue heap-empty? ] [ f ] }
@ -184,8 +184,7 @@ M: f sleep-until
GENERIC: sleep ( dt -- )
M: real sleep
>integer 1000 *
nano-count + sleep-until ;
>integer nano-count + sleep-until ;
: interrupt ( thread -- )
dup state>> [

View File

@ -18,8 +18,8 @@ STRUCT: timespec
swap >>usec
swap >>sec ;
: make-timespec ( us -- timespec )
1000000 /mod 1000 *
: make-timespec ( nanos -- timespec )
1000000000 /mod
timespec <struct>
swap >>nsec
swap >>sec ;

View File

@ -495,7 +495,7 @@ tuple
{ "<tuple>" "classes.tuple.private" (( layout -- tuple )) }
{ "profiling" "tools.profiler.private" (( ? -- )) }
{ "become" "kernel.private" (( old new -- )) }
{ "(sleep)" "threads.private" (( us -- )) }
{ "(sleep)" "threads.private" (( nanos -- )) }
{ "<tuple-boa>" "classes.tuple.private" (( ... layout -- tuple )) }
{ "callstack>array" "kernel" (( callstack -- array )) }
{ "innermost-frame-executing" "kernel.private" (( callstack -- obj )) }