From d74db3abb9f5d8b496accc6f8ff5e267372dcf5d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 6 Nov 2007 20:44:45 -0500 Subject: [PATCH 1/3] 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 ; From 8f2c563e57d4265dea2f0d4110bbfb90d772caca Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 6 Nov 2007 21:51:03 -0500 Subject: [PATCH 2/3] Memory defaults tweak --- vm/factor.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vm/factor.c b/vm/factor.c index 4dee712c0b..690f5d490c 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -13,7 +13,7 @@ void default_parameters(F_PARAMETERS *p) p->gen_count = 2; p->code_size = 4; p->young_size = 1; - p->aging_size = 4; + p->aging_size = 6; #else p->ds_size = 32 * CELLS; p->rs_size = 32 * CELLS; From 3efc9c797312c97150ea3333a843f8614903c5ea Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Nov 2007 14:01:45 -0500 Subject: [PATCH 3/3] Windows I/O cleanups, fix accept on CE --- extra/io/nonblocking/nonblocking.factor | 24 +++++++++-- extra/io/unix/backend/backend.factor | 17 ++------ extra/io/windows/ce/backend/backend.factor | 22 ++++++++++- extra/io/windows/ce/files/files.factor | 18 +++------ extra/io/windows/ce/sockets/sockets.factor | 46 +++++++++------------- extra/io/windows/launcher/launcher.factor | 4 +- extra/io/windows/nt/backend/backend.factor | 31 ++++++++------- extra/io/windows/nt/files/files.factor | 33 +++++++--------- extra/io/windows/nt/sockets/sockets.factor | 4 +- extra/io/windows/windows.factor | 36 ++++------------- 10 files changed, 113 insertions(+), 122 deletions(-) mode change 100644 => 100755 extra/io/nonblocking/nonblocking.factor mode change 100644 => 100755 extra/io/unix/backend/backend.factor mode change 100644 => 100755 extra/io/windows/nt/files/files.factor mode change 100644 => 100755 extra/io/windows/windows.factor diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor old mode 100644 new mode 100755 index 6741732cc4..7231bb6402 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -1,11 +1,12 @@ -! Copyright (C) 2007 Slava Pestov, Doug Coleman +! Copyright (C) 2005, 2007 Slava Pestov, Doug Coleman ! See http://factorcode.org/license.txt for BSD license. IN: io.nonblocking USING: math kernel io sequences io.buffers generic sbufs system io.streams.lines io.streams.plain io.streams.duplex -continuations debugger classes byte-arrays ; +continuations debugger classes byte-arrays namespaces ; -: default-buffer-size 64 1024 * ; inline +SYMBOL: default-buffer-size +64 1024 * default-buffer-size set-global ! Common delegate of native stream readers and writers TUPLE: port handle error timeout cutoff type eof? ; @@ -18,6 +19,7 @@ PREDICATE: port input-port port-type input eq? ; PREDICATE: port output-port port-type output eq? ; GENERIC: init-handle ( handle -- ) +GENERIC: close-handle ( handle -- ) : ( handle buffer -- port ) over init-handle @@ -29,7 +31,7 @@ GENERIC: init-handle ( handle -- ) } port construct ; : ( handle -- port ) - default-buffer-size ; + default-buffer-size get ; : ( handle -- stream ) input over set-port-type ; @@ -150,6 +152,20 @@ M: output-port stream-write1 M: output-port stream-write over length over wait-to-write >buffer ; +GENERIC: port-flush ( port -- ) + +M: output-port stream-flush ( port -- ) + dup port-flush pending-error ; + +M: port stream-close + dup port-type closed eq? [ + dup port-type >r closed over set-port-type r> + output eq? [ dup port-flush ] when + dup port-handle close-handle + dup delegate [ buffer-free ] when* + f over set-delegate + ] unless drop ; + TUPLE: server-port addr client ; : ( port addr -- server ) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor old mode 100644 new mode 100755 index a0d8658661..486fe46866 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -34,6 +34,9 @@ M: integer init-handle ( fd -- ) #! 1 are closed). F_SETFL O_NONBLOCK fcntl drop ; +M: integer close-handle ( fd -- ) + close ; + : report-error ( error port -- ) [ "Error on fd " % dup port-handle # ": " % swap % ] "" make swap set-port-error ; @@ -168,21 +171,9 @@ M: write-task task-container drop write-tasks get-global ; : (wait-to-write) ( port -- ) [ swap add-write-io-task stop ] callcc0 drop ; -: port-flush ( port -- ) +M: port port-flush ( port -- ) dup buffer-empty? [ drop ] [ (wait-to-write) ] if ; -M: output-port stream-flush - dup port-flush pending-error ; - -M: port stream-close - dup port-type closed eq? [ - dup port-type >r closed over set-port-type r> - output eq? [ dup port-flush ] when - dup port-handle close - dup delegate [ buffer-free ] when* - f over set-delegate - ] unless drop ; - USE: io M: unix-io init-io ( -- ) diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index f367296ea7..37eb161ff8 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -1,5 +1,6 @@ USING: io.nonblocking io.windows threads.private kernel -io.backend windows.winsock windows ; +io.backend windows.winsock windows.kernel32 windows +io.streams.duplex io namespaces alien.syntax system combinators ; IN: io.windows.ce.backend : port-errored ( port -- ) @@ -20,3 +21,22 @@ M: windows-ce-io flush-output ( port -- ) M: windows-ce-io init-io ( -- ) init-winsock ; + +LIBRARY: libc +FUNCTION: void* _getstdfilex int fd ; +FUNCTION: void* _fileno void* file ; + +M: windows-ce-io init-stdio ( -- ) + #! We support Windows NT too, to make this I/O backend + #! easier to debug. + 4096 default-buffer-size [ + winnt? [ + STD_INPUT_HANDLE GetStdHandle + STD_OUTPUT_HANDLE GetStdHandle + ] [ + 0 _getstdfilex _fileno + 1 _getstdfilex _fileno + ] if + >r f + r> f + ] with-variable stdio set ; diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor index ea00b0248c..277641a78a 100755 --- a/extra/io/windows/ce/files/files.factor +++ b/extra/io/windows/ce/files/files.factor @@ -14,23 +14,15 @@ 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 + 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 + FileArgs-lpNumberOfBytesRet *uint + over buffer-consume + port-flush ] if ; diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index e592d75ae0..8fd1bc5fea 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -1,7 +1,8 @@ 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 ; +threads.private windows windows.kernel32 io.windows.ce.backend +byte-arrays ; QUALIFIED: windows.winsock IN: io.windows.ce @@ -19,7 +20,7 @@ C: WSAArgs : make-WSAArgs ( port -- ) [ port-handle win32-file-handle ] keep - delegate 1 "DWORD" f f f ; + 1 "DWORD" f f f ; : setup-WSARecv ( -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine ) [ WSAArgs-s ] keep @@ -49,9 +50,9 @@ C: WSAArgs ! ] 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 = [ + win32-file-handle over buffer-end pick buffer-capacity 0 + windows.winsock:recv + dup windows.winsock:SOCKET_ERROR = [ drop port-errored ] [ dup zero? [ @@ -91,18 +92,10 @@ M: win32-socket wince-read ( port port-handle -- ) ! ] 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 ; + win32-file-handle over buffer@ pick buffer-length 0 + windows.winsock:send + dup windows.winsock:SOCKET_ERROR = + [ drop port-errored ] [ over buffer-consume port-flush ] if ; : do-connect ( addrspec -- socket ) [ tcp-socket dup ] keep @@ -123,12 +116,11 @@ M: windows-ce-io ( addrspec -- duplex-stream ) 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 + dup touch-port + dup port-handle win32-file-handle + swap server-port-addr sockaddr-type heap-size + dup [ + swap f 0 windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = [ windows.winsock:winsock-error ] when ] keep @@ -143,10 +135,10 @@ M: windows-ce-io ( addrspec -- datagram ) M: windows-ce-io receive ( datagram -- packet addrspec ) dup check-datagram-port [ - port-handle delegate win32-file-handle + port-handle win32-file-handle "WSABUF" - default-buffer-size over windows.winsock:set-WSABUF-len - default-buffer-size "char" over windows.winsock:set-WSABUF-buf + default-buffer-size get over windows.winsock:set-WSABUF-len + default-buffer-size get over windows.winsock:set-WSABUF-buf [ 1 0 [ @@ -167,7 +159,7 @@ M: windows-ce-io receive ( datagram -- packet addrspec ) M: windows-ce-io send ( packet addrspec datagram -- ) 3dup check-datagram-send - delegate port-handle delegate win32-file-handle + port-handle win32-file-handle rot dup length "WSABUF" [ windows.winsock:set-WSABUF-len ] keep [ windows.winsock:set-WSABUF-buf ] keep diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index a67aa96ce8..037253db11 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -83,8 +83,8 @@ C: pipe PIPE_ACCESS_DUPLEX FILE_FLAG_OVERLAPPED bitor PIPE_TYPE_BYTE PIPE_READMODE_BYTE PIPE_NOWAIT bitor bitor PIPE_UNLIMITED_INSTANCES - default-buffer-size - default-buffer-size + default-buffer-size get + default-buffer-size get 0 security-attributes-inherit CreateNamedPipe dup invalid-handle? ; diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 0cbdabfa1e..16e01b6103 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -1,13 +1,10 @@ -USING: alien alien.c-types arrays assocs combinators continuations -destructors io io.backend io.nonblocking io.windows libc -kernel math namespaces sequences threads tuples.lib windows -windows.errors windows.kernel32 prettyprint strings splitting -io.files windows.winsock ; +USING: alien alien.c-types arrays assocs combinators +continuations destructors io io.backend io.nonblocking +io.windows libc kernel math namespaces sequences threads +tuples.lib windows windows.errors windows.kernel32 strings +splitting io.files windows.winsock ; IN: io.windows.nt.backend -: .. global [ . flush ] bind ; -: .S global [ .s flush ] bind ; - : unicode-prefix ( -- seq ) "\\\\?\\" ; inline @@ -51,6 +48,12 @@ C: io-callback >r (make-overlapped) r> port-handle win32-file-ptr [ over set-OVERLAPPED-offset ] when* ; +: port-overlapped ( port -- overlapped ) + port-handle win32-file-overlapped ; + +: set-port-overlapped ( overlapped port -- ) + port-handle set-win32-file-overlapped ; + : completion-port ( handle existing -- handle ) f 1 CreateIoCompletionPort dup win32-error=0/f ; @@ -75,7 +78,7 @@ C: GetOverlappedResult-args : (save-callback) ( io-callback -- ) dup io-callback-port port-handle win32-file-overlapped - \ io-hash get-global set-at ; + io-hash get-global set-at ; : save-callback ( port -- ) [ @@ -95,7 +98,7 @@ C: GetQueuedCompletionStatusParams : lookup-callback ( GetQueuedCompletion-args -- callback ) GetQueuedCompletionStatusParams-lpOverlapped* *void* - \ io-hash get-global delete-at* drop ; + io-hash get-global delete-at* drop ; : wait-for-io ( timeout -- continuation/f ) wait-for-overlapped @@ -125,19 +128,17 @@ C: GetQueuedCompletionStatusParams drop ] if ; -: cancel-timedout ( -- ) +: cancel-timeout ( -- ) io-hash get-global values [ maybe-expire ] each ; M: windows-nt-io io-multiplex ( ms -- ) - cancel-timedout - [ wait-for-io ] [ global [ "error: " write . flush ] bind drop f ] recover - [ schedule-thread ] when* ; + cancel-timeout wait-for-io [ schedule-thread ] when* ; M: windows-nt-io init-io ( -- ) #! Should only be called on startup. Calling this at any #! other time can have unintended consequences. global [ master-completion-port \ master-completion-port set - H{ } clone \ io-hash set + H{ } clone io-hash set init-winsock ] bind ; diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor old mode 100644 new mode 100755 index 791b03ab5e..530bc14c3a --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -17,26 +17,24 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) 2drop ] if* ; -DEFER: (flush-output) : finish-flush ( port -- ) dup pending-error dup get-overlapped-result - [ over update-file-ptr ] keep - over delegate [ buffer-consume ] keep - buffer-length 0 > [ - (flush-output) - ] [ - drop - ] if ; + dup pick update-file-ptr + swap buffer-consume ; + +: save-overlapped-and-callback ( fileargs port -- ) + swap FileArgs-lpOverlapped over set-port-overlapped + save-callback ; : (flush-output) ( port -- ) dup touch-port dup make-FileArgs - [ setup-write WriteFile ] keep - >r dupd overlapped-error? r> swap [ - FileArgs-lpOverlapped over set-port-overlapped - dup save-callback - finish-flush + tuck setup-write WriteFile + dupd overlapped-error? [ + [ save-overlapped-and-callback ] keep + [ finish-flush ] keep + dup buffer-empty? [ drop ] [ (flush-output) ] if ] [ 2drop ] if ; @@ -49,17 +47,16 @@ M: windows-nt-io flush-output ( port -- ) dup get-overlapped-result dup zero? [ drop t swap set-port-eof? ] [ - [ over n>buffer ] keep + dup pick n>buffer swap update-file-ptr ] if ; : ((wait-to-read)) ( port -- ) dup touch-port dup make-FileArgs - [ setup-read ReadFile ] keep - >r dupd overlapped-error? r> swap [ - FileArgs-lpOverlapped over set-port-overlapped - dup save-callback + tuck setup-read ReadFile + dupd overlapped-error? [ + [ save-overlapped-and-callback ] keep finish-read ] [ 2drop diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 1b6288eb1d..74538ac06a 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -178,7 +178,7 @@ TUPLE: WSARecvFrom-args port ] keep "WSABUF" malloc-object dup free-always 2dup swap set-WSARecvFrom-args-lpBuffers* - default-buffer-size [ malloc dup free-always ] keep + default-buffer-size get [ malloc dup free-always ] keep pick set-WSABUF-len swap set-WSABUF-buf 1 over set-WSARecvFrom-args-dwBufferCount* @@ -256,6 +256,8 @@ TUPLE: WSASendTo-args port \ WSASendTo-args >tuple*< WSASendTo socket-error* ; +USE: io.sockets + M: windows-nt-io send ( packet addrspec datagram -- ) [ 3dup check-datagram-send diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor old mode 100644 new mode 100755 index 8d6d7cb6f2..894874a60b --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -31,12 +31,6 @@ TUPLE: win32-file handle ptr overlapped ; { set-win32-file-handle set-win32-file-ptr } \ win32-file construct ; -: set-port-overlapped ( overlapped port -- ) - port-handle set-win32-file-overlapped ; - -: port-overlapped ( port -- overlapped ) - port-handle win32-file-overlapped ; - HOOK: CreateFile-flags io-backend ( -- DWORD ) HOOK: flush-output io-backend ( port -- ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) @@ -48,7 +42,14 @@ M: windows-io normalize-directory ( string -- string ) : share-mode ( -- fixnum ) FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline -M: win32-file init-handle ( handle -- ) drop ; +M: win32-file init-handle ( handle -- ) + drop ; + +M: win32-file close-handle ( handle -- ) + win32-file-handle CloseHandle drop ; + +M: port port-flush + dup buffer-empty? [ dup flush-output ] unless drop ; ! Clean up resources (open handle) if add-completion fails : open-file ( path access-mode create-mode -- handle ) @@ -101,27 +102,6 @@ C: FileArgs [ FileArgs-lpNumberOfBytesRet ] keep FileArgs-lpOverlapped ; -M: output-port stream-flush ( port -- ) - dup buffer-empty? [ - dup flush-output - ] unless pending-error ; - -M: port stream-close ( port -- ) - dup port-type closed = [ - drop - ] [ - ! For duplex-streams, we call CloseHandle twice on the same handle - [ dup port-type output = [ stream-flush ] [ drop ] if ] keep - [ closed swap set-port-type ] keep - [ port-handle win32-file-handle CloseHandle drop ] keep - USE: namespaces - [ delegate [ buffer-free ] [ - global [ "delegate was empty!!" print flush ] bind - USE: windows.winsock.private - ] if* ] keep - f swap set-delegate - ] if ; - M: windows-io ( path -- stream ) open-read ;