Updating code to use with-out-parameters

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

diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor
index 49a1b2ae632491bad17de851abf6a25b5eefcd5e..17e92b9b9fd91b0d0c0cfa10bedfc850b8936af4 100644 (file)
--- a/basis/io/sockets/windows/nt/nt.factor
+++ b/basis/io/sockets/windows/nt/nt.factor
@@ -1,12 +1,14 @@
-USING: alien alien.accessors alien.c-types byte-arrays
+USING: alien alien.accessors alien.c-types alien.data byte-arrays
 continuations destructors io.ports io.timeouts io.sockets
-io.sockets io namespaces io.streams.duplex io.backend.windows
-io.sockets.windows io.backend.windows.nt windows.winsock kernel
-libc math sequences threads system combinators accessors ;
+io.sockets.private io namespaces io.streams.duplex
+io.backend.windows io.sockets.windows io.backend.windows.nt
+windows.winsock kernel libc math sequences threads system
+combinators accessors classes.struct windows.kernel32
+windows.types ;
 IN: io.sockets.windows.nt
 
-: malloc-int ( object -- object )
-    "int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline
+: malloc-int ( n -- alien )
+    <int> malloc-byte-array ; inline
 
 M: winnt WSASocket-flags ( -- DWORD )
     WSA_FLAG_OVERLAPPED ;
@@ -14,17 +16,17 @@ M: winnt WSASocket-flags ( -- DWORD )
 : get-ConnectEx-ptr ( socket -- void* )
     SIO_GET_EXTENSION_FUNCTION_POINTER
     WSAID_CONNECTEX
-    "GUID" heap-size
-    "void*" <c-object>
+    GUID heap-size
+    { void* }
     [
-        "void*" heap-size
-        "DWORD" <c-object>
+        void* heap-size
+        DWORD <c-object>
         f
         f
         WSAIoctl SOCKET_ERROR = [
             winsock-error-string throw
         ] when
-    ] keep *void* ;
+    ] [ ] with-out-parameters ;
 
 TUPLE: ConnectEx-args port
     s name namelen lpSendBuffer dwSendDataLength
@@ -53,9 +55,9 @@ TUPLE: ConnectEx-args port
         [ lpOverlapped>> ]
         [ ptr>> ]
     } cleave
-    "int"
-    { "SOCKET" "sockaddr_in*" "int" "PVOID" "DWORD" "LPDWORD" "void*" }
-    "stdcall" alien-indirect drop
+    int
+    { SOCKET void* int PVOID DWORD LPDWORD void* }
+    stdcall alien-indirect drop
     winsock-error-string [ throw ] when* ; inline
 
 M: object establish-connection ( client-out remote -- )
@@ -99,17 +101,20 @@ TUPLE: AcceptEx-args port
     } cleave AcceptEx drop
     winsock-error-string [ throw ] when* ; inline
 
+: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
+    f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
+
 : extract-remote-address ( AcceptEx -- sockaddr )
-    {
-        [ lpOutputBuffer>> ]
-        [ dwReceiveDataLength>> ]
-        [ dwLocalAddressLength>> ]
-        [ dwRemoteAddressLength>> ]
-    } cleave
-    f <void*>
-    0 <int>
-    f <void*>
-    [ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline
+    [
+        {
+            [ lpOutputBuffer>> ]
+            [ dwReceiveDataLength>> ]
+            [ dwLocalAddressLength>> ]
+            [ dwRemoteAddressLength>> ]
+        } cleave
+        (extract-remote-address)
+    ] [ port>> addr>> protocol-family ] bi
+    sockaddr-of-family ; inline
 
 M: object (accept) ( server addr -- handle sockaddr )
     [
@@ -127,9 +132,9 @@ TUPLE: WSARecvFrom-args port
        lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
 
 : make-receive-buffer ( -- WSABUF )
-    "WSABUF" malloc-object &free
-    default-buffer-size get over set-WSABUF-len
-    default-buffer-size get malloc &free over set-WSABUF-buf ; inline
+    WSABUF malloc-struct &free
+        default-buffer-size get
+        [ >>len ] [ malloc &free >>buf ] bi ; inline
 
 : <WSARecvFrom-args> ( datagram -- WSARecvFrom )
     WSARecvFrom-args new
@@ -158,8 +163,13 @@ TUPLE: WSARecvFrom-args port
     } cleave WSARecvFrom socket-error* ; inline
 
 : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
-    [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
-    [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
+    [ lpBuffers>> buf>> swap memory>byte-array ]
+    [
+        [ port>> addr>> empty-sockaddr dup ]
+        [ lpFrom>> ]
+        [ lpFromLen>> *int ]
+        tri memcpy
+    ] bi ; inline
 
 M: winnt (receive) ( datagram -- packet addrspec )
     [
@@ -175,11 +185,9 @@ TUPLE: WSASendTo-args port
        dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
 
 : make-send-buffer ( packet -- WSABUF )
-    "WSABUF" malloc-object &free
-    [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
-    [ [ length ] dip set-WSABUF-len ]
-    [ nip ]
-    2tri ; inline
+    [ WSABUF malloc-struct &free ] dip
+        [ malloc-byte-array &free >>buf ]
+        [ length >>len ] bi ; inline
 
 : <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
     WSASendTo-args new