Major I/O cleanup

extra/io/files/unique/unique-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io io.nonblocking kernel math
+USING: help.markup help.syntax io io.ports kernel math
 io.files.unique.private math.parser io.files ;
 IN: io.files.unique
 

extra/io/launcher/launcher.factor

@@ -4,7 +4,7 @@ USING: system kernel namespaces strings hashtables sequences
 assocs combinators vocabs.loader init threads continuations
 math accessors concurrency.flags destructors
 io io.backend io.timeouts io.pipes io.pipes.private io.encodings
-io.streams.duplex io.nonblocking ;
+io.streams.duplex io.ports ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple

extra/io/pipes/pipes-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.pipes io.streams.string io.encodings.utf8
-io.streams.duplex io.encodings namespaces continuations
+io.streams.duplex io.encodings io.timeouts namespaces
-tools.test kernel ;
+continuations tools.test kernel calendar ;
 IN: io.pipes.tests
 
 [ "Hello" ] [
@@ -24,3 +24,10 @@ IN: io.pipes.tests
         [ input-stream [ utf8 <decoder> ] change readln ]
     } run-pipeline
 ] unit-test
+
+[
+    utf8 <pipe> [
+        5 seconds over set-timeout
+        stream-readln
+    ] with-disposal
+] must-fail

extra/io/pipes/pipes.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.encodings io.backend io.nonblocking io.streams.duplex
+USING: io.encodings io.backend io.ports io.streams.duplex
 io splitting sequences sequences.lib namespaces kernel
 destructors math concurrency.combinators accessors
 arrays continuations quotations ;

extra/io/ports/ports-docs.factor

@@ -1,9 +1,9 @@
 USING: io io.buffers io.backend help.markup help.syntax kernel
 byte-arrays sbufs words continuations byte-vectors classes ;
-IN: io.nonblocking
+IN: io.ports
 
-ARTICLE: "io.nonblocking" "Non-blocking I/O implementation"
+ARTICLE: "io.ports" "Non-blocking I/O implementation"
-"On Windows and Unix, Factor implements blocking file and network streams on top of a non-blocking I/O substrate, ensuring that Factor threads will yield when performing I/O. This substrate is implemented in the " { $vocab-link "io.nonblocking" } " vocabulary."
+"On Windows and Unix, Factor implements blocking file and network streams on top of a non-blocking I/O substrate, ensuring that Factor threads will yield when performing I/O. This substrate is implemented in the " { $vocab-link "io.ports" } " vocabulary."
 $nl
 "A " { $emphasis "port" } " is a stream using non-blocking I/O substrate:"
 { $subsection port }
@@ -29,7 +29,7 @@ $nl
 { $subsection server-port }
 { $subsection datagram-port } ;
 
-ABOUT: "io.nonblocking"
+ABOUT: "io.ports"
 
 HELP: port
 { $class-description "Instances of this class present a blocking stream interface on top of an underlying non-blocking I/O system, giving the illusion of blocking by yielding the thread which is waiting for input or output."
@@ -81,10 +81,6 @@ HELP: (wait-to-read)
 { $contract "Suspends the current thread until the port's buffer has data available for reading." } ;
 
 HELP: wait-to-read
-{ $values { "count" "a non-negative integer" } { "port" input-port } }
-{ $description "If the port's buffer has at least " { $snippet "count" } " unread bytes, returns immediately, otherwise suspends the current thread until some data is available for reading." } ;
-
-HELP: wait-to-read1
 { $values { "port" input-port } }
 { $description "If the port's buffer has unread data, returns immediately, otherwise suspends the current thread until some data is available for reading." } ;
 

extra/io/ports/ports.factor

@@ -5,12 +5,12 @@ byte-vectors system io.encodings math.order io.backend
 continuations debugger classes byte-arrays namespaces splitting
 dlists assocs io.encodings.binary inspector accessors
 destructors ;
-IN: io.nonblocking
+IN: io.ports
 
 SYMBOL: default-buffer-size
 64 1024 * default-buffer-size set-global
 
-TUPLE: port handle buffer error timeout closed eof ;
+TUPLE: port handle error timeout closed ;
 
 M: port timeout timeout>> ;
 
@@ -37,26 +37,6 @@ M: handle-destructor dispose ( obj -- )
     new
         swap dup init-handle >>handle ; inline
 
-: <buffered-port> ( handle class -- port )
-    <port>
-        default-buffer-size get <buffer> >>buffer ; inline
-
-TUPLE: input-port < port ;
-
-: <input-port> ( handle -- input-port )
-    input-port <buffered-port> ;
-
-TUPLE: output-port < port ;
-
-: <output-port> ( handle -- output-port )
-    output-port <buffered-port> ;
-
-: <ports> ( read-handle write-handle -- input-port output-port )
-    [
-        [ <input-port> dup add-error-destructor ]
-        [ <output-port> dup add-error-destructor ] bi*
-    ] with-destructors ;
-
 : pending-error ( port -- )
     [ f ] change-error drop [ throw ] when* ;
 
@@ -68,19 +48,21 @@ M: port-closed-error summary
 : check-closed ( port -- port )
     dup closed>> [ port-closed-error ] when ;
 
-HOOK: cancel-io io-backend ( port -- )
+TUPLE: buffered-port < port buffer ;
 
-M: object cancel-io drop ;
+: <buffered-port> ( handle class -- port )
+    <port>
+        default-buffer-size get <buffer> >>buffer ; inline
 
-M: port timed-out cancel-io ;
+TUPLE: input-port < buffered-port eof ;
+
+: <input-port> ( handle -- input-port )
+    input-port <buffered-port> ;
 
 HOOK: (wait-to-read) io-backend ( port -- )
 
-: wait-to-read ( count port -- )
+: wait-to-read ( port -- )
-    tuck buffer>> buffer-length > [ (wait-to-read) ] [ drop ] if ;
+    dup buffer>> buffer-empty? [ (wait-to-read) ] [ drop ] if ;
-
-: wait-to-read1 ( port -- )
-    1 swap wait-to-read ;
 
 : unless-eof ( port quot -- value )
     >r dup buffer>> buffer-empty? over eof>> and
@@ -88,12 +70,16 @@ HOOK: (wait-to-read) io-backend ( port -- )
 
 M: input-port stream-read1
     check-closed
-    dup wait-to-read1 [ buffer>> buffer-pop ] unless-eof ;
+    dup wait-to-read [ buffer>> buffer-pop ] unless-eof ;
 
 : read-step ( count port -- byte-array/f )
-    [ wait-to-read ] 2keep
+    [ wait-to-read ] keep
     [ dupd buffer>> buffer-read ] unless-eof nip ;
 
+M: input-port stream-read-partial ( max stream -- byte-array/f )
+    check-closed
+    >r 0 max >integer r> read-step ;
+
 : read-loop ( count port accum -- )
     pick over length - dup 0 > [
         pick read-step dup [
@@ -117,9 +103,10 @@ M: input-port stream-read
         ] [ 2nip ] if
     ] [ 2nip ] if ;
 
-M: input-port stream-read-partial ( max stream -- byte-array/f )
+TUPLE: output-port < buffered-port ;
-    check-closed
+
-    >r 0 max >fixnum r> read-step ;
+: <output-port> ( handle -- output-port )
+    output-port <buffered-port> ;
 
 : can-write? ( len buffer -- ? )
     [ buffer-fill + ] keep buffer-capacity <= ;
@@ -143,7 +130,10 @@ M: output-port stream-write
         [ buffer>> >buffer ] 2bi
     ] if ;
 
-HOOK: flush-port io-backend ( port -- )
+HOOK: (wait-to-write) io-backend ( port -- )
+
+: flush-port ( port -- )
+    dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
 M: output-port stream-flush ( port -- )
     check-closed
@@ -154,35 +144,23 @@ GENERIC: close-port ( port -- )
 M: output-port close-port
     [ flush-port ] [ call-next-method ] bi ;
 
+M: buffered-port close-port
+    [ call-next-method ]
+    [ [ [ buffer-free ] when* f ] change-buffer drop ]
+    bi ;
+
+HOOK: cancel-io io-backend ( port -- )
+
+M: port timed-out cancel-io ;
+
 M: port close-port
-    dup cancel-io
+    [ cancel-io ] [ handle>> close-handle ] bi ;
-    dup handle>> close-handle
-    [ [ buffer-free ] when* f ] change-buffer drop ;
 
 M: port dispose
     dup closed>> [ drop ] [ t >>closed close-port ] if ;
 
-TUPLE: server-port < port addr client client-addr encoding ;
+: <ports> ( read-handle write-handle -- input-port output-port )
-
+    [
-: <server-port> ( handle addr encoding -- server )
+        [ <input-port> dup add-error-destructor ]
-    rot server-port <port>
+        [ <output-port> dup add-error-destructor ] bi*
-        swap >>encoding
+    ] with-destructors ;
-        swap >>addr ;
-
-: check-server-port ( port -- port )
-    dup server-port? [ "Not a server port" throw ] unless ; inline
-
-TUPLE: datagram-port < port addr packet packet-addr ;
-
-: <datagram-port> ( handle addr -- datagram )
-    swap datagram-port <port>
-        swap >>addr ;
-
-: check-datagram-port ( port -- port )
-    check-closed
-    dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
-
-: check-datagram-send ( packet addrspec port -- packet addrspec port )
-    check-datagram-port
-    2dup addr>> [ class ] bi@ assert=
-    pick class byte-array assert= ;

