Merge git://factorcode.org/git/factor
						commit
						3619953a15
					
				| 
						 | 
				
			
			@ -1,8 +1,12 @@
 | 
			
		|||
USING: system vocabs vocabs.loader kernel ;
 | 
			
		||||
USING: system vocabs vocabs.loader kernel combinators
 | 
			
		||||
namespaces sequences ;
 | 
			
		||||
IN: bootstrap.io
 | 
			
		||||
 | 
			
		||||
"bootstrap.compiler" vocab [
 | 
			
		||||
    unix? [ "io.unix" require ] when
 | 
			
		||||
    winnt? [ "io.windows.nt" require ] when
 | 
			
		||||
    wince? [ "io.windows.ce" require ] when
 | 
			
		||||
    "io." {
 | 
			
		||||
        { [ "io-backend" get ] [ "io-backend" get ] }
 | 
			
		||||
        { [ unix? ] [ "unix" ] }
 | 
			
		||||
        { [ winnt? ] [ "windows.nt" ] }
 | 
			
		||||
        { [ wince? ] [ "windows.ce" ] }
 | 
			
		||||
    } cond append require
 | 
			
		||||
] when
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -3,7 +3,8 @@
 | 
			
		|||
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 namespaces ;
 | 
			
		||||
continuations debugger classes byte-arrays namespaces
 | 
			
		||||
splitting ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: default-buffer-size
 | 
			
		||||
64 1024 * default-buffer-size set-global
 | 
			
		||||
| 
						 | 
				
			
			@ -137,11 +138,7 @@ M: input-port stream-read-partial ( max stream -- string/f )
 | 
			
		|||
    >r 0 max >fixnum r> read-step ;
 | 
			
		||||
 | 
			
		||||
: can-write? ( len writer -- ? )
 | 
			
		||||
    dup buffer-empty? [
 | 
			
		||||
        2drop t
 | 
			
		||||
    ] [
 | 
			
		||||
        [ buffer-fill + ] keep buffer-capacity <=
 | 
			
		||||
    ] if ;
 | 
			
		||||
    [ buffer-fill + ] keep buffer-capacity <= ;
 | 
			
		||||
 | 
			
		||||
: wait-to-write ( len port -- )
 | 
			
		||||
    tuck can-write? [ drop ] [ stream-flush ] if ;
 | 
			
		||||
| 
						 | 
				
			
			@ -150,7 +147,12 @@ M: output-port stream-write1
 | 
			
		|||
    1 over wait-to-write ch>buffer ;
 | 
			
		||||
 | 
			
		||||
M: output-port stream-write
 | 
			
		||||
    over length over wait-to-write >buffer ;
 | 
			
		||||
    over length over buffer-size > [
 | 
			
		||||
        [ buffer-size <groups> ] keep
 | 
			
		||||
        [ stream-write ] curry each
 | 
			
		||||
    ] [
 | 
			
		||||
        over length over wait-to-write >buffer
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
GENERIC: port-flush ( port -- )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -159,7 +159,7 @@ TUPLE: write-task ;
 | 
			
		|||
: <write-task> ( port -- task ) write-task <io-task> ;
 | 
			
		||||
 | 
			
		||||
M: write-task do-io-task
 | 
			
		||||
    io-task-port dup buffer-length zero? over port-error or
 | 
			
		||||
    io-task-port dup buffer-empty? over port-error or
 | 
			
		||||
    [ 0 swap buffer-reset t ] [ write-step ] if ;
 | 
			
		||||
 | 
			
		||||
M: write-task task-container drop write-tasks get-global ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,7 @@
 | 
			
		|||
USING: io.nonblocking io.windows threads.private kernel
 | 
			
		||||
io.backend windows.winsock windows.kernel32 windows
 | 
			
		||||
io.streams.duplex io namespaces alien.syntax system combinators ;
 | 
			
		||||
io.streams.duplex io namespaces alien.syntax system combinators
 | 
			
		||||
io.buffers ;
 | 
			
		||||
IN: io.windows.ce.backend
 | 
			
		||||
 | 
			
		||||
: port-errored ( port -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -16,8 +17,12 @@ M: input-port (wait-to-read) ( port -- )
 | 
			
		|||
 | 
			
		||||
GENERIC: wince-write ( port port-handle -- )
 | 
			
		||||
 | 
			
		||||
M: windows-ce-io flush-output ( port -- )
 | 
			
		||||
    dup port-handle wince-write ;
 | 
			
		||||
M: port port-flush
 | 
			
		||||
    dup buffer-empty? over port-error or [
 | 
			
		||||
        drop
 | 
			
		||||
    ] [
 | 
			
		||||
        dup dup port-handle wince-write port-flush
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
M: windows-ce-io init-io ( -- )
 | 
			
		||||
    init-winsock ;
 | 
			
		||||
| 
						 | 
				
			
			@ -29,7 +34,7 @@ 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 [
 | 
			
		||||
    512 default-buffer-size [
 | 
			
		||||
        winnt? [
 | 
			
		||||
            STD_INPUT_HANDLE GetStdHandle
 | 
			
		||||
            STD_OUTPUT_HANDLE GetStdHandle
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -23,6 +23,5 @@ M: win32-file wince-write ( port port-handle -- )
 | 
			
		|||
        drop port-errored
 | 
			
		||||
    ] [
 | 
			
		||||
        FileArgs-lpNumberOfBytesRet *uint
 | 
			
		||||
        over buffer-consume
 | 
			
		||||
        port-flush
 | 
			
		||||
        swap buffer-consume
 | 
			
		||||
    ] if ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -95,7 +95,7 @@ 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 ;
 | 
			
		||||
    [ drop port-errored ] [ swap buffer-consume ] if ;
 | 
			
		||||
 | 
			
		||||
: do-connect ( addrspec -- socket )
 | 
			
		||||
    [ tcp-socket dup ] keep
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -39,9 +39,12 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
 | 
			
		|||
        2drop
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
M: windows-nt-io flush-output ( port -- )
 | 
			
		||||
: flush-output ( port -- )
 | 
			
		||||
    [ (flush-output) ] with-destructors ;
 | 
			
		||||
 | 
			
		||||
M: port port-flush
 | 
			
		||||
    dup buffer-empty? [ dup flush-output ] unless drop ;
 | 
			
		||||
 | 
			
		||||
: finish-read ( port -- )
 | 
			
		||||
    dup pending-error
 | 
			
		||||
    dup get-overlapped-result dup zero? [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,7 +32,6 @@ TUPLE: win32-file handle ptr overlapped ;
 | 
			
		|||
    \ win32-file construct ;
 | 
			
		||||
 | 
			
		||||
HOOK: CreateFile-flags io-backend ( -- DWORD )
 | 
			
		||||
HOOK: flush-output io-backend ( port -- )
 | 
			
		||||
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
 | 
			
		||||
HOOK: add-completion io-backend ( port -- )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -48,9 +47,6 @@ M: win32-file init-handle ( handle -- )
 | 
			
		|||
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 )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue