Faster Unix stream-read1
parent
dced940348
commit
ff780119fa
|
@ -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
|
||||
|
|
|
@ -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
|
||||
] [
|
||||
|
|
Loading…
Reference in New Issue