diff --git a/extra/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor index a11a7adead..b645f25055 100755 --- a/extra/io/buffers/buffers-docs.factor +++ b/extra/io/buffers/buffers-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax byte-arrays alien ; +USING: help.markup help.syntax byte-arrays alien destructors ; IN: io.buffers ARTICLE: "buffers" "Locked I/O buffers" @@ -7,8 +7,8 @@ $nl "Buffer words are found in the " { $vocab-link "buffers" } " vocabulary." { $subsection buffer } { $subsection } -"Buffers must be manually deallocated:" -{ $subsection buffer-free } +"Buffers must be manually deallocated by calling " { $link dispose } "." +$nl "Buffer operations:" { $subsection buffer-reset } { $subsection buffer-length } @@ -40,11 +40,6 @@ HELP: { $values { "n" "a non-negative integer" } { "buffer" buffer } } { $description "Creates a buffer with an initial capacity of " { $snippet "n" } " bytes." } ; -HELP: buffer-free -{ $values { "buffer" buffer } } -{ $description "De-allocates a buffer's underlying storage. The buffer may not be used after being freed." } -{ $warning "You " { $emphasis "must" } " free a buffer using this word, before letting the GC collect the buffer tuple instance." } ; - HELP: buffer-reset { $values { "n" "a non-negative integer" } { "buffer" buffer } } { $description "Resets the fill pointer to 0 and the position to " { $snippet "count" } "." } ; @@ -61,10 +56,6 @@ HELP: buffer-end { $values { "buffer" buffer } { "alien" alien } } { $description "Outputs the memory address of the current fill-pointer." } ; -HELP: (buffer-read) -{ $values { "n" "a non-negative integer" } { "buffer" buffer } { "byte-array" byte-array } } -{ $description "Outputs a byte array of the first " { $snippet "n" } " bytes at the buffer's current position. If there are less than " { $snippet "n" } " bytes available, the output is truncated." } ; - HELP: buffer-read { $values { "n" "a non-negative integer" } { "buffer" buffer } { "byte-array" byte-array } } { $description "Collects a byte array of " { $snippet "n" } " bytes starting from the buffer's current position, and advances the position accordingly. If there are less than " { $snippet "n" } " bytes available, the output is truncated." } ; diff --git a/extra/io/buffers/buffers-tests.factor b/extra/io/buffers/buffers-tests.factor index f66f9ed313..74a1797efc 100755 --- a/extra/io/buffers/buffers-tests.factor +++ b/extra/io/buffers/buffers-tests.factor @@ -1,6 +1,7 @@ IN: io.buffers.tests USING: alien alien.c-types io.buffers kernel kernel.private libc -sequences tools.test namespaces byte-arrays strings accessors ; +sequences tools.test namespaces byte-arrays strings accessors +destructors ; : buffer-set ( string buffer -- ) over >byte-array over buffer-ptr byte-array>memory @@ -18,7 +19,7 @@ sequences tools.test namespaces byte-arrays strings accessors ; 65536 dup buffer-read-all over buffer-capacity - rot buffer-free + rot dispose ] unit-test [ "hello world" "" ] [ @@ -26,34 +27,34 @@ sequences tools.test namespaces byte-arrays strings accessors ; dup buffer-read-all >string 0 pick buffer-reset over buffer-read-all >string - rot buffer-free + rot dispose ] unit-test [ "hello" ] [ "hello world" string>buffer - 5 over buffer-read >string swap buffer-free + 5 over buffer-read >string swap dispose ] unit-test [ 11 ] [ "hello world" string>buffer - [ buffer-length ] keep buffer-free + [ buffer-length ] keep dispose ] unit-test [ "hello world" ] [ "hello" 1024 [ buffer-set ] keep " world" >byte-array over >buffer - dup buffer-read-all >string swap buffer-free + dup buffer-read-all >string swap dispose ] unit-test [ CHAR: e ] [ "hello" string>buffer - 1 over buffer-consume [ buffer-pop ] keep buffer-free + 1 over buffer-consume [ buffer-pop ] keep dispose ] unit-test "hello world" string>buffer "b" set [ "hello world" ] [ 1000 "b" get buffer-read >string ] unit-test -"b" get buffer-free +"b" get dispose 100 "b" set [ 1000 "b" get n>buffer >string ] must-fail -"b" get buffer-free +"b" get dispose diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index d5b917246a..042e3953f1 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -1,77 +1,100 @@ ! Copyright (C) 2004, 2005 Mackenzie Straight. ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.accessors alien.c-types alien.syntax kernel -kernel.private libc math sequences byte-arrays strings hints -accessors math.order ; +USING: accessors alien alien.accessors alien.c-types +alien.syntax kernel libc math sequences byte-arrays strings +hints accessors math.order destructors combinators ; IN: io.buffers -TUPLE: buffer size ptr fill pos ; +TUPLE: buffer size ptr fill pos disposed ; : ( n -- buffer ) - dup malloc 0 0 buffer boa ; + dup malloc 0 0 f buffer boa ; -: buffer-free ( buffer -- ) - dup buffer-ptr free f swap set-buffer-ptr ; +M: buffer dispose* ptr>> free ; : buffer-reset ( n buffer -- ) - 0 swap { set-buffer-fill set-buffer-pos } set-slots ; - -: buffer-consume ( n buffer -- ) - [ buffer-pos + ] keep - [ buffer-fill min ] keep - [ set-buffer-pos ] keep - dup buffer-pos over buffer-fill >= [ - 0 over set-buffer-pos - 0 over set-buffer-fill - ] when drop ; - -: buffer@ ( buffer -- alien ) - dup buffer-pos swap buffer-ptr ; - -: buffer-end ( buffer -- alien ) - dup buffer-fill swap buffer-ptr ; - -: buffer-peek ( buffer -- byte ) - buffer@ 0 alien-unsigned-1 ; - -: buffer-pop ( buffer -- byte ) - dup buffer-peek 1 rot buffer-consume ; - -: (buffer-read) ( n buffer -- byte-array ) - [ [ fill>> ] [ pos>> ] bi - min ] keep - buffer@ swap memory>byte-array ; - -: buffer-read ( n buffer -- byte-array ) - [ (buffer-read) ] [ buffer-consume ] 2bi ; - -: buffer-length ( buffer -- n ) - [ fill>> ] [ pos>> ] bi - ; + swap >>fill 0 >>pos drop ; : buffer-capacity ( buffer -- n ) - [ size>> ] [ fill>> ] bi - ; + [ size>> ] [ fill>> ] bi - ; inline : buffer-empty? ( buffer -- ? ) fill>> zero? ; +: buffer-consume ( n buffer -- ) + [ + ] change-pos + dup [ pos>> ] [ fill>> ] bi < + [ 0 >>pos 0 >>fill ] unless drop ; inline + +: buffer-peek ( buffer -- byte ) + [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline + +: buffer-pop ( buffer -- byte ) + [ buffer-peek ] [ 1 swap buffer-consume ] bi ; + +HINTS: buffer-pop buffer ; + +: buffer-length ( buffer -- n ) + [ fill>> ] [ pos>> ] bi - ; inline + +: buffer@ ( buffer -- alien ) + [ pos>> ] [ ptr>> ] bi ; + +: buffer-read ( n buffer -- byte-array ) + [ buffer-length min ] keep + [ buffer@ ] [ buffer-consume ] 2bi + swap memory>byte-array ; + +HINTS: buffer-read fixnum buffer ; + : extend-buffer ( n buffer -- ) - 2dup buffer-ptr swap realloc - over set-buffer-ptr set-buffer-size ; + 2dup ptr>> swap realloc >>ptr swap >>size drop ; + inline : check-overflow ( n buffer -- ) 2dup buffer-capacity > [ extend-buffer ] [ 2drop ] if ; + inline -: >buffer ( byte-array buffer -- ) - over length over check-overflow - [ buffer-end byte-array>memory ] 2keep - [ buffer-fill swap length + ] keep set-buffer-fill ; - -: byte>buffer ( byte buffer -- ) - 1 over check-overflow - [ buffer-end 0 set-alien-unsigned-1 ] keep - [ 1+ ] change-fill drop ; +: buffer-end ( buffer -- alien ) + [ fill>> ] [ ptr>> ] bi ; inline : n>buffer ( n buffer -- ) - [ buffer-fill + ] keep - [ buffer-size > [ "Buffer overflow" throw ] when ] 2keep - set-buffer-fill ; + [ + ] change-fill + [ fill>> ] [ size>> ] bi > + [ "Buffer overflow" throw ] when ; inline + +: >buffer ( byte-array buffer -- ) + [ [ length ] dip check-overflow ] + [ buffer-end byte-array>memory ] + [ [ length ] dip n>buffer ] + 2tri ; + +HINTS: >buffer byte-array buffer ; + +: byte>buffer ( byte buffer -- ) + [ 1 swap check-overflow ] + [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ] + [ 1 swap n>buffer ] + tri ; + +HINTS: byte>buffer fixnum buffer ; + +: search-buffer-until ( pos fill ptr separators -- n ) + [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ; + +: finish-buffer-until ( buffer n -- byte-array separator ) + [ + over pos>> - + over buffer-read + swap buffer-pop + ] [ + buffer>> f + ] if* ; + +: buffer-until ( separators buffer -- byte-array separator ) + swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip + search-buffer-until + finish-buffer-until ; + +HINTS: buffer-until { string buffer } ; diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index 1cbbac7f20..b761ecaf5b 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -71,6 +71,28 @@ M: input-port stream-read ] [ 2nip ] if ] [ 2nip ] if ; +: read-until-step ( separators port -- string/f separator/f ) + dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ; + +: read-until-loop ( seps port buf -- separator/f ) + 2over read-until-step over [ + >r over push-all r> dup [ + >r 3drop r> + ] [ + drop read-until-loop + ] if + ] [ + >r 2drop 2drop r> + ] if ; + +M: input-port stream-read-until ( seps port -- str/f sep/f ) + 2dup read-until-step dup [ >r 2nip r> ] [ + over [ + drop + BV{ } like [ read-until-loop ] keep B{ } like swap + ] [ >r 2nip r> ] if + ] if ; + TUPLE: output-port < buffered-port ; : ( handle -- output-port ) @@ -121,7 +143,7 @@ M: output-port dispose* M: buffered-port dispose* [ call-next-method ] - [ [ [ buffer-free ] when* f ] change-buffer drop ] + [ [ [ dispose ] when* f ] change-buffer drop ] bi ; M: port cancel-operation handle>> cancel-operation ;