Написать процедуру, которая в непустом списке L меняет местами первый и последний элементы

Program Spisok;
type
zap=record
fam:string[10];
im:string[7];
otc:string[13];
end;
ukaz=^element;
element=record
inf:zap;
next:ukaz;
end;
var newE,left,right,temp:ukaz;
z:zap;
number:integer;
 
procedure org;
begin
writeln('Выполняется процедура организации очереди');
writeln('Для выхода из процедуры введите символ: *');
writeln('Введите фамилию студента');
readln(z.fam);
writeln('Введите имя студента');
readln(z.im);
writeln('Введите отчество студента');
readln(z.otc);
if z.fam='*' then exit;
new(newE);
newE^.inf.fam:=z.fam;
newE^.inf.im:=z.im;
newE^.inf.otc:=z.otc;
newE^.next:=nil;
left:=newE;
right:=newE;
while true do
begin
writeln('Введите фамилию студента');
readln(z.fam);
writeln('Введите имя студента');
readln(z.im);
writeln('Введите отчество студента');
readln(z.otc);
if z.fam='*' then exit;
new(newE);
newE^.inf.fam:=z.fam;
newE^.inf.im:=z.im;
newE^.inf.otc:=z.otc;
newE^.next:=left;
left:=newE;
end;
end;
 
procedure dob;
begin
writeln('Введите фамилию студента');
readln(z.fam);
writeln('Введите имя студента');
readln(z.im);
writeln('Введите отчество студента');
readln(z.otc);
if z.fam='*' then exit;
new(newE);
newE^.inf.fam:=z.fam;
newE^.inf.im:=z.im;
newE^.inf.otc:=z.otc;
newE^.next:=nil;
rigth^.next:=newE;
right:=newE;
end;
 
procedure udal;
begin
writeln('Исключение главного элемента очереди');
writeln('Нажмите клавишу Enter');
readln;
temp:=left^.next;
dispose(left);
left:=temp;
end;
 
procedure prosmotr;
var i:integer;
begin
writeln('Очередь содержит следующие элементы');
temp:=left;
i:=1;
while temp<>nil do
begin
writeln(i,')',temp^.inf.fam,' ',temp^.inf.im,' ',temp^.inf.otc);
temp:=temp^.next;
i:=i+1;
end;
writeln('Нажмите кнопку Enter');
readln;
end;
{--------------------------------------------------------------------}
begin
while true do 
begin
writeln('1-организация очереди');
writeln('2-добавление элемента в очередь');
writeln('3-удаление элемента из очереди');
writeln('4-просмотр очереди');
writeln('5-выход');
writeln('------------------');
writeln('введите номер пункта меню');
readln(number);
case number of
1: org;
2: dob;
3: udal;
4: prosmotr;
5: exit;
end;
end;
end.

type
  zap = record
    fam: string[10];
    im: string[7];
    otc: string[13];
  end;
  ukaz = ^element;
  element = record
    inf: zap;
    next: ukaz;
  end;
 
var
  newE, left, right, temp: ukaz;
  z: zap;
  number: integer;
 
function InputZ : zap;
var
  z : zap;
begin
  writeln('Введите фамилию студента');
  readln(z.fam);
  writeln('Введите имя студента');
  readln(z.im);
  writeln('Введите отчество студента');
  readln(z.otc);
  InputZ := z;
end;
 
procedure dob(var first, last : ukaz);
var
  z : zap;
begin
  z := InputZ;
  if first = nil then
    begin
      New(first);
      last := first;
    end
  else
    begin
      New(last^.next);
      last := last^.next;
    end;
  last^.inf := z;
  last^.next := nil;
end;
 
procedure org(var first, last : ukaz);
var
  answer : String;
begin
  writeln('Выполняется процедура организации очереди');
  repeat
    WriteLn;
    WriteLn('Желаете добавить студента? 1 - да / 0 - нет');
    ReadLn(answer);
    if Length(answer) = 1 then
      case answer[1] of
        '1' : dob(first, last);
        '0' : Exit;
      end;
  until False;
end;
 
procedure udal(var first, last : ukaz);
var
  tmp : ukaz;
begin
  writeln('Исключение главного элемента очереди');
  if first = nil then
    WriteLn('Операция невозможна: очередь пуста!')
  else
    begin
      tmp := first;
      first := first^.next;
      dispose(tmp);
    end;
  writeln('Нажмите кнопку Enter');
  readln;
end;
 
procedure prosmotr(cur : ukaz);
var
  i : integer;
  z : zap;
begin
  if cur = nil then
    WriteLn('Очередь пуста!')
  else
    begin
      writeln('Очередь содержит следующие элементы');
      i := 0;
      while cur <> nil do
        begin
          inc(i);
          z := cur^.inf;
          writeln(i, ')', z.fam, ' ', z.im, ' ', z.otc);
          cur := cur^.next;
        end;
    end;
  writeln('Нажмите кнопку Enter');
  readln;
end;
 
procedure SwapFirstAndLast(var first, last : ukaz);
var
  tmp : ukaz;
begin
  if first = nil then WriteLn('Очередь пуста!')
  else if first = last then WriteLn('Первый = последнему!')
  else
    begin
      tmp := first;
      while tmp^.next <> last do tmp := tmp^.next;
      last^.next := first^.next;
      tmp^.next := first;
      first^.next := nil;
      tmp := last; last := first; first := tmp;
      prosmotr(first);
    end;
end;
 
{--------------------------------------------------------------------}
var
  first, last : ukaz;
begin
  first := nil;
  last  := nil;
  repeat
    writeln('1-организация очереди');
    writeln('2-добавление элемента в очередь');
    writeln('3-удаление элемента из очереди');
    writeln('4-просмотр очереди');
    writeln('5 - обменять первый и последний элементы');
    writeln('0-выход');
    writeln('------------------');
    writeln('введите номер пункта меню');
    readln(number);
    case number of
      1: org(first, last);
      2: dob(first, last);
      3: udal(first, last);
      4: prosmotr(first);
      5: SwapFirstAndLast(first, last);
      0: halt;
    end;
  until False;
end.

procedure SwapFirstAndLast(var first, last : ukaz);
var
  tmp : ukaz;
begin
  if first = nil then WriteLn('Очередь пуста!')
  else if first = last then WriteLn('Первый = последнему!')
  else if first^.next = last then
    begin
      last^.next := first; first^.next := nil;
      first := last; last := first^.next;
    end
  else
    begin
      tmp := first;
      while tmp^.next <> last do tmp := tmp^.next;
      last^.next := first^.next;
      tmp^.next := first;
      first^.next := nil;
      tmp := last; last := first; first := tmp;
      prosmotr(first);
    end;
end;