I/O backend cleanups, mostly CE
parent
32b3a70b44
commit
32df75da83
|
@ -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