From 8bf37558d42a1573650b4fa24c5c72b60675f760 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 1 Sep 2008 04:32:16 -0500 Subject: [PATCH] Clean up Windows I/O a bit, remove classes.tuple.lib --- basis/io/windows/launcher/launcher.factor | 16 ++- basis/io/windows/nt/backend/backend.factor | 5 +- basis/io/windows/nt/sockets/sockets.factor | 155 +++++++++++++-------- extra/classes/tuple/lib/authors.txt | 1 - extra/classes/tuple/lib/lib-docs.factor | 29 ---- extra/classes/tuple/lib/lib-tests.factor | 8 -- extra/classes/tuple/lib/lib.factor | 18 --- 7 files changed, 112 insertions(+), 120 deletions(-) delete mode 100644 extra/classes/tuple/lib/authors.txt delete mode 100644 extra/classes/tuple/lib/lib-docs.factor delete mode 100644 extra/classes/tuple/lib/lib-tests.factor delete mode 100755 extra/classes/tuple/lib/lib.factor diff --git a/basis/io/windows/launcher/launcher.factor b/basis/io/windows/launcher/launcher.factor index 9442fa9a72..ed9b53675b 100755 --- a/basis/io/windows/launcher/launcher.factor +++ b/basis/io/windows/launcher/launcher.factor @@ -6,7 +6,7 @@ windows.types math windows.kernel32 namespaces io.launcher kernel sequences windows.errors splitting system threads init strings combinators io.backend accessors concurrency.flags io.files assocs -io.files.private windows destructors classes.tuple.lib ; +io.files.private windows destructors ; IN: io.windows.launcher TUPLE: CreateProcess-args @@ -30,7 +30,19 @@ TUPLE: CreateProcess-args 0 >>dwCreateFlags ; : call-CreateProcess ( CreateProcess-args -- ) - CreateProcess-args >tuple< CreateProcess win32-error=0/f ; + { + [ lpApplicationName>> ] + [ lpCommandLine>> ] + [ lpProcessAttributes>> ] + [ lpThreadAttributes>> ] + [ bInheritHandles>> ] + [ dwCreateFlags>> ] + [ lpEnvironment>> ] + [ lpCurrentDirectory>> ] + [ lpStartupInfo>> ] + [ lpProcessInformation>> ] + } cleave + CreateProcess win32-error=0/f ; : count-trailing-backslashes ( str n -- str n ) >r "\\" ?tail r> swap [ diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor index e9df2ddab9..7fbc1dbcf9 100755 --- a/basis/io/windows/nt/backend/backend.factor +++ b/basis/io/windows/nt/backend/backend.factor @@ -1,9 +1,8 @@ USING: alien alien.c-types arrays assocs combinators continuations destructors io io.backend io.ports io.timeouts io.windows io.windows.files libc kernel math namespaces -sequences threads classes.tuple.lib windows windows.errors -windows.kernel32 strings splitting io.files -io.buffers qualified ascii system +sequences threads windows windows.errors windows.kernel32 +strings splitting io.files io.buffers qualified ascii system accessors locals ; QUALIFIED: windows.winsock IN: io.windows.nt.backend diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor index a31c41942f..41c5e88f5f 100755 --- a/basis/io/windows/nt/sockets/sockets.factor +++ b/basis/io/windows/nt/sockets/sockets.factor @@ -1,9 +1,8 @@ USING: alien alien.accessors alien.c-types byte-arrays continuations destructors io.ports io.timeouts io.sockets io.sockets io namespaces io.streams.duplex io.windows -io.windows.sockets -io.windows.nt.backend windows.winsock kernel libc math sequences -threads classes.tuple.lib system combinators accessors ; +io.windows.sockets io.windows.nt.backend windows.winsock kernel +libc math sequences threads system combinators accessors ; IN: io.windows.nt.sockets : malloc-int ( object -- object ) @@ -28,71 +27,89 @@ M: winnt WSASocket-flags ( -- DWORD ) ] keep *void* ; TUPLE: ConnectEx-args port - s* name* namelen* lpSendBuffer* dwSendDataLength* - lpdwBytesSent* lpOverlapped* ptr* ; + s name namelen lpSendBuffer dwSendDataLength + lpdwBytesSent lpOverlapped ptr ; : wait-for-socket ( args -- n ) - [ lpOverlapped*>> ] [ port>> ] bi twiddle-thumbs ; + [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline : ( sockaddr size -- ConnectEx ) ConnectEx-args new - swap >>namelen* - swap >>name* - f >>lpSendBuffer* - 0 >>dwSendDataLength* - f >>lpdwBytesSent* - (make-overlapped) >>lpOverlapped* ; + swap >>namelen + swap >>name + f >>lpSendBuffer + 0 >>dwSendDataLength + f >>lpdwBytesSent + (make-overlapped) >>lpOverlapped ; inline : call-ConnectEx ( ConnectEx -- ) - ConnectEx-args >tuple*< + { + [ s>> ] + [ name>> ] + [ namelen>> ] + [ lpSendBuffer>> ] + [ dwSendDataLength>> ] + [ lpdwBytesSent>> ] + [ lpOverlapped>> ] + [ ptr>> ] + } cleave "int" { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" } "stdcall" alien-indirect drop - winsock-error-string [ throw ] when* ; + winsock-error-string [ throw ] when* ; inline M: object establish-connection ( client-out remote -- ) make-sockaddr/size swap >>port - dup port>> handle>> handle>> >>s* - dup s*>> get-ConnectEx-ptr >>ptr* + dup port>> handle>> handle>> >>s + dup s>> get-ConnectEx-ptr >>ptr dup call-ConnectEx wait-for-socket drop ; TUPLE: AcceptEx-args port - sListenSocket* sAcceptSocket* lpOutputBuffer* dwReceiveDataLength* - dwLocalAddressLength* dwRemoteAddressLength* lpdwBytesReceived* lpOverlapped* ; + sListenSocket sAcceptSocket lpOutputBuffer dwReceiveDataLength + dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; : init-accept-buffer ( addr AcceptEx -- ) swap sockaddr-type heap-size 16 + - [ >>dwLocalAddressLength* ] [ >>dwRemoteAddressLength* ] bi - dup dwLocalAddressLength*>> 2 * malloc &free >>lpOutputBuffer* - drop ; + [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi + dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer + drop ; inline : ( server addr -- AcceptEx ) AcceptEx-args new 2dup init-accept-buffer - swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket* - over handle>> handle>> >>sListenSocket* + swap SOCK_STREAM open-socket |dispose handle>> >>sAcceptSocket + over handle>> handle>> >>sListenSocket swap >>port - 0 >>dwReceiveDataLength* - f >>lpdwBytesReceived* - (make-overlapped) >>lpOverlapped* ; + 0 >>dwReceiveDataLength + f >>lpdwBytesReceived + (make-overlapped) >>lpOverlapped ; inline : call-AcceptEx ( AcceptEx -- ) - AcceptEx-args >tuple*< AcceptEx drop - winsock-error-string [ throw ] when* ; + { + [ sListenSocket>> ] + [ sAcceptSocket>> ] + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] + [ lpdwBytesReceived>> ] + [ lpOverlapped>> ] + } cleave AcceptEx drop + winsock-error-string [ throw ] when* ; inline : extract-remote-address ( AcceptEx -- sockaddr ) { - [ lpOutputBuffer*>> ] - [ dwReceiveDataLength*>> ] - [ dwLocalAddressLength*>> ] - [ dwRemoteAddressLength*>> ] + [ lpOutputBuffer>> ] + [ dwReceiveDataLength>> ] + [ dwLocalAddressLength>> ] + [ dwRemoteAddressLength>> ] } cleave f 0 f - [ 0 GetAcceptExSockaddrs ] keep *void* ; + [ 0 GetAcceptExSockaddrs ] keep *void* ; inline M: object (accept) ( server addr -- handle sockaddr ) [ @@ -100,39 +117,49 @@ M: object (accept) ( server addr -- handle sockaddr ) { [ call-AcceptEx ] [ wait-for-socket drop ] - [ sAcceptSocket*>> ] + [ sAcceptSocket>> ] [ extract-remote-address ] } cleave ] with-destructors ; TUPLE: WSARecvFrom-args port - s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd* - lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ; + s lpBuffers dwBufferCount lpNumberOfBytesRecvd + lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ; : make-receive-buffer ( -- WSABUF ) "WSABUF" malloc-object &free default-buffer-size get over set-WSABUF-len - default-buffer-size get malloc &free over set-WSABUF-buf ; + default-buffer-size get malloc &free over set-WSABUF-buf ; inline : ( datagram -- WSARecvFrom ) WSARecvFrom-args new swap >>port - dup port>> handle>> handle>> >>s* + dup port>> handle>> handle>> >>s dup port>> addr>> sockaddr-type heap-size - [ malloc &free >>lpFrom* ] - [ malloc-int &free >>lpFromLen* ] bi - make-receive-buffer >>lpBuffers* - 1 >>dwBufferCount* - 0 malloc-int &free >>lpFlags* - 0 malloc-int &free >>lpNumberOfBytesRecvd* - (make-overlapped) >>lpOverlapped* ; + [ malloc &free >>lpFrom ] + [ malloc-int &free >>lpFromLen ] bi + make-receive-buffer >>lpBuffers + 1 >>dwBufferCount + 0 malloc-int &free >>lpFlags + 0 malloc-int &free >>lpNumberOfBytesRecvd + (make-overlapped) >>lpOverlapped ; inline : call-WSARecvFrom ( WSARecvFrom -- ) - WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ; + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesRecvd>> ] + [ lpFlags>> ] + [ lpFrom>> ] + [ lpFromLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSARecvFrom socket-error* ; inline : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr ) - [ lpBuffers*>> WSABUF-buf swap memory>byte-array ] - [ [ lpFrom*>> ] [ lpFromLen*>> *int ] bi memory>byte-array ] bi ; + [ lpBuffers>> WSABUF-buf swap memory>byte-array ] + [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline M: winnt (receive) ( datagram -- packet addrspec ) [ @@ -144,31 +171,41 @@ M: winnt (receive) ( datagram -- packet addrspec ) ] with-destructors ; TUPLE: WSASendTo-args port - s* lpBuffers* dwBufferCount* lpNumberOfBytesSent* - dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ; + s lpBuffers dwBufferCount lpNumberOfBytesSent + dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ; : make-send-buffer ( packet -- WSABUF ) "WSABUF" malloc-object &free [ >r malloc-byte-array &free r> set-WSABUF-buf ] [ >r length r> set-WSABUF-len ] [ nip ] - 2tri ; + 2tri ; inline : ( packet addrspec datagram -- WSASendTo ) WSASendTo-args new swap >>port - dup port>> handle>> handle>> >>s* + dup port>> handle>> handle>> >>s swap make-sockaddr/size >r malloc-byte-array &free - r> [ >>lpTo* ] [ >>iToLen* ] bi* - swap make-send-buffer >>lpBuffers* - 1 >>dwBufferCount* - 0 >>dwFlags* - 0 >>lpNumberOfBytesSent* - (make-overlapped) >>lpOverlapped* ; + r> [ >>lpTo ] [ >>iToLen ] bi* + swap make-send-buffer >>lpBuffers + 1 >>dwBufferCount + 0 >>dwFlags + 0 >>lpNumberOfBytesSent + (make-overlapped) >>lpOverlapped ; inline : call-WSASendTo ( WSASendTo -- ) - WSASendTo-args >tuple*< WSASendTo socket-error* ; + { + [ s>> ] + [ lpBuffers>> ] + [ dwBufferCount>> ] + [ lpNumberOfBytesSent>> ] + [ dwFlags>> ] + [ lpTo>> ] + [ iToLen>> ] + [ lpOverlapped>> ] + [ lpCompletionRoutine>> ] + } cleave WSASendTo socket-error* ; inline M: winnt (send) ( packet addrspec datagram -- ) [ diff --git a/extra/classes/tuple/lib/authors.txt b/extra/classes/tuple/lib/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/classes/tuple/lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/classes/tuple/lib/lib-docs.factor b/extra/classes/tuple/lib/lib-docs.factor deleted file mode 100644 index 0c4c11e46f..0000000000 --- a/extra/classes/tuple/lib/lib-docs.factor +++ /dev/null @@ -1,29 +0,0 @@ -USING: help.syntax help.markup kernel prettyprint sequences ; -IN: classes.tuple.lib - -HELP: >tuple< -{ $values { "class" "a tuple class" } } -{ $description "Explodes the tuple so that tuple slots are on the stack in the order listed in the tuple." } -{ $example - "USING: kernel prettyprint classes.tuple.lib ;" - "IN: scratchpad" - "TUPLE: foo a b c ;" - "1 2 3 \\ foo boa \\ foo >tuple< .s" - "1\n2\n3" -} -{ $notes "Words using " { $snippet ">tuple<" } " may be compiled." } -{ $see-also >tuple*< } ; - -HELP: >tuple*< -{ $values { "class" "a tuple class" } } -{ $description "Explodes the tuple so that tuple slots ending with '*' are on the stack in the order listed in the tuple." } -{ $example - "USING: kernel prettyprint classes.tuple.lib ;" - "IN: scratchpad" - "TUPLE: foo a bb* ccc dddd* ;" - "1 2 3 4 \\ foo boa \\ foo >tuple*< .s" - "2\n4" -} -{ $notes "Words using " { $snippet ">tuple*<" } " may be compiled." } -{ $see-also >tuple< } ; - diff --git a/extra/classes/tuple/lib/lib-tests.factor b/extra/classes/tuple/lib/lib-tests.factor deleted file mode 100644 index 7f7f24ab56..0000000000 --- a/extra/classes/tuple/lib/lib-tests.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: kernel tools.test classes.tuple.lib ; -IN: classes.tuple.lib.tests - -TUPLE: foo a b* c d* e f* ; - -[ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple< ] unit-test -[ 2 4 6 ] [ 1 2 3 4 5 6 \ foo boa \ foo >tuple*< ] unit-test - diff --git a/extra/classes/tuple/lib/lib.factor b/extra/classes/tuple/lib/lib.factor deleted file mode 100755 index a234ce0d41..0000000000 --- a/extra/classes/tuple/lib/lib.factor +++ /dev/null @@ -1,18 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel macros sequences slots words classes.tuple -quotations combinators accessors ; -IN: classes.tuple.lib - -: reader-slots ( seq -- quot ) - [ reader>> 1quotation ] map [ cleave ] curry ; - -MACRO: >tuple< ( class -- ) - all-slots rest-slice reader-slots ; - -MACRO: >tuple*< ( class -- ) - all-slots - [ slot-spec-name "*" tail? ] filter - reader-slots ; - -