extra/io/server/server-tests.factor

@@ -2,3 +2,4 @@ IN: io.server.tests
 USING: tools.test io.server io.server.private ;
 
 { 2 0 } [ [ ] server-loop ] must-infer-as
+{ 2 0 } [ [ ] with-connection ] must-infer-as

extra/io/server/server.factor

@@ -12,17 +12,19 @@ SYMBOL: servers
 
 LOG: accepted-connection NOTICE
 
-: with-client ( client addrspec quot -- )
+SYMBOL: remote-address
-    [
-        swap accepted-connection
-        with-stream*
-    ] 2curry with-disposal ; inline
 
-\ with-client DEBUG add-error-logging
+: with-connection ( client addrspec quot -- )
+    [
+        >r [ remote-address set ] [ accepted-connection ] bi
+        r> call
+    ] 2curry with-stream ; inline
+
+\ with-connection DEBUG add-error-logging
 
 : accept-loop ( server quot -- )
     [
-        >r accept r> [ with-client ] 3curry "Client" spawn drop
+        >r accept r> [ with-connection ] 3curry "Client" spawn drop
     ] 2keep accept-loop ; inline
 
 : server-loop ( addrspec encoding quot -- )

extra/io/sockets/headers/headers.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax byte-arrays io
-io.sockets.impl kernel structs math math.parser
+io.sockets kernel structs math math.parser
 prettyprint sequences ;
 IN: io.sockets.headers
 

extra/io/sockets/impl/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

extra/io/sockets/impl/impl-tests.factor

@@ -1,45 +0,0 @@
-USING: io.sockets.impl io.sockets kernel tools.test ;
-IN: io.sockets.impl.tests
-
-[ B{ 1 2 3 4 } ]
-[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
-
-[ "1.2.3.4" ]
-[ B{ 1 2 3 4 } T{ inet4 } inet-ntop ] unit-test
-
-[ "255.255.255.255" ]
-[ B{ 255 255 255 255 } T{ inet4 } inet-ntop ] unit-test
-
-[ B{ 255 255 255 255 } ]
-[ "255.255.255.255" T{ inet4 } inet-pton ] unit-test
-
-[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } ]
-[ "1:2:3:4:5:6:7:8" T{ inet6 } inet-pton ] unit-test
-
-[ "1:2:3:4:5:6:7:8" ]
-[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } T{ inet6 } inet-ntop ] unit-test
-
-[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
-[ "::" T{ inet6 } inet-pton ] unit-test
-
-[ "0:0:0:0:0:0:0:0" ]
-[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test
-
-[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
-[ "1::" T{ inet6 } inet-pton ] unit-test
-
-[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ]
-[ "::1" T{ inet6 } inet-pton ] unit-test
-
-[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ]
-[ "1::2" T{ inet6 } inet-pton ] unit-test
-
-[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 3 } ]
-[ "1::2:3" T{ inet6 } inet-pton ] unit-test
-
-[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } ]
-[ "1:2::3:4" T{ inet6 } inet-pton ] unit-test
-
-[ "1:2:0:0:0:0:3:4" ]
-[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
-

extra/io/sockets/impl/impl.factor

@@ -1,134 +0,0 @@
-! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays io.backend io.binary io.sockets
-io.encodings.ascii kernel math math.parser sequences splitting
-system alien.c-types alien.strings alien combinators namespaces
-parser ;
-IN: io.sockets.impl
-
-<< {
-    { [ os windows? ] [ "windows.winsock" ] }
-    { [ os unix? ] [ "unix" ] }
-} cond use+ >>
-
-GENERIC: protocol-family ( addrspec -- af )
-
-GENERIC: sockaddr-type ( addrspec -- type )
-
-GENERIC: make-sockaddr ( addrspec -- sockaddr )
-
-: make-sockaddr/size ( addrspec -- sockaddr size )
-    dup make-sockaddr swap sockaddr-type heap-size ;
-
-GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
-
-HOOK: addrinfo-error io-backend ( n -- )
-
-! IPV4 and IPV6
-GENERIC: address-size ( addrspec -- n )
-
-GENERIC: inet-ntop ( data addrspec -- str )
-
-GENERIC: inet-pton ( str addrspec -- data )
-
-
-M: inet4 inet-ntop ( data addrspec -- str )
-    drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
-
-M: inet4 inet-pton ( str addrspec -- data )
-    drop "." split [ string>number ] B{ } map-as ;
-
-M: inet4 address-size drop 4 ;
-
-M: inet4 protocol-family drop PF_INET ;
-
-M: inet4 sockaddr-type drop "sockaddr-in" c-type ;
-
-M: inet4 make-sockaddr ( inet -- sockaddr )
-    "sockaddr-in" <c-object>
-    AF_INET over set-sockaddr-in-family
-    over inet4-port htons over set-sockaddr-in-port
-    over inet4-host
-    "0.0.0.0" or
-    rot inet-pton *uint over set-sockaddr-in-addr ;
-
-SYMBOL: port-override
-
-: (port) port-override get swap or ;
-
-M: inet4 parse-sockaddr
-    >r dup sockaddr-in-addr <uint> r> inet-ntop
-    swap sockaddr-in-port ntohs (port) <inet4> ;
-
-M: inet6 inet-ntop ( data addrspec -- str )
-    drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
-
-M: inet6 inet-pton ( str addrspec -- data )
-    drop "::" split1
-    [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] bi@
-    2dup [ length ] bi@ + 8 swap - 0 <array> swap 3append
-    [ 2 >be ] map concat >byte-array ;
-
-M: inet6 address-size drop 16 ;
-
-M: inet6 protocol-family drop PF_INET6 ;
-
-M: inet6 sockaddr-type drop "sockaddr-in6" c-type ;
-
-M: inet6 make-sockaddr ( inet -- sockaddr )
-    "sockaddr-in6" <c-object>
-    AF_INET6 over set-sockaddr-in6-family
-    over inet6-port htons over set-sockaddr-in6-port
-    over inet6-host "::" or
-    rot inet-pton over set-sockaddr-in6-addr ;
-
-M: inet6 parse-sockaddr
-    >r dup sockaddr-in6-addr r> inet-ntop
-    swap sockaddr-in6-port ntohs (port) <inet6> ;
-
-: addrspec-of-family ( af -- addrspec )
-    {
-        { [ dup AF_INET = ] [ T{ inet4 } ] }
-        { [ dup AF_INET6 = ] [ T{ inet6 } ] }
-        { [ dup AF_UNIX = ] [ T{ local } ] }
-        [ f ]
-    } cond nip ;
-
-M: f parse-sockaddr nip ;
-
-: addrinfo>addrspec ( addrinfo -- addrspec )
-    [ addrinfo-addr ] [ addrinfo-family addrspec-of-family ] bi
-    parse-sockaddr ;
-
-: parse-addrinfo-list ( addrinfo -- seq )
-    [ addrinfo-next ] follow
-    [ addrinfo>addrspec ] map
-    [ ] filter ;
-
-: prepare-resolve-host ( host serv passive? -- host' serv' flags )
-    #! If the port is a number, we resolve for 'http' then
-    #! change it later. This is a workaround for a FreeBSD
-    #! getaddrinfo() limitation -- on Windows, Linux and Mac,
-    #! we can convert a number to a string and pass that as the
-    #! service name, but on FreeBSD this gives us an unknown
-    #! service error.
-    >r
-    dup integer? [ port-override set "http" ] when
-    r> AI_PASSIVE 0 ? ;
-
-M: object resolve-host ( host serv passive? -- seq )
-    [
-        prepare-resolve-host
-        "addrinfo" <c-object>
-        [ set-addrinfo-flags ] keep
-        PF_UNSPEC over set-addrinfo-family
-        IPPROTO_TCP over set-addrinfo-protocol
-        f <void*> [ getaddrinfo addrinfo-error ] keep *void*
-        [ parse-addrinfo-list ] keep
-        freeaddrinfo
-    ] with-scope ;
-
-M: object host-name ( -- name )
-    256 <byte-array> dup dup length gethostname
-    zero? [ "gethostname failed" throw ] unless
-    ascii alien>string ;

extra/io/sockets/sockets-docs.factor

@@ -64,7 +64,7 @@ HELP: local
 } ;
 
 HELP: inet
-{ $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet-host } " and " { $link inet-port } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link <inet> } "." }
+{ $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link <inet> } "." }
 { $notes
     "This address specifier is only supported by " { $link <client> } ", which calls " { $link resolve-host }  " to obtain a list of IP addresses associated with the host name, and attempts a connection to each one in turn until one succeeds. Other network words do not accept this address specifier, and " { $link resolve-host } " must be called directly; it is then up to the application to pick the correct address from the (possibly several) addresses associated to the host name."
 }
@@ -74,7 +74,7 @@ HELP: inet
 } ;
 
 HELP: inet4
