11.8. Практический пример построения стека

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 }

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; { продвижение вершины } FreeMem(Deleted^.Info,S.Size); { удаление значения }

Dispose(Deleted); { удаление узла }

end { while }

END;

PROCEDURE Push( VAR S : Stack; VAR E );

LABEL Quit;

VAR

NewNode : NodePtr; { новый узел }

BEGIN { Подстановка функции }

HeapError := ©HeapFunc; { обработки ошибок. }

StackError := StackOverflow; { возможно переполнение }

NewNode := New(NodePtr); { размещение узла }

if NewNode = nil

then goto Quit; { Негде! Выход. }

NewNode^.Next := S.Head; { установление связи }

S.Head := NewNode; { продвижение вершины }

GetMem(NewNode^.Info,S.Size); { размещение значения }

if NewNode^.Info = nil

then goto Quit; { Негде! Выйти. }

Move(E, NewNode^.Info^,S.Size); { перенос значения }

StackError := StackOk; { Все в порядке. Выход }

Quit:

HeapError := SaveHeapError; { вернем старую функцию }

END;

PROCEDURE Pop( VAR S : Stack; VAR E );

VAR Deleted : NodePtr; { выталкиваемый узел }

BEGIN

StackError := StackUnderflow; { возможна неудача }

if S.Head = nil then Exit; { Стек пуст! Выход. }

Deleted := S.Head; { удаляемый узел }

S.Head := Deleted^.Next; { продвижение вершины }

Move(Deleted^.Info^,E,S.Size); { перенос значения }

FreeMem(Deleted^.Info,S.Size); { удаление значения }

Dispose(Deleted); { удаление узла }

StackError := StackOk; { все в порядке }

END;

PROCEDURE Top( VAR S : Stack; VAR E );

BEGIN

StackError := StackUnderflow; { возможна неудача }

if S.Head = nil then Exit; { Стек пуст! Выход. }

Move(S.Head^.Info^,E.S.Size); { перенос значения }

StackError := StackOk; { все в порядке }

END;

FUNCTION Empty( VAR S : Stack ) : Boolean;

BEGIN

Empty := S.Head = nil { пусто, если список пуст }

END;

END. { unit StackManager }

PROGRAM UsesStack;{ПРОГРАММА, ХРАНЯЩАЯ ЗНАЧЕНИЯ В СТЕКЕ}

USES StackManager; VAR

St : Stack; { переменная структуры типа Stack (стек) }

I : Integer;

R : Real;

В : Byte;

BEGIN

InitStack( St, SizeOf( Integer ) ); { стек целых } { Поместить в стек 100 целых значений: }

for I:=1 to 100 do Push( St, I );

WriteLn( ' ':20, 'Первые 100 чисел' );

WriteLn( ' ': 20, '(целые значения)' );

WriteLn;

while not Empty(St) do begin { Пока стек не пуст: }

for В := 1 to 10 do begin {порциями по 10 элементов}

Pop( St, I ); { вытолкнуть очередное зна- }

Write( I:5 ) { чение и напечатать его }

end; { for В }

WriteLn { закрытие строки 10 чисел }

end; { while }

ReadLn; { пауза до нажатия ввода }

ReInitStack(St,SizeOf(Real)); {изменяется тип данных }

{ Поместить в стек 100 вещественных значений: }

for I := 1 to 100 do begin

R := I; { перевод в тип Real }

Push( St, R ); {и поместить его в стек }

end; { for I }

WriteLn( ' ':20, 'Первые 100 чисел' );

WriteLn( ' ': 17, '(вещественные значения)' );

WriteLn;

while not Empty(St) do begin { Пока стек не пуст: }

for B:=1 to 10 do begin { порциями по 10 элементов: }

Pop( St,R ); { вытолкнуть следующее зна- }

Write( R : 5 : 1 ) { чение и напечатать его }

end; { for В }

WriteLn { закрытие строки 10 чисел }

end; { while }

ReadLn { пауза до нажатия клавиши ввода }

END.