! Copyright (C) 2004, 2005 Mackenzie Straight.
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types
-alien.syntax kernel libc math sequences byte-arrays strings
-hints accessors math.order destructors combinators ;
+alien.data alien.syntax kernel libc math sequences byte-arrays
+strings hints math.order destructors combinators ;
IN: io.buffers
TUPLE: buffer
{ size fixnum }
-{ ptr simple-alien }
+{ ptr alien }
{ fill fixnum }
{ pos fixnum }
disposed ;
swap >>fill 0 >>pos drop ;
: buffer-capacity ( buffer -- n )
- [ size>> ] [ fill>> ] bi - ; inline
+ [ size>> ] [ fill>> ] bi - >fixnum ; inline
: buffer-empty? ( buffer -- ? )
fill>> zero? ; inline
[ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
: buffer-pop ( buffer -- byte )
- [ buffer-peek ] [ 1 swap buffer-consume ] bi ;
-
-HINTS: buffer-pop buffer ;
+ [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
: buffer-length ( buffer -- n )
[ fill>> ] [ pos>> ] bi - ; inline
: buffer@ ( buffer -- alien )
- [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
+ [ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
: buffer-read ( n buffer -- byte-array )
[ buffer-length min ] keep
HINTS: n>buffer fixnum buffer ;
: >buffer ( byte-array buffer -- )
- [ buffer-end byte-array>memory ]
- [ [ length ] dip n>buffer ]
+ [ buffer-end swap binary-object memcpy ]
+ [ [ byte-length ] dip n>buffer ]
2bi ;
HINTS: >buffer byte-array buffer ;
: byte>buffer ( byte buffer -- )
+ [ >fixnum ] dip
[ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
[ 1 swap n>buffer ]
- bi ;
-
-HINTS: byte>buffer fixnum buffer ;
+ bi ; inline
: search-buffer-until ( pos fill ptr separators -- n )
- [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ;
+ [ iota ] 2dip
+ [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry
+ find-from drop ; inline
: finish-buffer-until ( buffer n -- byte-array separator )
[
] [
[ buffer-length ] keep
buffer-read f
- ] if* ;
+ ] if* ; inline
: buffer-until ( separators buffer -- byte-array separator )
swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip