]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/sockets/windows/windows.factor
use radix literals
[factor.git] / basis / io / sockets / windows / windows.factor
index aea801615650313318eb388b57efdc7ad25d92fc..39d4310bb24af961a013efd17620e2db10ff43d1 100755 (executable)
@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.data classes.struct
 combinators destructors io.backend io.files.windows io.ports\r
 io.sockets io.sockets.icmp io.sockets.private kernel libc math\r
 sequences system windows.handles windows.kernel32 windows.types\r
-windows.winsock ;\r
+windows.winsock locals ;\r
 FROM: namespaces => get ;\r
 IN: io.sockets.windows\r
 \r
@@ -72,7 +72,7 @@ M: object ((client)) ( addrspec -- handle )
 \r
 ! http://support.microsoft.com/kb/127144\r
 ! NOTE: Possibly tweak this because of SYN flood attacks\r
-: listen-backlog ( -- n ) HEX: 7fffffff ; inline\r
+: listen-backlog ( -- n ) 0x7fffffff ; inline\r
 \r
 M: object (server) ( addrspec -- handle )\r
     [\r
@@ -89,7 +89,7 @@ M: windows (raw) ( addrspec -- handle )
 : malloc-int ( n -- alien )\r
     int <ref> malloc-byte-array ; inline\r
 \r
-M: winnt WSASocket-flags ( -- DWORD )\r
+M: windows WSASocket-flags ( -- DWORD )\r
     WSA_FLAG_OVERLAPPED ;\r
 \r
 : get-ConnectEx-ptr ( socket -- void* )\r
@@ -111,7 +111,7 @@ TUPLE: ConnectEx-args port
     s name namelen lpSendBuffer dwSendDataLength\r
     lpdwBytesSent lpOverlapped ptr ;\r
 \r
-: wait-for-socket ( args -- n )\r
+: wait-for-socket ( args -- count )\r
     [ lpOverlapped>> ] [ port>> ] bi twiddle-thumbs ; inline\r
 \r
 : <ConnectEx-args> ( sockaddr size -- ConnectEx )\r
@@ -211,19 +211,24 @@ TUPLE: WSARecvFrom-args port
        s lpBuffers dwBufferCount lpNumberOfBytesRecvd\r
        lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;\r
 \r
-: make-receive-buffer ( -- WSABUF )\r
+:: make-receive-buffer ( n buf -- buf' WSABUF )\r
+    buf >c-ptr pinned-alien?\r
+    [ buf ] [ n malloc &free [ buf n memcpy ] keep ] if :> buf'\r
+    buf'\r
     WSABUF malloc-struct &free\r
-        default-buffer-size get\r
-        [ >>len ] [ malloc &free >>buf ] bi ; inline\r
+        n >>len\r
+        buf' >>buf ; inline\r
 \r
-: <WSARecvFrom-args> ( datagram -- WSARecvFrom )\r
+:: <WSARecvFrom-args> ( n buf datagram -- buf buf' WSARecvFrom )\r
+    n buf make-receive-buffer :> ( buf' wsaBuf )\r
+    buf buf'\r
     WSARecvFrom-args new\r
-        swap >>port\r
-        dup port>> handle>> handle>> >>s\r
-        dup port>> addr>> sockaddr-size\r
+        datagram >>port\r
+        datagram handle>> handle>> >>s\r
+        datagram addr>> sockaddr-size\r
             [ malloc &free >>lpFrom ]\r
             [ malloc-int &free >>lpFromLen ] bi\r
-        make-receive-buffer >>lpBuffers\r
+        wsaBuf >>lpBuffers\r
         1 >>dwBufferCount\r
         0 malloc-int &free >>lpFlags\r
         0 malloc-int &free >>lpNumberOfBytesRecvd\r
@@ -242,16 +247,18 @@ TUPLE: WSARecvFrom-args port
         [ lpCompletionRoutine>> ]\r
     } cleave WSARecvFrom socket-error* ; inline\r
 \r
-: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )\r
-    [ lpBuffers>> buf>> swap memory>byte-array ]\r
-    [\r
-        [ port>> addr>> empty-sockaddr dup ]\r
-        [ lpFrom>> ]\r
-        [ lpFromLen>> int deref ]\r
-        tri memcpy\r
-    ] bi ; inline\r
+:: finalize-buf ( buf buf' count -- )\r
+    buf buf' eq? [ buf buf' count memcpy ] unless ; inline\r
+\r
+:: parse-WSARecvFrom ( buf buf' count wsaRecvFrom -- count sockaddr )\r
+    buf buf' count finalize-buf\r
+    count wsaRecvFrom\r
+    [ port>> addr>> empty-sockaddr dup ]\r
+    [ lpFrom>> ]\r
+    [ lpFromLen>> int deref ]\r
+    tri memcpy ; inline\r
 \r
-M: winnt (receive) ( datagram -- packet addrspec )\r
+M: windows (receive-unsafe) ( n buf datagram -- count addrspec )\r
     [\r
         <WSARecvFrom-args>\r
         [ call-WSARecvFrom ]\r
@@ -295,7 +302,7 @@ TUPLE: WSASendTo-args port
         [ lpCompletionRoutine>> ]\r
     } cleave WSASendTo socket-error* ; inline\r
 \r
-M: winnt (send) ( packet addrspec datagram -- )\r
+M: windows (send) ( packet addrspec datagram -- )\r
     [\r
         <WSASendTo-args>\r
         [ call-WSASendTo ]\r