-{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet4-host } " and " { $link inet4-port } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link <inet4> } "." }
+{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link <inet4> } "." }
 { $notes
 "New instances should not be created directly; instead, use " { $link resolve-host } " to look up the address associated to a host name. Also, try to support IPv6 where possible."
 }
@@ -83,7 +83,7 @@ HELP: inet4
 } ;
 
 HELP: inet6
-{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $link inet6-host } " and " { $link inet6-port } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link <inet6> } "." }
+{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link <inet6> } "." }
 { $notes
 "New instances should not be created directly; instead, use " { $link resolve-host } " to look up the address associated to a host name." }
 { $examples
@@ -91,13 +91,19 @@ HELP: inet6
 } ;
 
 HELP: <client>
-{ $values { "addrspec" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } }
+{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } }
-{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding." }
+{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding, together with the local address the socket was bound to." }
 { $errors "Throws an error if the connection cannot be established." }
+{ $notes "The " { $link with-client } " word is easier to use in most situations." }
 { $examples
     { $code "\"www.apple.com\" \"http\" <inet> utf8 <client>" }
 } ;
 
+HELP: with-client
+{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "quot" quotation } }
+{ $description "Opens a network connection and calls the quotation in a new dynamic scope with " { $link input-stream } " and " { $link output-stream } " rebound to the network streams. The local address the socket is bound to is stored in the " { $link local-address } " variable." }
+{ $errors "Throws an error if the connection cannot be established." } ;
+
 HELP: <server>
 { $values  { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } }
 { $description
@@ -113,6 +119,13 @@ HELP: <server>
     "To start a server which listens for connections from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:"
     { $code "\"localhost\" 1234 t resolve-host" }
     "Since " { $link resolve-host } " can return multiple address specifiers, your server code must listen on them all to work properly. The " { $vocab-link "io.server" } " vocabulary can be used to help with this."
+    $nl
+    "To start a TCP/IP server which listens for connections on a randomly-assigned port, set the port number in the address specifier to 0, and then read the " { $snippet "addr" } " slot of the server instance to obtain the actual port number it is listening on:"
+    { $unchecked-example
+        "f 0 <inet4> ascii <server>"
+        "[ addr>> . ] [ dispose ] bi"
+        "T{ inet4 f \"0.0.0.0\" 58901 }"
+    }
 }
 { $errors "Throws an error if the address is already in use, or if it if the system forbids access." } ;
 

extra/io/sockets/sockets-tests.factor

@@ -1,4 +1,46 @@
 IN: io.sockets.tests
 USING: io.sockets sequences math tools.test ;
 
+[ B{ 1 2 3 4 } ]
+[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
+
+[ "1.2.3.4" ]
+[ B{ 1 2 3 4 } T{ inet4 } inet-ntop ] unit-test
+
+[ "255.255.255.255" ]
+[ B{ 255 255 255 255 } T{ inet4 } inet-ntop ] unit-test
+
+[ B{ 255 255 255 255 } ]
+[ "255.255.255.255" T{ inet4 } inet-pton ] unit-test
+
+[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } ]
+[ "1:2:3:4:5:6:7:8" T{ inet6 } inet-pton ] unit-test
+
+[ "1:2:3:4:5:6:7:8" ]
+[ B{ 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 } T{ inet6 } inet-ntop ] unit-test
+
+[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
+[ "::" T{ inet6 } inet-pton ] unit-test
+
+[ "0:0:0:0:0:0:0:0" ]
+[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test
+
+[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
+[ "1::" T{ inet6 } inet-pton ] unit-test
+
+[ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } ]
+[ "::1" T{ inet6 } inet-pton ] unit-test
+
+[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 2 } ]
+[ "1::2" T{ inet6 } inet-pton ] unit-test
+
+[ B{ 0 1 0 0 0 0 0 0 0 0 0 0 0 2 0 3 } ]
+[ "1::2:3" T{ inet6 } inet-pton ] unit-test
+
+[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } ]
+[ "1:2::3:4" T{ inet6 } inet-pton ] unit-test
+
+[ "1:2:0:0:0:0:3:4" ]
+[ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
+
 [ t ] [ "localhost" 80 f resolve-host length 1 >= ] unit-test

extra/io/sockets/sockets.factor

@@ -1,10 +1,39 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman,
+! Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: generic kernel io.backend namespaces continuations
-sequences arrays io.encodings io.nonblocking io.streams.duplex
+sequences arrays io.encodings io.ports io.streams.duplex
-accessors destructors ;
+io.encodings.ascii alien.strings io.binary accessors destructors
+classes debugger byte-arrays system combinators parser
+alien.c-types math.parser splitting math assocs inspector ;
 IN: io.sockets
 
+<< {
+    { [ os windows? ] [ "windows.winsock" ] }
+    { [ os unix? ] [ "unix" ] }
+} cond use+ >>
+
+! Addressing
+GENERIC: protocol-family ( addrspec -- af )
+
+GENERIC: sockaddr-type ( addrspec -- type )
+
+GENERIC: make-sockaddr ( addrspec -- sockaddr )
+
+GENERIC: address-size ( addrspec -- n )
+
+GENERIC: inet-ntop ( data addrspec -- str )
+
+GENERIC: inet-pton ( str addrspec -- data )
+
+: make-sockaddr/size ( addrspec -- sockaddr size )
+    dup make-sockaddr swap sockaddr-type heap-size ;
+
+: empty-sockaddr/size ( addrspec -- sockaddr len )
+    sockaddr-type [ <c-object> ] [ heap-size <int> ] bi ;
+
+GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
+
 TUPLE: local path ;
 
 : <local> ( path -- addrspec )
@@ -14,59 +43,248 @@ TUPLE: inet4 host port ;
 
 C: <inet4> inet4
 
+M: inet4 inet-ntop ( data addrspec -- str )
+    drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
+
+ERROR: invalid-inet4 string reason ;
+
+M: invalid-inet4 summary drop "Invalid IPv4 address" ;
+
+M: inet4 inet-pton ( str addrspec -- data )
+    drop
+    [
+        "." split dup length 4 = [
+            "Must have four components" throw
+        ] unless
+        [
+            string>number
+            [ "Dotted component not a number" throw ] unless*
+        ] B{ } map-as
+    ] [ invalid-inet4 ] recover ;
+
+M: inet4 address-size drop 4 ;
+
+M: inet4 protocol-family drop PF_INET ;
+
+M: inet4 sockaddr-type drop "sockaddr-in" c-type ;
+
+M: inet4 make-sockaddr ( inet -- sockaddr )
+    "sockaddr-in" <c-object>
+    AF_INET over set-sockaddr-in-family
+    over inet4-port htons over set-sockaddr-in-port
+    over inet4-host
+    "0.0.0.0" or
+    rot inet-pton *uint over set-sockaddr-in-addr ;
+
+<PRIVATE
+
+SYMBOL: port-override
+
+: (port) port-override get swap or ;
+
+PRIVATE>
+
+M: inet4 parse-sockaddr
+    >r dup sockaddr-in-addr <uint> r> inet-ntop
+    swap sockaddr-in-port ntohs (port) <inet4> ;
+
 TUPLE: inet6 host port ;
 
 C: <inet6> inet6
 
+M: inet6 inet-ntop ( data addrspec -- str )
+    drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
+
+ERROR: invalid-inet6 string reason ;
+
+M: invalid-inet6 summary drop "Invalid IPv6 address" ;
+
+<PRIVATE
+
+: parse-inet6 ( string -- seq )
+    dup empty? [ drop f ] [
+        ":" split [
+            hex> [ "Component not a number" throw ] unless*
+        ] B{ } map-as
+    ] if ;
+
+: pad-inet6 ( string1 string2 -- seq )
+    2dup [ length ] bi@ + 8 swap -
+    dup 0 < [ "More than 8 components" throw ] when
+    <byte-array> swap 3append ;
+
+: inet6-bytes ( seq -- bytes )
+    [ 2 >be ] { } map-as concat >byte-array ;
+
+PRIVATE>
+
+M: inet6 inet-pton ( str addrspec -- data )
+    drop
+    [
+        "::" split1 [ parse-inet6 ] bi@ pad-inet6 inet6-bytes
+    ] [ invalid-inet6 ] recover ;
+
+M: inet6 address-size drop 16 ;
+
+M: inet6 protocol-family drop PF_INET6 ;
+
+M: inet6 sockaddr-type drop "sockaddr-in6" c-type ;
+
+M: inet6 make-sockaddr ( inet -- sockaddr )
+    "sockaddr-in6" <c-object>
+    AF_INET6 over set-sockaddr-in6-family
+    over inet6-port htons over set-sockaddr-in6-port
+    over inet6-host "::" or
+    rot inet-pton over set-sockaddr-in6-addr ;
+
+M: inet6 parse-sockaddr
+    >r dup sockaddr-in6-addr r> inet-ntop
+    swap sockaddr-in6-port ntohs (port) <inet6> ;
+
+: addrspec-of-family ( af -- addrspec )
+    {
+        { AF_INET [ T{ inet4 } ] }
+        { AF_INET6 [ T{ inet6 } ] }
+        { AF_UNIX [ T{ local } ] }
+        [ drop f ]
+    } case ;
+
+M: f parse-sockaddr nip ;
+
+GENERIC# (wait-to-connect) 1 ( client-out handle remote -- sockaddr )
+
+: wait-to-connect ( client-out handle remote -- local )
+    [ (wait-to-connect) ] keep parse-sockaddr ;
+
+GENERIC: ((client)) ( remote -- handle )
+
+GENERIC: (client) ( remote -- client-in client-out local )
+
+M: array (client) [ (client) 3array ] attempt-all first3 ;
+
+M: object (client) ( remote -- client-in client-out local )
+    [
+        [
+            ((client))
+            dup <ports>
+            2dup [ add-error-destructor ] bi@
+            dup dup handle>>
+        ] keep wait-to-connect
+    ] with-destructors ;
+
+: <client> ( remote encoding -- stream local )
+    >r (client) -rot r> <encoder-duplex> swap ;
+
+SYMBOL: local-address
+
+: with-client ( addrspec encoding quot -- )
+    >r <client> [ local-address set ] curry
+    r> compose with-stream ; inline
+
+TUPLE: server-port < port addr encoding ;
+
+: check-server-port ( port -- port )
+    check-closed
+    dup server-port? [ "Not a server port" throw ] unless ; inline
+
+GENERIC: (server) ( addrspec -- handle sockaddr )
+
+: <server> ( addrspec encoding -- server )
+    >r [ (server) ] keep parse-sockaddr
+    swap server-port <port>
+        swap >>addr
+        r> >>encoding ;
+
+HOOK: (accept) io-backend ( server -- handle sockaddr )
+
+: accept ( server -- client addrspec )
+    check-server-port
+    [ (accept) ] keep
+    tuck
+    [ [ dup <ports> ] [ encoding>> ] bi* <encoder-duplex> ]
+    [ addr>> parse-sockaddr ]
+    2bi* ;
+
+TUPLE: datagram-port < port addr ;
+
+HOOK: (datagram) io-backend ( addr -- datagram )
+
+: <datagram> ( addr -- datagram )
+    dup (datagram) datagram-port <port> swap >>addr ;
+
+: check-datagram-port ( port -- port )
+    check-closed
+    dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
+
+HOOK: (receive) io-backend ( datagram -- packet addrspec )
+
+: receive ( datagram -- packet sockaddr )
+    check-datagram-port
+    [ (receive) ] [ addr>> ] bi parse-sockaddr ;
+
+: check-datagram-send ( packet addrspec port -- packet addrspec port )
+    check-datagram-port
+    2dup addr>> [ class ] bi@ assert=
+    pick class byte-array assert= ;
+
+HOOK: (send) io-backend ( packet addrspec datagram -- )
+
+: send ( packet addrspec datagram -- )
+    check-datagram-send (send) ;
+
+: addrinfo>addrspec ( addrinfo -- addrspec )
+    [ addrinfo-addr ] [ addrinfo-family addrspec-of-family ] bi
+    parse-sockaddr ;
+
+: parse-addrinfo-list ( addrinfo -- seq )
+    [ addrinfo-next ] follow
+    [ addrinfo>addrspec ] map
+    [ ] filter ;
+
+: prepare-resolve-host ( host serv passive? -- host' serv' flags )
+    #! If the port is a number, we resolve for 'http' then
+    #! change it later. This is a workaround for a FreeBSD
+    #! getaddrinfo() limitation -- on Windows, Linux and Mac,
+    #! we can convert a number to a string and pass that as the
+    #! service name, but on FreeBSD this gives us an unknown
+    #! service error.
+    >r
+    dup integer? [ port-override set "http" ] when
+    r> AI_PASSIVE 0 ? ;
+
+HOOK: addrinfo-error io-backend ( n -- )
+
+: resolve-host ( host serv passive? -- seq )
+    [
+        prepare-resolve-host
+        "addrinfo" <c-object>
+        [ set-addrinfo-flags ] keep
+        PF_UNSPEC over set-addrinfo-family
+        IPPROTO_TCP over set-addrinfo-protocol
+        f <void*> [ getaddrinfo addrinfo-error ] keep *void*
+        [ parse-addrinfo-list ] keep
+        freeaddrinfo
+    ] with-scope ;
+
+: host-name ( -- string )
+    256 <byte-array> dup dup length gethostname
+    zero? [ "gethostname failed" throw ] unless
+    ascii alien>string ;
+
 TUPLE: inet host port ;
 
 C: <inet> inet
 
-GENERIC: wait-to-connect ( client-out handle -- )
-
-GENERIC: ((client)) ( addrspec -- handle )
-
-GENERIC: (client) ( addrspec -- client-in client-out )
-
-M: array (client) [ (client) 2array ] attempt-all first2 ;
-
-M: object (client)
-    [
-        ((client))
-        dup <ports>
-        2dup [ add-error-destructor ] bi@
-        dup dup handle>> wait-to-connect
-    ] with-destructors ;
-
-: <client> ( addrspec encoding -- stream )
-    >r (client) r> <encoder-duplex> ;
-
-: with-client ( addrspec encoding quot -- )
-    >r <client> r> with-stream ; inline
-
-HOOK: (server) io-backend ( addrspec -- handle )
-
-: <server> ( addrspec encoding -- server )
-    >r [ (server) ] keep r> <server-port> ;
-
-HOOK: (accept) io-backend ( server -- addrspec handle )
-
-: accept ( server -- client addrspec )
-    [ (accept) dup <ports> ] [ encoding>> ] bi
-    <encoder-duplex> swap ;
-
-HOOK: <datagram> io-backend ( addrspec -- datagram )
-
-HOOK: receive io-backend ( datagram -- packet addrspec )
-
-HOOK: send io-backend ( packet addrspec datagram -- )
-
-HOOK: resolve-host io-backend ( host serv passive? -- seq )
-
-HOOK: host-name io-backend ( -- string )
-
 : resolve-client-addr ( inet -- seq )
     [ host>> ] [ port>> ] bi f resolve-host ;
 
 M: inet (client)
     resolve-client-addr (client) ;
+
+ERROR: invalid-inet-server addrspec ;
+
+M: invalid-inet-server summary
+    drop "Cannot use <server> with <inet>; use <inet4> or <inet6> instead" ;
+
+M: inet (server)
+    invalid-inet-server ;

extra/io/timeouts/timeouts.factor

@@ -4,7 +4,6 @@ USING: kernel calendar alarms io io.encodings accessors
 namespaces ;
 IN: io.timeouts
 
-! Won't need this with new slot accessors
 GENERIC: timeout ( obj -- dt/f )
 GENERIC: set-timeout ( dt/f obj -- )
 
@@ -14,8 +13,6 @@ M: encoder set-timeout stream>> set-timeout ;
 
 GENERIC: timed-out ( obj -- )
 
-M: object timed-out drop ;
-
 : queue-timeout ( obj timeout -- alarm )
     >r [ timed-out ] curry r> later ;
 

extra/io/unix/backend/backend.factor

@@ -1,69 +1,85 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien generic assocs kernel kernel.private math
-io.nonblocking sequences strings structs sbufs threads unix
+io.ports sequences strings structs sbufs threads unix
 vectors io.buffers io.backend io.encodings math.parser
 continuations system libc qualified namespaces io.timeouts
-io.encodings.utf8 accessors ;
+io.encodings.utf8 accessors inspector combinators ;
 QUALIFIED: io
 IN: io.unix.backend
 
 ! I/O tasks
-TUPLE: io-task port callbacks ;
-
 GENERIC: handle-fd ( handle -- fd )
 
 M: integer handle-fd ;
 
-: io-task-fd port>> handle>> handle-fd ;
-
-: <io-task> ( port continuation/f class -- task )
-    new
-        swap [ 1vector ] [ V{ } clone ] if* >>callbacks
-        swap >>port ; inline
-
-TUPLE: input-task < io-task ;
-
-TUPLE: output-task < io-task ;
-
-GENERIC: do-io-task ( task -- ? )
-GENERIC: io-task-container ( mx task -- hashtable )
-
 ! I/O multiplexers
 TUPLE: mx fd reads writes ;
 
-M: input-task io-task-container drop reads>> ;
-
-M: output-task io-task-container drop writes>> ;
-
 : new-mx ( class -- obj )
     new
         H{ } clone >>reads
         H{ } clone >>writes ; inline
 
-GENERIC: register-io-task ( task mx -- )
+GENERIC: add-input-callback ( thread fd mx -- )
-GENERIC: unregister-io-task ( task mx -- )
+
+: add-callback ( thread fd assoc -- )
+    [ ?push ] change-at ;
+
+M: mx add-input-callback reads>> add-callback ;
+
+GENERIC: add-output-callback ( thread fd mx -- )
+
+M: mx add-output-callback writes>> add-callback ;
+
+GENERIC: remove-input-callbacks ( fd mx -- callbacks )
+
+M: mx remove-input-callbacks reads>> delete-at* drop ;
+
+GENERIC: remove-output-callbacks ( fd mx -- callbacks )
+
+M: mx remove-output-callbacks writes>> delete-at* drop ;
+
 GENERIC: wait-for-events ( ms mx -- )
 
-: fd/container ( task mx -- task fd container )
+TUPLE: unix-io-error error port ;
-    over io-task-container >r dup io-task-fd r> ; inline
 
-: check-io-task ( task mx -- )
+: report-error ( error port -- )
-    fd/container key? nip [
+    tuck unix-io-error boa >>error drop ;
-        "Cannot perform multiple reads from the same port" throw
-    ] when ;
 
-M: mx register-io-task ( task mx -- )
+: input-available ( fd mx -- )
-    2dup check-io-task fd/container set-at ;
+    remove-input-callbacks [ resume ] each ;
 
-: add-io-task ( task -- )
+: output-available ( fd mx -- )
-    mx get-global register-io-task ;
+    remove-output-callbacks [ resume ] each ;
 
-: with-port-continuation ( port quot -- port )
+TUPLE: io-timeout ;
-    [ "I/O" suspend drop ] curry with-timeout ; inline
 
-M: mx unregister-io-task ( task mx -- )
+M: io-timeout summary drop "I/O operation timed out" ;
-    fd/container delete-at drop ;
+
+M: unix cancel-io ( port -- )
+    io-timeout new over report-error
+    handle>> handle-fd mx get-global
+    [ input-available ] [ output-available ] 2bi ;
+
+SYMBOL: +retry+ ! just try the operation again without blocking
+SYMBOL: +input+
+SYMBOL: +output+
+
+: wait-for-port ( port event -- )
+    dup +retry+ eq? [ 2drop ] [
+        [
+            [
+                >r
+                swap handle>> handle-fd
+                mx get-global
+                r> {
+                    { +input+ [ add-input-callback ] }
+                    { +output+ [ add-output-callback ] }
+                } case
+            ] curry "I/O" suspend drop
+        ] curry with-timeout pending-error
+    ] if ;
 
 ! Some general stuff
 : file-mode OCT: 0666 ;
@@ -88,43 +104,8 @@ M: integer init-handle ( fd -- )
 M: integer close-handle ( fd -- )
     close ;
 
-TUPLE: unix-io-error error port ;
-
-: report-error ( error port -- )
-    tuck unix-io-error boa >>error drop ;
-
-: ignorable-error? ( n -- ? )
-    [ EAGAIN number= ] [ EINTR number= ] bi or ;
-
-: defer-error ( port -- ? )
-    #! Return t if it is an unrecoverable error.
-    err_no dup ignorable-error?
-    [ 2drop f ] [ strerror swap report-error t ] if ;
-
-: pop-callbacks ( mx task -- )
-    dup rot unregister-io-task
-    io-task-callbacks [ resume ] each ;
-
-: perform-io-task ( mx task -- )
-    dup do-io-task [ pop-callbacks ] [ 2drop ] if ;
-
-: handle-timeout ( port mx assoc -- )
-    >r swap port-handle r> delete-at* [
-        "I/O operation cancelled" over port>> report-error
-        pop-callbacks
-    ] [
-        2drop
-    ] if ;
-
-: cancel-io-tasks ( port mx -- )
-    [ dup reads>> handle-timeout ]
-    [ dup writes>> handle-timeout ] 2bi ;
-
-M: unix cancel-io ( port -- )
-    mx get-global cancel-io-tasks ;
-
 ! Readers
-: reader-eof ( reader -- )
+: eof ( reader -- )
     dup buffer>> buffer-empty? [ t >>eof ] when drop ;
 
 : (refill) ( port -- n )
@@ -132,62 +113,42 @@ M: unix cancel-io ( port -- )
     [ buffer>> buffer-end ]
     [ buffer>> buffer-capacity ] tri read ;
 
-GENERIC: refill ( port handle -- ? )
+! Returns an event to wait for which will ensure completion of
+! this request
+GENERIC: refill ( port handle -- event/f )
 
 M: integer refill
-    #! Return f if there is a recoverable error
+    over buffer>> [ buffer-end ] [ buffer-capacity ] bi read
-    drop
+    {
-    dup buffer>> buffer-empty? [
+        { [ dup 0 = ] [ drop eof f ] }
-        dup (refill) dup 0 >= [
+        { [ dup 0 > ] [ swap buffer>> n>buffer f ] }
-            swap buffer>> n>buffer t
+        { [ err_no EINTR = ] [ 2drop +retry+ ] }
-        ] [
+        { [ err_no EAGAIN = ] [ 2drop +input+ ] }
-            drop defer-error
+        [ (io-error) ]
-        ] if
+    } cond ;
-    ] [ drop t ] if ;
 
-TUPLE: read-task < input-task ;
+M: unix (wait-to-read) ( port -- )
-
+    dup dup handle>> refill dup
-: <read-task> ( port continuation -- task ) read-task <io-task> ;
+    [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ;
-
-M: read-task do-io-task
-    port>> dup dup handle>> refill
-    [ [ reader-eof ] [ drop ] if ] keep ;
-
-M: unix (wait-to-read)
-    [ <read-task> add-io-task ] with-port-continuation
-    pending-error ;
 
 ! Writers
-GENERIC: drain ( port handle -- ? )
+GENERIC: drain ( port handle -- event/f )
 
 M: integer drain
-    drop
+    over buffer>> [ buffer@ ] [ buffer-length ] bi write
-    dup
+    {
-    [ handle>> ]
+        { [ dup 0 >= ] [
-    [ buffer>> buffer@ ]
+            over buffer>> buffer-consume
-    [ buffer>> buffer-length ] tri
+            buffer>> buffer-empty? f +output+ ?
-    write dup 0 >=
+        ] }
-    [ swap buffer>> buffer-consume f ]
+        { [ err_no EINTR = ] [ 2drop +retry+ ] }
-    [ drop defer-error ] if ;
+        { [ err_no EAGAIN = ] [ 2drop +output+ ] }
+        [ (io-error) ]
+    } cond ;
 
-TUPLE: write-task < output-task ;
+M: unix (wait-to-write) ( port -- )
-
+    dup dup handle>> drain dup
-: <write-task> ( port continuation -- task ) write-task <io-task> ;
+    [ dupd wait-for-port (wait-to-write) ] [ 2drop ] if ;
-
-M: write-task do-io-task
-    io-task-port dup [ buffer>> buffer-empty? ] [ port-error ] bi or
-    [ 0 swap buffer>> buffer-reset t ] [ dup handle>> drain ] if ;
-
-: add-write-io-task ( port continuation -- )
-    over handle>> mx get-global writes>> at*
-    [ io-task-callbacks push drop ]
-    [ drop <write-task> add-io-task ] if ;
-
-: (wait-to-write) ( port -- )
-    [ add-write-io-task ] with-port-continuation drop ;
-
-M: unix flush-port ( port -- )
-    dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
 M: unix io-multiplex ( ms/f -- )
     mx get-global wait-for-events ;
@@ -203,16 +164,10 @@ TUPLE: mx-port < port mx ;
 : <mx-port> ( mx -- port )
     dup fd>> mx-port <port> swap >>mx ;
 
-TUPLE: mx-task < io-task ;
-
-: <mx-task> ( port -- task )
-    f mx-task <io-task> ;
-
-M: mx-task do-io-task
-    port>> mx>> 0 swap wait-for-events f ;
-
 : multiplexer-error ( n -- )
-    0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ;
+    0 < [
+        err_no [ EAGAIN = ] [ EINTR = ] bi or [ (io-error) ] unless
+    ] when ;
 
 : ?flag ( n mask symbol -- n )
     pick rot bitand 0 > [ , ] [ drop ] if ;

extra/io/unix/bsd/bsd.factor

@@ -3,16 +3,16 @@
 IN: io.unix.bsd
 USING: namespaces system kernel accessors assocs continuations
 unix
-io.backend io.unix.backend io.unix.select io.unix.kqueue io.monitors ;
+io.backend io.unix.backend io.unix.select io.monitors ;
 
 M: bsd init-io ( -- )
-    <select-mx> mx set-global
+    <select-mx> mx set-global ;
-    <kqueue-mx> kqueue-mx set-global
+!     <kqueue-mx> kqueue-mx set-global
-    kqueue-mx get-global <mx-port> <mx-task>
+!     kqueue-mx get-global <mx-port> <mx-task>
-    dup io-task-fd
+!     dup io-task-fd
-    [ mx get-global reads>> set-at ]
+!     [ mx get-global reads>> set-at ]
-    [ mx get-global writes>> set-at ] 2bi ;
+!     [ mx get-global writes>> set-at ] 2bi ;
 
-M: bsd (monitor) ( path recursive? mailbox -- )
+! M: bsd (monitor) ( path recursive? mailbox -- )
-    swap [ "Recursive kqueue monitors not supported" throw ] when
+!     swap [ "Recursive kqueue monitors not supported" throw ] when
-    <vnode-monitor> ;
+!     <vnode-monitor> ;

extra/io/unix/epoll/epoll.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel io.nonblocking io.unix.backend
+USING: alien.c-types kernel io.ports io.unix.backend
 bit-arrays sequences assocs unix unix.linux.epoll math
 namespaces structs ;
 IN: io.unix.epoll

extra/io/unix/files/files.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.backend io.nonblocking io.unix.backend io.files io
+USING: io.backend io.ports io.unix.backend io.files io
 unix unix.stat unix.time kernel math continuations
 math.bitfields byte-arrays alien combinators calendar
 io.encodings.binary accessors sequences strings system

extra/io/unix/files/unique/unique.factor

@@ -1,4 +1,4 @@
-USING: kernel io.nonblocking io.unix.backend math.bitfields
+USING: kernel io.ports io.unix.backend math.bitfields
 unix io.files.unique.backend system ;
 IN: io.unix.files.unique
 

extra/io/unix/kqueue/kqueue.factor

@@ -4,7 +4,7 @@ USING: alien.c-types kernel math math.bitfields namespaces
 locals accessors combinators threads vectors hashtables
 sequences assocs continuations sets
 unix unix.time unix.kqueue unix.process
-io.nonblocking io.unix.backend io.launcher io.unix.launcher
+io.ports io.unix.backend io.launcher io.unix.launcher
 io.monitors ;
 IN: io.unix.kqueue
 

extra/io/unix/launcher/launcher.factor

@@ -3,7 +3,7 @@
 USING: kernel namespaces math system sequences debugger
 continuations arrays assocs combinators alien.c-types strings
 threads accessors
-io io.backend io.launcher io.nonblocking io.files
+io io.backend io.launcher io.ports io.files
 io.files.private io.unix.files io.unix.backend
 io.unix.launcher.parser
 unix unix.process ;

extra/io/unix/linux/monitors/monitors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io.backend io.monitors io.monitors.recursive
-io.files io.buffers io.monitors io.nonblocking io.timeouts
+io.files io.buffers io.monitors io.ports io.timeouts
 io.unix.backend io.unix.select io.encodings.utf8
 unix.linux.inotify assocs namespaces threads continuations init
 math math.bitfields sets alien alien.strings alien.c-types
@@ -110,7 +110,7 @@ M: linux-monitor dispose ( monitor -- )
     ] if ;
 
 : inotify-read-loop ( port -- )
-    dup wait-to-read1
+    dup wait-to-read
     0 over buffer>> parse-file-notifications
     0 over buffer>> buffer-reset
     inotify-read-loop ;

extra/io/unix/pipes/pipes.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system alien.c-types kernel unix math sequences
-qualified io.unix.backend io.nonblocking ;
+qualified io.unix.backend io.ports ;
 IN: io.unix.pipes
 QUALIFIED: io.pipes
 

extra/io/unix/select/select.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel io.nonblocking io.unix.backend
+USING: alien.c-types kernel io.ports io.unix.backend
 bit-arrays sequences assocs unix math namespaces structs
-accessors math.order ;
+accessors math.order locals ;
 IN: io.unix.select
 
 TUPLE: select-mx < mx read-fdset write-fdset ;
@@ -21,21 +21,20 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 : clear-nth ( n seq -- ? )
     [ nth ] [ f -rot set-nth ] 2bi ;
 
-: check-fd ( fd task fdset mx -- )
+:: check-fd ( fd fdset mx quot -- )
-    roll munge rot clear-nth
+    fd munge fdset clear-nth [ fd mx quot call ] when ; inline
-    [ swap perform-io-task ] [ 2drop ] if ;
 
-: check-fdset ( tasks fdset mx -- )
+: check-fdset ( fds fdset mx quot -- )
-    [ check-fd ] 2curry assoc-each ;
+    [ check-fd ] 3curry each ; inline
 
-: init-fdset ( tasks fdset -- )
+: init-fdset ( fds fdset -- )
-    [ >r drop t swap munge r> set-nth ] curry assoc-each ;
+    [ >r t swap munge r> set-nth ] curry each ;
 
 : read-fdset/tasks
-    [ reads>> ] [ read-fdset>> ] bi ;
+    [ reads>> keys ] [ read-fdset>> ] bi ;
 
 : write-fdset/tasks
-    [ writes>> ] [ write-fdset>> ] bi ;
+    [ writes>> keys ] [ write-fdset>> ] bi ;
 
 : max-fd ( assoc -- n )
     dup assoc-empty? [ drop 0 ] [ keys supremum ] if ;
@@ -45,12 +44,13 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 
 : init-fdsets ( mx -- nfds read write except )
     [ num-fds ]
-    [ read-fdset/tasks tuck init-fdset ]
+    [ read-fdset/tasks [ init-fdset ] keep ]
-    [ write-fdset/tasks tuck init-fdset ] tri
+    [ write-fdset/tasks [ init-fdset ] keep ] tri
     f ;
 
-M: select-mx wait-for-events ( ms mx -- )
+M:: select-mx wait-for-events ( ms mx -- )
-    swap >r dup init-fdsets r> dup [ make-timeval ] when
+    mx
-    select multiplexer-error
+    [ init-fdsets ms dup [ make-timeval ] when select multiplexer-error ]
-    dup read-fdset/tasks pick check-fdset
+    [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
-    dup write-fdset/tasks rot check-fdset ;
+    [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
+    tri ;

extra/io/unix/sockets/secure/secure.factor

@@ -4,7 +4,7 @@ USING: accessors byte-arrays kernel debugger sequences namespaces math
 math.order combinators init alien alien.c-types alien.strings libc
 continuations destructors
 openssl openssl.libcrypto openssl.libssl
-io.files io.nonblocking io.unix.backend io.unix.sockets
+io.files io.ports io.unix.backend io.unix.sockets
 io.encodings.ascii io.buffers io.sockets io.sockets.secure
 unix ;
 IN: io.unix.sockets.secure
@@ -16,64 +16,56 @@ IN: io.unix.sockets.secure
 
 M: ssl-handle handle-fd file>> ;
 
-: syscall-error ( port r -- )
+: syscall-error ( port r -- * )
     ERR_get_error dup zero? [
         drop
         {
-            { -1 [ err_no strerror ] }
+            { -1 [ (io-error) ] }
-            { 0 [ "Premature EOF" ] }
+            { 0 [ "Premature EOF" throw ] }
         } case
     ] [
-        nip (ssl-error-string)
+        nip (ssl-error)
-    ] if swap report-error ;
+    ] if ;
 
 : check-response ( port r -- port r n )
     over handle>> handle>> over SSL_get_error ; inline
 
 ! Input ports
-: report-ssl-error ( port r -- )
+: check-read-response ( port r -- event )
-    drop ssl-error-string swap report-error ;
-
-: check-read-response ( port r -- ? )
     check-response
     {
-        { SSL_ERROR_NONE [ swap buffer>> n>buffer t ] }
+        { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] }
-        { SSL_ERROR_ZERO_RETURN [ drop reader-eof t ] }
+        { SSL_ERROR_ZERO_RETURN [ drop eof f ] }
-        { SSL_ERROR_WANT_READ [ 2drop f ] }
+        { SSL_ERROR_WANT_READ [ 2drop +input+ ] }
-        { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
-        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SYSCALL [ syscall-error ] }
-        { SSL_ERROR_SSL [ report-ssl-error t ] }
+        { SSL_ERROR_SSL [ (ssl-error) ] }
     } case ;
 
 M: ssl-handle refill
-    drop
+    handle>> ! ssl
-    dup buffer>> buffer-empty? [
+    over buffer>>
-        dup
+    [ buffer-end ] ! buf
-        [ handle>> handle>> ] ! ssl
+    [ buffer-capacity ] bi ! len
-        [ buffer>> buffer-end ] ! buf
+    SSL_read
-        [ buffer>> buffer-capacity ] tri ! len
+    check-read-response ;
-        SSL_read
-        check-read-response
-    ] [ drop t ] if ;
 
 ! Output ports
-: check-write-response ( port r -- ? )
+: check-write-response ( port r -- event )
     check-response
     {
         { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] }
-        ! { SSL_ERROR_ZERO_RETURN [ drop reader-eof ] } ! XXX
+        { SSL_ERROR_WANT_READ [ 2drop +input+ ] }
-        { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
-        { SSL_ERROR_WANT_WRITE [ 2drop f ] }
+        { SSL_ERROR_SYSCALL [ syscall-error ] }
-        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SSL [ (ssl-error) ] }
-        { SSL_ERROR_SSL [ report-ssl-error t ] }
     } case ;
 
 M: ssl-handle drain
-    drop
+    handle>> ! ssl
-    dup
+    over buffer>>
-    [ handle>> handle>> ] ! ssl
+    [ buffer@ ] ! buf
-    [ buffer>> buffer@ ] ! buf
+    [ buffer-length ] bi ! len
-    [ buffer>> buffer-length ] tri ! len
     SSL_write
     check-write-response ;
 
@@ -81,17 +73,20 @@ M: ssl-handle drain
 M: ssl ((client)) ( addrspec -- handle )
     [ addrspec>> ((client)) <ssl-socket> ] with-destructors ;
 
-: check-connect-response ( port r -- ? )
+: check-connect-response ( port r -- event )
     check-response
     {
-        { SSL_ERROR_NONE [ 2drop t ] }
+        { SSL_ERROR_NONE [ 2drop f ] }
-        { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_READ [ 2drop +input+ ] }
-        { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_WRITE [ 2drop +output+ ] }
-        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SYSCALL [ syscall-error ] }
-        { SSL_ERROR_SSL [ report-ssl-error t ] }
+        { SSL_ERROR_SSL [ (ssl-error) ] }
     } case ;
 
