basis/io/buffers/buffers.factor

   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 ;
   7 IN: io.buffers
   8
   9 TUPLE: buffer
  10 { size fixnum }
  11 { ptr alien }
  12 { fill fixnum }
  13 { pos fixnum }
  14 disposed ;
  15
  16 : <buffer> ( n -- buffer )
  17     dup malloc 0 0 f buffer boa ; inline
  18
  19 M: buffer dispose* ptr>> free ; inline
  20
  21 TYPED: buffer-reset ( n: fixnum buffer: buffer -- )
  22     swap >>fill 0 >>pos drop ; inline
  23
  24 TYPED: buffer-capacity ( buffer: buffer -- n )
  25     [ size>> ] [ fill>> ] bi fixnum-fast ; inline
  26
  27 TYPED: buffer-empty? ( buffer: buffer -- ? )
  28     fill>> zero? ; inline
  29
  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
  34
  35 TYPED: buffer-peek ( buffer: buffer -- byte )
  36     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
  37
  38 TYPED: buffer-pop ( buffer: buffer -- byte )
  39     [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
  40
  41 TYPED: buffer-length ( buffer: buffer -- n )
  42     [ fill>> ] [ pos>> ] bi fixnum-fast ; inline
  43
  44 TYPED: buffer@ ( buffer: buffer -- alien )
  45     [ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
  46
  47 TYPED: buffer-read-unsafe ( n: fixnum buffer: buffer -- n ptr )
  48     [ buffer-length min ] keep
  49     [ buffer@ ] [ buffer-consume ] 2bi ; inline
  50
  51 TYPED: buffer-read ( n: fixnum buffer: buffer -- byte-array )
  52     buffer-read-unsafe swap memory>byte-array ; inline
  53
  54 TYPED: buffer-read-into ( dst n: fixnum buffer: buffer -- count )
  55     buffer-read-unsafe swap [
  56         pick c-ptr? [
  57             memcpy
  58         ] [
  59             spin
  60             [ swap alien-unsigned-1 ]
  61             [ set-nth-unsafe ] bi-curry*
  62             [ bi ] 2curry each-integer
  63         ] if
  64     ] keep ; inline
  65
  66 TYPED: buffer-end ( buffer: buffer -- alien )
  67     [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
  68
  69 TYPED: buffer+ ( n: fixnum buffer: buffer -- )
  70     [ fixnum+fast ] change-fill drop ; inline
  71
  72 TYPED: buffer-write ( c-ptr n buffer: buffer -- )
  73     [ buffer-end -rot memcpy ] [ buffer+ ] 2bi ; inline
  74
  75 TYPED: buffer-write1 ( byte: fixnum buffer: buffer -- )
  76     [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
  77     [ 1 swap buffer+ ] bi ; inline
  78
  79 TYPED: buffer-find ( seps buffer: buffer -- n/f )
  80     [
  81         swap [ [ pos>> ] [ fill>> ] [ ptr>> ] tri ] dip
  82         [ swap alien-unsigned-1 ] [ member-eq? ] bi-curry*
  83         compose (find-integer)
  84     ] [
  85         [ pos>> - ] curry [ f ] if*
  86     ] bi ; inline
  87
  88 <PRIVATE
  89
  90 : search-buffer-until ( seps buffer -- buffer n/f )
  91     [ buffer-find ] keep swap ; inline
  92
  93 : finish-buffer-until ( buffer n -- byte-array sep/f )
  94     [
  95         over buffer-read
  96         swap buffer-pop
  97     ] [
  98         [ buffer-length ] keep
  99         buffer-read f
 100     ] if* ; inline
 101
 102 PRIVATE>
 103
 104 TYPED: buffer-read-until ( seps buffer: buffer -- byte-array sep/f )
 105     search-buffer-until
 106     finish-buffer-until ;