Обработка Стека. Развернуть (дно-вверху, вершина-внизу)

uses crt;
type
    pitem = ^item;
    item = record
        data: integer;
        prev: pitem
    end;
 
var
    top, p: pitem;
    i,v,m,n, k: integer;
 
procedure add(x:integer);
begin
    new(p);
    p^.data := x;
    p^.prev := top;
    top := p
end;
procedure del;
begin
    if top<>nil then begin
        p := top^.prev;
        dispose(top);
        top := p
    end;
end;
procedure wstack;
begin
    writeln('Содержимое стека: ');
    p := top;
    while p <> nil do begin
        write(p^.data, ' ');
        p := p^.prev;
    end;
    writeln;
end;
begin
    top := nil;
    writeln('Введите кол-во элементов в стеке');
    readln(m);
    for k := 1 to m do
        add(k);
    wstack;
    writeln('Введите количество элементов необходимых для добавления в стек');
    readln(v);
    writeln('Введите добавляемое в стек значение: ');
    for i:=1 to v do
    begin
    readln(n);
    add(n);
    end;
    wstack;
    writeln('Количество элементов стека для удаления? ');
    readln(n);
    for k:=1 to n do
        del;
    wstack;
readln
end.

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = Integer;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, расположенный на вершине стека. Поэтому, переменная
  представляющая стек, будет иметь тип TPElem.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := aPSt;
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Result := False;
  if aPSt = nil then Exit;
 
  PElem := aPSt;
  aPSt := PElem^.PNext;
  aData := PElem^.Data;
  Dispose(PElem);
  Result := True;
end;
 
{Распечатка элементов стека в направлении вершина - дно.}
procedure StWriteln(aPSt : TPElem);
var
  i : Integer;
begin
  if aPSt = nil then
    Writeln('Стек пуст.')
  else begin
    i := 0;
    while aPSt <> nil do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(aPSt^.Data);
      aPSt := aPSt^.PNext;
    end;
    Writeln;
  end;
end;
 
{Освобождение памяти, выделенной для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
var
  PSt1, PSt2 : TPElem;
  Data : TData;
  i, Code : Integer;
  S : String;
begin
  {Начальная инициализация стеков.}
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    {Добавление элементов в первый стек.}
    Writeln('Добавление элементов в первый стек.');
    Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
    i := 0; {Счётчик введённых элементов.}
    repeat
      Write('Элемент ', i + 1, ': ');
      Readln(S);
      if S <> '' then begin
        Val(S, Data, Code);
        if Code = 0 then begin
          Push(PSt1, Data); {Добавление элемента в стек.}
          Inc(i);
        end else
          Writeln('Неверный ввод. Должно быть задано целое число. Повторите.');
      end;
    until S = '';
 
    {Распечатка стеков.}
    Writeln('Начальное состояние стеков.');
    Writeln('Первый стек (вершина - дно):');
    StWriteln(PSt1);
    Writeln('Второй стек (вершина - дно):');
    StWriteln(PSt2);
 
    {Переливаем элементы из первого стека во второй стек.}
    while Pop(PSt1, Data) do Push(PSt2, Data);
 
    {Распечатка стеков.}
    Writeln('Состояние стеков после переливания:');
    Writeln('Первый стек (вершина - дно):');
    StWriteln(PSt1);
    Writeln('Второй стек (вершина - дно):');
    StWriteln(PSt2);
 
    {Освобождение памяти, выделенной для стеков.}
    StFree(PSt1);
    StFree(PSt2);
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

    {Переливаем элементы из первого стека во второй стек.}
    while Pop(PSt1, Data) do Push(PSt2, Data);