finish stream-write-attr/stream-write1 split
parent
9004533730
commit
34ba2a6bfc
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue