Merge git://factorcode.org/git/factor
commit
2b5d33e740
|
@ -1,8 +1,12 @@
|
||||||
USING: system vocabs vocabs.loader kernel ;
|
USING: system vocabs vocabs.loader kernel combinators
|
||||||
|
namespaces sequences ;
|
||||||
IN: bootstrap.io
|
IN: bootstrap.io
|
||||||
|
|
||||||
"bootstrap.compiler" vocab [
|
"bootstrap.compiler" vocab [
|
||||||
unix? [ "io.unix" require ] when
|
"io." {
|
||||||
winnt? [ "io.windows.nt" require ] when
|
{ [ "io-backend" get ] [ "io-backend" get ] }
|
||||||
wince? [ "io.windows.ce" require ] when
|
{ [ unix? ] [ "unix" ] }
|
||||||
|
{ [ winnt? ] [ "windows.nt" ] }
|
||||||
|
{ [ wince? ] [ "windows.ce" ] }
|
||||||
|
} cond append require
|
||||||
] when
|
] when
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
IN: io.nonblocking
|
IN: io.nonblocking
|
||||||
USING: math kernel io sequences io.buffers generic sbufs
|
USING: math kernel io sequences io.buffers generic sbufs
|
||||||
system io.streams.lines io.streams.plain io.streams.duplex
|
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
|
SYMBOL: default-buffer-size
|
||||||
64 1024 * default-buffer-size set-global
|
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 ;
|
>r 0 max >fixnum r> read-step ;
|
||||||
|
|
||||||
: can-write? ( len writer -- ? )
|
: can-write? ( len writer -- ? )
|
||||||
dup buffer-empty? [
|
[ buffer-fill + ] keep buffer-capacity <= ;
|
||||||
2drop t
|
|
||||||
] [
|
|
||||||
[ buffer-fill + ] keep buffer-capacity <=
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: wait-to-write ( len port -- )
|
: wait-to-write ( len port -- )
|
||||||
tuck can-write? [ drop ] [ stream-flush ] if ;
|
tuck can-write? [ drop ] [ stream-flush ] if ;
|
||||||
|
@ -150,7 +147,12 @@ M: output-port stream-write1
|
||||||
1 over wait-to-write ch>buffer ;
|
1 over wait-to-write ch>buffer ;
|
||||||
|
|
||||||
M: output-port stream-write
|
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 -- )
|
GENERIC: port-flush ( port -- )
|
||||||
|
|
||||||
|
|
|
@ -159,7 +159,7 @@ TUPLE: write-task ;
|
||||||
: <write-task> ( port -- task ) write-task <io-task> ;
|
: <write-task> ( port -- task ) write-task <io-task> ;
|
||||||
|
|
||||||
M: write-task do-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 ;
|
[ 0 swap buffer-reset t ] [ write-step ] if ;
|
||||||
|
|
||||||
M: write-task task-container drop write-tasks get-global ;
|
M: write-task task-container drop write-tasks get-global ;
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
USING: io.nonblocking io.windows threads.private kernel
|
USING: io.nonblocking io.windows threads.private kernel
|
||||||
io.backend windows.winsock windows.kernel32 windows
|
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
|
IN: io.windows.ce.backend
|
||||||
|
|
||||||
: port-errored ( port -- )
|
: port-errored ( port -- )
|
||||||
|
@ -16,8 +17,12 @@ M: input-port (wait-to-read) ( port -- )
|
||||||
|
|
||||||
GENERIC: wince-write ( port port-handle -- )
|
GENERIC: wince-write ( port port-handle -- )
|
||||||
|
|
||||||
M: windows-ce-io flush-output ( port -- )
|
M: port port-flush
|
||||||
dup port-handle wince-write ;
|
dup buffer-empty? over port-error or [
|
||||||
|
drop
|
||||||
|
] [
|
||||||
|
dup dup port-handle wince-write port-flush
|
||||||
|
] if ;
|
||||||
|
|
||||||
M: windows-ce-io init-io ( -- )
|
M: windows-ce-io init-io ( -- )
|
||||||
init-winsock ;
|
init-winsock ;
|
||||||
|
@ -29,7 +34,7 @@ FUNCTION: void* _fileno void* file ;
|
||||||
M: windows-ce-io init-stdio ( -- )
|
M: windows-ce-io init-stdio ( -- )
|
||||||
#! We support Windows NT too, to make this I/O backend
|
#! We support Windows NT too, to make this I/O backend
|
||||||
#! easier to debug.
|
#! easier to debug.
|
||||||
4096 default-buffer-size [
|
512 default-buffer-size [
|
||||||
winnt? [
|
winnt? [
|
||||||
STD_INPUT_HANDLE GetStdHandle
|
STD_INPUT_HANDLE GetStdHandle
|
||||||
STD_OUTPUT_HANDLE GetStdHandle
|
STD_OUTPUT_HANDLE GetStdHandle
|
||||||
|
|
|
@ -23,6 +23,5 @@ M: win32-file wince-write ( port port-handle -- )
|
||||||
drop port-errored
|
drop port-errored
|
||||||
] [
|
] [
|
||||||
FileArgs-lpNumberOfBytesRet *uint
|
FileArgs-lpNumberOfBytesRet *uint
|
||||||
over buffer-consume
|
swap buffer-consume
|
||||||
port-flush
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -95,7 +95,7 @@ M: win32-socket wince-write ( port port-handle -- )
|
||||||
win32-file-handle over buffer@ pick buffer-length 0
|
win32-file-handle over buffer@ pick buffer-length 0
|
||||||
windows.winsock:send
|
windows.winsock:send
|
||||||
dup windows.winsock:SOCKET_ERROR =
|
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 )
|
: do-connect ( addrspec -- socket )
|
||||||
[ tcp-socket dup ] keep
|
[ tcp-socket dup ] keep
|
||||||
|
|
|
@ -39,9 +39,12 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
|
||||||
2drop
|
2drop
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: windows-nt-io flush-output ( port -- )
|
: flush-output ( port -- )
|
||||||
[ (flush-output) ] with-destructors ;
|
[ (flush-output) ] with-destructors ;
|
||||||
|
|
||||||
|
M: port port-flush
|
||||||
|
dup buffer-empty? [ dup flush-output ] unless drop ;
|
||||||
|
|
||||||
: finish-read ( port -- )
|
: finish-read ( port -- )
|
||||||
dup pending-error
|
dup pending-error
|
||||||
dup get-overlapped-result dup zero? [
|
dup get-overlapped-result dup zero? [
|
||||||
|
|
|
@ -32,7 +32,6 @@ TUPLE: win32-file handle ptr overlapped ;
|
||||||
\ win32-file construct ;
|
\ win32-file construct ;
|
||||||
|
|
||||||
HOOK: CreateFile-flags io-backend ( -- DWORD )
|
HOOK: CreateFile-flags io-backend ( -- DWORD )
|
||||||
HOOK: flush-output io-backend ( port -- )
|
|
||||||
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
|
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
|
||||||
HOOK: add-completion io-backend ( port -- )
|
HOOK: add-completion io-backend ( port -- )
|
||||||
|
|
||||||
|
@ -48,9 +47,6 @@ M: win32-file init-handle ( handle -- )
|
||||||
M: win32-file close-handle ( handle -- )
|
M: win32-file close-handle ( handle -- )
|
||||||
win32-file-handle CloseHandle drop ;
|
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
|
! Clean up resources (open handle) if add-completion fails
|
||||||
: open-file ( path access-mode create-mode -- handle )
|
: open-file ( path access-mode create-mode -- handle )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue