|
|
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: 1622 (0x656)
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⟧
with Text_Io;
package body Stack is
Freecell : Pcell;
procedure Create (F : in out Object) is
begin
F := Empty_Stack;
Text_Io.Put_Line ("pile creee");
end Create;
function Newcell (E : in Integer) return Pcell is
Result : Pcell;
begin
if Freecell /= null then
Result := Freecell;
Freecell := Freecell.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 := Freecell;
Freecell := O;
end Oldcell;
procedure Enqueue (F : in out Object; E : in Integer) is
Cellwork, Temp : Pcell;
begin
Text_Io.Put_Line ("element empile : " & Integer'Image (E));
if F = Empty_Stack then
Cellwork := Newcell (E);
F.Head := Cellwork;
else
Cellwork := Newcell (E);
Temp := F.Head;
F.Head := Cellwork;
F.Head.Suc := Temp;
end if;
end Enqueue;
procedure Dequeue (F : in out Object; E : in out Integer) is
Cellwork : Pcell;
begin
if F = Empty_Stack then
raise Empty;
else
E := F.Head.Val;
Cellwork := F.Head;
F.Head := F.Head.Suc;
Oldcell (Cellwork);
Text_Io.Put_Line ("valeur depilee : " & Integer'Image (E));
end if;
end Dequeue;
begin
for I in 1 .. 50 loop
Freecell := new Cell'(0, Freecell);
end loop;
end Stack;