diff --git a/extra/concurrency/distributed/distributed-tests.factor b/extra/concurrency/distributed/distributed-tests.factor index 840c5efa36..645728780d 100755 --- a/extra/concurrency/distributed/distributed-tests.factor +++ b/extra/concurrency/distributed/distributed-tests.factor @@ -13,7 +13,8 @@ concurrency.messaging continuations ; [ ] [ test-node dup 1array swap (start-node) ] unit-test -[ ] [ 1000 sleep ] unit-test +[ ] [ yield ] unit-test +[ ] [ yield ] unit-test [ ] [ [ diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index cd079690e3..ebcc67374b 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -127,7 +127,7 @@ M: postgresql-malloc-destructor dispose ( obj -- ) alien>> PQfreemem ; : &postgresql-free ( alien -- alien ) - &dispose ; inline + dup &dispose drop ; inline : pq-get-blob ( handle row column -- obj/f ) [ PQgetvalue ] 3keep 3dup PQgetlength diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index 2b1d62aaeb..f1f4ca9cf2 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -28,10 +28,10 @@ M: handle-destructor dispose ( obj -- ) handle>> close-handle ; : &close-handle ( handle -- handle ) - &dispose ; inline + dup &dispose drop ; inline : |close-handle ( handle -- handle ) - |dispose ; inline + dup |dispose drop ; inline : ( handle class -- port ) new diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index ac58a54bb8..ba6d16a364 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -151,7 +151,10 @@ M: inet6 parse-sockaddr M: f parse-sockaddr nip ; -GENERIC# get-local-address 1 ( handle remote -- sockaddr ) +GENERIC: (get-local-address) ( handle remote -- sockaddr ) + +: get-local-address ( handle remote -- local ) + [ (get-local-address) ] keep parse-sockaddr ; GENERIC: establish-connection ( client-out remote -- ) @@ -163,8 +166,13 @@ M: array (client) [ (client) 3array ] attempt-all first3 ; M: object (client) ( remote -- client-in client-out local ) [ - [ ((client)) dup 2dup [ |dispose drop ] bi@ ] keep - [ establish-connection ] [ drop ] [ get-local-address ] 2tri + [ ((client)) ] keep + [ + >r dup [ |dispose ] bi@ dup r> + establish-connection + ] + [ get-local-address ] + 2bi ] with-destructors ; : ( remote encoding -- stream local ) @@ -182,23 +190,23 @@ TUPLE: server-port < port addr encoding ; check-closed dup server-port? [ "Not a server port" throw ] unless ; inline -GENERIC: (server) ( addrspec -- handle sockaddr ) +GENERIC: (server) ( addrspec -- handle ) : ( addrspec encoding -- server ) - >r [ (server) ] keep parse-sockaddr - swap server-port - swap >>addr - r> >>encoding ; + >r + [ (server) ] keep + [ drop server-port ] [ get-local-address ] 2bi + >>addr r> >>encoding ; -GENERIC: (accept) ( server addrspec -- handle remote ) +GENERIC: (accept) ( server addrspec -- handle ) : accept ( server -- client remote ) - check-server-port - [ dup addr>> (accept) ] keep - tuck - [ [ dup ] [ encoding>> ] bi* ] - [ addr>> parse-sockaddr ] - 2bi* ; + [ + dup addr>> + [ (accept) ] keep + [ drop dup ] [ get-local-address ] 2bi + -rot + ] keep encoding>> swap ; TUPLE: datagram-port < port addr ; diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index 1d240057b0..05164aca34 100644 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -92,12 +92,12 @@ M: ssl parse-sockaddr addrspec>> parse-sockaddr ; 2dup SSL_connect check-connect-response dup [ >r over r> wait-for-port do-ssl-connect ] [ 3drop ] if ; -M: ssl-handle (wait-to-connect) +M: ssl establish-connection ( client-out remote -- ) addrspec>> - [ >r file>> r> (wait-to-connect) ] - [ drop handle>> do-ssl-connect ] - [ drop t >>connected 2drop ] - 3tri ; + [ establish-connection ] + [ drop dup handle>> do-ssl-connect ] + [ drop t >>connected drop ] + 2tri ; M: ssl (server) addrspec>> (server) ; @@ -117,12 +117,8 @@ M: ssl (server) addrspec>> (server) ; M: ssl (accept) [ - addrspec>> - (accept) >r - |close-handle - |close-handle + addrspec>> (accept) |close-handle |close-handle dup do-ssl-accept - r> ] with-destructors ; : check-shutdown-response ( handle r -- event ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 7973ca5164..83aa01d79a 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -22,7 +22,7 @@ M: unix addrinfo-error ( n -- ) dup zero? [ drop ] [ gai_strerror throw ] if ; ! Client sockets - TCP and Unix domain -M: fd get-local-address ( handle remote -- sockaddr ) +M: object (get-local-address) ( handle remote -- sockaddr ) >r handle-fd r> empty-sockaddr/size [ getsockname io-error ] 2keep drop ; @@ -32,18 +32,18 @@ M: fd get-local-address ( handle remote -- sockaddr ) : wait-to-connect ( port -- ) dup handle>> handle-fd f 0 write { - { [ 0 = ] [ drop f ] } + { [ 0 = ] [ drop ] } { [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] } { [ err_no EINTR = ] [ wait-to-connect ] } [ (io-error) ] } cond ; M: object establish-connection ( client-out remote -- ) - [ drop ] [ [ handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi + [ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi { - { [ 0 = ] [ ] } + { [ 0 = ] [ drop ] } { [ err_no EINPROGRESS = ] [ - [ +output+ wait-for-port ] [ check-connection ] [ ] tri + [ +output+ wait-for-port ] [ wait-to-connect ] bi ] } [ (io-error) ] } cond ; @@ -60,27 +60,22 @@ M: object ((client)) ( addrspec -- fd ) dup init-server-socket dup handle-fd rot make-sockaddr/size bind io-error ; -M: object (server) ( addrspec -- handle sockaddr ) +M: object (server) ( addrspec -- handle ) [ - [ - SOCK_STREAM server-socket-fd - dup handle-fd 10 listen io-error - dup - ] keep - get-socket-name + SOCK_STREAM server-socket-fd + dup handle-fd 10 listen io-error ] with-destructors ; -: do-accept ( server addrspec -- fd remote ) - [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* - [ accept ] 2keep drop ; inline +: do-accept ( server addrspec -- fd ) + [ handle>> handle-fd ] [ empty-sockaddr/size ] bi* accept ; inline -M: object (accept) ( server addrspec -- fd remote ) +M: object (accept) ( server addrspec -- fd ) 2dup do-accept { - { [ over 0 >= ] [ { [ drop ] [ drop ] [ ] [ ] } spread ] } - { [ err_no EINTR = ] [ 2drop (accept) ] } + { [ dup 0 >= ] [ 2nip ] } + { [ err_no EINTR = ] [ drop (accept) ] } { [ err_no EAGAIN = ] [ - 2drop + drop [ drop +input+ wait-for-port ] [ (accept) ] 2bi diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index f4f2496cc6..8fdc0e07a4 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -110,16 +110,14 @@ M: email clone : (send) ( email -- ) [ - [ - helo get-ok - dup from>> mail-from get-ok - dup to>> [ rcpt-to get-ok ] each - data get-ok - dup headers>> write-headers - crlf - body>> send-body get-ok - quit get-ok USING: continuations debugger ; - ] [ global [ error. :c ] bind ] recover + helo get-ok + dup from>> mail-from get-ok + dup to>> [ rcpt-to get-ok ] each + data get-ok + dup headers>> write-headers + crlf + body>> send-body get-ok + quit get-ok ] with-smtp-connection ; : extract-email ( recepient -- email )