Faster Unix stream-read1

slava 2006-08-06 00:14:14 +00:00
parent dced940348
commit ff780119fa
2 changed files with 26 additions and 12 deletions

View File

@ -1,7 +1,5 @@
+ 0.84:
= bug fixes:
- fix contribs: boids, automata
- sometimes darcs get fails with the httpd
- gdb triggers 'mutliple i/o ops on port' error
@ -15,9 +13,6 @@
- nasty inference regressions
- [ [ dup call ] dup call ] infer hangs
- the invalid recursion form case needs to be fixed, for inlines too
= features:
- graphical module manager tool
- instead of decompiling words, add them to a 'recompile' set; compiler
treats words in the recompile set as if they were not compiled

View File

@ -167,7 +167,7 @@ GENERIC: task-container ( task -- vector )
: refill ( port -- ? )
#! Return f if there is a recoverable error
dup buffer-length zero? [
dup buffer-empty? [
dup (refill) dup 0 >= [
swap n>buffer t
] [
@ -177,6 +177,30 @@ GENERIC: task-container ( task -- vector )
drop t
] if ;
! Reading a single character
TUPLE: read1-task ;
C: read1-task ( port -- task )
[ >r <io-task> r> set-delegate ] keep ;
M: read1-task do-io-task ( task -- ? )
io-task-port dup refill [
[
dup buffer-empty?
[ t over set-port-eof? ] when
] when drop
] keep ;
M: read1-task task-container drop read-tasks get-global ;
: wait-to-read1 ( port -- )
dup buffer-empty? [
[ swap <read1-task> add-io-task stop ] callcc0
] when pending-error ;
M: input-port stream-read1 ( stream -- char/f )
dup wait-to-read1 dup port-eof? [ drop f ] [ buffer-pop ] if ;
! Reading character counts
: read-step ( count reader -- ? )
dup port-sbuf -rot >r over length - ( remaining) r>
@ -187,7 +211,7 @@ GENERIC: task-container ( task -- vector )
] if ;
: can-read-count? ( count reader -- ? )
dup pending-error 0 over port-sbuf set-length read-step ;
0 over port-sbuf set-length read-step ;
TUPLE: read-task count ;
@ -219,10 +243,6 @@ M: input-port stream-read ( count stream -- string )
[ wait-to-read ] keep dup port-eof?
[ drop f ] [ port-sbuf >string ] if ;
M: input-port stream-read1 ( stream -- char/f )
1 over wait-to-read dup port-eof?
[ drop f ] [ port-sbuf first ] if ;
! Writers
: open-write ( path -- fd )
@ -242,7 +262,6 @@ M: input-port stream-read1 ( stream -- char/f )
: can-write? ( len writer -- ? )
#! If the buffer is empty and the string is too long,
#! extend the buffer.
dup pending-error
dup buffer-empty? [
2drop t
] [