-M: ssl-handle (wait-to-connect)
+: do-ssl-connect ( port ssl -- )
-    handle>> ! ssl
+    2dup SSL_connect check-connect-response dup
-    SSL_connect
+    [ nip wait-for-port ] [ 3drop ] if ;
-    check-connect-response ;
+
+M: ssl-handle wait-to-connect
+    [ file>> wait-to-connect ]
+    [ handle>> do-ssl-connect ] 2bi ;

extra/io/unix/sockets/sockets.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. 
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings generic kernel math
-namespaces threads sequences byte-arrays io.nonblocking
+namespaces threads sequences byte-arrays io.ports
-io.binary io.unix.backend io.streams.duplex io.sockets.impl
+io.binary io.unix.backend io.streams.duplex
-io.backend io.nonblocking io.files io.files.private
+io.backend io.ports io.files io.files.private
 io.encodings.utf8 math.parser continuations libc combinators
-system accessors qualified destructors unix ;
+system accessors qualified destructors unix locals ;
 
 EXCLUDE: io => read write close ;
 EXCLUDE: io.sockets => accept ;
@@ -28,23 +28,11 @@ M: unix addrinfo-error ( n -- )
 : init-client-socket ( fd -- )
     SOL_SOCKET SO_OOBINLINE sockopt ;
 
