Merge git://factorcode.org/git/factor

extra/io/nonblocking/nonblocking.factor

@@ -1,11 +1,12 @@
-! Copyright (C) 2007 Slava Pestov, Doug Coleman
+! Copyright (C) 2005, 2007 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.nonblocking
 USING: math kernel io sequences io.buffers generic sbufs
 system io.streams.lines io.streams.plain io.streams.duplex
-continuations debugger classes byte-arrays ;
+continuations debugger classes byte-arrays namespaces ;
 
-: default-buffer-size 64 1024 * ; inline
+SYMBOL: default-buffer-size
+64 1024 * default-buffer-size set-global
 
 ! Common delegate of native stream readers and writers
 TUPLE: port handle error timeout cutoff type eof? ;
@@ -18,6 +19,7 @@ PREDICATE: port input-port port-type input eq? ;
 PREDICATE: port output-port port-type output eq? ;
 
 GENERIC: init-handle ( handle -- )
+GENERIC: close-handle ( handle -- )
 
 : <port> ( handle buffer -- port )
     over init-handle
@@ -29,7 +31,7 @@ GENERIC: init-handle ( handle -- )
     } port construct ;
 
 : <buffered-port> ( handle -- port )
-    default-buffer-size <buffer> <port> ;
+    default-buffer-size get <buffer> <port> ;
 
 : <reader> ( handle -- stream )
     <buffered-port> input over set-port-type <line-reader> ;
@@ -150,6 +152,20 @@ M: output-port stream-write1
 M: output-port stream-write
     over length over wait-to-write >buffer ;
 
+GENERIC: port-flush ( port -- )
+
+M: output-port stream-flush ( port -- )
+    dup port-flush pending-error ;
+
+M: port stream-close
+    dup port-type closed eq? [
+        dup port-type >r closed over set-port-type r>
+        output eq? [ dup port-flush ] when
+        dup port-handle close-handle
+        dup delegate [ buffer-free ] when*
+        f over set-delegate
+    ] unless drop ;
+
 TUPLE: server-port addr client ;
 
 : <server-port> ( port addr -- server )

extra/io/unix/backend/backend.factor

@@ -34,6 +34,9 @@ M: integer init-handle ( fd -- )
     #! 1 are closed).
     F_SETFL O_NONBLOCK fcntl drop ;
 
