From b002cc1e9483e461d8b05d0b8b028716cccedcba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 11 Nov 2007 16:09:24 -0500 Subject: [PATCH] Fix Windows CE UDP and --- extra/io/windows/ce/sockets/sockets.factor | 153 +++++++-------------- extra/io/windows/windows.factor | 28 ++-- extra/windows/kernel32/kernel32.factor | 1 + extra/windows/winsock/winsock.factor | 7 +- 4 files changed, 74 insertions(+), 115 deletions(-) mode change 100644 => 100755 extra/windows/kernel32/kernel32.factor diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index 659f481188..da64b25933 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -8,89 +8,16 @@ IN: io.windows.ce M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ; -TUPLE: WSAArgs - s - lpBuffers - dwBufferCount - lpNumberOfBytesRet - lpFlags - lpOverlapped - lpCompletionRoutine ; -C: WSAArgs - -: make-WSAArgs ( port -- ) - [ port-handle win32-file-handle ] keep - 1 "DWORD" f f f ; - -: setup-WSARecv ( -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine ) - [ WSAArgs-s ] keep - [ - WSAArgs-lpBuffers [ buffer-capacity ] keep - buffer-end - "WSABUF" - [ windows.winsock:set-WSABUF-buf ] keep - [ windows.winsock:set-WSABUF-len ] keep - ] keep - [ WSAArgs-dwBufferCount ] keep - [ WSAArgs-lpNumberOfBytesRet ] keep - [ WSAArgs-lpFlags ] keep - [ WSAArgs-lpOverlapped ] keep - WSAArgs-lpCompletionRoutine ; - -! M: win32-socket wince-read ( port port-handle -- ) - ! drop dup make-WSAArgs dup setup-WSARecv WSARecv zero? [ - ! drop port-errored - ! ] [ - ! WSAArgs-lpNumberOfBytesRet *uint dup zero? [ - ! drop - ! t swap set-port-eof? - ! ] [ - ! swap n>buffer - ! ] if - ! ] if ; - M: win32-socket wince-read ( port port-handle -- ) win32-file-handle over buffer-end pick buffer-capacity 0 windows.winsock:recv dup windows.winsock:SOCKET_ERROR = [ drop port-errored ] [ - dup zero? [ - drop - t swap set-port-eof? - ] [ - swap n>buffer - ] if + dup zero? + [ drop t swap set-port-eof? ] [ swap n>buffer ] if ] if ; -: setup-WSASend ( -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine ) - [ WSAArgs-s ] keep - [ - WSAArgs-lpBuffers [ buffer-length ] keep - buffer@ - "WSABUF" - [ windows.winsock:set-WSABUF-buf ] keep - [ windows.winsock:set-WSABUF-len ] keep - ] keep - [ WSAArgs-dwBufferCount ] keep - [ WSAArgs-lpNumberOfBytesRet ] keep - [ WSAArgs-lpFlags ] keep - [ WSAArgs-lpOverlapped ] keep - WSAArgs-lpCompletionRoutine ; - -! M: win32-socket wince-write ( port port-handle -- ) - ! drop dup make-WSAArgs dup setup-WSASend WSASend zero? [ - ! drop port-errored - ! ] [ - ! FileArgs-lpNumberOfBytesRet *uint ! *DWORD - ! over delegate [ buffer-consume ] keep - ! buffer-length 0 > [ - ! flush-output - ! ] [ - ! drop - ! ] if - ! ] if ; - M: win32-socket wince-write ( port port-handle -- ) win32-file-handle over buffer@ pick buffer-length 0 windows.winsock:send @@ -100,8 +27,9 @@ M: win32-socket wince-write ( port port-handle -- ) : do-connect ( addrspec -- socket ) [ tcp-socket dup ] keep make-sockaddr/size - f f f f windows.winsock:WSAConnect zero? - [ windows.winsock:winsock-error ] unless ; + f f f f + windows.winsock:WSAConnect + windows.winsock:winsock-error!=0/f ; M: windows-ce-io (client) ( addrspec -- duplex-stream ) do-connect dup handle>duplex-stream ; @@ -121,7 +49,8 @@ M: windows-ce-io accept ( server -- client ) swap server-port-addr sockaddr-type heap-size dup [ swap f 0 - windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = + windows.winsock:WSAAccept + dup windows.winsock:INVALID_SOCKET = [ windows.winsock:winsock-error ] when ] keep ] keep server-port-addr parse-sockaddr swap @@ -132,39 +61,55 @@ M: windows-ce-io ( addrspec -- datagram ) windows.winsock:SOCK_DGRAM server-fd f ] keep ; +: packet-size 65536 ; inline + +: receive-buffer ( -- buf ) + \ receive-buffer get-global expired? [ + packet-size malloc \ receive-buffer set-global + ] when + \ receive-buffer get-global ; + +: make-WSABUF ( len buf -- ptr ) + "WSABUF" + [ windows.winsock:set-WSABUF-buf ] keep + [ windows.winsock:set-WSABUF-len ] keep ; + +: receive-WSABUF ( -- buf ) + packet-size receive-buffer make-WSABUF ; + +: packet-data ( len -- byte-array ) + receive-buffer swap memory>string >byte-array ; + +packet-size receive-buffer set-global + M: windows-ce-io receive ( datagram -- packet addrspec ) dup check-datagram-port [ port-handle win32-file-handle - "WSABUF" - default-buffer-size get over windows.winsock:set-WSABUF-len - default-buffer-size get over windows.winsock:set-WSABUF-buf - [ - 1 - 0 [ - 0 - 64 "char" [ - 64 - f - f - windows.winsock:WSARecvFrom zero? - [ windows.winsock:winsock-error ] unless - ] keep - ] keep *uint - ] keep - ] keep - ! sockaddr count buf datagram - >r windows.winsock:WSABUF-buf swap memory>string swap r> - datagram-port-addr parse-sockaddr ; + receive-WSABUF + 1 + 0 [ + 0 + 64 "char" [ + 64 + f + f + windows.winsock:WSARecvFrom + windows.winsock:winsock-error!=0/f + ] keep + ] keep *uint packet-data swap + ] keep datagram-port-addr parse-sockaddr ; + +: send-WSABUF ( byte-array -- ptr ) + dup length packet-size > [ "UDP packet too long" throw ] when + dup length receive-buffer rot pick memcpy + receive-buffer make-WSABUF ; M: windows-ce-io send ( packet addrspec datagram -- ) 3dup check-datagram-send port-handle win32-file-handle - rot dup length "WSABUF" - [ windows.winsock:set-WSABUF-len ] keep - [ windows.winsock:set-WSABUF-buf ] keep - + rot send-WSABUF rot make-sockaddr/size >r >r 1 0 0 r> r> f f - windows.winsock:WSASendTo zero? - [ windows.winsock:winsock-error ] unless ; + windows.winsock:WSASendTo + windows.winsock:winsock-error!=0/f ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 16b7c4847f..ff9cd22d23 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -1,9 +1,8 @@ -USING: alien alien.c-types arrays destructors io -io.backend io.buffers io.files io.nonblocking io.sockets -io.sockets.impl windows.errors strings io.streams.duplex -kernel math namespaces sequences windows -windows.kernel32 windows.winsock windows.winsock.private ; -USE: prettyprint +USING: alien alien.c-types arrays destructors io io.backend +io.buffers io.files io.nonblocking io.sockets io.binary +io.sockets.impl windows.errors strings io.streams.duplex kernel +math namespaces sequences windows windows.kernel32 +windows.winsock windows.winsock.private ; IN: io.windows TUPLE: windows-nt-io ; @@ -67,9 +66,18 @@ M: win32-file close-handle ( handle -- ) : (open-append) ( path -- handle ) normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; +: set-file-pointer ( handle length -- ) + dupd d>w/w FILE_BEGIN SetFilePointer + INVALID_SET_FILE_POINTER = [ + CloseHandle "SetFilePointer failed" throw + ] when drop ; + : open-append ( path -- handle length ) - dup file-length dup - [ >r (open-append) r> ] [ drop open-write ] if ; + dup file-length dup [ + >r (open-append) r> 2dup set-file-pointer + ] [ + drop open-write + ] if ; TUPLE: FileArgs hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRet lpOverlapped ; @@ -160,13 +168,13 @@ USE: namespaces : listen-backlog ( -- n ) HEX: 7fffffff ; inline : listen-on-socket ( socket -- ) - listen-backlog listen winsock-error!=0/f ; + listen-backlog listen winsock-return-check ; M: win32-socket stream-close ( stream -- ) win32-file-handle closesocket drop ; M: windows-io addrinfo-error ( n -- ) - winsock-error!=0/f ; + winsock-return-check ; : tcp-socket ( addrspec -- socket ) protocol-family SOCK_STREAM open-socket ; diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor old mode 100644 new mode 100755 index e11f6ed081..cdf87c5cca --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -96,6 +96,7 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : INVALID_HANDLE_VALUE -1 ; inline : INVALID_FILE_SIZE HEX: FFFFFFFF ; inline +: INVALID_SET_FILE_POINTER HEX: ffffffff ; inline : FILE_BEGIN 0 ; inline : FILE_CURRENT 1 ; inline diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor index f87ebab0d8..7cad474cac 100755 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -413,6 +413,11 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi ] when ; : winsock-error!=0/f ( n/f -- ) + { 0 f } member? [ + winsock-error-string throw + ] unless ; + +: winsock-return-check ( n/f -- ) dup { 0 f } member? [ drop ] [ @@ -433,5 +438,5 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi SOCKET_ERROR = [ winsock-error ] when ; : init-winsock ( -- ) - HEX: 0202 WSAStartup winsock-error!=0/f ; + HEX: 0202 WSAStartup winsock-return-check ;