tpu/u_pilapi.pas

{  -*- mode: fundamental -*- }
{ ppc386 -va -vh *.pas }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ COMIENZO DE DESCRIPCION

Pilas de enteros  por punteros. keywords: pila

FIN DE DESCRIPCION }
{ $Id: u_pilapi.pas,v 1.2 2002/04/25 16:06:10 mstorti Exp $}
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
unit u_pilapi;
interface
type
  tipo_elemento = integer ;
  p_tipo_celda = ^tipo_celda;
  tipo_celda = record
    elemento: tipo_elemento;
    sig:      p_tipo_celda
  end;
  pilapi = object
  private
    top : p_tipo_celda;
    procedure ERROR (s: string);
  public
    procedure ANULA;
    procedure METE (x:tipo_elemento);
    procedure SACA;
    function  VACIA : boolean;
    function  TOPE  : tipo_elemento;
    procedure IMPRIME (s : string) ;
  end;

  implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure pilapi.ERROR (s: string);
begin
  write ('error: ');
  writeln (s);
  halt;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure pilapi.ANULA;
var
   p,q : p_tipo_celda;
begin
   if top=nil then new(top);
   q := top^.sig;
   while q <> nil do
   begin
      p:=q^.sig;
      dispose(q);
      q:=p;
   end;
   top^.sig := nil;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure pilapi.METE (x: tipo_elemento);
var
  aux: p_tipo_celda;
begin
   new(aux);
   aux^.elemento := x;
   aux^.sig := top^.sig;
   top^.sig := aux;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure pilapi.SACA;
var
   q : p_tipo_celda;
begin
   if (VACIA) then ERROR ('la pila esta vacia');
   q := top^.sig;
   top^.sig  := top^.sig^.sig ;
   dispose(q);
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function  pilapi.VACIA : boolean;
begin
  VACIA := ( top^.sig = nil );
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function  pilapi.TOPE : tipo_elemento;
begin
  if ( VACIA ) then ERROR (' la pila esta vacia');
  TOPE := top^.sig^.elemento ;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure pilapi.IMPRIME (s: string) ;
var
  q : p_tipo_celda;
begin
  if length (s) > 0 then write (s) else write ('pila: ');
  q := top^.sig;
  while (q <> nil) do begin
    write (q^.elemento,' ');
    q := q^.sig;
  end ; {while}
  writeln ;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}