Извлечение элемента из стека

В результате выполнения этой операции некоторой переменной i должно быть присвоено значение первого элемента стека и значение указателя на начало списка должно быть перенесено на следующий элемент стека.

Procedure readStack(Var u : EXST; Var i : integer);

Var

x : EXST;

Begin

i := u^.Data; {считываем значение поля данных в переменную}

x := u; {запоминаем адрес вершины стека}

u := u^.Next; {переносим вершину стека на следующий элемент}

dispose(x); {освобождаем память, занятую уже ненужным элементом стека}

End.

Недостатком описанной процедуры является предположение о том, что стек не пуст. Для его исправления следует разработать логическую функцию проверки пустоты обрабатываемого стека.

Function FreeStack(u : EXST) : boolean;

Задание. Описать функцию и закончить программу, для чего описать процедуру вывода значений элементов стека на экран (она аналогична выводу списка). Протестировать программу, дополнить комментарием и показать файл и листинг учителю для оценки.

Чтобы наглядно рассмотреть работу стека, наберите следующую программу.

Program Demidenko;

Uses

Crt, Graph;

Type

sp=^spis;

ecord

elem : byte;

next : sp;

End;

Var

a, b : byte;

s : string;

gd, gm, c : integer;

head, some, x : sp;

bol : boolean;

ch : char;

Procedure OutX(x, y : integer);

Begin

Line(x+50,y+10,x+70,y+10);

Line(x+50,y+10,x+55,y+10-3);

Line(x+50,y+10,x+55,y+10+3);

Line(x+55,y+13,x+55,y+10-3);

OutTextXY(x+70,y+10,'x');

End;

Procedure Wiv (x, y : integer; ss : sp);

Begin

Line(x,y,x+50,y);

Line(x,y,x,y+20);

Line(x,y+20,x+50,y+20);

Line(x+50,y,x+50,y+20);

Line(x+30,y,x+30,y+20);

if some=ss

then

Begin

Line(x+50,y+10,x+70,y+10);

Line(x+50,y+10,x+55,y+10-3);

Line(x+50,y+10,x+55,y+10+3);

Line(x+55,y+13,x+55,y+10-3); End;

Str(ss^.elem, s);

OutTextXY(x+10,y+10,s);

if (ss^.next<>nil)

then

Begin

Line(x+40,y+10,x+40,y+40);

Line(x+40,y+40,x+37,y+40-5);

Line(x+40,y+40,x+43,y+40-5);

Line(x+43,y+40-5,x+37,y+40-5);

Wiv(x,y+40,ss^.next);

End

else

Begin

Line(x+40,y+10,x+40,y+30);

Line(x+40,y+30,x+37,y+25);

Line(x+40,y+30,x+43,y+25);

Line(x+43,y+25,x+37,y+25);

Line(x+35,y+32,x+45,y+32);

Line(x+36,y+35,x+44,y+35);

Line(x+38,y+38,x+42,y+38);

End;

End;

Procedure Insertsp(x : byte);

Begin

Cleardevice;

OutTextXY(50,20,'NEW(X)');

new(some);

Line(20,100,20+50,100);

Line(20,100,20,100+20);

Line(20,100+20,20+50,100+20);

Line(20+50,100,20+50,100+20);

Line(20+30,100,20+30,100+20);

Outx(20,100);

if head<>nil

then

Wiv(20,140,head);

Delay(1000);

Cleardevice;

OutTextXY(50,20,'X^.NEXT:=TAIL');

OutTextXY(50,40,'TAIL:=X');

some^.next:=head;

head:=some;

Wiv(20,100,head);

Delay(1000);

Cleardevice;

Str(x,s);

OutTextXY(50,20,'SOME^.ELEM:='+s);

some^.elem:=x;

Wiv(20,100,head);

Delay(1000);

End;

Procedure DelSp;

Begin

Cleardevice;

if head=nil

then

Begin

Y(50,20,'Элемент не существует!');

Delay(1000);

End

else

if head^.next<>nil

then

Begin

OutTextXY(50,20,'X:=TAIL');

OutTextXY(50,40,'TAIL:=TAIL^.NEXT');

some:=some^.next;

Wiv(20,100,head);

OutX(20,100);

Delay(1000);

Cleardevice;

OutTextXY(50,20,'DISPOSE(X)');

Wiv(20,100,head);

OutX(20,100);

Setcolor(red);

Line(20,90,70,130);

Line(70,90,20,130);

Setcolor(white);

Delay(1000);

Cleardevice;

head:=head^.next;

some:=head;

Wiv(20,100,head);

End

else

Begin

OutTextXY(50,20,'DISPOSE(TAIL)');

Wiv(20,100,head);

Setcolor(red);

Line(20,90,70,130);

Line(70,90,20,130);

Setcolor(white);

Delay(1000);

ClearDevice;

head:=nil;

some:=head;

End;

End;

Begin

ClrScr;

bol:=false;

gD := Detect;

InitGraph(gD, gM,'c:\tp7\bgi\');

TextBackGround(black);

Setbkcolor(black);

Head:=nil;

Some:=head;

Repeat

OutTextXY(250,200,'1 * Добавить элемент');

OutTextXY(250,220,'2 * Удалить элемент');

OutTextXY(250,240,'Esc Выход');

ch:=readkey;

case ch of

'1' : Begin

OutTextXY(250,260,'Введите число:');

gotoxy(48,17);

readln(b);

InsertSp(b);

End;

'2' : delsp;

#27 : Begin

CloseGraph;

Halt;

End;

End;

until bol;

CloseGraph;

End.