Вылетает программа - Pascal

Формулировка задачи:

Есть готовая программа. У меня срабатывает с 4го раза. Ещё у одного человека тоже работает, у третьего во время запуска вылетает, у препода тоже вылетает. Суть в том, что из исходного стека надо получить обратный. У меня при первых трех запусках показывает только исходный стек. На четвертый запуск все работает как надо. Где тут может быть собака зарыта. Вот код

Type Adres = ^Zveno;
  Zveno = Record
  Adrcled: Adres;
  Element: integer;
 End;
Stek = Adres;
Var
 St, NewSt: Stek;
 n, h:integer;
Procedure Zanes (Var St: Stek; El:integer);
 Var
  Q: Adres;
 Begin
  New (Q);
  Q^.Element := El;
  Q^.Adrcled := St;
  St := Q
 End;
Procedure Vibor (Var St, NewSt: Stek; Var A: integer);
 Var
  Q: Adres;
 Begin
  A := St^.Element;
  Zanes(NewSt, A);
  Q := St;
  St := St^.Adrcled;
  Dispose (Q)
 End;
Procedure Print (Var St: Stek);
 Var
  Q, R: Adres;
 Begin
  Q := St;
  R := St;
  while Q<>nil do
   begin
    R := Q;
    write(R^.Element, ' ');
    Q := Q^.Adrcled;    
    Dispose(R);
   end;
End;
begin
 St := Nil;
 n:=random(2, 15);
 for h:=1 to n do
  begin
    Zanes(St, random(-50, 50));
  end;
 writeln('Исходный стек:');
 Print(St);
 for h:=1 to n do
  begin
    Vibor(St,NewSt, St^.Element);
  end; 
 writeln();
 writeln('Полученный стек:');
 Print(NewSt);
end.

Решение задачи: «Вылетает программа»

Листинг программы

type
  Stek = ^Zveno;
  Zveno = Record
    Adrcled: Stek;
    Element: integer;
  End;
 
Procedure Push(Var St: Stek; El:integer);
Var
  Q: Stek;
Begin
  New (Q);
  Q^.Element := El;
  Q^.Adrcled := St;
  St := Q
End;
 
function Pop(var St : Stek) : Integer;
var t : Stek;
begin
  t := St; St := St^.Adrcled;
  Pop := t^.Element; Dispose(t);
end;
 
Procedure Print(St: Stek);
Begin
  while St<>nil do
    begin
      write(St^.Element, ' ');
      St := St^.Adrcled;    
    end;
  WriteLn;
End;
 
Var
 St, NewSt: Stek;
 n, h:integer;
begin
 St := Nil;
 n := random(2, 15);
 for h:=1 to n do
   Push(St, random(-50, 50));
 writeln('Исходный стек:');
 Print(St);
 
 NewSt := nil;
 while St <> nil do
   Push(NewSt, Pop(St));
 writeln('Полученный стек:');
 Print(NewSt);
end.

Объяснение кода листинга программы

Объявление типа данных Stek для ссылки на вершину стека
Объявление типа данных Zveno для записи о вершине стека, содержащей ссылку на следующий элемент стека и значение элемента
Создание процедуры Push для добавления элемента в стек
- Создание новой вершины стека
- Запись значения элемента в новую вершину стека
- Запись ссылки на текущую вершину стека в поле Adrcled новой вершины стека
- Обновление текущей вершины стека на новую вершину стека
Создание функции Pop для удаления элемента из стека
- Передача текущей вершины стека в функцию Pop
- Обновление текущей вершины стека на предыдущую вершину стека
- Возврат значения элемента, которое было только что удалено из стека
Создание процедуры Print для печати содержимого стека
- Цикл, который проходит через каждую вершину стека, пока стек не станет пустым
- Печать значения элемента каждой вершины стека
- Обновление текущей вершины стека на следующую вершину стека
Объявление переменных St, NewSt, n и h для хранения состояния стека и его размера
Инициализация переменной St как пустого стека
Инициализация переменной n случайным числом от 2 до 15
Цикл, который проходит от 1 до n, для добавления элементов в стек
- Вызов процедуры Push для добавления элемента в стек
Печать содержимого стека
Инициализация переменной NewSt как пустого стека
Цикл, который проходит через каждую вершину стека, пока стек не станет пустым
- Вызов процедуры Push для добавления элемента в новый стек
Печать содержимого нового стека
Конец программы