finish stream-write-attr/stream-write1 split

cvs
Slava Pestov 2005-07-17 19:22:06 +00:00
parent 9004533730
commit 34ba2a6bfc
8 changed files with 33 additions and 46 deletions

View File

@ -65,7 +65,6 @@ Investigate:
- nappend: instead of using push, enlarge the sequence with set-length
then add set the elements with set-nth
- specialized arrays
- phase out sbuf-append
+ kernel:
@ -89,7 +88,6 @@ Investigate:
- reading and writing byte arrays
- clean up line reading code in win32-io
- unix io: handle \n\r and \n\0
- separate words for writing characters and strings
- stream server can hang because of exception handler limitations
- better i/o scheduler
- unify unparse and prettyprint

View File

@ -109,13 +109,7 @@ SYMBOL: building
: , ( obj -- )
#! Add to the sequence being built with make-seq.
! The behavior where a string can be passed is deprecated;
! use % instead!
building get dup sbuf? [
over string? [ swap nappend ] [ push ] ifte
] [
push
] ifte ;
building get push ;
: unique, ( obj -- )
#! Add the object to the sequence being built with make-seq

View File

@ -37,6 +37,8 @@ C: buffer ( size -- buffer )
: buffer@ ( buffer -- int ) dup buffer-ptr swap buffer-pos + ;
: buffer-end ( buffer -- int ) dup buffer-ptr swap buffer-fill + ;
: buffer-first-n ( count buffer -- string )
[ dup buffer-fill swap buffer-pos - min ] keep
buffer@ swap memory>string ;
@ -62,10 +64,10 @@ C: buffer ( size -- buffer )
2dup buffer-ptr swap realloc check-ptr
over set-buffer-ptr set-buffer-size ;
: check-overflow ( string buffer -- )
over length over buffer-capacity > [
: check-overflow ( length buffer -- )
2dup buffer-capacity > [
dup eof? [
>r length r> buffer-extend
buffer-extend
] [
"Buffer overflow" throw
] ifte
@ -74,30 +76,21 @@ C: buffer ( size -- buffer )
] ifte ;
: >buffer ( string buffer -- )
2dup check-overflow
[ dup buffer-ptr swap buffer-fill + string>memory ] 2keep
over length over check-overflow
[ buffer-end string>memory ] 2keep
[ buffer-fill swap length + ] keep set-buffer-fill ;
: ch>buffer ( char buffer -- )
1 over check-overflow
[ buffer-end <alien> 0 set-alien-unsigned-1 ] keep
[ buffer-fill 1 + ] keep set-buffer-fill ;
: n>buffer ( count buffer -- )
#! Increases the fill pointer by count.
[ buffer-fill + ] keep set-buffer-fill ;
: buffer-end ( buffer -- int ) dup buffer-ptr swap buffer-fill + ;
: buffer-peek ( buffer -- char )
buffer@ <alien> 0 alien-unsigned-1 ;
: buffer-pop ( buffer -- char )
[ buffer-peek 1 ] keep buffer-consume ;
: buffer-append ( buffer buffer -- )
#! Append first buffer to second buffer.
2dup buffer-end over buffer-ptr rot buffer-fill memcpy
>r buffer-fill r> n>buffer ;
: buffer-set ( string buffer -- )
2dup buffer-ptr string>memory
>r length r> buffer-reset ;
: string>buffer ( string -- buffer )
dup length <buffer> tuck buffer-set ;

View File

@ -16,8 +16,7 @@ M: c-stream stream-write1 ( char stream -- )
>r ch>string r> c-stream-out fwrite ;
M: c-stream stream-write-attr ( str style stream -- )
nip >r dup string? [ ch>string ] unless r>
c-stream-out fwrite ;
nip c-stream-out fwrite ;
M: c-stream stream-read1 ( stream -- str )
c-stream-in dup [ fgetc ] when ;

View File

@ -2,10 +2,7 @@ USING: io kernel math namespaces sequences strings ;
! String buffers support the stream output protocol.
M: sbuf stream-write1 push ;
M: sbuf stream-write-attr
nip over string? [ swap nappend ] [ push ] ifte ;
M: sbuf stream-write-attr rot nappend drop ;
M: sbuf stream-close drop ;
M: sbuf stream-flush drop ;
M: sbuf stream-auto-flush drop ;

View File

@ -1,5 +1,17 @@
IN: temporary
USING: kernel io-internals test ;
USING: io-internals kernel kernel-internals sequences test ;
: buffer-append ( buffer buffer -- )
#! Append first buffer to second buffer.
2dup buffer-end over buffer-ptr rot buffer-fill memcpy
>r buffer-fill r> n>buffer ;
: buffer-set ( string buffer -- )
2dup buffer-ptr string>memory
>r length r> buffer-reset ;
: string>buffer ( string -- buffer )
dup length <buffer> tuck buffer-set ;
[ "" 65536 ] [
65536 <buffer>

View File

@ -38,20 +38,20 @@ prettyprint sequences io strings words styles ;
! 4 bytes -- length. -1 means EOF
! remaining -- input
: jedit-write-attr ( str style -- )
CHAR: w write
CHAR: w write1
[ drop . f . ] string-out
dup write-len write ;
TUPLE: jedit-stream ;
M: jedit-stream stream-readln ( stream -- str )
[ CHAR: r write flush 4 read be> read ] with-wrapper ;
[ CHAR: r write1 flush 4 read be> read ] with-wrapper ;
M: jedit-stream stream-write-attr ( str style stream -- )
[ jedit-write-attr ] with-wrapper ;
M: jedit-stream stream-flush ( stream -- )
[ CHAR: f write flush ] with-wrapper ;
[ CHAR: f write1 flush ] with-wrapper ;
C: jedit-stream ( stream -- stream )
[ >r <wrapper-stream> r> set-delegate ] keep ;

View File

@ -293,17 +293,11 @@ M: port stream-auto-flush ( stream -- ) drop ;
: wait-to-write ( len port -- )
tuck can-write? [ dup stream-flush ] unless pending-error ;
: blocking-write1 ( str writer -- )
1 over wait-to-write >buffer ;
M: port stream-write1 ( char writer -- )
nip >r dup string? [ ch>string ] unless r> blocking-write ;
: blocking-write ( str writer -- )
over length over wait-to-write >buffer ;
1 over wait-to-write ch>buffer ;
M: port stream-write-attr ( string style writer -- )
nip >r dup string? [ ch>string ] unless r> blocking-write ;
nip over length over wait-to-write >buffer ;
M: port stream-close ( stream -- )
dup stream-flush