DataMuseum.dk

top - 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⟧ 

TextFile

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