-TUPLE: connect-task < output-task ;
+: get-socket-name ( fd addrspec -- sockaddr )
-
+    empty-sockaddr/size [ getsockname io-error ] 2keep drop ;
-: <connect-task> ( port continuation -- task )
-    connect-task <io-task> ;
-
-GENERIC: (wait-to-connect) ( port handle -- ? )
 
 M: integer (wait-to-connect)
-    f 0 write 0 < [ defer-error ] [ drop t ] if ;
+    >r >r +output+ wait-for-port r> r> get-socket-name ;
-
-M: connect-task do-io-task
-    port>> dup handle>> (wait-to-connect) ;
-
-M: object wait-to-connect ( client-out fd -- )
-    drop
-    [ <connect-task> add-io-task ] with-port-continuation
-    pending-error ;
 
 M: object ((client)) ( addrspec -- fd )
     [ protocol-family SOCK_STREAM socket-fd ] [ make-sockaddr/size ] bi
@@ -56,49 +44,41 @@ M: object ((client)) ( addrspec -- fd )
 : init-server-socket ( fd -- )
     SOL_SOCKET SO_REUSEADDR sockopt ;
 
-TUPLE: accept-task < input-task ;
-
-: <accept-task> ( port continuation  -- task )
-    accept-task <io-task> ;
-
-: accept-sockaddr ( port -- fd sockaddr )
-    [ handle>> ] [ addr>> sockaddr-type ] bi
-    dup <c-object> [ swap heap-size <int> accept ] keep ; inline
-
-: do-accept ( port fd sockaddr -- )
-    swapd over addr>> parse-sockaddr >>client-addr (>>client) ;
-
-M: accept-task do-io-task
-    io-task-port dup accept-sockaddr
-    over 0 >= [ do-accept t ] [ 2drop defer-error ] if ;
-
-: wait-to-accept ( server -- )
-    [ <accept-task> add-io-task ] with-port-continuation drop ;
-
 : server-socket-fd ( addrspec type -- fd )
     >r dup protocol-family r> socket-fd
     dup init-server-socket
