FIFO Queue

This implements a FIFO queue. It was based on the code in a comp.lang.forth post titled "A queue without move", but has been refactored and expanded slightly. See https://narkive.com/khcCauFY for the original posting.

Limits

The queue size needs to be a power of 2.

Code

~~~:q:new    (n-a) here [ #0 , #0 , dup , allot ] dip ; :q:named  (ns-) [ q:new ] dip const ; :q:head   (q-a) ; immediate :q:tail   (q-a) n:inc ; :q:size   (q-n) #2 + fetch ; :q:list   (q-a) #3 + ; :q:mask   (q-n) q:size n:dec ; :q:length (q-n) [ q:head fetch ] [ q:tail fetch ] bi - ; :q:free   (q-n) &q:size sip q:length - ; :q:clear  (q-)  [ q:head v:off ] [ q:tail v:off ] bi ; :q:masked (aq-n) q:mask swap fetch and ; :q:empty? (q-f)  q:length n:zero? ; :q:full?  (q-f)  &q:length &q:size bi eq? ; :q:reset0 (q-)   dup q:empty? &q:clear &drop choose ;   {{   'R var     (for_adding_values)   :append-value swap @R q:list @R q:head @R q:masked + store                 @R q:head v:inc ;      (for_fetching_values)   :peek-value   @R q:list  @R q:tail @R q:masked + fetch ;   :fetch-value  peek-value @R q:tail v:inc swap @R q:reset0 ; ---reveal---   :q:add (nq-f)     [ !R ] [ q:free n:strictly-positive? dup ] bi     [ append-value ] if; nip ;     :q:get (q-nf)     [ !R ] [ q:length n:strictly-positive? dup ] bi     [ fetch-value ] if; #0 swap ;     :q:peek (q-nf)     [ !R ] [ q:length n:strictly-positive? dup ] bi     [ peek-value swap ] if; #0 swap ; }} ~~~

I am separating out the display code as it's fairly large and some may want to leave it out. (When compiled, this increases the size by more than 50%. While useful, the size hit may make it undesirable on systems with tight memory constraints)

~~~{{   'R var     (for_display)   :head?    @R q:tail @R q:masked eq? ;   :tail?    @R q:head fetch n:dec @R q:mask and eq? ;   :display  nl I dup n:put sp dup @R q:list + fetch n:put sp ;   :indicators dup head? [ '<--_tail s:put ] if                   tail? [ '<--_head s:put ] if ; ---reveal---   :q:put (q-)     [ !R ] [ q:free ] [ q:length ] tri     '\nin_que:_%n,_free:_%n s:format s:put     @R q:length n:strictly-positive?     [ @R q:size [ display indicators ] indexed-times ]     [ 'queue_is_empty s:put nl ] choose ; }} ~~~

Usage

The original didn't include any documentation, so here are a few brief notes on this.

Creating a new queue:

q:new q:named

Examples:

#16 q:new        (returns_a_pointer_to_the_queue) #16 'Q q:named   (create_a_queue_and_create_a_constant)                  (pointing_to_it)

See the Limits section for a note on the sizing.

Adding Values:

#1 Q q:add #2 Q q:add

The q:add returns a flag indicating success or fail. Check or discard this as necessary for your application.

Retreive Values:

Q q:get Q q:get

Like q:add, this returns a flag indicating success or failure. This also returns the value, or a value of 0 on failure.

Empty the Queue:

Q q:clear

Queue Queries:

Q q:size Q q:length

A Test

```#16 'Q q:named Q q:empty? n:put nl #100 Q q:add drop Q q:empty? n:put nl Q q:get drop-pair Q q:empty? n:put nl nl   Q q:full? n:put nl #16 [ #100 Q q:add drop ] times Q q:full? n:put nl Q q:size [ Q q:get drop-pair ] times Q q:full? n:put nl nl   #100 Q q:add #200 Q q:add #300 Q q:add #400 Q q:add #500 Q q:add dump-stack nl reset Q q:put nl 'values:_ s:put Q q:get drop n:put sp Q q:get drop n:put sp Q q:peek drop n:put sp Q q:peek drop n:put sp Q q:peek drop n:put sp Q q:get drop n:put sp Q q:get drop n:put nl nl Q q:put ```