1 ! Copyright (C) 2004, 2005 Mackenzie Straight.
2 ! Copyright (C) 2006, 2010 Slava Pestov.
3 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors alien alien.accessors alien.data byte-arrays
5 combinators destructors kernel libc math math.order math.private
6 sequences sequences.private typed ;
16 : <buffer> ( n -- buffer )
17 dup malloc 0 0 f buffer boa ; inline
19 M: buffer dispose* ptr>> free ; inline
21 TYPED: buffer-reset ( n: fixnum buffer: buffer -- )
22 swap >>fill 0 >>pos drop ; inline
24 TYPED: buffer-capacity ( buffer: buffer -- n )
25 [ size>> ] [ fill>> ] bi fixnum-fast ; inline
27 TYPED: buffer-empty? ( buffer: buffer -- ? )
30 TYPED: buffer-consume ( n: fixnum buffer: buffer -- )
31 [ fixnum+fast ] change-pos
32 dup [ pos>> ] [ fill>> ] bi <
33 [ 0 >>pos 0 >>fill ] unless drop ; inline
35 TYPED: buffer-peek ( buffer: buffer -- byte )
36 [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
38 TYPED: buffer-pop ( buffer: buffer -- byte )
39 [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
41 TYPED: buffer-length ( buffer: buffer -- n )
42 [ fill>> ] [ pos>> ] bi fixnum-fast ; inline
44 TYPED: buffer@ ( buffer: buffer -- alien )
45 [ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
47 TYPED: buffer-read-unsafe ( n: fixnum buffer: buffer -- n ptr )
48 [ buffer-length min ] keep
49 [ buffer@ ] [ buffer-consume ] 2bi ; inline
51 TYPED: buffer-read ( n: fixnum buffer: buffer -- byte-array )
52 buffer-read-unsafe swap memory>byte-array ; inline
54 TYPED: buffer-read-into ( dst n: fixnum buffer: buffer -- count )
55 buffer-read-unsafe swap [
60 [ swap alien-unsigned-1 ]
61 [ set-nth-unsafe ] bi-curry*
62 [ bi ] 2curry each-integer
66 TYPED: buffer-end ( buffer: buffer -- alien )
67 [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
69 TYPED: buffer+ ( n: fixnum buffer: buffer -- )
70 [ fixnum+fast ] change-fill drop ; inline
72 TYPED: buffer-write ( c-ptr n buffer: buffer -- )
73 [ buffer-end -rot memcpy ] [ buffer+ ] 2bi ; inline
75 TYPED: buffer-write1 ( byte: fixnum buffer: buffer -- )
76 [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
77 [ 1 swap buffer+ ] bi ; inline
79 TYPED: buffer-find ( seps buffer: buffer -- n/f )
81 swap [ [ pos>> ] [ fill>> ] [ ptr>> ] tri ] dip
82 [ swap alien-unsigned-1 ] [ member-eq? ] bi-curry*
83 compose find-integer-from
85 [ pos>> - ] curry [ f ] if*
90 : search-buffer-until ( seps buffer -- buffer n/f )
91 [ buffer-find ] keep swap ; inline
93 : finish-buffer-until ( buffer n -- byte-array sep/f )
98 [ buffer-length ] keep
104 TYPED: buffer-read-until ( seps buffer: buffer -- byte-array sep/f )
106 finish-buffer-until ;