Лаба по ДСД

Program stack;

Type
te = integer;
pe = ^node;
node = record
inf: te;
next: pe;
end;

Var
stk: pe;
n: integer;
x: te;

//*************************************************************
//* Вставка в стек *
//*************************************************************
Procedure InsInStack(Var stk: pe; a: te);
Var
q: pe;
Begin
new(q);
q^.inf := a;
q^.next := stk;
stk := q
End;// end of InsInStack()


//*************************************************************
//* Создание стека *
//*************************************************************
Function CreateStack: pe;
Const
MAXLEN = 16;
Var
i,m: integer;
stk: pe;
a: te;
Begin
stk := NIL;

Write('Введите число элементов стека (не более ', MAXLEN,') и нажмите Enter: ');
Readln(m);

If (m > MAXLEN) Or (m < 1) Then
Begin
Writeln('Недопустимый размер стека, программа будет останолена. Нажмите Enter.');
Readln;
Halt(0);
End

Else
Begin
For i := 1 To m Do
Begin
Write('Введите значение ', i, '-го элемента и нажмите Enter: ');
Readln(a);
InsInStack(stk, a)
End;
End;

CreateStack := stk
End; // end of CreateStack()


//*************************************************************
//* Уничтожение стека *
//*************************************************************
Procedure DestroyStack(stk: pe);
Var
q: pe;
Begin
While stk <> NIL Do
Begin
q := stk;
stk := stk^.next;
Dispose(q)
End
End; // end of DestroyStack()


//*************************************************************
//* Поиск элемента *
//*************************************************************
Function Find(stk: pe; a: te): integer;
Var
n: integer;
flag: boolean;
Begin
n := 0;
flag := false;
While stk <> NIL Do
Begin
inc(n);
If stk^.inf = a Then // если искомый элемент найден,
Begin
flag := true; // то поднимаем флаг
Break // и выходим и цикла
End;
stk := stk^.next
End;

If flag = true Then
Find := n
Else
Find := 0
End; // end of Find()


//*************************************************************
//* Печать элементов стека *
//*************************************************************
Procedure PrintStack(stk: pe);
Begin
Writeln('Вывод элементов стека сверху вниз:');
While stk <> NIL Do
Begin
Writeln(stk^.inf);
stk := stk^.next
End
End;

//*************************************************************
//* Точка входа *
//*************************************************************

Begin
stk := NIL;
stk := CreateStack;
PrintStack(stk);
Writeln('Введите искомое значение и нажмите Enter: ');
Readln(x);
n := Find(stk, x);

If n <> 0 Then
Writeln('Элемент стека, содержащий искомое значение, ', n, '-й сверху.')
Else
Writeln('В стеке нет элементов, содержащих искомое значение.');

Writeln('Нажмите Enter для завершения.');
Readln;
DestroyStack(stk)
End.// end of Program