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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/io/launcher/launcher.factor
View File

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

2
extra/io/nonblocking/nonblocking.factor
View File

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

18
extra/io/timeouts/timeouts.factor
View File

@ -8,21 +8,21 @@ TUPLE: lapse entry timeout cutoff ;
: <lapse> f 0 0 \ lapse construct-boa ; : <lapse> f 0 0 \ lapse construct-boa ;
GENERIC: lapse ( obj -- lapse ) GENERIC: get-lapse ( obj -- lapse )
GENERIC: set-timeout ( ms obj -- ) 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 M: duplex-stream set-timeout
2dup 2dup
duplex-stream-in set-timeout duplex-stream-in set-timeout
duplex-stream-out set-timeout ; duplex-stream-out set-timeout ;
: timeout ( obj -- ms ) lapse lapse-timeout ; : timeout ( obj -- ms ) get-lapse lapse-timeout ;
: entry ( obj -- dlist-node ) lapse lapse-entry ; : entry ( obj -- dlist-node ) get-lapse lapse-entry ;
: set-entry ( dlist-node -- obj ) lapse set-lapse-entry ; : set-entry ( obj dlist-node -- ) get-lapse set-lapse-entry ;
: cutoff ( obj -- ms ) lapse lapse-cutoff ; : cutoff ( obj -- ms ) get-lapse lapse-cutoff ;
: set-cutoff ( ms obj -- ) lapse set-lapse-cutoff ; : set-cutoff ( ms obj -- ) get-lapse set-lapse-cutoff ;
SYMBOL: timeout-queue SYMBOL: timeout-queue
@ -62,6 +62,6 @@ M: object timed-out drop ;
over begin-timeout keep unqueue-timeout ; inline over begin-timeout keep unqueue-timeout ; inline
: expiry-thread ( -- ) : 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