Создать стек из случайных целых чисел и поменять местами его крайние элементы

var
  yk,tmp,tmp1:List; {Указатель на "начало" стека}
...
begin
...
  tmp:=yk;
  while tmp^.next<>nil do
    tmp:=tmp^.next;  {ставим tmp на последний элемент}
  tmp1:=yk;
  while tmp1^.next<>tmp do {tmp1 ставим на предпоследний элемент}
    tmp1^.next;
  if tmp1=yk then {в стеке два элемента}
  begin
    yk^.next:=nil;
    tmp^.next:=yk;
    yk:=tmp;
  end
  else
  begin
    tmp1^.next:=yk;
    tmp^.next:=yk^.next;
    yk^.next:=nil;
    yk:=tmp;
  end;
...
end.

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('‘⥪ Їгбв.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
 
var
  yk,tmp,tmp1:List; {Указатель на "начало" стека}
 
begin
...
  tmp:=yk;
  while tmp^.next<>nil do
    tmp:=tmp^.next;  {ставим tmp на последний элемент}
  tmp1:=yk;
  while tmp1^.next<>tmp do {tmp1 ставим на предпоследний элемент}
    tmp1^.next;
  if tmp1=yk then {в стеке два элемента}
  begin
    yk^.next:=nil;
    tmp^.next:=yk;
    yk:=tmp;
  end
  else
  begin
    tmp1^.next:=yk;
    tmp^.next:=yk^.next;
    yk^.next:=nil;
    yk:=tmp;
  end;
...
end.

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('‘⥪ Їгбв.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
 
procedure change(var yk:List);
var
  tmp,tmp1:List;
begin
  if yk=nil then
    exit;
  tmp:=yk;
  while tmp^.next<>nil do
    tmp:=tmp^.next;  {ставим tmp на последний элемент}
  tmp1:=yk;
  while tmp1^.next<>tmp do {tmp1 ставим на предпоследний элемент}
    tmp1:=tmp1^.next;
  if tmp1=yk then {в стеке два элемента}
  begin
    yk^.next:=nil;
    tmp^.next:=yk;
    yk:=tmp;
  end
  else
  begin
    tmp1^.next:=yk;
    tmp^.next:=yk^.next;
    yk^.next:=nil;
    yk:=tmp;
  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;
 
var
  yk:List; {Указатель на "начало" стека}
  n:integer;
  znach:Tinf;
begin
  randomize;
  repeat
    clrscr;
    Writeln('Vvedute kolu4ectvo elementov v steke');
    Write('N= ');
    readln(n);
  until n>0;
  while n>0 do
  begin
    znach:=random(1000);
    AddElem(yk,znach);
    dec(n);
  end;
  clrscr;
  Writeln('Ctek do u3menenui');
  Print(yk);
  change(yk);
  Writeln;
  Writeln('Ctek pocle u3menenui');
  Print(yk);
  readln;
  FreeStek(yk);
end.