DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦ed463e38d⟧ TextFile

    Length: 1227 (0x4cb)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Text_Io;

package body Fifo is
    Freecells : Pcell;--lien avec les elements libres

    function Newcell (E : in Integer) return Pcell is
        Result : Pcell;
    begin  
        if Freecells /= null then
            Result := Freecells;
            Freecells := Freecells.Suc;
            Result.all := Cell'(E, null);
            return Result;
        else
            return new Cell'(E, null);
        end if;
    end Newcell;

    procedure Oldcell (O : Pcell) is
    begin
        O.Suc := Freecells;
        Freecells := O;
    end Oldcell;

    procedure Enqueue (F : in out Object; E : in Integer) is
    begin
        F.Tail.Suc := Newcell (E);
        F.Tail := F.Tail.Suc;
    end Enqueue;


    procedure Dequeue (F : in out Object; E : out Integer) is  
        Tempo : Pcell;
    begin
        if F = Emptyfifo then
            raise Empty;
        else  
            E := F.Head.Val;
            Tempo := F.Head.Suc;
            Oldcell (F.Head);
            F.Head := Tempo;
        end if;
    end Dequeue;  
begin
    for I in 1 .. 50 loop
        Freecells := new Cell'(0, Freecells);
    end loop;

exception

    when Storage_Error =>
        Text_Io.Put_Line ("erreur package fifo");
end Fifo;