|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 1227 (0x4cb)
Types: TextFile
Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─⟦d65440be7⟧ »DATA«
└─⟦this⟧
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;