+M: integer close-handle ( fd -- )
+    close ;
+
 : report-error ( error port -- )
     [ "Error on fd " % dup port-handle # ": " % swap % ] "" make
     swap set-port-error ;
@@ -168,21 +171,9 @@ M: write-task task-container drop write-tasks get-global ;
 : (wait-to-write) ( port -- )
     [ swap <write-task> add-write-io-task stop ] callcc0 drop ;
 
-: port-flush ( port -- )
+M: port port-flush ( port -- )
     dup buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
-M: output-port stream-flush
-    dup port-flush pending-error ;
-
-M: port stream-close
-    dup port-type closed eq? [
-        dup port-type >r closed over set-port-type r>
-        output eq? [ dup port-flush ] when
-        dup port-handle close
-        dup delegate [ buffer-free ] when*
-        f over set-delegate
-    ] unless drop ;
-
 USE: io
 
 M: unix-io init-io ( -- )

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

@@ -0,0 +1,42 @@
+USING: io.nonblocking io.windows threads.private kernel
+io.backend windows.winsock windows.kernel32 windows
+io.streams.duplex io namespaces alien.syntax system combinators ;
+IN: io.windows.ce.backend
+
+: port-errored ( port -- )
+    win32-error-string swap set-port-error ;
+
+M: windows-ce-io io-multiplex ( ms -- ) (sleep) ;
+M: windows-ce-io add-completion ( port -- ) drop ;
+
+GENERIC: wince-read ( port port-handle -- )
+
+M: input-port (wait-to-read) ( port -- )
+    dup port-handle wince-read ;
+
+GENERIC: wince-write ( port port-handle -- )
+
+M: windows-ce-io flush-output ( port -- )
+    dup port-handle wince-write ;
+
+M: windows-ce-io init-io ( -- )
+    init-winsock ;
+
+LIBRARY: libc
+FUNCTION: void* _getstdfilex int fd ;
+FUNCTION: void* _fileno void* file ;
+
+M: windows-ce-io init-stdio ( -- )
+    #! We support Windows NT too, to make this I/O backend
+    #! easier to debug.
+    4096 default-buffer-size [
+        winnt? [
+            STD_INPUT_HANDLE GetStdHandle
+            STD_OUTPUT_HANDLE GetStdHandle
+        ] [
+            0 _getstdfilex _fileno
+            1 _getstdfilex _fileno
+        ] if
+        >r f <win32-file> <reader>
+        r> f <win32-file> <writer>
+    ] with-variable <duplex-stream> stdio set ;

extra/io/windows/ce/ce.factor

@@ -1,235 +1,5 @@
-USING: alien alien.c-types combinators
+USING: io.backend io.windows io.windows.ce.backend
-io io.backend io.buffers io.files io.nonblocking io.sockets
+io.windows.ce.files io.windows.ce.sockets namespaces ;
-io.sockets.impl io.windows kernel libc math namespaces
-prettyprint qualified sequences strings threads threads.private
-windows windows.kernel32 ;
-QUALIFIED: windows.winsock
 IN: io.windows.ce
 
-! M: windows-ce-io normalize-pathname ( string -- string )
-    ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
-
-M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ;
-M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
-M: windows-ce-io io-multiplex ( ms -- ) (sleep) ;
-M: windows-ce-io add-completion ( port -- ? ) drop f ;
-
-: port-errored ( port -- )
-    win32-error-string swap set-port-error ;
-
-GENERIC: wince-read ( port port-handle -- )
-
-M: win32-file wince-read
-    drop dup make-FileArgs dup setup-read ReadFile zero? [
-        drop port-errored
-    ] [
-        FileArgs-lpNumberOfBytesRet *uint dup zero? [
-            drop
-            t swap set-port-eof?
-        ] [
-            swap n>buffer
-        ] if
-    ] if ;
-
-TUPLE: WSAArgs
-    s
-    lpBuffers
-    dwBufferCount
-    lpNumberOfBytesRet
-    lpFlags
-    lpOverlapped
-    lpCompletionRoutine ;
-C: <WSAArgs> WSAArgs
-
-: make-WSAArgs ( port -- <WSARecv> )
-    [ port-handle win32-file-handle ] keep
-    delegate 1 "DWORD" <c-object> f f f <WSAArgs> ;
-
-: setup-WSARecv ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
-    [ WSAArgs-s ] keep
-    [
-        WSAArgs-lpBuffers [ buffer-capacity ] keep
-        buffer-end
-        "WSABUF" <c-object>
-        [ windows.winsock:set-WSABUF-buf ] keep
-        [ windows.winsock:set-WSABUF-len ] keep
-    ] keep
-    [ WSAArgs-dwBufferCount ] keep
-    [ WSAArgs-lpNumberOfBytesRet ] keep
-    [ WSAArgs-lpFlags ] keep
-    [ WSAArgs-lpOverlapped ] keep
-    WSAArgs-lpCompletionRoutine ;
-
-! M: win32-socket wince-read ( port port-handle -- )
-    ! drop dup make-WSAArgs dup setup-WSARecv WSARecv zero? [
-        ! drop port-errored
-    ! ] [
-        ! WSAArgs-lpNumberOfBytesRet *uint dup zero? [
-            ! drop
-            ! t swap set-port-eof?
-        ! ] [
-            ! swap n>buffer
-        ! ] if
-    ! ] if ;
-
-M: win32-socket wince-read ( port port-handle -- )
-    win32-file-handle over
-    delegate [ buffer-end ] keep buffer-capacity 0
-    windows.winsock:recv dup windows.winsock:SOCKET_ERROR = [
-        drop port-errored
-    ] [
-        dup zero? [
-            drop
-            t swap set-port-eof?
-        ] [
-            swap n>buffer
-        ] if
-    ] if ;
-
-M: input-port (wait-to-read) ( port -- )
-    dup port-handle wince-read ;
-
-GENERIC: wince-write ( port port-handle -- )
-
-M: win32-file wince-write ( port port-handle -- )
-    drop dup make-FileArgs dup setup-write WriteFile zero? [
-        drop port-errored
-    ] [
-        FileArgs-lpNumberOfBytesRet *uint ! *DWORD
-        over delegate [ buffer-consume ] keep
-        buffer-length 0 > [
-            flush-output
-        ] [
-            drop
-        ] if
-    ] if ;
-
-: setup-WSASend ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
-    [ WSAArgs-s ] keep
-    [
-        WSAArgs-lpBuffers [ buffer-length ] keep
-        buffer@
-        "WSABUF" <c-object>
-        [ windows.winsock:set-WSABUF-buf ] keep
-        [ windows.winsock:set-WSABUF-len ] keep
-    ] keep
-    [ WSAArgs-dwBufferCount ] keep
-    [ WSAArgs-lpNumberOfBytesRet ] keep
-    [ WSAArgs-lpFlags ] keep
-    [ WSAArgs-lpOverlapped ] keep
-    WSAArgs-lpCompletionRoutine ;
-
-! M: win32-socket wince-write ( port port-handle -- )
-    ! drop dup make-WSAArgs dup setup-WSASend WSASend zero? [
-        ! drop port-errored
-    ! ] [
-        ! FileArgs-lpNumberOfBytesRet *uint ! *DWORD
-        ! over delegate [ buffer-consume ] keep
-        ! buffer-length 0 > [
-            ! flush-output
-        ! ] [
-            ! drop
-        ! ] if
-    ! ] if ;
-
-M: win32-socket wince-write ( port port-handle -- )
-    win32-file-handle over
-    delegate [ buffer@ ] keep
-    buffer-length 0 windows.winsock:send dup windows.winsock:SOCKET_ERROR = [
-        drop port-errored
-    ] [
-        over delegate [ buffer-consume ] keep
-        buffer-length 0 > [
-            flush-output
-        ] [
-            drop
-        ] if
-    ] if ;
-
-M: windows-ce-io flush-output ( port -- )
-    dup port-handle wince-write ;
-
-M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ;
-
-: do-connect ( addrspec -- socket )
-    [ tcp-socket dup ] keep
-    make-sockaddr/size
-    f f f f windows.winsock:WSAConnect zero? [
-        winsock-error-string throw
-    ] unless ;
-
-M: windows-ce-io (client) ( addrspec -- duplex-stream )
-    do-connect <win32-socket> dup handle>duplex-stream ;
-
-M: windows-ce-io <server> ( addrspec -- duplex-stream )
-    [
-        windows.winsock:SOCK_STREAM server-fd
-        dup listen-on-socket
-        <win32-socket> f <port>
-    ] keep <server-port> ;
-
-M: windows-ce-io accept ( server -- client )
-    dup check-server-port
-    [
-        [ touch-port ] keep
-        [ port-handle win32-file-handle ] keep
-        server-port-addr sockaddr-type heap-size
-        [ "char" <c-array> ] keep [
-            <int>
-            f 0
-            windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = [
-                winsock-error-string throw
-            ] when
-        ] keep
-    ] keep server-port-addr parse-sockaddr swap
-    <win32-socket> dup handle>duplex-stream <client-stream> ;
-
 T{ windows-ce-io } io-backend set-global
-
-M: windows-ce-io init-io ( -- )
-    init-winsock ;
-
-M: windows-ce-io <datagram> ( addrspec -- datagram )
-    [
-        windows.winsock:SOCK_DGRAM server-fd <win32-socket> f <port>
-    ] keep <datagram-port> ;
-
-M: windows-ce-io receive ( datagram -- packet addrspec )
-    dup check-datagram-port
-    [
-        port-handle delegate win32-file-handle
-        "WSABUF" <c-object>
-        default-buffer-size over windows.winsock:set-WSABUF-len
-        default-buffer-size "char" <c-array> over windows.winsock:set-WSABUF-buf
-        [
-            1
-            0 <uint> [
-                0 <uint>
-                64 "char" <c-array> [
-                    64 <int>
-                    f
-                    f
-                    windows.winsock:WSARecvFrom zero? [
-                        winsock-error-string throw
-                    ] unless
-                ] keep
-            ] keep *uint
-        ] keep
-    ] keep
-    ! sockaddr count buf datagram
-    >r windows.winsock:WSABUF-buf swap memory>string swap r>
-    datagram-port-addr parse-sockaddr ;
-
-M: windows-ce-io send ( packet addrspec datagram -- )
-    3dup check-datagram-send
-    delegate port-handle delegate win32-file-handle
-    rot dup length "WSABUF" <c-object>
-    [ windows.winsock:set-WSABUF-len ] keep
-    [ windows.winsock:set-WSABUF-buf ] keep
-    
-    rot make-sockaddr/size
-    >r >r 1 0 <uint> 0 r> r> f f 
-    windows.winsock:WSASendTo zero? [
-        winsock-error-string throw
-    ] unless ;
-

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

@@ -0,0 +1,28 @@
+USING: alien alien.c-types combinators io io.backend io.buffers
+io.files io.nonblocking io.windows kernel libc math namespaces
+prettyprint sequences strings threads threads.private
+windows windows.kernel32 io.windows.ce.backend ;
+IN: windows.ce.files
+
+! M: windows-ce-io normalize-pathname ( string -- string )
+    ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
+
+M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ;
+M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ;
+
+M: win32-file wince-read
+    drop dup make-FileArgs dup setup-read ReadFile zero? [
+        drop port-errored
+    ] [
+        FileArgs-lpNumberOfBytesRet *uint dup zero?
+        [ drop t swap set-port-eof? ] [ swap n>buffer ] if
+    ] if ;
+
+M: win32-file wince-write ( port port-handle -- )
+    drop dup make-FileArgs dup setup-write WriteFile zero? [
+        drop port-errored
+    ] [
+        FileArgs-lpNumberOfBytesRet *uint
+        over buffer-consume
+        port-flush
+    ] if ;

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

@@ -0,0 +1,170 @@
+USING: alien alien.c-types combinators io io.backend io.buffers
+io.nonblocking io.sockets io.sockets.impl io.windows kernel libc
+math namespaces prettyprint qualified sequences strings threads
+threads.private windows windows.kernel32 io.windows.ce.backend
+byte-arrays ;
+QUALIFIED: windows.winsock
+IN: io.windows.ce
+
+M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ;
+
+TUPLE: WSAArgs
+    s
+    lpBuffers
+    dwBufferCount
+    lpNumberOfBytesRet
+    lpFlags
+    lpOverlapped
+    lpCompletionRoutine ;
+C: <WSAArgs> WSAArgs
+
+: make-WSAArgs ( port -- <WSARecv> )
+    [ port-handle win32-file-handle ] keep
+    1 "DWORD" <c-object> f f f <WSAArgs> ;
+
+: setup-WSARecv ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
+    [ WSAArgs-s ] keep
+    [
+        WSAArgs-lpBuffers [ buffer-capacity ] keep
+        buffer-end
+        "WSABUF" <c-object>
+        [ windows.winsock:set-WSABUF-buf ] keep
+        [ windows.winsock:set-WSABUF-len ] keep
+    ] keep
+    [ WSAArgs-dwBufferCount ] keep
+    [ WSAArgs-lpNumberOfBytesRet ] keep
+    [ WSAArgs-lpFlags ] keep
+    [ WSAArgs-lpOverlapped ] keep
+    WSAArgs-lpCompletionRoutine ;
+
+! M: win32-socket wince-read ( port port-handle -- )
+    ! drop dup make-WSAArgs dup setup-WSARecv WSARecv zero? [
+        ! drop port-errored
+    ! ] [
+        ! WSAArgs-lpNumberOfBytesRet *uint dup zero? [
+            ! drop
+            ! t swap set-port-eof?
+        ! ] [
+            ! swap n>buffer
+        ! ] if
+    ! ] if ;
+
+M: win32-socket wince-read ( port port-handle -- )
+    win32-file-handle over buffer-end pick buffer-capacity 0
+    windows.winsock:recv
+    dup windows.winsock:SOCKET_ERROR = [
+        drop port-errored
+    ] [
+        dup zero? [
+            drop
+            t swap set-port-eof?
+        ] [
+            swap n>buffer
+        ] if
+    ] if ;
+
+: setup-WSASend ( <WSAArgs> -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine )
+    [ WSAArgs-s ] keep
+    [
+        WSAArgs-lpBuffers [ buffer-length ] keep
+        buffer@
+        "WSABUF" <c-object>
+        [ windows.winsock:set-WSABUF-buf ] keep
+        [ windows.winsock:set-WSABUF-len ] keep
+    ] keep
+    [ WSAArgs-dwBufferCount ] keep
+    [ WSAArgs-lpNumberOfBytesRet ] keep
+    [ WSAArgs-lpFlags ] keep
+    [ WSAArgs-lpOverlapped ] keep
+    WSAArgs-lpCompletionRoutine ;
+
+! M: win32-socket wince-write ( port port-handle -- )
+    ! drop dup make-WSAArgs dup setup-WSASend WSASend zero? [
+        ! drop port-errored
+    ! ] [
+        ! FileArgs-lpNumberOfBytesRet *uint ! *DWORD
+        ! over delegate [ buffer-consume ] keep
+        ! buffer-length 0 > [
+            ! flush-output
+        ! ] [
+            ! drop
+        ! ] if
+    ! ] if ;
+
+M: win32-socket wince-write ( port port-handle -- )
+    win32-file-handle over buffer@ pick buffer-length 0
+    windows.winsock:send
+    dup windows.winsock:SOCKET_ERROR =
+    [ drop port-errored ] [ over buffer-consume port-flush ] if ;
+
+: do-connect ( addrspec -- socket )
+    [ tcp-socket dup ] keep
+    make-sockaddr/size
+    f f f f windows.winsock:WSAConnect zero?
+    [ windows.winsock:winsock-error ] unless ;
+
+M: windows-ce-io (client) ( addrspec -- duplex-stream )
+    do-connect <win32-socket> dup handle>duplex-stream ;
+
+M: windows-ce-io <server> ( addrspec -- duplex-stream )
+    [
+        windows.winsock:SOCK_STREAM server-fd
+        dup listen-on-socket
+        <win32-socket> f <port>
+    ] keep <server-port> ;
+
+M: windows-ce-io accept ( server -- client )
+    dup check-server-port
+    [
+        dup touch-port
+        dup port-handle win32-file-handle
+        swap server-port-addr sockaddr-type heap-size
+        dup <byte-array> [
+            swap <int> f 0
+            windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET =
+            [ windows.winsock:winsock-error ] when
+        ] keep
+    ] keep server-port-addr parse-sockaddr swap
+    <win32-socket> dup handle>duplex-stream <client-stream> ;
+
+M: windows-ce-io <datagram> ( addrspec -- datagram )
+    [
+        windows.winsock:SOCK_DGRAM server-fd <win32-socket> f <port>
+    ] keep <datagram-port> ;
+
+M: windows-ce-io receive ( datagram -- packet addrspec )
+    dup check-datagram-port
+    [
+        port-handle win32-file-handle
+        "WSABUF" <c-object>
+        default-buffer-size get over windows.winsock:set-WSABUF-len
+        default-buffer-size get <byte-array> over windows.winsock:set-WSABUF-buf
+        [
+            1
+            0 <uint> [
+                0 <uint>
+                64 "char" <c-array> [
+                    64 <int>
+                    f
+                    f
+                    windows.winsock:WSARecvFrom zero?
+                    [ windows.winsock:winsock-error ] unless
+                ] keep
+            ] keep *uint
+        ] keep
+    ] keep
+    ! sockaddr count buf datagram
+    >r windows.winsock:WSABUF-buf swap memory>string swap r>
+    datagram-port-addr parse-sockaddr ;
+
+M: windows-ce-io send ( packet addrspec datagram -- )
+    3dup check-datagram-send
+    port-handle win32-file-handle
+    rot dup length "WSABUF" <c-object>
+    [ windows.winsock:set-WSABUF-len ] keep
+    [ windows.winsock:set-WSABUF-buf ] keep
+
+    rot make-sockaddr/size
+    >r >r 1 0 <uint> 0 r> r> f f
+    windows.winsock:WSASendTo zero?
+    [ windows.winsock:winsock-error ] unless ;

extra/io/windows/launcher/launcher.factor

@@ -83,8 +83,8 @@ C: <pipe> pipe
     PIPE_ACCESS_DUPLEX FILE_FLAG_OVERLAPPED bitor
     PIPE_TYPE_BYTE PIPE_READMODE_BYTE PIPE_NOWAIT bitor bitor
     PIPE_UNLIMITED_INSTANCES
-    default-buffer-size
+    default-buffer-size get
-    default-buffer-size
+    default-buffer-size get
     0
     security-attributes-inherit
     CreateNamedPipe dup invalid-handle? ;

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

@@ -1,13 +1,10 @@
-USING: alien alien.c-types arrays assocs combinators continuations
+USING: alien alien.c-types arrays assocs combinators
-destructors io io.backend io.nonblocking io.windows libc
+continuations destructors io io.backend io.nonblocking
-kernel math namespaces sequences threads tuples.lib windows
+io.windows libc kernel math namespaces sequences threads
-windows.errors windows.kernel32 prettyprint strings splitting
+tuples.lib windows windows.errors windows.kernel32 strings
-io.files windows.winsock ;
+splitting io.files windows.winsock ;
 IN: io.windows.nt.backend
 
-: .. global [ . flush ] bind ;
-: .S global [ .s flush ] bind ;
-
 : unicode-prefix ( -- seq )
     "\\\\?\\" ; inline
 
@@ -51,6 +48,12 @@ C: <io-callback> io-callback
     >r (make-overlapped) r> port-handle win32-file-ptr
     [ over set-OVERLAPPED-offset ] when* ;
 
+: port-overlapped ( port -- overlapped )
+    port-handle win32-file-overlapped ;
+
+: set-port-overlapped ( overlapped port -- )
+    port-handle set-win32-file-overlapped ;
+
 : completion-port ( handle existing -- handle )
      f 1 CreateIoCompletionPort dup win32-error=0/f ;
 
@@ -75,7 +78,7 @@ C: <GetOverlappedResult-args> GetOverlappedResult-args
 
 : (save-callback) ( io-callback -- )
     dup io-callback-port port-handle win32-file-overlapped
-    \ io-hash get-global set-at ;
+    io-hash get-global set-at ;
 
 : save-callback ( port -- )
     [
@@ -95,7 +98,7 @@ C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
 
 : lookup-callback ( GetQueuedCompletion-args -- callback )
     GetQueuedCompletionStatusParams-lpOverlapped* *void*
-    \ io-hash get-global delete-at* drop ;
+    io-hash get-global delete-at* drop ;
 
 : wait-for-io ( timeout -- continuation/f )
     wait-for-overlapped
@@ -125,19 +128,17 @@ C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
         drop
     ] if ;
 
-: cancel-timedout ( -- )
+: cancel-timeout ( -- )
     io-hash get-global values [ maybe-expire ] each ;
 
 M: windows-nt-io io-multiplex ( ms -- )
-    cancel-timedout
+    cancel-timeout wait-for-io [ schedule-thread ] when* ;
-    [ wait-for-io ] [ global [ "error: " write . flush ] bind drop f ] recover
-    [ schedule-thread ] when* ;
 
 M: windows-nt-io init-io ( -- )
     #! Should only be called on startup. Calling this at any
     #! other time can have unintended consequences.
     global [
         master-completion-port \ master-completion-port set
-        H{ } clone \ io-hash set
+        H{ } clone io-hash set
         init-winsock
     ] bind ;

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

@@ -17,26 +17,24 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
         2drop
     ] if* ;
 
