steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactor win32-streams some more

erg 2006-09-05 19:15:47 +00:00
parent ebfa4605b2
commit 04a5a94d57
1 changed files with 19 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
library/io/windows/stream.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2005 Mackenzie Straight. ! Copyright (C) 2004, 2006 Mackenzie Straight, Doug Coleman.
IN: win32-stream IN: win32-stream
USING: alien generic hashtables io-internals kernel USING: alien generic hashtables io-internals kernel
@ -35,7 +35,6 @@ SYMBOL: cutoff
: update-timeout ( -- ) : update-timeout ( -- )
timeout get [ millis + cutoff set ] when* ; timeout get [ millis + cutoff set ] when* ;
! Read ! Read
: fill-input ( -- ) : fill-input ( -- )
update-timeout [ update-timeout [
@ -45,7 +44,6 @@ SYMBOL: cutoff
f r> f r>
ReadFile [ handle-io-error ] unless stop ReadFile [ handle-io-error ] unless stop
] callcc1 pending-error ] callcc1 pending-error
dup in-buffer get n>buffer update-file-pointer ; dup in-buffer get n>buffer update-file-pointer ;
: consume-input ( count buffer -- str ) : consume-input ( count buffer -- str )
@ -71,10 +69,7 @@ SYMBOL: cutoff
] if ] if
] if ; ] if ;
! Write ! Write
: flush-output ( -- ) : flush-output ( -- )
update-timeout [ update-timeout [
stream get alloc-io-callback init-overlapped >r stream get alloc-io-callback init-overlapped >r
@ -85,46 +80,35 @@ SYMBOL: cutoff
out-buffer get [ buffer-consume ] keep out-buffer get [ buffer-consume ] keep
buffer-length 0 > [ flush-output ] when ; buffer-length 0 > [ flush-output ] when ;
! : maybe-flush-output ( buffer -- ) : maybe-flush-output ( buffer -- )
: maybe-flush-output ( -- ) buffer-length 0 > [ flush-output ] when ;
out-buffer get buffer-length 0 > [ flush-output ] when ;
GENERIC: do-write GENERIC: do-write
M: integer do-write ( integer -- ) M: integer do-write ( buffer integer -- )
out-buffer get [ buffer-capacity zero? [ flush-output ] when ] keep over buffer-capacity zero? [ flush-output ] when
>r ch>string r> >buffer ; ch>string swap >buffer ;
M: string do-write ( string -- ) M: string do-write ( buffer string -- )
dup length out-buffer get buffer-capacity <= [ dup length pick buffer-capacity <= [
out-buffer get >buffer swap >buffer
] [ ] [
dup length out-buffer get buffer-size > [ dup length pick buffer-size > [
dup length out-buffer get extend-buffer do-write dup length pick extend-buffer
] [ flush-output do-write ] if ] [
flush-output
] if do-write
] if ; ] if ;
! : peek-input ( -- str ) 1 in-buffer get buffer-first-n ;
: synch-win32-stream ( win32-stream -- )
win32-stream-this the-hash set
;
M: win32-stream stream-close ( stream -- ) M: win32-stream stream-close ( stream -- )
win32-stream-this [ win32-stream-this [
maybe-flush-output out-buffer get maybe-flush-output
handle get CloseHandle drop handle get CloseHandle drop
in-buffer get buffer-free in-buffer get buffer-free
out-buffer get buffer-free out-buffer get buffer-free
] bind ; ] bind ;
M: win32-stream stream-read1 ( stream -- ch/f ) M: win32-stream stream-read1 ( stream -- ch/f )
win32-stream-this [ win32-stream-this [
1 in-buffer get consume-input >string-or-f first 1 in-buffer get consume-input >string-or-f first
@ -138,16 +122,13 @@ M: win32-stream stream-read ( n stream -- str/f )
M: win32-stream stream-flush ( stream -- ) M: win32-stream stream-flush ( stream -- )
win32-stream-this [ maybe-flush-output ] bind ; win32-stream-this [ out-buffer get maybe-flush-output ] bind ;
M: win32-stream stream-write1 ( ch stream -- ) M: win32-stream stream-write1 ( ch stream -- )
win32-stream-this [ >fixnum do-write ] bind ; win32-stream-this [ >r out-buffer get r> >fixnum do-write ] bind ;
M: win32-stream stream-write ( str stream -- ) M: win32-stream stream-write ( str stream -- )
win32-stream-this [ do-write ] bind ; win32-stream-this [ >r out-buffer get r> do-write ] bind ;
M: win32-stream set-timeout ( n stream -- ) M: win32-stream set-timeout ( n stream -- )