двусвязный список

{Ввести последовательность натуральных чисел. Если в последовательности есть простые числа,
 упорядочить последовательность по неубыванию суммы цифр. В противном случае удалить из
 последовательности числа с нечетным количеством цифр и продублировать 4-х значные числа.
 Последовательность хранить в двусвязном циклическом списке с фиктивным элементом.}
 
program labor18;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
type pList=^TList;
     TList=record
            Data:integer;
            L,R:pList;
            end;
var
    num,l,z,h,u,n:integer;
    sent,p,q,tmp:pList;
function Add(data:integer;pred:pList):pList;
 
begin
  New(P);
  p^.data:=data;
  p^.l:=pred;
  p^.r:=pred.R;
  pred^.r:=p;
  result:=P;
end;
 
function prime(x:Integer):Boolean;
var d :Integer;
begin
  prime:=False;
  if x<2 then Exit;
    for d:=2 to Round(Sqrt(x)) do
      if x mod d=0 then
        Exit;
 
  prime:=True;
end;
 
function kol(var a:Integer):Boolean;
begin
  kol:=False;
  n:=a;
  u:=0;
  while n>0 do begin
    inc(u);
    n:=n div 10;
  end;
  if (u mod 2<>0) then kol:=True;
end;
 
function kol2(var a:Integer):Boolean;
begin
  kol2:=False;
  n:=a;
  u:=0;
  while n>0 do begin
    inc(u);
    n:=n div 10;
  end;
  if u=4 then kol2:=True;
end;
 
function sum(a:Integer):Integer;
var
  s:Integer;
begin
  n:=a;
  s:=0;
  while n>0 do begin
    s:=n mod 10+s;
    n:=n div 10;
  end;
  Result:=s;
end;
 
begin
  Reset(Input,'input.txt');
  Rewrite(Output,'output.txt');
  New(sent);
  sent^.l:=sent;
  sent^.r:=sent;
  p:=sent^.R;
  while not SeekEoln do begin
    read(num);
    p:=add(num,p);
  end;
  l:=0;
  p:=sent^.R;
  while p<>sent do begin
    if prime(p^.Data) then inc(l);
    p:=p^.R;
  end;
  if l<>0 then begin
    p:=sent^.R;
    while p<>sent do begin
      z:=sum(p^.Data);
      h:=sum(p^.r^.Data);
      if z>h then begin
        {здесь нужно поменять местами p^.Data и p^.r^.Data}
      end;
      p:=p^.R;
    end;
  end else begin
    p:=sent^.r;
    while p<>sent do begin
      if kol(p^.Data) then begin
        p^.l^.R:=p^.R;
        p^.r^.l:=p^.L;
      end else
        if kol2(p^.Data) then begin
          q:=p;
          New(tmp);
          tmp^.Data:=q^.Data;
          tmp^.l:=q;
          tmp^.r:=q^.R;
          q^.r^.l:=tmp;
          q^.r:=tmp;
          p:=p^.R;
        end;
      p:=p^.R;
    end;
  end;
  p:=sent^.R;
  while p<>sent do begin
    write(p^.data,' ');
    p:=p^.R;
  end;

var
  Data : Integer;
...

      if z>h then
      begin
        Data := p^.Data;
        p^.Data := p^.r^.Data;
        p^.r^.Data := Data;
      end;

    p:=sent^.r;
    w:=p^.r;
    while  w<>sent do begin
      j:=w^.l;
      z:=sum(j^.Data);
      h:=sum(w^.Data);
      while (j<>sent) and (z>h) do begin
        num:=j^.Data;
        j^.Data:=w^.Data;
        w^.Data:=num;
        j:=j^.L;
        w:=w^.L;
        z:=sum(j^.Data);
        h:=sum(w^.Data);
      end;
      w:=w^.R;
    end;