DataMuseum.dk

top - download

    Length: 1786 (0x6fa)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

package body Fifo is
    Free_Cells : Pcell;

    function New_Cell (I : Item) return Pcell is
        Temporary_Cell : Pcell;
    begin
        if Free_Cells = null then
            return new Cell'(I, null);
        else
            Temporary_Cell := Free_Cells;
            Free_Cells := Free_Cells.Follow;
            Temporary_Cell.Content := I;
            Temporary_Cell.Follow := null;
            return Temporary_Cell;
        end if;
    end New_Cell;

    procedure Dispose_Cell (The_Cell : Pcell) is
    begin
        The_Cell.Follow := Free_Cells;
        Free_Cells := The_Cell;
    end Dispose_Cell;

    function Make return Object is
    begin
        return Object'(null, null);
    end Make;


    procedure Enqueue (I : Item; To : in out Object) is
    begin  
        if Is_Empty (To) then
            To.Head := New_Cell (I);
            To.Tail := To.Head;
        else
            To.Tail.Follow := New_Cell (I);
            To.Tail := To.Tail.Follow;
        end if;
    end Enqueue;


    procedure Dequeue (I : out Item; From : in out Object) is
        Old_Follow : Pcell;
    begin
        I := From.Head.Content;
        if From.Head = From.Tail then
            Dispose_Cell (From.Head);
            From.Head := null;
            From.Tail := null;
        else
            Old_Follow := From.Head.Follow;
            Dispose_Cell (From.Head);
            From.Head := Old_Follow;
        end if;
    end Dequeue;


    function Is_Empty (F : Object) return Boolean is
    begin
        return F.Head = null and F.Tail = null;
    end Is_Empty;

begin
    declare  
        C : Pcell;
    begin
        for I in 1 .. 50 loop
            C := new Cell;
            C.Follow := Free_Cells;
            Free_Cells := C;
        end loop;
    end;
end Fifo;