CONTOH PROGRAM STACK DALAM BAHASA PASCAL _2_ ( STACK )

program membalik_urutan_angka;
uses crt;
const maks_stack=10;

type tipedata=integer;
tipestack=record
top:0..maks_stack;
data:
array[1..maks_stack]of tipedata
end;
var s:tipestack;
x:tipedata;
angka:tipedata;
lanjut:boolean;
temp:char;
procedure error;
begin
write('stack penuh,angka terlalu banyak');
lanjut:=false;
end;
procedure inisialisasi(var s:tipestack);
begin
s.top:=0
end;
function penuh(s:tipestack):boolean;
begin
penuh:=(s.top=maks_stack)
end;
function kosong(s:tipestack):boolean;
begin
kosong:=(s.top=0)
end;
function size(s:tipestack):integer;
begin
size:=s.top
end;
procedure push(x:tipedata;var s:tipestack);
begin
if penuh(s)then
error
{procedure untuk memberitahukan stack penuh}
else
begin
s.top:=s.top+1;
s.data[s.top]:=x;
end;
end;
procedure pop(var x:tipedata;var s:tipestack);
begin
if kosong(s)then
error{procedure untuk memberitahukan stack kosong}
else
begin
x:=s.data[s.top];
s.top:=s.top-1;
end;
end;
{program utama}
begin
repeat
clrscr;
writeln('membalik urutan angka');
writeln('masukan barisan angka, pisahkan dengan spasi,akhiri dengan angka 0');

write('->:');read(angka);
lanjut:=true;
while lanjut and(angka <> 0) do
begin
x:=angka;push(x,s);
read(angka)
end;
writeln;
writeln('barisan angka dengan urutan terbalik:');
write('<-:');
while not(kosong(s)) do
begin
pop(x,s);write(x,' ');
end;
writeln;
write('coba lagi dengan data yang lain(y/n)? []');
gotoxy(wherex-2,wherey);temp:=readkey
until upcase(temp)='n'
end.