From 73f4de490ab8914d8f465f0ce9b7371c7259b6be Mon Sep 17 00:00:00 2001 From: erg Date: Sat, 9 Sep 2006 21:04:46 +0000 Subject: [PATCH] major win32 io cleanup, removed callcc1 quotation building at runtime --- library/io/windows/io-internals.factor | 9 +- library/io/windows/io-last.factor | 6 +- library/io/windows/server.factor | 62 +++++------ library/io/windows/stream.factor | 137 ++++++++++++++----------- 4 files changed, 111 insertions(+), 103 deletions(-) diff --git a/library/io/windows/io-internals.factor b/library/io/windows/io-internals.factor index 0dbfe8056f..1b90e5965e 100644 --- a/library/io/windows/io-internals.factor +++ b/library/io/windows/io-internals.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2005 Mackenzie Straight. +! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. IN: win32-io-internals USING: alien arrays errors kernel kernel-internals math namespaces threads @@ -10,13 +10,13 @@ SYMBOL: io-queue TUPLE: io-queue free-list callbacks ; TUPLE: io-callback overlapped quotation stream ; -GENERIC: expire - : expected-error? ( -- bool ) [ ERROR_IO_PENDING ERROR_HANDLE_EOF ERROR_SUCCESS WAIT_TIMEOUT + 997 ] member? ; +USE: prettyprint : handle-io-error ( -- ) GetLastError expected-error? [ win32-throw-error ] unless ; @@ -86,6 +86,9 @@ C: io-callback ( -- callback ) overlapped-ext-user-data get-io-callback ] if ; +IN: win32-stream +DEFER: expire +IN: win32-io-internals : cancel-timedout ( -- ) io-queue get io-queue-callbacks [ io-callback-stream [ expire ] when* ] each ; diff --git a/library/io/windows/io-last.factor b/library/io/windows/io-last.factor index 06a3356287..58a190de9f 100644 --- a/library/io/windows/io-last.factor +++ b/library/io/windows/io-last.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2003, 2004 Mackenzie Straight. +! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. IN: io USING: compiler namespaces kernel win32-io-internals win32-stream win32-api @@ -6,12 +6,12 @@ USING: compiler namespaces kernel win32-io-internals win32-stream win32-api : ; : ; -: ; +: make-win32-server ; IN: io-internals : io-multiplex ( ms -- ) - #! FIXME: needs to work given a timeout + #! FIXME: needs to work given a timeout (???) dup -1 = [ drop INFINITE ] when cancel-timedout wait-for-io swap [ schedule-thread-with ] [ drop ] if* ; diff --git a/library/io/windows/server.factor b/library/io/windows/server.factor index 0f29b2d21c..318bcc41aa 100644 --- a/library/io/windows/server.factor +++ b/library/io/windows/server.factor @@ -5,14 +5,9 @@ USING: alien errors generic kernel kernel-internals math namespaces prettyprint sequences io strings threads win32-api win32-io-internals io-internals ; -TUPLE: win32-server this ; -TUPLE: win32-client-stream host port this ; -SYMBOL: socket -SYMBOL: stream -SYMBOL: timeout -SYMBOL: cutoff +TUPLE: win32-client-stream host port ; -: (handle-socket-error) +: (handle-socket-error) ( -- ) WSAGetLastError [ ERROR_IO_PENDING ERROR_SUCCESS ] member? [ WSAGetLastError error_message throw ] unless ; @@ -25,7 +20,6 @@ SYMBOL: cutoff : init-winsock ( -- ) HEX: 0202 WSAStartup handle-socket-error!=0/f ; - : new-socket ( -- socket ) AF_INET SOCK_STREAM 0 f f WSA_FLAG_OVERLAPPED WSASocket dup INVALID_SOCKET = [ (handle-socket-error) ] when ; @@ -39,7 +33,7 @@ SYMBOL: cutoff : bind-socket ( port socket -- ) swap setup-sockaddr "sockaddr-in" c-size wsa-bind handle-socket-error!=0/f ; -: listen-backlog 20 ; inline +: listen-backlog ( -- n ) 20 ; inline : listen-socket ( socket -- ) listen-backlog wsa-listen handle-socket-error!=0/f ; @@ -59,27 +53,14 @@ C: win32-client-stream ( buf stream -- stream ) [ set-win32-client-stream-host ] keep [ set-win32-client-stream-port ] keep ; -M: win32-client-stream client-stream-host win32-client-stream-host ; -M: win32-client-stream client-stream-port win32-client-stream-port ; +M: win32-client-stream client-stream-host ( win32-client-stream -- host ) + win32-client-stream-host ; +M: win32-client-stream client-stream-port ( win32-client-stream -- port ) + win32-client-stream-port ; -C: win32-server ( port -- server ) - swap [ - new-socket tuck bind-socket dup listen-socket - dup add-completion - socket set - dup stream set - ] make-hash over set-win32-server-this ; - -M: win32-server stream-close - win32-server-this [ socket get CloseHandle drop ] bind ; - -M: win32-server set-timeout - win32-server-this [ timeout set ] bind ; - -M: win32-server expire - win32-server-this [ - timeout get [ millis cutoff get > [ socket get CancelIo ] when ] when - ] bind ; +: make-win32-server ( port -- win32-stream ) + new-socket tuck bind-socket dup listen-socket dup add-completion + ; : client-sockaddr ( host port -- sockaddr ) setup-sockaddr [ @@ -87,22 +68,27 @@ M: win32-server expire r> set-sockaddr-in-addr ] keep ; -IN: io +IN: io + +USE: interpreter +SYMBOL: serv : accept ( server -- client ) - win32-server-this [ - update-timeout new-socket 64 + [ + duplex-stream-in + serv set + serv get update-timeout new-socket 64 [ - stream get alloc-io-callback init-overlapped - >r >r >r socket get r> r> + serv get alloc-io-callback f swap init-overlapped + >r >r >r serv get win32-stream-handle r> r> buffer-ptr 0 32 32 f r> AcceptEx handle-socket-error!=0/f stop - ] callcc1 pending-error drop - swap dup add-completion + ] callcc1 drop + swap dup add-completion dupd swap buffer-free - ] bind ; + ] with-scope ; : ( host port -- stream ) client-sockaddr new-socket [ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep - dup add-completion ; + dup add-completion ; diff --git a/library/io/windows/stream.factor b/library/io/windows/stream.factor index 6a1624050b..91301baa65 100644 --- a/library/io/windows/stream.factor +++ b/library/io/windows/stream.factor @@ -1,17 +1,19 @@ ! Copyright (C) 2004, 2006 Mackenzie Straight, Doug Coleman. IN: win32-stream -USING: alien generic hashtables io-internals kernel +USING: alien errors generic hashtables io-internals kernel kernel-internals math namespaces prettyprint sequences io strings threads win32-api win32-io-internals ; +USE: interpreter -TUPLE: win32-stream handle in-buffer out-buffer fileptr file-size timeout cutoff ; +TUPLE: win32-stream handle timeout cutoff fileptr file-size ; +TUPLE: win32-stream-reader in ; +TUPLE: win32-stream-writer out ; +TUPLE: win32-duplex-stream ; +SYMBOL: stream : win32-buffer-size 16384 ; inline -: pending-error ( len/status -- len/status ) - dup [ win32-throw-error ] unless ; - : init-overlapped ( fileptr overlapped -- overlapped ) 0 over set-overlapped-ext-internal 0 over set-overlapped-ext-internal-high @@ -36,28 +38,21 @@ TUPLE: win32-stream handle in-buffer out-buffer fileptr file-size timeout cutoff ! Read : fill-input ( stream -- ) dup update-timeout - dup unit [ - [ alloc-io-callback ] keep - win32-stream-fileptr swap init-overlapped >r - ] append - over win32-stream-handle unit append - over win32-stream-in-buffer unit append - [ - [ buffer@ ] keep - buffer-capacity - ] append - over win32-stream-file-size unit append - over win32-stream-fileptr [ - min ] curry - [ when* f r> ReadFile [ handle-io-error ] unless stop ] - curry append - callcc1 pending-error - [ over win32-stream-in-buffer n>buffer ] keep + over alloc-io-callback + over win32-stream-fileptr swap init-overlapped >r + dup win32-stream-handle + over win32-stream-reader-in + [ buffer@ ] keep buffer-capacity + >r pick r> swap dup win32-stream-file-size + [ swap win32-stream-fileptr - min ] when* + f r> ReadFile zero? [ handle-io-error ] when stop + ] callcc1 [ over win32-stream-reader-in n>buffer ] keep swap update-file-pointer ; : consume-input ( count stream -- str ) - dup win32-stream-in-buffer buffer-length zero? [ dup fill-input ] when - win32-stream-in-buffer + dup win32-stream-reader-in buffer-length zero? [ dup fill-input ] when + win32-stream-reader-in [ buffer-size min ] keep [ buffer-first-n ] 2keep buffer-consume ; @@ -79,34 +74,29 @@ TUPLE: win32-stream handle in-buffer out-buffer fileptr file-size timeout cutoff ! Write : flush-output ( stream -- ) dup update-timeout - dup unit [ - [ alloc-io-callback ] keep - win32-stream-fileptr swap init-overlapped >r - ] append - over win32-stream-handle unit append - over win32-stream-out-buffer unit append - [ + over alloc-io-callback + over win32-stream-fileptr swap init-overlapped >r + dup win32-stream-handle + over win32-stream-writer-out [ buffer@ ] keep buffer-length - f r> WriteFile [ handle-io-error ] unless stop - ] append - callcc1 pending-error - dup pick update-file-pointer - over win32-stream-out-buffer [ buffer-consume ] keep + f r> WriteFile zero? [ handle-io-error ] when stop + ] callcc1 [ over update-file-pointer ] keep + over win32-stream-writer-out [ buffer-consume ] keep buffer-length 0 > [ flush-output ] [ drop ] if ; : maybe-flush-output ( stream -- ) - dup win32-stream-out-buffer buffer-length 0 > [ flush-output ] [ drop ] if ; + dup win32-stream-writer-out buffer-length 0 > [ flush-output ] [ drop ] if ; G: do-write 1 standard-combination ; M: integer do-write ( integer stream -- ) - dup win32-stream-out-buffer buffer-capacity zero? + dup win32-stream-writer-out buffer-capacity zero? [ dup flush-output ] when - >r ch>string r> win32-stream-out-buffer >buffer ; + >r ch>string r> win32-stream-writer-out >buffer ; M: string do-write ( string stream -- ) - over length over win32-stream-out-buffer 2dup buffer-capacity <= [ - 2drop win32-stream-out-buffer >buffer + over length over win32-stream-writer-out 2dup buffer-capacity <= [ + 2drop win32-stream-writer-out >buffer ] [ 2dup buffer-size > [ extend-buffer @@ -115,24 +105,30 @@ M: string do-write ( string stream -- ) ] if do-write ] if ; -M: win32-stream stream-close ( stream -- ) - dup maybe-flush-output - dup win32-stream-handle CloseHandle 0 = [ win32-throw-error ] when - dup win32-stream-in-buffer buffer-free - win32-stream-out-buffer buffer-free ; -M: win32-stream stream-read1 ( stream -- ch/f ) +M: win32-stream-reader stream-close ( stream -- ) + dup win32-stream-reader-in buffer-free + win32-stream-handle CloseHandle 0 = [ win32-throw-error ] when ; + +M: win32-stream-reader stream-read1 ( stream -- ch/f ) >r 1 r> consume-input >string-or-f first ; -M: win32-stream stream-read ( n stream -- str/f ) + +M: win32-stream-reader stream-read ( n stream -- str/f ) >r [ ] keep r> -rot do-read-count ; -M: win32-stream stream-flush ( stream -- ) maybe-flush-output ; -M: win32-stream stream-write1 ( ch stream -- ) >r >fixnum r> do-write ; -M: win32-stream stream-write ( str stream -- ) do-write ; + +M: win32-stream-writer stream-close ( stream -- ) + dup maybe-flush-output + dup win32-stream-writer-out buffer-free + win32-stream-handle CloseHandle 0 = [ win32-throw-error ] when ; + +M: win32-stream-writer stream-flush ( stream -- ) maybe-flush-output ; +M: win32-stream-writer stream-write1 ( ch stream -- ) >r >fixnum r> do-write ; +M: win32-stream-writer stream-write ( str stream -- ) do-write ; M: win32-stream set-timeout ( n stream -- ) set-win32-stream-timeout ; -M: win32-stream expire ( stream -- ) +: expire ( stream -- ) dup win32-stream-timeout millis pick win32-stream-cutoff > and [ win32-stream-handle CancelIo [ win32-throw-error ] unless ] [ @@ -141,17 +137,40 @@ M: win32-stream expire ( stream -- ) C: win32-stream ( handle -- stream ) [ set-win32-stream-handle ] keep - win32-buffer-size swap [ set-win32-stream-in-buffer ] keep - win32-buffer-size swap [ set-win32-stream-out-buffer ] keep - 0 swap [ set-win32-stream-fileptr ] keep - dup win32-stream-handle f GetFileSize dup -1 = [ drop f ] when - swap [ set-win32-stream-file-size ] keep f swap [ set-win32-stream-timeout ] keep - 0 swap [ set-win32-stream-cutoff ] keep ; + 0 swap [ set-win32-stream-cutoff ] keep + dup win32-stream-handle f GetFileSize dup -1 = [ drop f ] when + over set-win32-stream-file-size + 0 swap [ set-win32-stream-fileptr ] keep ; + +C: win32-stream-reader ( stream -- stream ) + [ set-delegate ] keep + win32-buffer-size swap [ set-win32-stream-reader-in ] keep ; + +C: win32-stream-writer ( stream -- stream ) + [ set-delegate ] keep + win32-buffer-size swap [ set-win32-stream-writer-out ] keep ; + +: make-win32-file-reader ( stream -- stream ) + ; : ( path -- stream ) - t f win32-open-file ; + t f win32-open-file make-win32-file-reader ; + +: make-win32-file-writer ( stream -- stream ) + ; : ( path -- stream ) - f t win32-open-file ; + f t win32-open-file make-win32-file-writer ; + +C: win32-duplex-stream ( stream -- stream ) + >r [ make-win32-file-reader ] keep make-win32-file-writer r> + [ set-delegate ] keep ; + +M: win32-duplex-stream stream-close ( stream -- ) + dup duplex-stream-out maybe-flush-output + dup duplex-stream-out win32-stream-writer-out buffer-free + dup duplex-stream-in win32-stream-reader-in buffer-free + duplex-stream-in + win32-stream-handle CloseHandle drop ; ! 0 = [ win32-throw-error ] when ;