core/io/buffer/buffer.factor

   1 ! Copyright (C) 2004, 2005 Mackenzie Straight.
   2 ! Copyright (C) 2006 Slava Pestov.
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 IN: io-internals
   5 USING: alien errors kernel kernel-internals libc math sequences
   6 strings ;
   7
   8 TUPLE: buffer size ptr fill pos ;
   9
  10 C: buffer ( n -- buffer )
  11     2dup set-buffer-size
  12     [ >r malloc check-ptr alien-address r> set-buffer-ptr ] keep
  13     0 over set-buffer-fill
  14     0 over set-buffer-pos ;
  15
  16 : buffer-free ( buffer -- )
  17     dup buffer-ptr <alien> free  0 swap set-buffer-ptr ;
  18
  19 : buffer-contents ( buffer -- string )
  20     dup buffer-ptr over buffer-pos +
  21     over buffer-fill rot buffer-pos - memory>string ;
  22
  23 : buffer-reset ( n buffer -- )
  24     [ set-buffer-fill ] keep 0 swap set-buffer-pos ;
  25
  26 : buffer-consume ( n buffer -- )
  27     [ buffer-pos + ] keep
  28     [ buffer-fill min ] keep
  29     [ set-buffer-pos ] keep
  30     dup buffer-pos over buffer-fill >= [
  31         0 over set-buffer-pos
  32         0 over set-buffer-fill
  33     ] when drop ;
  34
  35 : buffer@ ( buffer -- n ) dup buffer-ptr swap buffer-pos + ;
  36
  37 : buffer-end ( buffer -- n ) dup buffer-ptr swap buffer-fill + ;
  38
  39 : buffer-first-n ( n buffer -- string )
  40     [ dup buffer-fill swap buffer-pos - min ] keep
  41     buffer@ swap memory>string ;
  42
  43 : buffer> ( n buffer -- string )
  44     [ buffer-first-n ] 2keep buffer-consume ;
  45
  46 : buffer>> ( buffer -- string )
  47     [ buffer-contents ] keep 0 swap buffer-reset ;
  48
  49 : buffer-length ( buffer -- n )
  50     dup buffer-fill swap buffer-pos - ;
  51
  52 : buffer-capacity ( buffer -- n )
  53     dup buffer-size swap buffer-fill - ;
  54
  55 : buffer-empty? ( buffer -- ? ) buffer-fill zero? ;
  56
  57 : extend-buffer ( n buffer -- )
  58     2dup buffer-ptr <alien> swap realloc check-ptr alien-address
  59     over set-buffer-ptr set-buffer-size ;
  60
  61 : check-overflow ( n buffer -- )
  62     2dup buffer-capacity > [ extend-buffer ] [ 2drop ] if ;
  63
  64 : >buffer ( string buffer -- )
  65     over length over check-overflow
  66     [ buffer-end string>memory ] 2keep
  67     [ buffer-fill swap length + ] keep set-buffer-fill ;
  68
  69 : ch>buffer ( ch buffer -- )
  70     1 over check-overflow
  71     [ buffer-end f swap set-alien-unsigned-1 ] keep
  72     [ buffer-fill 1+ ] keep set-buffer-fill ;
  73
  74 : buffer-bound ( buffer -- n )
  75     dup buffer-ptr swap buffer-size + ;
  76
  77 : n>buffer ( n buffer -- )
  78     [ buffer-fill + ] keep
  79     [ buffer-bound > [ "Buffer overflow" throw ] when ] 2keep
  80     set-buffer-fill ;
  81
  82 : buffer-peek ( buffer -- ch )
  83     buffer@ f swap alien-unsigned-1 ;
  84
  85 : buffer-pop ( buffer -- ch )
  86     [ buffer-peek  1 ] keep buffer-consume ;