Kruhová fronta alias ring buffer

Napsáno zpětně, podle toho, co si pamatuju z přednášky 1. 12. 2006:

Deprecated: Assigning the return value of new by reference is deprecated in /DISK2/WWW/lokiware.info/mff/formatters/highlight/pascal.php on line 5

program RingBuffer (input, output);

{ Kruhove fronte se anglicky rika ring buffer, nebo circular buffer. }

const
    RBufSize    = 8;            { Staci }
    
type
    RBItem      = integer;      { Pro ukazkove ucely jsou polozkami kruhove fronty cislicka. }
    RBItemPtr   = ^RBItem;
    RBuffer     = record
        buf         : array[0..RBufSize] of RBItem;
        head        : integer;                          { place for newly added items }
        tail        : integer;                          { the "oldest" item }
        isEmpty     : boolean;
    end;
    RBufferPtr  = ^RBuffer;
    
    
procedure RBMakeEmpty(buf : RBufferPtr);
begin
    buf^.head       := 0;
    buf^.tail       := 0;
    buf^.isEmpty    := TRUE;
end;


function RBIsFull(buf : RBufferPtr) : boolean;
begin
    RBIsFull    := (buf^.head = buf^.tail) and not buf^.isEmpty;
end;


function RBAddItem(buf : RBufferPtr; item : RBItem) : boolean;
begin
    if not RBIsFull(buf) then
    begin
        buf^.buf[buf^.head] := item;
        buf^.head           := (buf^.head+1) mod RBufSize;
        if buf^.isEmpty then
            buf^.isEmpty    := FALSE;
        RBAddItem := TRUE;
    end
    else
        RBAddItem := FALSE;
end;


function RBGetItem(buf : RBufferPtr; item : RBItemPtr) : boolean;
begin
    if not buf^.isEmpty then
    begin
        item^   := buf^.buf[buf^.tail];
        buf^.tail           := (buf^.tail+1) mod RBufSize;
        if buf^.tail = buf^.head then
            buf^.isEmpty    := TRUE;
        RBGetItem := TRUE;
    end
    else
        RBGetItem := FALSE;
end;


var
    i       : integer;
    t       : RBItem;
    fifo    : RBuffer;
    trash   : boolean;  { we assign boolean return values here, as Turbo Pascal can't ignore them }

begin
    RBMakeEmpty(@fifo);
    
    { store and retrieve numbers 1..max }
    write('* test 1:');
    i := 1;
    while RBAddItem(@fifo, i) do
        inc(i);

    while RBGetItem(@fifo, @t) do
        write(' ', t);
    writeln;
    writeln;

    { store and retrieve numbers 1..42 }
    write('* test 2:');
    for i := 1 to 7 do
        trash := RBAddItem(@fifo, i);   
    for i := 8 to 42 do
    begin
        trash := RBGetItem(@fifo, @t);
        write(' ', t);
        trash := RBAddItem(@fifo, i);
    end;
    while RBGetItem(@fifo, @t) do
        write(' ', t);
    writeln;
    writeln;

end.

Matfiz: KruhováFronta

Kruhová fronta alias ring buffer