fth/ring.fs

   1 \ FLK Ring buffer handling
   2
   3 \ $Id$
   4 \ $Log$
   5
   6 \ The following words provide tools to handle a finite ring buffer acting as
   7 \ both a fifo and an array. The user of these words has to create the actual
   8 \ data space for the buffer.
   9 \
  10 \ Data is assumed to be added at the head pointer and retrieved at the tail
  11 \ pointer. The pointer contain the index where next fetch/store has to be
  12 \ done.
  13 \
  14 \ To use this file you need to define the following constants to contain the
  15 \ exception numbers. So you can use e.g. the proposed exception word (in FLK
  16 \ and gforth included).
  17
  18 \ Constant    Meaning
  19 \ RB-E-OVERFLOW   Tried to advance head pointer in a full buffer.
  20 \ RB-E-UNDERFLOW  Tried to remove data from an empty buffer.
  21 \ RB-E-RANGE    Tried to access an index outside the given limit.
  22
  23 \ Structure of the ring buffer record
  24 \ Offset  Meaning
  25 \ 0     Length
  26 \ 1 Cell  Head index
  27 \ 2 cells   tail index
  28 \ 3 cells   state ( RB-S-...)
  29
  30 \ States of a ring buffer. It is full, empty or none of both.
  31 0 CONSTANT RB-S-NORMAL
  32 1 CONSTANT RB-S-FULL
  33 2 CONSTANT RB-S-EMPTY
  34
  35 \ \ Create a structure to store the working data of the ring buffer.
  36 \ : RING-BUFFER         ( length -<name>- )
  37 \ ( OK )
  38 \  CREATE , 0 , 0 , RB-S-EMPTY , ;
  39
  40 \ Return the length of the buffer.
  41 : RB-LENGTH         ( rb -- length )
  42 ( OK )
  43   @ ;
  44
  45 \ Return the state of the buffer.
  46 : RB-STATE@         ( rb -- state )
  47 ( OK )
  48   3 CELLS + @ ;
  49
  50 \ Set the state of the buffer.
  51 : RB-STATE!         ( state rb -- )
  52 ( OK )
  53   3 CELLS + ! ;
  54
  55 \ Factor to fetch, modify and store a pointer.
  56 : (rb-advance)        ( rb p-addr -- rb p)
  57 ( OK )
  58   DUP @ 1+        \ rb p-addr p
  59   ROT DUP @         \ p-addr p rb len
  60   ROT TUCK        \ p-a rb p len p
  61   > INVERT IF         \ p-a rb p
  62     DROP 0
  63   THEN          \ p-addr rb p
  64   ROT OVER SWAP ! ;       \ rb p
  65
  66 \ Advance the head pointer (Data has been already added.).
  67 : RB-INSERTED         ( rb -- )
  68 ( OK )
  69   DUP RB-STATE@ RB-S-FULL =     \ rb full?
  70   IF RB-E-OVERFLOW THROW THEN     \ rb
  71   DUP CELL+         \ rb hp-addr
  72   (rb-advance)        \ rb hp
  73   OVER 2 CELLS + @      \ rb hp tp
  74   = IF RB-S-FULL ELSE RB-S-NORMAL THEN  \ rb state
  75   SWAP RB-STATE! ;
  76
  77 \ Advance the tail pointer (Data has been already removed.).
  78 : RB-DELETED        ( rb -- )
  79 ( OK )
  80   DUP RB-STATE@ RB-S-EMPTY =    \ rb empty?
  81   IF RB-E-UNDERFLOW THROW THEN    \ rb
  82   DUP 2 CELLS + (rb-advance)    \ rb tp
  83   OVER CELL+ @        \ rb tp hp
  84   = IF RB-S-EMPTY ELSE RB-S-NORMAL THEN \ rb state
  85   SWAP RB-STATE! ;
  86
  87 \ Return the index relative to the tail pointer. Therefore index 0 is the
  88 \ element that was added first, index 1 the one added next etc.
  89 : RB-INDEX        ( ind rb -- absind )
  90 ( OK )
  91   2DUP @ < INVERT
  92   IF RB-E-RANGE THROW THEN    \ ind rb
  93   DUP @ SWAP 2 CELLS + @    \ ind len tp
  94   ROT +         \ len absind
  95   2DUP > IF         \ len absind
  96     ( correct index )
  97     NIP         \ absind
  98   ELSE          \ len absind
  99     ( outside )
 100     SWAP -        \ absind
 101   THEN ;
 102
 103 \ Set the ring buffer to its initial state.
 104 : RB-RESET        ( rb -- )
 105 ( OK )
 106   CELL+ 0 OVER !      \ hp-a
 107   CELL+ 0 OVER !      \ tp-a
 108   CELL+ RB-S-EMPTY SWAP ! ;
 109
 110 \ Return the number of entries.
 111 : RB-ENTRIES        ( rb -- entries )
 112 ( OK )
 113   DUP RB-STATE@ RB-S-EMPTY = IF
 114     DROP 0 EXIT
 115   THEN
 116   DUP CELL+ DUP @ SWAP CELL+ @    \ rb hp tp
 117   2DUP > IF ( no wrap around )    \ rb hp tp
 118     ROT DROP
 119   ELSE ( wrap around )      \ rb hp tp
 120     ROT @         \ hp tp length
 121     ROT + SWAP        \ hp+l tp
 122   THEN
 123   - ;
 124
 125 \ Decrease the head-pointer.
 126 : RB-SHORTEND         ( rb -- )
 127 ( OK )
 128   DUP RB-STATE@ RB-S-EMPTY =
 129   IF RB-E-UNDERFLOW THROW THEN    \ rb
 130   DUP CELL+ @         \ rb hp
 131   DUP 0= IF         \ rb hp
 132     DROP DUP @        \ rb hp
 133   THEN 1-         \ rb hp-1
 134   2DUP SWAP CELL+ !       \ rb nhp
 135   OVER 2 CELLS + @      \ rb nhp tp
 136   = IF RB-S-EMPTY ELSE RB-S-NORMAL THEN \ rb state
 137   SWAP RB-STATE!  ;
 138
 139 \ Return the index of the head pointer.
 140 : RB-HEAD-INDEX       ( rb -- ind )
 141   CELL+ @ ;
 142
 143 \ Return the index of the tail pointer.
 144 : RB-TAIL-INDEX       ( rb -- ind )
 145   2 CELLS + @ ;