win32 io bugfixes
parent
b645c7d5ae
commit
07af3690f2
|
@ -1,20 +0,0 @@
|
||||||
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
|
||||||
|
|
||||||
IN: io
|
|
||||||
USING: compiler namespaces kernel win32-io-internals win32-stream win32-api
|
|
||||||
threads ;
|
|
||||||
|
|
||||||
: <file-reader> <win32-file-reader> ;
|
|
||||||
: <file-writer> <win32-file-writer> ;
|
|
||||||
: <server> make-win32-server ;
|
|
||||||
|
|
||||||
IN: io-internals
|
|
||||||
|
|
||||||
: io-multiplex ( ms -- )
|
|
||||||
dup -1 = [ drop INFINITE ] when cancel-timedout wait-for-io
|
|
||||||
swap [ schedule-thread-with ] [ drop ] if* ;
|
|
||||||
|
|
||||||
: init-io ( -- )
|
|
||||||
win32-init-stdio
|
|
||||||
init-winsock ;
|
|
||||||
|
|
|
@ -0,0 +1,41 @@
|
||||||
|
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
||||||
|
|
||||||
|
IN: io
|
||||||
|
USING: win32-api win32-io-internals win32-server win32-stream ;
|
||||||
|
USING: alien kernel io-internals namespaces threads ;
|
||||||
|
|
||||||
|
: <file-reader> ( path -- stream ) <win32-file-reader> ;
|
||||||
|
: <file-writer> ( path -- stream ) <win32-file-writer> ;
|
||||||
|
|
||||||
|
SYMBOL: serv
|
||||||
|
: accept ( server -- client )
|
||||||
|
[
|
||||||
|
duplex-stream-in
|
||||||
|
serv set
|
||||||
|
serv get update-timeout new-socket 64 <buffer>
|
||||||
|
[
|
||||||
|
serv get alloc-io-callback f swap init-overlapped
|
||||||
|
>r >r >r serv get win32-stream-handle r> r>
|
||||||
|
buffer-ptr <alien> 0 32 32 f r> AcceptEx
|
||||||
|
handle-socket-error!=0/f stop
|
||||||
|
] callcc1 drop
|
||||||
|
swap dup add-completion <win32-stream> <win32-duplex-stream>
|
||||||
|
dupd <win32-client-stream> swap buffer-free
|
||||||
|
] with-scope ;
|
||||||
|
|
||||||
|
: <client> ( host port -- stream )
|
||||||
|
client-sockaddr new-socket
|
||||||
|
[ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep
|
||||||
|
dup add-completion <win32-stream> <win32-duplex-stream> ;
|
||||||
|
: <server> ( port -- stream ) make-win32-server ;
|
||||||
|
|
||||||
|
IN: io-internals
|
||||||
|
|
||||||
|
: io-multiplex ( ms -- )
|
||||||
|
dup -1 = [ drop INFINITE ] when cancel-timedout wait-for-io
|
||||||
|
swap [ schedule-thread-with ] [ drop ] if* ;
|
||||||
|
|
||||||
|
: init-io ( -- )
|
||||||
|
win32-init-stdio
|
||||||
|
init-winsock ;
|
||||||
|
|
|
@ -5,5 +5,5 @@ PROVIDE: library/io/windows {
|
||||||
"io-internals.factor"
|
"io-internals.factor"
|
||||||
"stream.factor"
|
"stream.factor"
|
||||||
"server.factor"
|
"server.factor"
|
||||||
"io-last.factor"
|
"io.factor"
|
||||||
} ;
|
} ;
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
||||||
|
|
||||||
IN: win32-stream
|
IN: win32-server
|
||||||
USING: alien errors generic kernel kernel-internals math namespaces
|
USING: alien errors generic kernel kernel-internals math namespaces
|
||||||
prettyprint sequences io strings threads win32-api
|
prettyprint sequences io strings threads win32-api
|
||||||
win32-io-internals io-internals ;
|
win32-io-internals io-internals win32-stream ;
|
||||||
|
|
||||||
TUPLE: win32-client-stream host port ;
|
TUPLE: win32-client-stream host port ;
|
||||||
|
|
||||||
|
@ -68,26 +68,3 @@ M: win32-client-stream client-stream-port ( win32-client-stream -- port )
|
||||||
r> set-sockaddr-in-addr
|
r> set-sockaddr-in-addr
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
IN: io
|
|
||||||
|
|
||||||
SYMBOL: serv
|
|
||||||
: accept ( server -- client )
|
|
||||||
[
|
|
||||||
duplex-stream-in
|
|
||||||
serv set
|
|
||||||
serv get update-timeout new-socket 64 <buffer>
|
|
||||||
[
|
|
||||||
serv get alloc-io-callback f swap init-overlapped
|
|
||||||
>r >r >r serv get win32-stream-handle r> r>
|
|
||||||
buffer-ptr <alien> 0 32 32 f r> AcceptEx
|
|
||||||
handle-socket-error!=0/f stop
|
|
||||||
] callcc1 drop
|
|
||||||
swap dup add-completion <win32-stream> <win32-duplex-stream>
|
|
||||||
dupd <win32-client-stream> swap buffer-free
|
|
||||||
] with-scope ;
|
|
||||||
|
|
||||||
: <client> ( host port -- stream )
|
|
||||||
client-sockaddr new-socket
|
|
||||||
[ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep
|
|
||||||
dup add-completion <win32-stream> <win32-duplex-stream> ;
|
|
||||||
|
|
||||||
|
|
|
@ -64,8 +64,7 @@ TUPLE: win32-duplex-stream ;
|
||||||
dup empty? [
|
dup empty? [
|
||||||
2drop >string-or-f nip
|
2drop >string-or-f nip
|
||||||
] [
|
] [
|
||||||
swapd over >r nappend r>
|
rot >r [ length - ] keep r> [ swap nappend ] keep swap do-read-count
|
||||||
[ length - ] keep swap do-read-count
|
|
||||||
] if
|
] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
@ -112,8 +111,7 @@ M: win32-stream-reader stream-read1 ( stream -- ch/f )
|
||||||
>r 1 r> consume-input >string-or-f first ;
|
>r 1 r> consume-input >string-or-f first ;
|
||||||
|
|
||||||
M: win32-stream-reader stream-read ( n stream -- str/f )
|
M: win32-stream-reader stream-read ( n stream -- str/f )
|
||||||
>r [ <sbuf> ] keep r> -rot do-read-count ;
|
swap >r win32-buffer-size <sbuf> r> do-read-count ;
|
||||||
|
|
||||||
|
|
||||||
M: win32-stream-writer stream-close ( stream -- )
|
M: win32-stream-writer stream-close ( stream -- )
|
||||||
dup maybe-flush-output
|
dup maybe-flush-output
|
||||||
|
|
Loading…
Reference in New Issue