I/O backend cleanups, mostly CE

release
Slava Pestov 2007-11-09 03:01:45 -05:00
parent 32b3a70b44
commit 32df75da83
7 changed files with 25 additions and 20 deletions

View File

@ -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 -- )

View File

@ -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 ;

View File

@ -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

View File

@ -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 ;

View File

@ -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

View File

@ -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? [

View File

@ -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 )
[