Fixing some issues

db4
Slava Pestov 2008-02-09 21:56:50 -06:00
parent c8f042aef4
commit dd8e38a7f0
3 changed files with 12 additions and 10 deletions

View File

@ -106,6 +106,8 @@ HOOK: kill-process* io-backend ( handle -- )
t over set-process-killed?
process-handle [ kill-process* ] when* ;
M: process get-lapse process-lapse ;
M: process timed-out kill-process ;
HOOK: process-stream* io-backend ( desc -- stream process )

View File

@ -17,7 +17,7 @@ lapse
type eof? ;
! Ports support the lapse protocol
M: port lapse port-lapse ;
M: port get-lapse port-lapse ;
SYMBOL: closed

View File

@ -8,21 +8,21 @@ TUPLE: lapse entry timeout cutoff ;
: <lapse> f 0 0 \ lapse construct-boa ;
GENERIC: lapse ( obj -- lapse )
GENERIC: get-lapse ( obj -- lapse )
GENERIC: set-timeout ( ms obj -- )
M: object set-timeout lapse set-lapse-timeout ;
M: object set-timeout get-lapse set-lapse-timeout ;
M: duplex-stream set-timeout
2dup
duplex-stream-in set-timeout
duplex-stream-out set-timeout ;
: timeout ( obj -- ms ) lapse lapse-timeout ;
: entry ( obj -- dlist-node ) lapse lapse-entry ;
: set-entry ( dlist-node -- obj ) lapse set-lapse-entry ;
: cutoff ( obj -- ms ) lapse lapse-cutoff ;
: set-cutoff ( ms obj -- ) lapse set-lapse-cutoff ;
: timeout ( obj -- ms ) get-lapse lapse-timeout ;
: entry ( obj -- dlist-node ) get-lapse lapse-entry ;
: set-entry ( obj dlist-node -- ) get-lapse set-lapse-entry ;
: cutoff ( obj -- ms ) get-lapse lapse-cutoff ;
: set-cutoff ( ms obj -- ) get-lapse set-lapse-cutoff ;
SYMBOL: timeout-queue
@ -62,6 +62,6 @@ M: object timed-out drop ;
over begin-timeout keep unqueue-timeout ; inline
: expiry-thread ( -- )
expire-timeouts 5000 sleep expire-timeouts ;
expire-timeouts 5000 sleep expiry-thread ;
[ expiry-thread ] "io.timeouts" add-init-hook
[ [ expiry-thread ] in-thread ] "io.timeouts" add-init-hook