Fix sockets on Windows, and re-organize things so that windows.winsock doesn't get...

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index aa113c0efe30cd7c0a71ddd8a71ac8d2a092598f..46d4d28cfc5783555571e2be64ad5ce58d00f99c 100755 (executable)
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -4,7 +4,6 @@ io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
 io.streams.c io.streams.null libc kernel math namespaces sequences
 threads windows windows.errors windows.kernel32 strings splitting
 ascii system accessors locals classes.struct combinators.short-circuit ;
-QUALIFIED: windows.winsock
 IN: io.backend.windows.nt
 
 ! Global variable with assoc mapping overlapped to threads
@@ -79,8 +78,7 @@ M: winnt io-multiplex ( us -- )
 
 M: winnt init-io ( -- )
     <master-completion-port> master-completion-port set-global
-    H{ } clone pending-overlapped set-global
-    windows.winsock:init-winsock ;
+    H{ } clone pending-overlapped set-global ;
 
 ERROR: invalid-file-size n ;
 

diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor
index c7be2229ccefa061e2659e0a4e8c23b77fea2409..940633c70e5dcd151d7c03cd128d2b4b38d4b44c 100755 (executable)
--- a/basis/io/backend/windows/windows.factor
+++ b/basis/io/backend/windows/windows.factor
@@ -3,8 +3,8 @@
 USING: alien alien.c-types arrays destructors io io.backend
 io.buffers io.files io.ports io.binary io.timeouts system
 strings kernel math namespaces sequences windows.errors
-windows.kernel32 windows.shell32 windows.types windows.winsock
-splitting continuations math.bitwise accessors init sets assocs
+windows.kernel32 windows.shell32 windows.types splitting
+continuations math.bitwise accessors init sets assocs
 classes.struct classes ;
 IN: io.backend.windows
 

diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor
old mode 100644 (file)
new mode 100755 (executable)
index a4a3f07..0964cdc
--- a/basis/io/sockets/sockets-tests.factor
+++ b/basis/io/sockets/sockets-tests.factor
@@ -1,7 +1,8 @@
 IN: io.sockets.tests
