Ниже приведен текст модуля StackManager (рис. 11.10), реализующего операции со стеком и пример программы, использующей его (рис. 11.11). Все тексты написаны и любезно предоставлены Г.П. Шушпановым.
| UNIT StackManager; {БИБЛИОТЕКА СРЕДСТВ РАБОТЫ СО СТЕКОМ }
| INTERFACE
| CONST { коды ошибок, возникающих при работе со стеком }
| >StackOk =0; { успешное завершение }
| >StackOverflow =1; { переполнение стека }
| >StackUnderflow =2; { стек был пуст }
| VAR
| >StackError : Byte; { результат операции со стеком }
| TYPE
| >NodePtr = ^Node; { ссылка на узел }
| >Node = RECORD { Узел, состоящий из }
| >Info : Pointer; { ссылки на значение и }
| >Next : NodePtr; { ссылки на следующий }
| >END; { узел. }
| >Stack = RECORD { тип стека - запись }
| >Head : NodePtr; { ссылка на голову списка }
| >Size : Word; { размер элемента данных в }
| >END; { стеке }
| PROCEDURE InitStack( VAR S : Stack; Size : Word );
| >{ формирует стек с элементами размера Size }
| PROCEDURE ReInitStack(VAR S : Stack; Size : Word);
| >{ переопределяет стек для элементов другого размера }
| PROCEDURE ClearStack( VAR S : Stack );
| { очищает стек }
| PROCEDURE Push( VAR S : Stack; VAR E );
| { помещает значение переменной E в стек S }
Рис. 11.10
- 216 -
| PROCEDURE Pop( VAR S : Stack; VAR E );
| >{ выталкивает значение из стека в переменную E }
| PROCEDURE Top( VAR S : Stack; VAR Е );
| >{ копирует значение на вершине стека в переменную E }
| >FUNCTION Empty( VAR S : Stack ) : Boolean;
| >{ возвращает True, если стек пуст }
| IMPLEMENTATION
| >VAR { переменная для хранения }
| >SaveHeapError : Pointer; { адреса старой функции }
| >{ обработки ошибок кучи }
| >{$F+}
| >FUNCTION HeapFunc( Size : Word ) : Integer;
| BEGIN
| >HeapFunc := 1;
| >{вернуть nil, если нельзя разместить переменную в куче}
| END;
| >{$F-}
| PROCEDURE InitStack( VAR S : Stack; Size : Word );
| BEGIN { сохранение стандартного }
| > SaveHeapError := HeapError; { обработчика ошибок кучи }
| > S.Head := nil; { установка вершины }
| > S.Size := Size; { размер значения }
| > StackError := StackOk; { все в порядке }
| END;
| PROCEDURE ReInitStack(VAR S : Stack; Size : Word );
| BEGIN
| >if S.Head <> nil then
| > ClearStack(S); { очистка стека }
| > S.Size := Size; { установка нового размера значения }
| > StackError := StackOk; { все в порядке }
| END;
| PROCEDURE СlearStack(VAR S : Stack);
| VAR Deleted : NodePtr; { удаляемый элемент }
| BEGIN
| > StackError := StackOk;
| > while S.Head <> nil do
| >begin { Цикл по всем элементам:}
| > Deleted := S.Head; { удаляемый узел }
| > S.Head := Deleted^.Next; { продвижение вершины }