steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/factor

release
Slava Pestov 2007-11-11 19:30:30 -05:00
parent 232ce7d9f4 abf65f92d8
commit 5f37939800
4 changed files with 74 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
extra/io/windows/ce/sockets/sockets.factor
View File

@ -8,89 +8,16 @@ IN: io.windows.ce
M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ; M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ;
TUPLE: WSAArgs
s
lpBuffers
dwBufferCount
lpNumberOfBytesRet
lpFlags
lpOverlapped
lpCompletionRoutine ;
C: <WSAArgs> WSAArgs
: make-WSAArgs ( port -- <WSARecv> )
[ port-handle win32-file-handle ] keep
1 "DWORD" <c-object> f f f <WSAArgs> ;
: setup-WSARecv ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
[ WSAArgs-s ] keep
[
WSAArgs-lpBuffers [ buffer-capacity ] keep
buffer-end
"WSABUF" <c-object>
[ 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 -- ) M: win32-socket wince-read ( port port-handle -- )
win32-file-handle over buffer-end pick buffer-capacity 0 win32-file-handle over buffer-end pick buffer-capacity 0
windows.winsock:recv windows.winsock:recv
dup windows.winsock:SOCKET_ERROR = [ dup windows.winsock:SOCKET_ERROR = [
drop port-errored drop port-errored
] [ ] [
dup zero? [ dup zero?
drop [ drop t swap set-port-eof? ] [ swap n>buffer ] if
t swap set-port-eof?
] [
swap n>buffer
] if
] if ; ] if ;
: setup-WSASend ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
[ WSAArgs-s ] keep
[
WSAArgs-lpBuffers [ buffer-length ] keep
buffer@
"WSABUF" <c-object>
[ 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 -- ) M: win32-socket wince-write ( port port-handle -- )
win32-file-handle over buffer@ pick buffer-length 0 win32-file-handle over buffer@ pick buffer-length 0
windows.winsock:send windows.winsock:send
@ -100,8 +27,9 @@ M: win32-socket wince-write ( port port-handle -- )
: do-connect ( addrspec -- socket ) : do-connect ( addrspec -- socket )
[ tcp-socket dup ] keep [ tcp-socket dup ] keep
make-sockaddr/size make-sockaddr/size
f f f f windows.winsock:WSAConnect zero? f f f f
[ windows.winsock:winsock-error ] unless ; windows.winsock:WSAConnect
windows.winsock:winsock-error!=0/f ;
M: windows-ce-io (client) ( addrspec -- duplex-stream ) M: windows-ce-io (client) ( addrspec -- duplex-stream )
do-connect <win32-socket> dup handle>duplex-stream ; do-connect <win32-socket> dup handle>duplex-stream ;
@ -121,7 +49,8 @@ M: windows-ce-io accept ( server -- client )
swap server-port-addr sockaddr-type heap-size swap server-port-addr sockaddr-type heap-size
dup <byte-array> [ dup <byte-array> [
swap <int> f 0 swap <int> f 0
windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = windows.winsock:WSAAccept
dup windows.winsock:INVALID_SOCKET =
[ windows.winsock:winsock-error ] when [ windows.winsock:winsock-error ] when
] keep ] keep
] keep server-port-addr parse-sockaddr swap ] keep server-port-addr parse-sockaddr swap
@ -132,14 +61,32 @@ M: windows-ce-io <datagram> ( addrspec -- datagram )
windows.winsock:SOCK_DGRAM server-fd <win32-socket> f <port> windows.winsock:SOCK_DGRAM server-fd <win32-socket> f <port>
] keep <datagram-port> ; ] keep <datagram-port> ;
: 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" <c-object>
[ 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 <byte-array> receive-buffer set-global
M: windows-ce-io receive ( datagram -- packet addrspec ) M: windows-ce-io receive ( datagram -- packet addrspec )
dup check-datagram-port dup check-datagram-port
[ [
port-handle win32-file-handle port-handle win32-file-handle
"WSABUF" <c-object> receive-WSABUF
default-buffer-size get over windows.winsock:set-WSABUF-len
default-buffer-size get <byte-array> over windows.winsock:set-WSABUF-buf
[
1 1
0 <uint> [ 0 <uint> [
0 <uint> 0 <uint>
@ -147,24 +94,22 @@ M: windows-ce-io receive ( datagram -- packet addrspec )
64 <int> 64 <int>
f f
f f
windows.winsock:WSARecvFrom zero? windows.winsock:WSARecvFrom
[ windows.winsock:winsock-error ] unless windows.winsock:winsock-error!=0/f
] keep ] keep
] keep *uint ] keep *uint packet-data swap
] keep ] keep datagram-port-addr parse-sockaddr ;
] keep
! sockaddr count buf datagram : send-WSABUF ( byte-array -- ptr )
>r windows.winsock:WSABUF-buf swap memory>string swap r> dup length packet-size > [ "UDP packet too long" throw ] when
datagram-port-addr parse-sockaddr ; dup length receive-buffer rot pick memcpy
receive-buffer make-WSABUF ;
M: windows-ce-io send ( packet addrspec datagram -- ) M: windows-ce-io send ( packet addrspec datagram -- )
3dup check-datagram-send 3dup check-datagram-send
port-handle win32-file-handle port-handle win32-file-handle
rot dup length "WSABUF" <c-object> rot send-WSABUF
[ windows.winsock:set-WSABUF-len ] keep
[ windows.winsock:set-WSABUF-buf ] keep
rot make-sockaddr/size rot make-sockaddr/size
>r >r 1 0 <uint> 0 r> r> f f >r >r 1 0 <uint> 0 r> r> f f
windows.winsock:WSASendTo zero? windows.winsock:WSASendTo
[ windows.winsock:winsock-error ] unless ; windows.winsock:winsock-error!=0/f ;