-USING: io.sockets sequences math tools.test namespaces accessors 
-kernel destructors calendar io.timeouts io.encodings.utf8 io
-concurrency.promises threads io.streams.string ;
+USING: io.sockets io.sockets.private sequences math tools.test
+namespaces accessors kernel destructors calendar io.timeouts
+io.encodings.utf8 io concurrency.promises threads
+io.streams.string ;
 
 [ B{ 1 2 3 4 } ]
 [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
old mode 100644 (file)
new mode 100755 (executable)
index be132b7..601d269
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -39,13 +39,9 @@ GENERIC: inet-pton ( str addrspec -- data )
 
 GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
 
-: sockaddr-of-family ( alien af -- addrspec )
-    {
-        { AF_INET [ sockaddr-in memory>struct ] }
-        { AF_INET6 [ sockaddr-in6 memory>struct ] }
-        { AF_UNIX [ sockaddr-un memory>struct ] }
-        [ 2drop f ]
-    } case ;
+HOOK: sockaddr-of-family os ( alien af -- sockaddr )
+
+HOOK: addrspec-of-family os ( af -- addrspec )
 
 PRIVATE>
 
@@ -223,14 +219,6 @@ HOOK: (receive) io-backend ( datagram -- packet addrspec )
 
 HOOK: (send) io-backend ( packet addrspec datagram -- )
 
-: addrspec-of-family ( af -- addrspec )
-    {
-        { AF_INET [ T{ inet4 } ] }
-        { AF_INET6 [ T{ inet6 } ] }
-        { AF_UNIX [ T{ local } ] }
-        [ drop f ]
-    } case ;
-
 : addrinfo>addrspec ( addrinfo -- addrspec )
     [ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
     [ family>> addrspec-of-family ] bi

diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor
old mode 100644 (file)
new mode 100755 (executable)
index 27abffc..e892c6a
--- a/basis/io/sockets/unix/unix.factor
+++ b/basis/io/sockets/unix/unix.factor
@@ -22,6 +22,22 @@ IN: io.sockets.unix
 M: unix addrinfo-error ( n -- )
     [ gai_strerror throw ] unless-zero ;
 
+M: unix sockaddr-of-family ( alien af -- addrspec )
+    {
+        { AF_INET [ sockaddr-in memory>struct ] }
+        { AF_INET6 [ sockaddr-in6 memory>struct ] }
+        { AF_UNIX [ sockaddr-un memory>struct ] }
+        [ 2drop f ]
+    } case ;
+
+M: unix addrspec-of-family ( af -- addrspec )
+    {
+        { AF_INET [ T{ inet4 } ] }
+        { AF_INET6 [ T{ inet6 } ] }
+        { AF_UNIX [ T{ local } ] }
+        [ drop f ]
+    } case ;
+
 ! Client sockets - TCP and Unix domain
 M: object (get-local-address) ( handle remote -- sockaddr )
     [ handle-fd ] dip empty-sockaddr/size <int>
@@ -100,19 +116,17 @@ CONSTANT: packet-size 65536
 [ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
 
 :: do-receive ( port -- packet sockaddr )
-    port addr>> empty-sockaddr/size [| sockaddr len |
-        port handle>> handle-fd ! s
-        receive-buffer get-global ! buf
-        packet-size ! nbytes
-        0 ! flags
-        sockaddr ! from
-        len <int> ! fromlen
-        recvfrom dup 0 >= [
-            receive-buffer get-global swap memory>byte-array sockaddr
-        ] [
-            drop f f
-        ] if
-    ] call ;
+    port addr>> empty-sockaddr/size :> len :> sockaddr
+    port handle>> handle-fd ! s
+    receive-buffer get-global ! buf
+    packet-size ! nbytes
+    0 ! flags
+    sockaddr ! from
+    len <int> ! fromlen
+    recvfrom dup 0 >=
+    [ receive-buffer get-global swap memory>byte-array sockaddr ]
+    [ drop f f ]
+    if ;
 
 M: unix (receive) ( datagram -- packet sockaddr )
     dup do-receive dup [ [ drop ] 2dip ] [

diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor
index 1bb5e0d10225588fba01d0d95f42c4605800e211..f423a42b6523e940f16669805403cdcf3875b46b 100755 (executable)
--- a/basis/io/sockets/windows/nt/nt.factor
+++ b/basis/io/sockets/windows/nt/nt.factor
@@ -1,13 +1,13 @@
 USING: alien alien.accessors alien.c-types byte-arrays
 continuations destructors io.ports io.timeouts 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
-classes.struct windows.kernel32 ;
+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 ;
 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 ;
@@ -100,17 +100,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 )
     [
@@ -160,7 +163,12 @@ TUPLE: WSARecvFrom-args port
 
 : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
     [ lpBuffers>> buf>> swap memory>byte-array ]
-    [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
+    [
+        [ port>> addr>> empty-sockaddr dup ]
+        [ lpFrom>> ]
+        [ lpFromLen>> *int ]
+        tri memcpy
+    ] bi ; inline
 
 M: winnt (receive) ( datagram -- packet addrspec )
     [

diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor
old mode 100644 (file)
new mode 100755 (executable)
index 2900940..ccf86ca
--- a/basis/io/sockets/windows/windows.factor
+++ b/basis/io/sockets/windows/windows.factor
@@ -1,7 +1,25 @@
-USING: kernel accessors io.sockets io.backend.windows io.backend\r
-windows.winsock system destructors alien.c-types ;\r
+USING: kernel accessors io.sockets io.sockets.private\r
+io.backend.windows io.backend windows.winsock system destructors\r
+alien.c-types classes.struct combinators ;\r
 IN: io.sockets.windows\r
 \r
+M: windows addrinfo-error ( n -- )\r
+    winsock-return-check ;\r
+\r
+M: windows sockaddr-of-family ( alien af -- addrspec )\r
+    {\r
+        { AF_INET [ sockaddr-in memory>struct ] }\r
+        { AF_INET6 [ sockaddr-in6 memory>struct ] }\r
+        [ 2drop f ]\r
+    } case ;\r
+\r
+M: windows addrspec-of-family ( af -- addrspec )\r
+    {\r
+        { AF_INET [ T{ inet4 } ] }\r
+        { AF_INET6 [ T{ inet6 } ] }\r
+        [ drop f ]\r
+    } case ;\r
+\r
 HOOK: WSASocket-flags io-backend ( -- DWORD )\r
 \r
 TUPLE: win32-socket < win32-file ;\r
@@ -13,8 +31,7 @@ M: win32-socket dispose ( stream -- )
     handle>> closesocket drop ;\r
 \r
 : unspecific-sockaddr/size ( addrspec -- sockaddr len )\r
-    [ empty-sockaddr/size ] [ protocol-family ] bi\r
-    pick set-sockaddr-in-family ;\r
+    [ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;\r
 \r
 : opened-socket ( handle -- win32-socket )\r
     <win32-socket> |dispose dup add-completion ;\r
@@ -56,6 +73,3 @@ M: object (server) ( addrspec -- handle )
 \r
 M: windows (datagram) ( addrspec -- handle )\r
     [ SOCK_DGRAM server-socket ] with-destructors ;\r
-\r
-M: windows addrinfo-error ( n -- )\r
-    winsock-return-check ;\r

diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 6b99824cb79190529407b3c3802b354a473cdc3b..87b8970b02d1f40bfcd03c85d5024c8fa3116cb4 100755 (executable)
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -1,15 +1,11 @@
 ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax arrays
-byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors math.bitwise io.encodings.utf16n classes.struct
-literals windows.com.syntax ;
+byte-arrays kernel literals math sequences windows.types
+windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
+classes.struct windows.com.syntax init ;
 IN: windows.winsock
 
-USE: libc
-: alien>byte-array ( alien str -- byte-array )
-    heap-size dup <byte-array> [ -rot memcpy ] keep ;
-
 TYPEDEF: void* SOCKET
 
 : <wsadata> ( -- byte-array )
@@ -30,7 +26,7 @@ CONSTANT: SO_BROADCAST   HEX:  20
 CONSTANT: SO_USELOOPBACK HEX:  40
 CONSTANT: SO_LINGER      HEX:  80
 CONSTANT: SO_OOBINLINE   HEX: 100
-CONSTANT: SO_DONTLINGER $[ SO_LINGER bitnot ]
+: SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
 
 CONSTANT: SO_SNDBUF     HEX: 1001
 CONSTANT: SO_RCVBUF     HEX: 1002
@@ -75,7 +71,9 @@ CONSTANT: PF_INET6      23
 CONSTANT: AI_PASSIVE     1
 CONSTANT: AI_CANONNAME   2
 CONSTANT: AI_NUMERICHOST 4
-CONSTANT: AI_MASK $[ { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ]
+
+: AI_MASK ( -- n )
+    { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
 
 CONSTANT: NI_NUMERICHOST 1
 CONSTANT: NI_NUMERICSERV 2
@@ -96,7 +94,8 @@ ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
 
 CONSTANT: INADDR_ANY 0
 
-CONSTANT: INVALID_SOCKET $[ -1 <alien> ]
+: INVALID_SOCKET ( -- n ) -1 <alien> ; inline
+
 CONSTANT: SOCKET_ERROR -1
 
 CONSTANT: SD_RECV 0
@@ -105,10 +104,6 @@ CONSTANT: SD_BOTH 2
 
 CONSTANT: SOL_SOCKET HEX: ffff
 
-! TYPEDEF: uint in_addr_t
-! C-STRUCT: in_addr
-    ! { "in_addr_t" "s_addr" } ;
-
 STRUCT: sockaddr-in
     { family short }
     { port ushort }
@@ -379,7 +374,17 @@ LIBRARY: mswsock
 
 ! Not in Windows CE
 FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
-FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, void* f, void* g, void* h ) ;
+
+FUNCTION: void GetAcceptExSockaddrs (
+  PVOID lpOutputBuffer,
+  DWORD dwReceiveDataLength,
+  DWORD dwLocalAddressLength,
+  DWORD dwRemoteAddressLength,
+  LPSOCKADDR* LocalSockaddr,
+  LPINT LocalSockaddrLength,
+  LPSOCKADDR* RemoteSockaddr,
+  LPINT RemoteSockaddrLength
+) ;
 
 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 
@@ -431,3 +436,5 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 
 : init-winsock ( -- )
     HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
+
+[ init-winsock ] "windows.winsock" add-init-hook