From 92ebcc36199eba0f51fe08445110a72d7812b5fe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 31 Jan 2008 12:27:37 -0600 Subject: [PATCH] New timeout implementation --- extra/io/nonblocking/nonblocking.factor | 11 +++++++--- extra/io/unix/backend/backend.factor | 14 +++++++----- extra/io/unix/sockets/sockets.factor | 9 ++++---- extra/io/windows/ce/sockets/sockets.factor | 25 +++++++++++----------- extra/io/windows/nt/files/files.factor | 11 +++------- extra/io/windows/nt/monitor/monitor.factor | 7 ++++-- extra/io/windows/nt/sockets/sockets.factor | 19 ++++++++-------- 7 files changed, 53 insertions(+), 43 deletions(-) diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index ca50d7063a..3588ea5d14 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -77,7 +77,7 @@ M: object expire-port drop ; [ pop-back expire-port expire-timeouts ] [ drop ] if ] if ; -: touch-port ( port -- ) +: begin-timeout ( port -- ) dup port-timeout dup zero? [ 2drop ] [ @@ -85,8 +85,13 @@ M: object expire-port drop ; dup unqueue-timeout queue-timeout ] if ; -M: port set-timeout - [ set-port-timeout ] keep touch-port ; +: end-timeout ( port -- ) + unqueue-timeout ; + +: with-port-timeout ( port quot -- ) + over begin-timeout keep end-timeout ; inline + +M: port set-timeout set-port-timeout ; GENERIC: (wait-to-read) ( port -- ) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 6da26b5b67..141b115ebe 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -57,7 +57,11 @@ GENERIC: wait-for-events ( ms mx -- ) M: mx register-io-task ( task mx -- ) 2dup check-io-task fd/container set-at ; -: add-io-task ( task -- ) mx get-global register-io-task ; +: add-io-task ( task -- ) + mx get-global register-io-task stop ; + +: with-port-continuation ( port quot -- port ) + [ callcc0 ] curry with-port-timeout ; inline M: mx unregister-io-task ( task mx -- ) fd/container delete-at drop ; @@ -98,7 +102,6 @@ M: integer close-handle ( fd -- ) io-task-callbacks [ schedule-thread ] each ; : handle-io-task ( mx task -- ) - dup io-task-port touch-port dup do-io-task [ pop-callbacks ] [ 2drop ] if ; : handle-timeout ( mx task -- ) @@ -133,7 +136,8 @@ M: read-task do-io-task [ [ reader-eof ] [ drop ] if ] keep ; M: input-port (wait-to-read) - [ add-io-task stop ] callcc0 pending-error ; + [ add-io-task ] with-port-continuation + pending-error ; ! Writers : write-step ( port -- ? ) @@ -151,11 +155,11 @@ M: write-task do-io-task : add-write-io-task ( port continuation -- ) over port-handle mx get-global mx-writes at* - [ io-task-callbacks push drop ] + [ io-task-callbacks push stop ] [ drop add-io-task ] if ; : (wait-to-write) ( port -- ) - [ add-write-io-task stop ] callcc0 drop ; + [ add-write-io-task ] with-port-continuation drop ; M: port port-flush ( port -- ) dup buffer-empty? [ drop ] [ (wait-to-write) ] if ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 748dbc40a7..59a9a8ac2e 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -40,7 +40,7 @@ M: connect-task do-io-task 0 < [ defer-error ] [ drop t ] if ; : wait-to-connect ( port -- ) - [ add-io-task stop ] callcc0 drop ; + [ add-io-task ] with-port-continuation drop ; M: unix-io (client) ( addrspec -- stream ) dup make-sockaddr/size >r >r @@ -82,7 +82,7 @@ M: accept-task do-io-task over 0 >= [ do-accept t ] [ 2drop defer-error ] if ; : wait-to-accept ( server -- ) - [ add-io-task stop ] callcc0 drop ; + [ add-io-task ] with-port-continuation drop ; USE: io.sockets @@ -147,7 +147,7 @@ M: receive-task do-io-task ] if ; : wait-receive ( stream -- ) - [ add-io-task stop ] callcc0 drop ; + [ add-io-task ] with-port-continuation drop ; M: unix-io receive ( datagram -- packet addrspec ) dup check-datagram-port @@ -178,7 +178,8 @@ M: send-task do-io-task swap 0 < [ io-task-port defer-error ] [ drop t ] if ; : wait-send ( packet sockaddr len stream -- ) - [ add-io-task stop ] callcc0 2drop 2drop ; + [ add-io-task ] with-port-continuation + 2drop 2drop ; M: unix-io send ( packet addrspec datagram -- ) 3dup check-datagram-send diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index 5f87088804..9114dceb75 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -42,19 +42,20 @@ M: windows-ce-io ( addrspec -- duplex-stream ) ] keep ; M: windows-ce-io accept ( server -- client ) - dup check-server-port [ - dup touch-port - dup port-handle win32-file-handle - swap server-port-addr sockaddr-type heap-size - dup [ - swap f 0 - windows.winsock:WSAAccept - dup windows.winsock:INVALID_SOCKET = - [ windows.winsock:winsock-error ] when - ] keep - ] keep server-port-addr parse-sockaddr swap - dup handle>duplex-stream ; + dup check-server-port + [ + dup port-handle win32-file-handle + swap server-port-addr sockaddr-type heap-size + dup [ + swap f 0 + windows.winsock:WSAAccept + dup windows.winsock:INVALID_SOCKET = + [ windows.winsock:winsock-error ] when + ] keep + ] keep server-port-addr parse-sockaddr swap + dup handle>duplex-stream + ] with-port-timeout ; M: windows-ce-io ( addrspec -- datagram ) [ diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 06edd8b3ee..4a304e5ac9 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -24,7 +24,6 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) swap buffer-consume ; : (flush-output) ( port -- ) - dup touch-port dup make-FileArgs tuck setup-write WriteFile dupd overlapped-error? [ @@ -37,7 +36,7 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) ] if ; : flush-output ( port -- ) - [ (flush-output) ] with-destructors ; + [ [ (flush-output) ] with-port-timeout ] with-destructors ; M: port port-flush dup buffer-empty? [ dup flush-output ] unless drop ; @@ -52,17 +51,13 @@ M: port port-flush ] if ; : ((wait-to-read)) ( port -- ) - dup touch-port dup make-FileArgs tuck setup-read ReadFile dupd overlapped-error? [ >r FileArgs-lpOverlapped r> [ save-callback ] 2keep finish-read - ] [ - 2drop - ] if ; + ] [ 2drop ] if ; M: input-port (wait-to-read) ( port -- ) - [ ((wait-to-read)) ] with-destructors ; - + [ [ ((wait-to-read)) ] with-port-timeout ] with-destructors ; diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor index f296e859f0..a7c065b878 100755 --- a/extra/io/windows/nt/monitor/monitor.factor +++ b/extra/io/windows/nt/monitor/monitor.factor @@ -46,8 +46,11 @@ M: windows-nt-io ( path recursive? -- monitor ) : read-changes ( monitor -- bytes ) [ - dup begin-reading-changes swap [ save-callback ] 2keep - get-overlapped-result + [ + dup begin-reading-changes + swap [ save-callback ] 2keep + get-overlapped-result + ] with-port-timeout ] with-destructors ; : parse-action-flag ( action mask symbol -- action ) diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 6c7db33ee3..b9ce5aad4c 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -129,15 +129,16 @@ TUPLE: AcceptEx-args port M: windows-nt-io accept ( server -- client ) [ - dup check-server-port - dup touch-port - \ AcceptEx-args construct-empty - [ init-accept ] keep - [ (accept) ] keep - [ accept-continuation ] keep - AcceptEx-args-port pending-error - dup duplex-stream-in pending-error - dup duplex-stream-out pending-error + [ + dup check-server-port + \ AcceptEx-args construct-empty + [ init-accept ] keep + [ (accept) ] keep + [ accept-continuation ] keep + AcceptEx-args-port pending-error + dup duplex-stream-in pending-error + dup duplex-stream-out pending-error + ] with-port-timeout ] with-destructors ; M: windows-nt-io ( addrspec -- server )