diff --git a/library/io/windows/io-last.factor b/library/io/windows/io-last.factor deleted file mode 100644 index 9947d53bc0..0000000000 --- a/library/io/windows/io-last.factor +++ /dev/null @@ -1,20 +0,0 @@ -! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. - -IN: io -USING: compiler namespaces kernel win32-io-internals win32-stream win32-api - threads ; - -: ; -: ; -: make-win32-server ; - -IN: io-internals - -: io-multiplex ( ms -- ) - dup -1 = [ drop INFINITE ] when cancel-timedout wait-for-io - swap [ schedule-thread-with ] [ drop ] if* ; - -: init-io ( -- ) - win32-init-stdio - init-winsock ; - diff --git a/library/io/windows/io.factor b/library/io/windows/io.factor new file mode 100644 index 0000000000..6188fee500 --- /dev/null +++ b/library/io/windows/io.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. + +IN: io +USING: win32-api win32-io-internals win32-server win32-stream ; +USING: alien kernel io-internals namespaces threads ; + +: ( path -- stream ) ; +: ( path -- stream ) ; + +SYMBOL: serv +: accept ( server -- client ) + [ + duplex-stream-in + serv set + serv get update-timeout new-socket 64 + [ + 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 drop + swap dup add-completion + dupd swap buffer-free + ] with-scope ; + +: ( host port -- stream ) + client-sockaddr new-socket + [ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep + dup add-completion ; +: ( port -- stream ) make-win32-server ; + +IN: io-internals + +: io-multiplex ( ms -- ) + dup -1 = [ drop INFINITE ] when cancel-timedout wait-for-io + swap [ schedule-thread-with ] [ drop ] if* ; + +: init-io ( -- ) + win32-init-stdio + init-winsock ; + diff --git a/library/io/windows/load.factor b/library/io/windows/load.factor index b84ace5781..b71d8355f5 100644 --- a/library/io/windows/load.factor +++ b/library/io/windows/load.factor @@ -5,5 +5,5 @@ PROVIDE: library/io/windows { "io-internals.factor" "stream.factor" "server.factor" - "io-last.factor" + "io.factor" } ; diff --git a/library/io/windows/server.factor b/library/io/windows/server.factor index 0f14f168ec..1010e0a227 100644 --- a/library/io/windows/server.factor +++ b/library/io/windows/server.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. -IN: win32-stream +IN: win32-server USING: alien errors generic kernel kernel-internals math namespaces prettyprint sequences io strings threads win32-api - win32-io-internals io-internals ; + win32-io-internals io-internals win32-stream ; TUPLE: win32-client-stream host port ; @@ -68,26 +68,3 @@ M: win32-client-stream client-stream-port ( win32-client-stream -- port ) r> set-sockaddr-in-addr ] keep ; -IN: io - -SYMBOL: serv -: accept ( server -- client ) - [ - duplex-stream-in - serv set - serv get update-timeout new-socket 64 - [ - 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 drop - swap dup add-completion - dupd swap buffer-free - ] with-scope ; - -: ( host port -- stream ) - client-sockaddr new-socket - [ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep - dup add-completion ; - diff --git a/library/io/windows/stream.factor b/library/io/windows/stream.factor index fd77ffcfde..945f794d7f 100644 --- a/library/io/windows/stream.factor +++ b/library/io/windows/stream.factor @@ -64,8 +64,7 @@ TUPLE: win32-duplex-stream ; dup empty? [ 2drop >string-or-f nip ] [ - swapd over >r nappend r> - [ length - ] keep swap do-read-count + rot >r [ length - ] keep r> [ swap nappend ] keep swap do-read-count ] if ] if ; @@ -112,8 +111,7 @@ M: win32-stream-reader stream-read1 ( stream -- ch/f ) >r 1 r> consume-input >string-or-f first ; M: win32-stream-reader stream-read ( n stream -- str/f ) - >r [ ] keep r> -rot do-read-count ; - + swap >r win32-buffer-size r> do-read-count ; M: win32-stream-writer stream-close ( stream -- ) dup maybe-flush-output