use radix literals

[factor.git] / basis / io / sockets / windows / windows.factor

diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor
index ade64485db3b5488d604e6b44b3d86d69e522364..39d4310bb24af961a013efd17620e2db10ff43d1 100755 (executable)
--- a/basis/io/sockets/windows/windows.factor
+++ b/basis/io/sockets/windows/windows.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2007, 2009 Slava Pestov, Doug Coleman.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: accessors alien alien.c-types alien.data classes.struct\r
-combinators destructors io.backend io.ports io.files.windows\r
-io.sockets io.sockets.private kernel libc math sequences system\r
-windows.handles windows.kernel32 windows.types windows.winsock ;\r
+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 locals ;\r
 FROM: namespaces => get ;\r
 IN: io.sockets.windows\r
 \r
@@ -41,17 +42,17 @@ M: win32-socket dispose* ( stream -- )
     <win32-socket> |dispose add-completion ;\r
 \r
 : open-socket ( addrspec type -- win32-socket )\r
-    [ protocol-family ] dip\r
-    0 f 0 WSASocket-flags WSASocket\r
+    [ drop protocol-family ] [ swap protocol ] 2bi\r
+    f 0 WSASocket-flags WSASocket\r
     dup socket-error\r
     opened-socket ;\r
 \r
 M: object (get-local-address) ( socket addrspec -- sockaddr )\r
-    [ handle>> ] dip empty-sockaddr/size <int>\r
+    [ handle>> ] dip empty-sockaddr/size int <ref>\r
     [ getsockname socket-error ] 2keep drop ;\r
 \r
 M: object (get-remote-address) ( socket addrspec -- sockaddr )\r
-    [ handle>> ] dip empty-sockaddr/size <int>\r
+    [ handle>> ] dip empty-sockaddr/size int <ref>\r
     [ getpeername socket-error ] 2keep drop ;\r
 \r
 : bind-socket ( win32-socket sockaddr len -- )\r
@@ -71,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
@@ -82,11 +83,13 @@ M: object (server) ( addrspec -- handle )
 M: windows (datagram) ( addrspec -- handle )\r
     [ SOCK_DGRAM server-socket ] with-destructors ;\r
 \r
+M: windows (raw) ( addrspec -- handle )\r
+    [ SOCK_RAW server-socket ] with-destructors ;\r
 \r
 : malloc-int ( n -- alien )\r
-    <int> malloc-byte-array ; inline\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
@@ -96,7 +99,7 @@ M: winnt WSASocket-flags ( -- DWORD )
     { void* }\r
     [\r
         void* heap-size\r
-        DWORD <c-object>\r
+        0 DWORD <ref>\r
         f\r
         f\r
         WSAIoctl SOCKET_ERROR = [\r
@@ -108,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
@@ -178,7 +181,8 @@ TUPLE: AcceptEx-args port
     } cleave AcceptEx drop winsock-error ; inline\r
 \r
 : (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )\r
-    f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;\r
+    f void* <ref> 0 int <ref> f void* <ref>\r
+    [ 0 int <ref> GetAcceptExSockaddrs ] keep void* deref ;\r
 \r
 : extract-remote-address ( AcceptEx -- sockaddr )\r
     [\r
@@ -207,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
@@ -238,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 ]\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
@@ -275,7 +286,7 @@ TUPLE: WSASendTo-args port
         swap make-send-buffer >>lpBuffers\r
         1 >>dwBufferCount\r
         0 >>dwFlags\r
-        0 <uint> >>lpNumberOfBytesSent\r
+        0 uint <ref> >>lpNumberOfBytesSent\r
         (make-overlapped) >>lpOverlapped ; inline\r
 \r
 : call-WSASendTo ( WSASendTo -- )\r
@@ -291,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