Стеки...

[Donim]

Условие: Даны два непустых стека из элементов типа byte. Организовать перемещение элементов из первого стека во второй, пока значение вершины первого стека не станет четным (перемещенные элементы первого стека будут располагаться во втором стеке в порядке, обратном исходному). Если в первом стеке нет элементов с четными значениями, то переместить из первого стека во второй все элементы.


Код выдает ошибку " Непредвиденное исключение EInvalidPointer. Invalid pointer operation. Программа завершена (стеки.pas, строка 30)" или просто не заполняет второй стек. Как это исправить?

type
  Stack = ^TStackItem;
  TStackItem = record { Элемент стека }
    Value: byte; { Значение элемента }
    Next: Stack; { указатель на следующий }
  end;

///Добавляет элемент в стек
procedure Push(var head: Stack; Value: byte);
var
  tmp: Stack;
begin
  new(tmp);
  tmp^.Value := Value;
  tmp^.Next := head;
  head := tmp;
end;

///Забирает элемент из стека
function Pop(var head: Stack ): byte;
var
  tmp: Stack;
begin
  if (head <> nil) then begin
    tmp := head;
    head := head^.Next;
    Pop := tmp^.Value;
    Dispose(tmp);
  end
  else
    Pop := 0;
end;

///Проверяет стек на пустоту
function IsEmpty(head: Stack): boolean;
begin
  IsEmpty := (head = nil);
end;

///показывает верхний элемент стека
function Top(s: Stack): byte;
begin
  Assert(not IsEmpty(s));
  result := s^.Value;
end;

///Заполняет оба стека случайными числами
procedure Zap(var s, s1: Stack; n: byte);
var
  i: byte;
begin
  for i := 1 to n do
  begin
    //Randomize;
    Push(s, random(255));
    Push(s1, random(255));
  end;
end;

///Перемещает элементы стека
Procedure Peremest(var s, s1: Stack; n:byte);
var
  mas: array [1..50] of byte;
  i,j : byte;
begin
  i := 1;
  while IsEmpty(s) = false do
  begin
    if Top(s) mod 2 <> 0 then
    begin
      mas[i] := Pop(s);
      Pop(s1);
      inc(i);
    end
    else
      break;
  end;
  
  if mas[1] <> 0 then
  For j:= 1 to i do
    Push(s1, mas[j]);
end;

///Выводит стек на экран
procedure Vivod(s: Stack);

var
  mas: array [1..50] of byte;
  i,j: byte;

begin
  i := 1;
  while IsEmpty(s) = false do
  begin
    mas[i] := Pop(s);
    inc(i);
  end;
  
  for j:= 1 to i do
    writeln(mas[j]);
end;


var
  s, s1: Stack;
  n: byte;
  mas: array [1..50] of byte;
  i,j : byte;

begin
  write('Введите количество элементов в стеках: '); readln(n);
  n:=n-1;
  s:=nil; s1:=nil;
  Zap(s, s1, n);
  writeln('Первый стек ');Vivod(s);
  writeln('Второй стек ');Vivod(s1);
  
  Peremest(s, s1, n);

  if IsEmpty(s1) = false then
  begin
  writeln('Не удачные данные ');
  end
  else
  begin
  writeln('Полученный стек ');Vivod(s1);
  end;
  
end.