From d74db3abb9f5d8b496accc6f8ff5e267372dcf5d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 6 Nov 2007 20:44:45 -0500 Subject: [PATCH] Windows CE I/O cleanup --- extra/io/windows/ce/backend/backend.factor | 22 ++ extra/io/windows/ce/ce.factor | 234 +-------------------- extra/io/windows/ce/files/files.factor | 36 ++++ extra/io/windows/ce/sockets/sockets.factor | 178 ++++++++++++++++ extra/windows/winsock/winsock.factor | 10 +- 5 files changed, 244 insertions(+), 236 deletions(-) create mode 100755 extra/io/windows/ce/backend/backend.factor mode change 100644 => 100755 extra/io/windows/ce/ce.factor create mode 100755 extra/io/windows/ce/files/files.factor create mode 100755 extra/io/windows/ce/sockets/sockets.factor mode change 100644 => 100755 extra/windows/winsock/winsock.factor diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor new file mode 100755 index 0000000000..f367296ea7 --- /dev/null +++ b/extra/io/windows/ce/backend/backend.factor @@ -0,0 +1,22 @@ +USING: io.nonblocking io.windows threads.private kernel +io.backend windows.winsock windows ; +IN: io.windows.ce.backend + +: port-errored ( port -- ) + win32-error-string swap set-port-error ; + +M: windows-ce-io io-multiplex ( ms -- ) (sleep) ; +M: windows-ce-io add-completion ( port -- ) drop ; + +GENERIC: wince-read ( port port-handle -- ) + +M: input-port (wait-to-read) ( port -- ) + dup port-handle wince-read ; + +GENERIC: wince-write ( port port-handle -- ) + +M: windows-ce-io flush-output ( port -- ) + dup port-handle wince-write ; + +M: windows-ce-io init-io ( -- ) + init-winsock ; diff --git a/extra/io/windows/ce/ce.factor b/extra/io/windows/ce/ce.factor old mode 100644 new mode 100755 index b45f2df4d7..4c0237761e --- a/extra/io/windows/ce/ce.factor +++ b/extra/io/windows/ce/ce.factor @@ -1,235 +1,5 @@ -USING: alien alien.c-types combinators -io io.backend io.buffers io.files io.nonblocking io.sockets -io.sockets.impl io.windows kernel libc math namespaces -prettyprint qualified sequences strings threads threads.private -windows windows.kernel32 ; -QUALIFIED: windows.winsock +USING: io.backend io.windows io.windows.ce.backend +io.windows.ce.files io.windows.ce.sockets namespaces ; IN: io.windows.ce -! M: windows-ce-io normalize-pathname ( string -- string ) - ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; - -M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ; -M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ; -M: windows-ce-io io-multiplex ( ms -- ) (sleep) ; -M: windows-ce-io add-completion ( port -- ? ) drop f ; - -: port-errored ( port -- ) - win32-error-string swap set-port-error ; - -GENERIC: wince-read ( port port-handle -- ) - -M: win32-file wince-read - drop dup make-FileArgs dup setup-read ReadFile zero? [ - drop port-errored - ] [ - FileArgs-lpNumberOfBytesRet *uint dup zero? [ - drop - t swap set-port-eof? - ] [ - swap n>buffer - ] if - ] if ; - -TUPLE: WSAArgs - s - lpBuffers - dwBufferCount - lpNumberOfBytesRet - lpFlags - lpOverlapped - lpCompletionRoutine ; -C: WSAArgs - -: make-WSAArgs ( port -- ) - [ port-handle win32-file-handle ] keep - delegate 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 - delegate [ buffer-end ] keep 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 - ] if ; - -M: input-port (wait-to-read) ( port -- ) - dup port-handle wince-read ; - -GENERIC: wince-write ( port port-handle -- ) - -M: win32-file wince-write ( port port-handle -- ) - drop dup make-FileArgs dup setup-write WriteFile zero? [ - drop port-errored - ] [ - FileArgs-lpNumberOfBytesRet *uint ! *DWORD - over delegate [ buffer-consume ] keep - buffer-length 0 > [ - flush-output - ] [ - drop - ] 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 - delegate [ buffer@ ] keep - buffer-length 0 windows.winsock:send dup windows.winsock:SOCKET_ERROR = [ - drop port-errored - ] [ - over delegate [ buffer-consume ] keep - buffer-length 0 > [ - flush-output - ] [ - drop - ] if - ] if ; - -M: windows-ce-io flush-output ( port -- ) - dup port-handle wince-write ; - -M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ; - -: do-connect ( addrspec -- socket ) - [ tcp-socket dup ] keep - make-sockaddr/size - f f f f windows.winsock:WSAConnect zero? [ - winsock-error-string throw - ] unless ; - -M: windows-ce-io (client) ( addrspec -- duplex-stream ) - do-connect dup handle>duplex-stream ; - -M: windows-ce-io ( addrspec -- duplex-stream ) - [ - windows.winsock:SOCK_STREAM server-fd - dup listen-on-socket - f - ] keep ; - -M: windows-ce-io accept ( server -- client ) - dup check-server-port - [ - [ touch-port ] keep - [ port-handle win32-file-handle ] keep - server-port-addr sockaddr-type heap-size - [ "char" ] keep [ - - f 0 - windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = [ - winsock-error-string throw - ] when - ] keep - ] keep server-port-addr parse-sockaddr swap - dup handle>duplex-stream ; - T{ windows-ce-io } io-backend set-global - -M: windows-ce-io init-io ( -- ) - init-winsock ; - -M: windows-ce-io ( addrspec -- datagram ) - [ - windows.winsock:SOCK_DGRAM server-fd f - ] keep ; - -M: windows-ce-io receive ( datagram -- packet addrspec ) - dup check-datagram-port - [ - port-handle delegate win32-file-handle - "WSABUF" - default-buffer-size over windows.winsock:set-WSABUF-len - default-buffer-size "char" over windows.winsock:set-WSABUF-buf - [ - 1 - 0 [ - 0 - 64 "char" [ - 64 - f - f - windows.winsock:WSARecvFrom zero? [ - winsock-error-string throw - ] 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 ; - -M: windows-ce-io send ( packet addrspec datagram -- ) - 3dup check-datagram-send - delegate port-handle delegate win32-file-handle - rot dup length "WSABUF" - [ windows.winsock:set-WSABUF-len ] keep - [ windows.winsock:set-WSABUF-buf ] keep - - rot make-sockaddr/size - >r >r 1 0 0 r> r> f f - windows.winsock:WSASendTo zero? [ - winsock-error-string throw - ] unless ; - diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor new file mode 100755 index 0000000000..ea00b0248c --- /dev/null +++ b/extra/io/windows/ce/files/files.factor @@ -0,0 +1,36 @@ +USING: alien alien.c-types combinators io io.backend io.buffers +io.files io.nonblocking io.windows kernel libc math namespaces +prettyprint sequences strings threads threads.private +windows windows.kernel32 io.windows.ce.backend ; +IN: windows.ce.files + +! M: windows-ce-io normalize-pathname ( string -- string ) + ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; + +M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ; +M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ; + +M: win32-file wince-read + drop dup make-FileArgs dup setup-read ReadFile zero? [ + drop port-errored + ] [ + FileArgs-lpNumberOfBytesRet *uint dup zero? [ + drop + t swap set-port-eof? + ] [ + swap n>buffer + ] if + ] if ; + +M: win32-file wince-write ( port port-handle -- ) + drop dup make-FileArgs dup setup-write WriteFile zero? [ + drop port-errored + ] [ + FileArgs-lpNumberOfBytesRet *uint ! *DWORD + over delegate [ buffer-consume ] keep + buffer-length 0 > [ + flush-output + ] [ + drop + ] if + ] if ; diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor new file mode 100755 index 0000000000..e592d75ae0 --- /dev/null +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -0,0 +1,178 @@ +USING: alien alien.c-types combinators io io.backend io.buffers +io.nonblocking io.sockets io.sockets.impl io.windows kernel libc +math namespaces prettyprint qualified sequences strings threads +threads.private windows windows.kernel32 io.windows.ce.backend ; +QUALIFIED: windows.winsock +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 + delegate 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 + delegate [ buffer-end ] keep 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 + ] 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 + delegate [ buffer@ ] keep + buffer-length 0 windows.winsock:send dup windows.winsock:SOCKET_ERROR = [ + drop port-errored + ] [ + over delegate [ buffer-consume ] keep + buffer-length 0 > [ + flush-output + ] [ + drop + ] if + ] if ; + +: do-connect ( addrspec -- socket ) + [ tcp-socket dup ] keep + make-sockaddr/size + f f f f windows.winsock:WSAConnect zero? + [ windows.winsock:winsock-error ] unless ; + +M: windows-ce-io (client) ( addrspec -- duplex-stream ) + do-connect dup handle>duplex-stream ; + +M: windows-ce-io ( addrspec -- duplex-stream ) + [ + windows.winsock:SOCK_STREAM server-fd + dup listen-on-socket + f + ] keep ; + +M: windows-ce-io accept ( server -- client ) + dup check-server-port + [ + [ touch-port ] keep + [ port-handle win32-file-handle ] keep + server-port-addr sockaddr-type heap-size + [ "char" ] keep [ + + 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 ; + +M: windows-ce-io ( addrspec -- datagram ) + [ + windows.winsock:SOCK_DGRAM server-fd f + ] keep ; + +M: windows-ce-io receive ( datagram -- packet addrspec ) + dup check-datagram-port + [ + port-handle delegate win32-file-handle + "WSABUF" + default-buffer-size over windows.winsock:set-WSABUF-len + default-buffer-size "char" 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 ; + +M: windows-ce-io send ( packet addrspec datagram -- ) + 3dup check-datagram-send + delegate port-handle delegate win32-file-handle + rot dup length "WSABUF" + [ windows.winsock:set-WSABUF-len ] keep + [ windows.winsock:set-WSABUF-buf ] keep + + rot make-sockaddr/size + >r >r 1 0 0 r> r> f f + windows.winsock:WSASendTo zero? + [ windows.winsock:winsock-error ] unless ; diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor old mode 100644 new mode 100755 index 9a031baa1e..f87ebab0d8 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -166,9 +166,8 @@ FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ; FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ; FUNCTION: int closesocket ( SOCKET s ) ; FUNCTION: int shutdown ( SOCKET s, int how ) ; -! FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ; -! FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ; - +FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ; +FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ; TYPEDEF: uint SERVICETYPE TYPEDEF: OVERLAPPED WSAOVERLAPPED @@ -405,6 +404,9 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi : winsock-error-string ( -- string/f ) WSAGetLastError (winsock-error-string) ; +: winsock-error ( -- ) + winsock-error-string [ throw ] when* ; + : winsock-error=0/f ( n/f -- ) { 0 f } member? [ winsock-error-string throw @@ -428,7 +430,7 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi ] when ; : socket-error ( n -- ) - SOCKET_ERROR = [ winsock-error-string throw ] when ; + SOCKET_ERROR = [ winsock-error ] when ; : init-winsock ( -- ) HEX: 0202 WSAStartup winsock-error!=0/f ;