From 34ba2a6bfc017bca0a02343eda8889c6a444c1f3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 17 Jul 2005 19:22:06 +0000 Subject: [PATCH] finish stream-write-attr/stream-write1 split --- TODO.FACTOR.txt | 2 -- library/collections/namespaces.factor | 8 +------ library/io/buffer.factor | 31 +++++++++++---------------- library/io/c-streams.factor | 3 +-- library/io/string-streams.factor | 5 +---- library/test/io/buffer.factor | 14 +++++++++++- library/tools/jedit-wire.factor | 6 +++--- library/unix/io.factor | 10 ++------- 8 files changed, 33 insertions(+), 46 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index ae333cab08..718d764fac 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -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 diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index fab5d8de1f..9c8ef4888b 100644 --- a/library/collections/namespaces.factor +++ b/library/collections/namespaces.factor @@ -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 diff --git a/library/io/buffer.factor b/library/io/buffer.factor index 624fa87943..0da40f7db5 100644 --- a/library/io/buffer.factor +++ b/library/io/buffer.factor @@ -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 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@ 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 tuck buffer-set ; diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor index 239cd9b1f3..e93180899b 100644 --- a/library/io/c-streams.factor +++ b/library/io/c-streams.factor @@ -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 ; diff --git a/library/io/string-streams.factor b/library/io/string-streams.factor index dee33b278c..2db2cf436b 100644 --- a/library/io/string-streams.factor +++ b/library/io/string-streams.factor @@ -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 ; diff --git a/library/test/io/buffer.factor b/library/test/io/buffer.factor index 2106c08682..49d023641a 100644 --- a/library/test/io/buffer.factor +++ b/library/test/io/buffer.factor @@ -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 tuck buffer-set ; [ "" 65536 ] [ 65536 diff --git a/library/tools/jedit-wire.factor b/library/tools/jedit-wire.factor index a0c7c39a20..6fa3de6958 100644 --- a/library/tools/jedit-wire.factor +++ b/library/tools/jedit-wire.factor @@ -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 r> set-delegate ] keep ; diff --git a/library/unix/io.factor b/library/unix/io.factor index c606545081..ec86637e99 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -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