|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 1797 (0x705)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦91f445216⟧
└─⟦this⟧
generic
type OBJET is private;
package PILE_PKG is
type tPile is limited private;
Pile_Vide:exception;
procedure Empiler(PILE: in out tPile; x:in objet);
procedure Depiler(PILE: in out tPile);
function Vide(PILE:in tPile) return boolean;
function Consulter(PILE:in tPile) return objet;
private
type Noeud;
type tPile is access Noeud;
type Noeud is record
Contenu:objet;
Suivant:tPile:=null;
end record;
end PILE_PKG;
with UNCHECKED_DEALLOCATION;
package body PILE_PKG is
procedure Dispose is new UNCHECKED_DEALLOCATION(Noeud,tPile);
procedure Empiler(PILE: in out tPile; x:in objet) is
p:tPile;
begin
p:=new NOEUD'(Contenu=>x, Suivant=>PILE);
PILE:=p;
end Empiler;
procedure Depiler(PILE: in out tPile) is
p: tPile;
begin
p:=PILE;
PILE:=PILE.Suivant;
dispose(p);
exception
when Constraint_Error => raise Pile_Vide;
end Depiler;
function Vide(PILE:in tPile) return boolean is
begin
return (PILE=NULL);
end Vide;
function Consulter(PILE:in tPile) return objet is
begin
return PILE.Contenu;
end Consulter;
end PILE_PKG;
with PILE_PKG,text_io;
procedure stack_try is
package gestion_pile is new pile_pkg(character);
pile:gestion_pile.tPile;
begin
gestion_pile.Empiler(pile,'a');
gestion_pile.Empiler(pile,'b');
gestion_pile.Empiler(pile,'c');
gestion_pile.Empiler(pile,'d');
text_io.put(gestion_pile.Consulter(pile));
gestion_pile.Depiler(pile);
text_io.put(gestion_pile.Consulter(pile));
gestion_pile.Depiler(pile);
text_io.put(gestion_pile.Consulter(pile));
gestion_pile.Depiler(pile);
text_io.put(gestion_pile.Consulter(pile));
gestion_pile.Depiler(pile);
end stack_try