102 lines
2.9 KiB
Factor
102 lines
2.9 KiB
Factor
! Copyright (C) 2004, 2005 Mackenzie Straight.
|
|
! Copyright (C) 2006, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien alien.accessors alien.data byte-arrays
|
|
combinators destructors kernel libc math math.order math.private
|
|
sequences sequences.private typed ;
|
|
IN: io.buffers
|
|
|
|
TUPLE: buffer
|
|
{ size fixnum }
|
|
{ ptr alien }
|
|
{ fill fixnum }
|
|
{ pos fixnum }
|
|
disposed ;
|
|
|
|
: <buffer> ( n -- buffer )
|
|
dup malloc 0 0 f buffer boa ; inline
|
|
|
|
M: buffer dispose* ptr>> free ; inline
|
|
|
|
TYPED: buffer-reset ( n: fixnum buffer: buffer -- )
|
|
swap >>fill 0 >>pos drop ; inline
|
|
|
|
TYPED: buffer-capacity ( buffer: buffer -- n )
|
|
[ size>> ] [ fill>> ] bi fixnum-fast ; inline
|
|
|
|
TYPED: buffer-empty? ( buffer: buffer -- ? )
|
|
fill>> zero? ; inline
|
|
|
|
TYPED: buffer-consume ( n: fixnum buffer: buffer -- )
|
|
[ fixnum+fast ] change-pos
|
|
dup [ pos>> ] [ fill>> ] bi <
|
|
[ 0 >>pos 0 >>fill ] unless drop ; inline
|
|
|
|
TYPED: buffer-peek ( buffer: buffer -- byte )
|
|
[ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
|
|
|
|
TYPED: buffer-pop ( buffer: buffer -- byte )
|
|
[ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
|
|
|
|
TYPED: buffer-length ( buffer: buffer -- n )
|
|
[ fill>> ] [ pos>> ] bi fixnum-fast ; inline
|
|
|
|
TYPED: buffer@ ( buffer: buffer -- alien )
|
|
[ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
|
|
|
|
TYPED: buffer-read-unsafe ( n: fixnum buffer: buffer -- n ptr )
|
|
[ buffer-length min ] keep
|
|
[ buffer@ ] [ buffer-consume ] 2bi ; inline
|
|
|
|
TYPED: buffer-read ( n: fixnum buffer: buffer -- byte-array )
|
|
buffer-read-unsafe swap memory>byte-array ; inline
|
|
|
|
TYPED: buffer-read-into ( dst n: fixnum buffer: buffer -- count )
|
|
buffer-read-unsafe swap [
|
|
pick c-ptr? [
|
|
memcpy
|
|
] [
|
|
-rot swap
|
|
[ swap alien-unsigned-1 ]
|
|
[ set-nth-unsafe ] bi-curry*
|
|
[ bi ] 2curry each-integer
|
|
] if
|
|
] keep ; inline
|
|
|
|
TYPED: buffer-end ( buffer: buffer -- alien )
|
|
[ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
|
|
|
|
TYPED: buffer+ ( n: fixnum buffer: buffer -- )
|
|
[ fixnum+fast ] change-fill drop ; inline
|
|
|
|
TYPED: buffer-write ( c-ptr n buffer: buffer -- )
|
|
[ buffer-end -rot memcpy ] [ buffer+ ] 2bi ; inline
|
|
|
|
TYPED: buffer-write1 ( byte: fixnum buffer: buffer -- )
|
|
[ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
|
|
[ 1 swap buffer+ ] bi ; inline
|
|
|
|
<PRIVATE
|
|
|
|
: search-buffer-until ( pos fill ptr seps -- n )
|
|
[ iota ] 2dip
|
|
[ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry
|
|
find-from drop ; inline
|
|
|
|
: finish-buffer-until ( buffer n -- byte-array sep/f )
|
|
[
|
|
over pos>> -
|
|
over buffer-read
|
|
swap buffer-pop
|
|
] [
|
|
[ buffer-length ] keep
|
|
buffer-read f
|
|
] if* ; inline
|
|
|
|
PRIVATE>
|
|
|
|
TYPED: buffer-read-until ( seps buffer: buffer -- byte-array sep/f )
|
|
swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
|
|
search-buffer-until
|
|
finish-buffer-until ;
|