-    dup rot make-sockaddr/size bind
+    dup rot make-sockaddr/size bind io-error ;
-    zero? [ dup close (io-error) ] unless ;
 
-M: unix (server) ( addrspec -- handle )
+M: object (server) ( addrspec -- handle sockaddr )
     [
-        SOCK_STREAM server-socket-fd
+        [
-        dup 10 listen io-error
+            SOCK_STREAM server-socket-fd
+            dup 10 listen io-error
+            dup
+        ] keep
+        get-socket-name
     ] with-destructors ;
 
-M: unix (accept) ( server -- addrspec handle )
+: do-accept ( server -- fd sockaddr )
-    #! Wait for a client connection.
+    [ handle>> ] [ addr>> empty-sockaddr/size ] bi
-    check-server-port
+    [ accept ] 2keep drop ; inline
-    [ wait-to-accept ]
+
-    [ pending-error ]
+M: unix (accept) ( server -- fd sockaddr )
-    [ [ client-addr>> ] [ client>> ] bi ] tri ;
+    dup do-accept
+    {
+        { [ over 0 >= ] [ rot drop ] }
+        { [ err_no EINTR = ] [ 2drop do-accept ] }
+        { [ err_no EAGAIN = ] [
+            2drop
+            [ +input+ wait-for-port ]
+            [ do-accept ] bi
+        ] }
+        [ (io-error) ]
+    } cond ;
 
 ! Datagram sockets - UDP and Unix domain
