db4
Slava Pestov 2008-06-29 02:17:32 -05:00
parent 378b9d4508
commit 733479b8e2
3 changed files with 22 additions and 32 deletions

View File

@ -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" } }

View File

@ -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 ;
: <buffer> ( 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 <displaced-alien> ; 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 ;

View File

@ -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 <groups> ]
[ buffer>> size>> <groups> ]
[ [ stream-write ] curry ] bi
each
] [