Даны указатели P1 и P2 на вершины двух непустых стеков. Перемещать элементы из первого стека во второй, пока значение вершины первого стека не станет четным (перемещенные элементы первого стека будут располагаться во втором стеке в порядке, обратном исходному) — Pascal(Паскаль)

Program Stek;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе стека}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент}
  end;
 
{Процедура добавляющая элемент в стек}
procedure AddElem(var stek1:List;znach1:TInf);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList)); {выделяем в памяти место для нового элемента}
  tmp^.next:=stek1;  {указатель на следующий элемент "направляем" на вершину стека}
  tmp^.data:=znach1; {добавляем к элементу данные}
  stek1:=tmp; {вершина стека изменилась, надо перенести и указатели на неё}
end;
 
{Процедура вывода стека}
procedure Print(stek1:List);
begin
  if stek1=nil then {проверка на пустоту стека}
  begin
    writeln('Stek /7Yct.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
 
{Процедура освобождения памяти занятой стеком}
Procedure FreeStek(stek1:List);
var
  tmp:List;
begin
  while stek1<>nil do {пока stek1 не станет указывать в "пустоту" делать}
  begin
    tmp:=stek1; {указатель tmp направим на вершину стека}
    stek1:=stek1^.next; {вершину стека перенесём на следующий за данной вершиной элемент}
    FreeMem(tmp,SizeOf(Tlist)); {освободим память занятую под старую вершину}
  end;
end;
 
Procedure Swap(var stk,stk1:List);
var
  tmpl:List;
begin
  while (stk<>nil) and (stk^.data mod 2<>0) do
  begin
    tmpl:=stk;
    stk:=stk^.next;
    tmpl^.next:=stk1;
    stk1:=tmpl;
  end;
end;
 
var
  Stk,Stk1, {переменная, которая всегда будет указывать на "вершину" стека}
  tmpl:List; {рабочая переменная}
  znach:Tinf; {данные вводимые пользователем}
  ch,num:char; {для работы менюшки}
begin
  Stk:=nil;
  Stk1:=nil;
  repeat {цикл для нашего меню}
    clrscr; {очистка экрана, далее идёт вывод самого меню}
    Writeln('Programma dl9 paboTbl co ctekom.');
    Writeln('Bblberute }l{elaeMble deuctvi9:');
    Writeln('1) Dobavit'' element.');
    Writeln('2) Vblvod steka.');
    Writeln('3) /7epemeLLIat''.');
    Writeln('4) Exit.');
    writeln;
    ch:=readkey; {ожидаем нажатия клавиши}
    case ch of {выбираем клавишу}
      '1':begin
            Writeln('Vvedute nomep steka c kotopblm bydem rabotat''');
            num:=readkey;
            write('Vvedute 3na4enue dobaBl9emogo elementa ');
            readln(znach); {считываем значение добавляемого нового элемент}
            tmpl:=nil;
            case num of
              '1':AddElem(Stk,znach);
              '2':AddElem(Stk1,znach);
            end;
          end;
      '2':begin
            Writeln('Vvedute nomep steka c kotopblm bydem rabotat''');
            num:=readkey;
            clrscr; {очистка экрана}
            case num of
              '1':Print(Stk);
              '2':Print(Stk1);
            else
              Writeln('He cyLL/ecTVyet steka s takum nomepom.');
            end;
            readkey; {ожидаем нажатия клавиши}
          end;
      '3':begin
            clrscr;
            Writeln('Steku do u3menenui:');
            Writeln('Stek number 1:');
            Print(stk);
            writeln;
            Writeln('Stek number 2:');
            Print(stk1);
            writeln;
            Swap(Stk,Stk1);
            Writeln;
            Writeln('Cteki pocle u3menenui');
            Writeln('Stek number 1:');
            Print(stk);
            writeln;
            Writeln('Stek number 2:');
            Print(stk1);
            readkey;
          end;
    end;
  until ch='4';
  FreeStek(Stk); {освобождаем память занятую стеком}
  FreeStek(Stk1);
end.