-DEFER: (flush-output)
 : finish-flush ( port -- )
     dup pending-error
     dup get-overlapped-result
-    [ over update-file-ptr ] keep
+    dup pick update-file-ptr
-    over delegate [ buffer-consume ] keep
+    swap buffer-consume ;
-    buffer-length 0 > [
+
-        (flush-output)
+: save-overlapped-and-callback ( fileargs port -- )
-    ] [
+    swap FileArgs-lpOverlapped over set-port-overlapped
-        drop
+    save-callback ;
-    ] if ;
 
 : (flush-output) ( port -- )
     dup touch-port
     dup make-FileArgs
-    [ setup-write WriteFile ] keep
+    tuck setup-write WriteFile
-    >r dupd overlapped-error? r> swap [
+    dupd overlapped-error? [
-        FileArgs-lpOverlapped over set-port-overlapped
+        [ save-overlapped-and-callback ] keep
-        dup save-callback
+        [ finish-flush ] keep
-        finish-flush
+        dup buffer-empty? [ drop ] [ (flush-output) ] if
     ] [
         2drop
     ] if ;
@@ -49,17 +47,16 @@ M: windows-nt-io flush-output ( port -- )
     dup get-overlapped-result dup zero? [
         drop t swap set-port-eof?
     ] [
-        [ over n>buffer ] keep
+        dup pick n>buffer
         swap update-file-ptr
     ] if ;
 
 : ((wait-to-read)) ( port -- )
     dup touch-port
     dup make-FileArgs
-    [ setup-read ReadFile ] keep
+    tuck setup-read ReadFile
-    >r dupd overlapped-error? r> swap [
+    dupd overlapped-error? [
-        FileArgs-lpOverlapped over set-port-overlapped
+        [ save-overlapped-and-callback ] keep
-        dup save-callback
         finish-read
     ] [
         2drop

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

@@ -178,7 +178,7 @@ TUPLE: WSARecvFrom-args port
     ] keep
     "WSABUF" malloc-object dup free-always
     2dup swap set-WSARecvFrom-args-lpBuffers*
-    default-buffer-size [ malloc dup free-always ] keep
+    default-buffer-size get [ malloc dup free-always ] keep
     pick set-WSABUF-len
     swap set-WSABUF-buf
     1 over set-WSARecvFrom-args-dwBufferCount*
@@ -256,6 +256,8 @@ TUPLE: WSASendTo-args port
     \ WSASendTo-args >tuple*<
     WSASendTo socket-error* ;
 
+USE: io.sockets
+
 M: windows-nt-io send ( packet addrspec datagram -- )
     [
         3dup check-datagram-send

extra/io/windows/windows.factor

@@ -31,12 +31,6 @@ TUPLE: win32-file handle ptr overlapped ;
     { set-win32-file-handle set-win32-file-ptr }
     \ win32-file construct ;
 
-: set-port-overlapped ( overlapped port -- )
-    port-handle set-win32-file-overlapped ;
-
-: port-overlapped ( port -- overlapped )
-    port-handle win32-file-overlapped ;
-
 HOOK: CreateFile-flags io-backend ( -- DWORD )
 HOOK: flush-output io-backend ( port -- )
 HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
@@ -48,7 +42,14 @@ M: windows-io normalize-directory ( string -- string )
 : share-mode ( -- fixnum )
     FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline
 
-M: win32-file init-handle ( handle -- ) drop ;
+M: win32-file init-handle ( handle -- )
+    drop ;
+
+M: win32-file close-handle ( handle -- )
+    win32-file-handle CloseHandle drop ;
+
+M: port port-flush
+    dup buffer-empty? [ dup flush-output ] unless drop ;
 
 ! Clean up resources (open handle) if add-completion fails
 : open-file ( path access-mode create-mode -- handle )
@@ -101,27 +102,6 @@ C: <FileArgs> FileArgs
     [ FileArgs-lpNumberOfBytesRet ] keep
     FileArgs-lpOverlapped ;
 
-M: output-port stream-flush ( port -- )
-    dup buffer-empty? [
-        dup flush-output
-    ] unless pending-error ;
-
-M: port stream-close ( port -- )
-    dup port-type closed = [
-        drop
-    ] [
-        ! For duplex-streams, we call CloseHandle twice on the same handle
-        [ dup port-type output = [ stream-flush ] [ drop ] if ] keep
-        [ closed swap set-port-type ] keep
-        [ port-handle win32-file-handle CloseHandle drop ] keep
-        USE: namespaces
-        [ delegate [ buffer-free ] [
-            global [ "delegate was empty!!" print flush ] bind
-            USE: windows.winsock.private
-        ] if* ] keep
-        f swap set-delegate
-    ] if ;
-
 M: windows-io <file-reader> ( path -- stream )
     open-read <win32-file> <reader> ;
 

extra/windows/winsock/winsock.factor

@@ -166,9 +166,8 @@ FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
 FUNCTION: int closesocket ( SOCKET s ) ;
 FUNCTION: int shutdown ( SOCKET s, int how ) ;
-! FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
+FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
-! FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
+FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
-
 
 TYPEDEF: uint SERVICETYPE
 TYPEDEF: OVERLAPPED WSAOVERLAPPED
@@ -405,6 +404,9 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
 : winsock-error-string ( -- string/f )
     WSAGetLastError (winsock-error-string) ;
 
+: winsock-error ( -- )
+    winsock-error-string [ throw ] when* ;
+
 : winsock-error=0/f ( n/f -- )
     { 0 f } member? [
         winsock-error-string throw
@@ -428,7 +430,7 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
     ] when ;
 
 : socket-error ( n -- )
-    SOCKET_ERROR = [ winsock-error-string throw ] when ;
+    SOCKET_ERROR = [ winsock-error ] when ;
 
 : init-winsock ( -- )
     HEX: 0202 <wsadata> WSAStartup winsock-error!=0/f ;

vm/factor.c

@@ -13,7 +13,7 @@ void default_parameters(F_PARAMETERS *p)
 	p->gen_count = 2;
 	p->code_size = 4;
 	p->young_size = 1;
-	p->aging_size = 4;
+	p->aging_size = 6;
 #else
 	p->ds_size = 32 * CELLS;
 	p->rs_size = 32 * CELLS;