! Copyright (C) 2004, 2005 Mackenzie Straight. ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.accessors alien.c-types alien.syntax kernel kernel.private libc math sequences byte-arrays strings hints accessors math.order ; IN: io.buffers TUPLE: buffer size ptr fill pos ; : ( n -- buffer ) dup malloc 0 0 buffer boa ; : buffer-free ( buffer -- ) dup buffer-ptr free f swap set-buffer-ptr ; : buffer-reset ( n buffer -- ) 0 swap { set-buffer-fill set-buffer-pos } set-slots ; : buffer-consume ( n buffer -- ) [ buffer-pos + ] keep [ buffer-fill min ] keep [ set-buffer-pos ] keep dup buffer-pos over buffer-fill >= [ 0 over set-buffer-pos 0 over set-buffer-fill ] when drop ; : buffer@ ( buffer -- alien ) dup buffer-pos swap buffer-ptr ; : buffer-end ( buffer -- alien ) dup buffer-fill swap buffer-ptr ; : buffer-peek ( buffer -- byte ) buffer@ 0 alien-unsigned-1 ; : buffer-pop ( buffer -- byte ) dup buffer-peek 1 rot buffer-consume ; : (buffer-read) ( n buffer -- byte-array ) [ [ fill>> ] [ pos>> ] bi - min ] keep buffer@ swap memory>byte-array ; : buffer-read ( n buffer -- byte-array ) [ (buffer-read) ] [ buffer-consume ] 2bi ; : buffer-length ( buffer -- n ) [ fill>> ] [ pos>> ] bi - ; : buffer-capacity ( buffer -- n ) [ size>> ] [ fill>> ] bi - ; : buffer-empty? ( buffer -- ? ) fill>> zero? ; : extend-buffer ( n buffer -- ) 2dup buffer-ptr swap realloc over set-buffer-ptr set-buffer-size ; : check-overflow ( n buffer -- ) 2dup buffer-capacity > [ extend-buffer ] [ 2drop ] if ; : >buffer ( byte-array buffer -- ) over length over check-overflow [ buffer-end byte-array>memory ] 2keep [ buffer-fill swap length + ] keep set-buffer-fill ; : byte>buffer ( byte buffer -- ) 1 over check-overflow [ buffer-end 0 set-alien-unsigned-1 ] keep [ 1+ ] change-fill drop ; : n>buffer ( n buffer -- ) [ buffer-fill + ] keep [ buffer-size > [ "Buffer overflow" throw ] when ] 2keep set-buffer-fill ;