-M: unix <datagram>
+M: unix (datagram)
-    [
+    [ SOCK_DGRAM server-socket-fd ] with-destructors ;
-        [ SOCK_DGRAM server-socket-fd ] keep <datagram-port>
-    ] with-destructors ;
 
 SYMBOL: receive-buffer
 
@@ -106,76 +86,45 @@ SYMBOL: receive-buffer
 
 packet-size <byte-array> receive-buffer set-global
 
-: setup-receive ( port -- s buffer len flags from fromlen )
+:: do-receive ( port -- packet sockaddr )
-    dup port-handle
+    port addr>> empty-sockaddr/size [| sockaddr len |
-    swap datagram-port-addr sockaddr-type
+        port handle>> ! s
-    dup <c-object> swap heap-size <int>
+        receive-buffer get-global ! buf
-    >r >r receive-buffer get-global packet-size 0 r> r> ;
+        packet-size ! nbytes
+        0 ! flags
+        sockaddr ! from
+        len ! fromlen
+        recvfrom dup 0 >= [
+            receive-buffer get-global swap head sockaddr
+        ] [
+            drop f f
+        ] if
+    ] call ;
 
-: do-receive ( s buffer len flags from fromlen -- sockaddr data )
+M: unix (receive) ( datagram -- packet sockaddr )
-    over >r recvfrom r>
+    dup do-receive dup [ rot drop ] [
-    over -1 = [
+        2drop [ +input+ wait-for-port ] [ (receive) ] bi
-        2drop f f
-    ] [
-        receive-buffer get-global
-        rot head
     ] if ;
 
-TUPLE: receive-task < input-task ;
+:: do-send ( packet sockaddr len socket datagram -- )
+    socket packet dup length 0 sockaddr len sendto
+    0 < [
+        err_no EINTR = [
+            packet sockaddr len socket datagram do-send
+        ] [
+            err_no EAGAIN = [
+                datagram +output+ wait-for-port
+                packet sockaddr len socket datagram do-send
+            ] [
+                (io-error)
+            ] if
+        ] if
+    ] when ;
 
-: <receive-task> ( stream continuation  -- task )
+M: unix (send) ( packet addrspec datagram -- )
-    receive-task <io-task> ;
+    [ make-sockaddr/size ] [ [ handle>> ] keep ] bi* do-send ;
-
-M: receive-task do-io-task
-    io-task-port
-    dup setup-receive do-receive dup [
-        pick set-datagram-port-packet
-        over datagram-port-addr parse-sockaddr
-        swap set-datagram-port-packet-addr
-        t
-    ] [
-        2drop defer-error
-    ] if ;
-
-: wait-receive ( stream -- )
-    [ <receive-task> add-io-task ] with-port-continuation drop ;
-
-M: unix receive ( datagram -- packet addrspec )
-    check-datagram-port
-    [ wait-receive ]
-    [ pending-error ]
-    [ [ packet>> ] [ packet-addr>> ] bi ] tri ;
-
-: do-send ( socket data sockaddr len -- n )
-    >r >r dup length 0 r> r> sendto ;
-
-TUPLE: send-task < output-task packet sockaddr len ;
-
-: <send-task> ( packet sockaddr len stream continuation -- task )
-    send-task <io-task> [
-        {
-            set-send-task-packet
-            set-send-task-sockaddr
-            set-send-task-len
-        } set-slots
-    ] keep ;
-
-M: send-task do-io-task
-    [ io-task-port port-handle ] keep
-    [ send-task-packet ] keep
-    [ send-task-sockaddr ] keep
-    [ send-task-len do-send ] keep
-    swap 0 < [ io-task-port defer-error ] [ drop t ] if ;
-
-: wait-send ( packet sockaddr len stream -- )
-    [ <send-task> add-io-task ] with-port-continuation
-    2drop 2drop ;
-
-M: unix send ( packet addrspec datagram -- )
-    check-datagram-send
-    [ >r make-sockaddr/size r> wait-send ] keep
-    pending-error ;
 
+! Unix domain sockets
 M: local protocol-family drop PF_UNIX ;
 
 M: local sockaddr-type drop "sockaddr-un" c-type ;

extra/io/windows/ce/backend/backend.factor

@@ -1,4 +1,4 @@
-USING: io.nonblocking io.windows threads.private kernel
+USING: io.ports io.windows threads.private kernel
 io.backend windows.winsock windows.kernel32 windows
 io.streams.duplex io namespaces alien.syntax system combinators
 io.buffers io.encodings io.encodings.utf8 combinators.lib ;

extra/io/windows/ce/files/files.factor

@@ -1,5 +1,5 @@
 USING: alien alien.c-types combinators io io.backend io.buffers
-io.files io.nonblocking io.windows kernel libc math namespaces
+io.files io.ports io.windows kernel libc math namespaces
 prettyprint sequences strings threads threads.private
 windows windows.kernel32 io.windows.ce.backend system ;
 IN: windows.ce.files

extra/io/windows/ce/sockets/sockets.factor

@@ -1,5 +1,5 @@
 USING: alien alien.c-types combinators io io.backend io.buffers
-io.nonblocking io.sockets io.sockets.impl io.windows kernel libc
+io.ports io.sockets io.windows kernel libc
 math namespaces prettyprint qualified sequences strings threads
 threads.private windows windows.kernel32 io.windows.ce.backend
 byte-arrays system ;
@@ -41,7 +41,6 @@ M: wince (server) ( addrspec -- handle )
 
 M: wince (accept) ( server -- client )
     [
-        dup check-server-port
         [
             dup port-handle win32-file-handle
             swap server-port-addr sockaddr-type heap-size

extra/io/windows/files/files.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types io.backend io.files io.windows kernel math
 windows windows.kernel32 windows.time calendar combinators
 math.functions sequences namespaces words symbols system
-combinators.lib io.nonblocking destructors math.bitfields.lib ;
+combinators.lib io.ports destructors math.bitfields.lib ;
 IN: io.windows.files
 
 SYMBOLS: +read-only+ +hidden+ +system+

extra/io/windows/files/unique/unique.factor

@@ -1,5 +1,5 @@
 USING: kernel system io.files.unique.backend
-windows.kernel32 io.windows io.nonblocking windows ;
+windows.kernel32 io.windows io.ports windows ;
 IN: io.windows.files.unique
 
 M: windows (make-unique-file) ( path -- )

extra/io/windows/launcher/launcher.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays continuations io
-io.windows io.windows.nt.pipes libc io.nonblocking
+io.windows io.windows.nt.pipes libc io.ports
 windows.types math windows.kernel32
 namespaces io.launcher kernel sequences windows.errors
 splitting system threads init strings combinators

extra/io/windows/mmap/mmap.factor

@@ -1,5 +1,5 @@
 USING: alien alien.c-types alien.syntax arrays continuations
-destructors generic io.mmap io.nonblocking io.windows
+destructors generic io.mmap io.ports io.windows
 kernel libc math namespaces quotations sequences windows
 windows.advapi32 windows.kernel32 io.backend system ;
 IN: io.windows.mmap

extra/io/windows/nt/backend/backend.factor

@@ -1,5 +1,5 @@
 USING: alien alien.c-types arrays assocs combinators
-continuations destructors io io.backend io.nonblocking
+continuations destructors io io.backend io.ports
 io.windows libc kernel math namespaces sequences
 threads classes.tuple.lib windows windows.errors
 windows.kernel32 strings splitting io.files qualified ascii

extra/io/windows/nt/files/files.factor

@@ -1,5 +1,5 @@
 USING: continuations destructors io.buffers io.files io.backend
-io.timeouts io.nonblocking io.windows io.windows.nt.backend
+io.timeouts io.ports io.windows io.windows.nt.backend
 kernel libc math threads windows windows.kernel32 system
 alien.c-types alien.arrays alien.strings sequences combinators
 combinators.lib sequences.lib ascii splitting alien strings

extra/io/windows/nt/launcher/launcher.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays continuations destructors io
-io.windows libc io.nonblocking io.pipes windows.types
+io.windows libc io.ports io.pipes windows.types
 math windows.kernel32 windows namespaces io.launcher kernel
 sequences windows.errors assocs splitting system strings
 io.windows.launcher io.windows.nt.pipes io.backend io.files

extra/io/windows/nt/monitors/monitors.factor

@@ -5,7 +5,7 @@ kernel math assocs namespaces continuations sequences hashtables
 sorting arrays combinators math.bitfields strings system
 accessors threads splitting
 io.backend io.windows io.windows.nt.backend io.windows.nt.files
-io.monitors io.nonblocking io.buffers io.files io.timeouts io
+io.monitors io.ports io.buffers io.files io.timeouts io
 windows windows.kernel32 windows.types ;
 IN: io.windows.nt.monitors
 

extra/io/windows/nt/pipes/pipes.factor

@@ -3,7 +3,7 @@
 USING: alien alien.c-types arrays destructors io io.windows libc
 windows.types math.bitfields windows.kernel32 windows namespaces
 kernel sequences windows.errors assocs math.parser system random
-combinators accessors io.pipes io.nonblocking ;
+combinators accessors io.pipes io.ports ;
 IN: io.windows.nt.pipes
 
 ! This code is based on

extra/io/windows/nt/sockets/sockets.factor

@@ -1,6 +1,6 @@
 USING: alien alien.accessors alien.c-types byte-arrays
-continuations destructors io.nonblocking io.timeouts io.sockets
+continuations destructors io.ports io.timeouts io.sockets
-io.sockets.impl io namespaces io.streams.duplex io.windows
+io.sockets io namespaces io.streams.duplex io.windows
 io.windows.nt.backend windows.winsock kernel libc math sequences
 threads classes.tuple.lib system accessors ;
 IN: io.windows.nt.sockets
@@ -125,7 +125,6 @@ TUPLE: AcceptEx-args port
 M: winnt (accept) ( server -- addrspec handle )
     [
         [
-            check-server-port
             \ AcceptEx-args new
             [ init-accept ] keep
             [ ((accept)) ] keep
@@ -141,13 +140,11 @@ M: winnt (server) ( addrspec -- handle )
         f <win32-socket>
     ] with-destructors ;
 
-M: winnt <datagram> ( addrspec -- datagram )
+M: winnt (datagram) ( addrspec -- handle )
     [
-        [
+        SOCK_DGRAM server-fd
-            SOCK_DGRAM server-fd
+        dup add-completion
-            dup add-completion
+        f <win32-socket>
-            f <win32-socket>
-        ] keep <datagram-port>
     ] with-destructors ;
 
 TUPLE: WSARecvFrom-args port

extra/io/windows/windows.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays destructors io io.backend
-io.buffers io.files io.nonblocking io.sockets io.binary
+io.buffers io.files io.ports io.sockets io.binary
-io.sockets.impl windows.errors strings
+io.sockets windows.errors strings
 kernel math namespaces sequences windows windows.kernel32
 windows.shell32 windows.types windows.winsock splitting
 continuations math.bitfields system accessors ;

extra/openssl/openssl.factor

@@ -5,7 +5,7 @@ math.order combinators init alien alien.c-types alien.strings libc
 continuations destructors debugger inspector
 locals unicode.case
 openssl.libcrypto openssl.libssl
-io.nonblocking io.files io.encodings.ascii io.sockets.secure ;
+io.ports io.files io.encodings.ascii io.sockets.secure ;
 IN: openssl
 
 ! This code is based on http://www.rtfm.com/openssl-examples/
@@ -25,8 +25,11 @@ M: TLSv1  ssl-method drop TLSv1_method ;
 : ssl-error-string ( -- string )
     ERR_get_error ERR_clear_error f ERR_error_string ;
 
+: (ssl-error) ( -- * )
+    ssl-error-string throw ;
+
 : ssl-error ( obj -- )
-    { f 0 } member? [ ssl-error-string throw ] when ;
+    { f 0 } member? [ (ssl-error) ] when ;
 
 : init-ssl ( -- )
     SSL_library_init ssl-error

extra/random/unix/unix.factor

@@ -1,4 +1,4 @@
-USING: alien.c-types io io.files io.nonblocking kernel
+USING: alien.c-types io io.files io.ports kernel
 namespaces random io.encodings.binary init
 accessors system ;
 IN: random.unix

extra/tools/deploy/shaker/shaker.factor

@@ -133,7 +133,7 @@ IN: tools.deploy.shaker
 
         [
             io.backend:io-backend ,
-            "default-buffer-size" "io.nonblocking" lookup ,
+            "default-buffer-size" "io.ports" lookup ,
         ] { } make
         { "alarms" "io" "tools" } strip-vocab-globals %
 

extra/unix/linux/ifreq/ifreq.factor

@@ -1,7 +1,6 @@
 
 USING: kernel alien alien.c-types
        io.sockets
-       io.sockets.impl
        unix
        unix.linux.sockios
        unix.linux.if ;

extra/unix/linux/route/route.factor

@@ -42,7 +42,7 @@ C-STRUCT: struct-rtentry
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-USING: kernel alien.c-types io.sockets io.sockets.impl
+USING: kernel alien.c-types io.sockets
        unix unix.linux.sockios ;
 
 : route ( dst gateway genmask flags -- )