28
extra/io/windows/windows.factor
View File

@ -1,9 +1,8 @@
USING: alien alien.c-types arrays destructors io USING: alien alien.c-types arrays destructors io io.backend
io.backend io.buffers io.files io.nonblocking io.sockets io.buffers io.files io.nonblocking io.sockets io.binary
io.sockets.impl windows.errors strings io.streams.duplex io.sockets.impl windows.errors strings io.streams.duplex kernel
kernel math namespaces sequences windows math namespaces sequences windows windows.kernel32
windows.kernel32 windows.winsock windows.winsock.private ; windows.winsock windows.winsock.private ;
USE: prettyprint
IN: io.windows IN: io.windows
TUPLE: windows-nt-io ; TUPLE: windows-nt-io ;
@ -67,9 +66,18 @@ M: win32-file close-handle ( handle -- )
: (open-append) ( path -- handle ) : (open-append) ( path -- handle )
normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ;
: set-file-pointer ( handle length -- )
dupd d>w/w <uint> FILE_BEGIN SetFilePointer
INVALID_SET_FILE_POINTER = [
CloseHandle "SetFilePointer failed" throw
] when drop ;
: open-append ( path -- handle length ) : open-append ( path -- handle length )
dup file-length dup dup file-length dup [
[ >r (open-append) r> ] [ drop open-write ] if ; >r (open-append) r> 2dup set-file-pointer
] [
drop open-write
] if ;
TUPLE: FileArgs TUPLE: FileArgs
hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRet lpOverlapped ; hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRet lpOverlapped ;
@ -160,13 +168,13 @@ USE: namespaces
: listen-backlog ( -- n ) HEX: 7fffffff ; inline : listen-backlog ( -- n ) HEX: 7fffffff ; inline
: listen-on-socket ( socket -- ) : listen-on-socket ( socket -- )
listen-backlog listen winsock-error!=0/f ; listen-backlog listen winsock-return-check ;
M: win32-socket stream-close ( stream -- ) M: win32-socket stream-close ( stream -- )
win32-file-handle closesocket drop ; win32-file-handle closesocket drop ;
M: windows-io addrinfo-error ( n -- ) M: windows-io addrinfo-error ( n -- )
winsock-error!=0/f ; winsock-return-check ;
: tcp-socket ( addrspec -- socket ) : tcp-socket ( addrspec -- socket )
protocol-family SOCK_STREAM open-socket ; protocol-family SOCK_STREAM open-socket ;

1
extra/windows/kernel32/kernel32.factor Normal file → Executable file
View File

@ -96,6 +96,7 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
: INVALID_HANDLE_VALUE -1 <alien> ; inline : INVALID_HANDLE_VALUE -1 <alien> ; inline
: INVALID_FILE_SIZE HEX: FFFFFFFF ; inline : INVALID_FILE_SIZE HEX: FFFFFFFF ; inline
: INVALID_SET_FILE_POINTER HEX: ffffffff ; inline
: FILE_BEGIN 0 ; inline : FILE_BEGIN 0 ; inline
: FILE_CURRENT 1 ; inline : FILE_CURRENT 1 ; inline

7
extra/windows/winsock/winsock.factor
View File

@ -413,6 +413,11 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
] when ; ] when ;
: winsock-error!=0/f ( n/f -- ) : winsock-error!=0/f ( n/f -- )
{ 0 f } member? [
winsock-error-string throw
] unless ;
: winsock-return-check ( n/f -- )
dup { 0 f } member? [ dup { 0 f } member? [
drop drop
] [ ] [
@ -433,5 +438,5 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
SOCKET_ERROR = [ winsock-error ] when ; SOCKET_ERROR = [ winsock-error ] when ;
: init-winsock ( -- ) : init-winsock ( -- )
HEX: 0202 <wsadata> WSAStartup winsock-error!=0/f ; HEX: 0202 <wsadata> WSAStartup winsock-return-check ;