uses Crt;
type plist = ^list;
     list = record
          info: integer;
          link: plist;
     end;
var
   f1,f2,f3,top:plist;
procedure rdlist(var lst: plist);
var p,q,s: plist;
    buf: integer;
    function rdint(var buf:integer):Boolean;
    begin
         {$i-}
         read(buf);
         rdint:=IOResult=0;
         {$i+}
    end;{rdint}
begin
     q:=nil;
     while rdint(buf) do
           begin
                new(s);
                s^.info:=buf;
                s^.link:=q;
                q:=s;
           end;
     p:=nil;
     while q<>nil do
           begin
                s:=q; q:=q^.link;
                s^.link:=p; p:=s;
           end;
     lst:=p;
end; {rdlist}
procedure wrlist(f:plist);
begin
     if f<>nil then
        begin
             write (f^.info, '  ');
             wrlist (f^.link);
        end;
end;
Function Sort(head : plist) : plist;
var newh, max, prev, pmax, cur : plist;
begin
     newh:=nil;
     while head<>nil do
     begin
          max:=head;
          prev:=head;
          cur:=head^.link;
          while cur<>nil do
          begin
               if cur^.info>max^.info then
               begin
                    max:=cur;
                    pmax:=prev;
               end;
               prev:=cur; cur:=cur^.link;
          end;
          if max=head then head:=head^.link
          else pmax^.link:=max^.link;
          max^.link:=newh; newh:=max;
     end;
     Sort:=newh;
end;
Procedure Unite (var cur, head1, head2 : plist);
begin
     if head2<>nil then
     begin
          if head1=nil then
             head1:=head2 else
             begin
                  cur:=head1;
                  while cur^.link<>nil do
                        begin
                             cur^.info:=head1^.info;
                             cur:=cur^.link;
                             head1:=head1^.link;
                        end;
                  cur^.link:=head2;
             end;
          head2:=nil;
     end;
end;
BEGIN
  clrscr;
  write('Spisok 1(letter for exit) = ');
  rdlist(f1);
  wrlist(f1);
  writeln;
  write('Spisok 2(letter for exit) = ');
  rdlist(f2);
  wrlist(f2);
  writeln;
  write('Otsortirovanni spisok 1 = ');
  f1 := sort(f1);
  wrlist(f1);
  writeln;
  write('Otsortirovanni spisok 2 = ');
  f2:= sort(f2);
  wrlist(f2);
  writeln;
  write('Novi spisok = ');
  unite(f3,f1,f2);
  wrlist(f3);
  readln;
  readln;
end.