diff --git a/extra/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor index b645f25055..266c0d64f1 100755 --- a/extra/io/buffers/buffers-docs.factor +++ b/extra/io/buffers/buffers-docs.factor @@ -2,7 +2,11 @@ USING: help.markup help.syntax byte-arrays alien destructors ; IN: io.buffers ARTICLE: "buffers" "Locked I/O buffers" -"I/O buffers are first-in-first-out queues of bytes. Their key feature is that they are backed by manually allocated storage that does not get moved by the garbage collector. They are used to implement native I/O backends." +"I/O buffers are first-in-first-out queues of bytes." +$nl +"Buffers are backed by manually allocated storage that does not get moved by the garbage collector; they are also low-level and sacrifice error checking for efficiency." +$nl +"Buffers are used to implement native I/O backends." $nl "Buffer words are found in the " { $vocab-link "buffers" } " vocabulary." { $subsection buffer } @@ -20,7 +24,6 @@ $nl { $subsection buffer-pop } { $subsection buffer-read } "Writing to the buffer:" -{ $subsection extend-buffer } { $subsection byte>buffer } { $subsection >buffer } { $subsection n>buffer } ; @@ -72,28 +75,20 @@ HELP: buffer-empty? { $values { "buffer" buffer } { "?" "a boolean" } } { $description "Tests if the buffer contains no more data to be read." } ; -HELP: extend-buffer -{ $values { "n" "a non-negative integer" } { "buffer" buffer } } -{ $description "Grows a buffer to fit " { $snippet "n" } " bytes of data." } ; - -HELP: check-overflow -{ $values { "n" "a non-negative integer" } { "buffer" buffer } } -{ $description "Grows the buffer, if possible, so it can accomodate " { $snippet "n" } " bytes." } -{ $warning "I/O system implementations should call this word or one of the other words that calls this word, at the beginning of an I/O transaction, when the buffer is empty. Buffers cannot be resized if they contain data; one of the requirements of a buffer is to remain fixed in memory while I/O operations are in progress." } -{ $errors "Throws an error if the buffer contains unread data, and the new data does not fit." } ; - HELP: >buffer { $values { "byte-array" byte-array } { "buffer" buffer } } -{ $description "Copies a byte array to the buffer's fill pointer, and advances it accordingly." } ; +{ $description "Copies a byte array to the buffer's fill pointer, and advances it accordingly." } +{ $warning "This word will corrupt memory if the byte array is larger than the space available in the buffer." } ; HELP: byte>buffer { $values { "byte" "a byte" } { "buffer" buffer } } -{ $description "Appends a single byte to a buffer." } ; +{ $description "Appends a single byte to a buffer." } +{ $warning "This word will corrupt memory if the buffer is full." } ; HELP: n>buffer { $values { "n" "a non-negative integer" } { "buffer" buffer } } { $description "Advances the fill pointer by " { $snippet "n" } " bytes." } -{ $errors "Throws an error if the buffer does not contain " { $snippet "n" } " bytes of data." } ; +{ $warning "This word will leave the buffer in an invalid state if it does not have " { $snippet "n" } " bytes available." } ; HELP: buffer-peek { $values { "buffer" buffer } { "byte" "a byte" } } diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index a65717fb86..3627a764ba 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -6,7 +6,12 @@ alien.syntax kernel libc math sequences byte-arrays strings hints accessors math.order destructors combinators ; IN: io.buffers -TUPLE: buffer size ptr fill pos disposed ; +TUPLE: buffer +{ "size" fixnum } +{ "ptr" simple-alien } +{ "fill" fixnum } +{ "pos" fixnum } +disposed ; : ( n -- buffer ) dup malloc 0 0 f buffer boa ; @@ -48,35 +53,25 @@ HINTS: buffer-pop buffer ; HINTS: buffer-read fixnum buffer ; -: extend-buffer ( n buffer -- ) - 2dup ptr>> swap realloc >>ptr swap >>size drop ; - inline - -: check-overflow ( n buffer -- ) - 2dup buffer-capacity > [ extend-buffer ] [ 2drop ] if ; - inline - : buffer-end ( buffer -- alien ) [ fill>> ] [ ptr>> ] bi ; inline : n>buffer ( n buffer -- ) - [ + ] change-fill - [ fill>> ] [ size>> ] bi > - [ "Buffer overflow" throw ] when ; inline + [ + ] change-fill drop ; inline + +HINTS: n>buffer fixnum buffer ; : >buffer ( byte-array buffer -- ) - [ [ length ] dip check-overflow ] [ buffer-end byte-array>memory ] [ [ length ] dip n>buffer ] - 2tri ; + 2bi ; 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 ; + bi ; HINTS: byte>buffer fixnum buffer ; diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index f54cd2e9b3..3aea311336 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -110,7 +110,7 @@ M: output-port stream-write1 M: output-port stream-write dup check-disposed over length over buffer>> buffer-size > [ - [ buffer>> buffer-size ] + [ buffer>> size>> ] [ [ stream-write ] curry ] bi each ] [