Вычислить произведение двух многочленов

program polynom2 (infile1, infile2, output);
 
uses crt;
 
type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              coef: infotype;
              expnt: infotype;
              next: list
            end;
 
 
var
  infile1, infile2,ff: text;
  L1, L2, L3: list;
  vibor:integer;
 
 
function FIRST (L: list): position;
  begin
    FIRST:= L
  end;
function ENDLIS (L: list): position;
  var
    p: position;
  begin
    p:= L;
    while p^.next <> nil do
      p:= p^.next;
    ENDLIS:= p
  end;
function NEXT (p: position; L:list): position;
  begin
    NEXT:= p^.next
  end;
function RETRIEVEC (p: position; L: list): infotype;
  begin
    RETRIEVEC:= p^.next^.coef
  end;
function RETRIEVEE (p: position; L: list): infotype;
  begin
    RETRIEVEE:= p^.next^.expnt
  end;
procedure DELETE (var p: position; var L: list);
  begin
    p^.next:= p^.next^.next
  end;
procedure MAKENULL (var L: list);
  begin
    new(L);
    L^.next:=nil;
  end;
procedure INSERTP (p: position; c, e: infotype; var L: list);
  var
    q: position;
  begin
    q:= p^.next;
    new(p^.next);
    p^.next^.coef:=c;
    p^.next^.expnt:=e;
    p^.next^.next:=q
  end;
 
 
 
procedure sortrtn (top:list);
  var
    t,p,q,e: position;                
    sorted,sw1,sw2,sw3 :boolean;     
  begin
{ this code sets e to base-1}
    e:=top;
    while e^.next^.next<>nil do
      e:=e^.next;
 
    repeat
      t:=top;
      p:=t^.next;
      q:=p^.next;
      sorted:=true;
      sw3:=false;
      while ((not sw3) and (e<>top)) do
        begin
          if p^.expnt < q^.expnt
            then
{                       SWAP ENTRIES P & Q                        }
              begin
                if e=p then sw1:=true;
                if e=q then sw2:=true;
                p^.next:=q^.next;
                q^.next:=p;
                t^.next:=q;
                p:=q;
                q:=q^.next;
                if sw1=true
                  then
                    begin
                      e:=p;
                      sw1:=false
                    end;
                if sw2=true
                  then
                    begin
                      e:=q;
                      sw2:=false
                    end;
                sorted:=false
              end;
 
          if e=p
            then
              begin
                e:=t;         {decrement e}
                sw3:=true     {end of pass}
              end;
          t:=t^.next;
          p:=p^.next;
          q:=q^.next
        end                         {end of pass (while loop)}
    until (sorted=true)             {end of sort (repeat loop)}
  end;                              {sortrtn}
 
procedure read_in (var f: text; var L: list);
 
  var
    p: position;
    c, e: infotype;
  begin
    p:= FIRST(L);
    while not eof(f) do
      begin
        readln (f,c,e);
        INSERTP (p, c, e, L);
        p:= NEXT(p, L)
      end
  end;
 
procedure read_kb (var L: list);
 
  var
    p: position;
    c, e: infotype;
  begin
    p:= FIRST(L);
    while (c<>0) or (e<>0) do
      begin
        writeln('Vvedite element,naprimer "12 3". 0 0 - exit');
        readln (c,e);
        INSERTP (p, c, e, L);
        p:= NEXT(p, L)
      end
  end;
procedure print_out (var L: list);
   
  var
    p: position;
    c, e:infotype;
  begin
    assign(ff,'out1.txt');
    rewrite(ff);
    writeln;
    writeln;
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        c:= RETRIEVEC (p, L);
        e:= RETRIEVEE (p, L);
        write (c:1,'x',e:1);
        write (ff,c:1,'x',e:1);
        p:= NEXT(p, L);
        if p <> ENDLIS(L) then
          write (' + ')  ;
          write (ff,' + ');
 
      end;
  end;
 
procedure POLYADD (L1, L2: list; var L3: list); 
  var                                           
    c1, c2, e1, e2: infotype;
    p1, p2, p3: position;
  begin
    MAKENULL (L3);
    p1:= FIRST(L1);
    p2:= FIRST(L2);
    p3:= FIRST(L3);
    while ((p1<>ENDLIS(L1)) or (p2<>ENDLIS(L2))) do
      if p2<>ENDLIS(L2)
        then
          begin
            if p1<>ENDLIS(L1)
              then
                begin
                  c2:= RETRIEVEC (p2, L2);
                  e2:= RETRIEVEE (p2, L2);
                  c1:= RETRIEVEC (p1, L1);
                  e1:= RETRIEVEE (p1, L1);
                  if e1=e2
                    then
                      begin
 
                        INSERTP (p3, c1 + c2, e1, L3);
                        p1:= NEXT(p1, L1);
                        p2:= NEXT(p2, L2)
                      end
                    else
                      if e1>e2
                        then
                          begin
                            INSERTP (p3, c1, e1, L3);
                            p1:= NEXT(p1, L1)
                          end
                        else
                          begin
                            INSERTP (p3, c2, e2, L3);
                            p2:= NEXT(p2, L2)
                          end;
                  p3:= NEXT(p3, L3)
                end
              else
                begin
                  INSERTP (p3, RETRIEVEC (p2, L2), RETRIEVEE (p2, L2), L3);
                  p3:= NEXT(p3, L3);
                  p2:= NEXT(p2, L2)
                end
          end
        else
          begin
            INSERTP (p3, RETRIEVEC (p1, L1), RETRIEVEE (p1, L1), L3);
            p3:= NEXT(p3, L3);
            p1:= NEXT(p1, L1)
          end
  end;
 
procedure REPLACE (var L4, L5: list); 
  var                                 
    p, q, s: position;
  begin
    p:= FIRST(L4);
    q:= NEXT(p, L4);
    while q<>nil do
      begin
        s:= NEXT(q, L4);
        dispose(q);
        q:= s
      end;
    p^.next:= NEXT(L5, L5);
    dispose(L5)
  end;
 
procedure CASTOFF (var L: list); 
  var                             
    p, q, s: position;
  begin
    p:= FIRST(L);
    q:= NEXT(p, L);
    while q<>nil do
      begin
        s:= NEXT(q, L);
        dispose(q);
        q:= s
      end;
    p^.next:=nil
  end;
 
procedure POLYMULT (var L1, L2, L4: list);
  var
    L3, L5: list;
    c1, e1: infotype;
    p, q: position;
  begin
    MAKENULL(L3);
    MAKENULL(L4);
    p:= FIRST(L1);
    while p <> ENDLIS(L1) do
      begin
        c1:= RETRIEVEC(p, L1);
        e1:= RETRIEVEE(p, L1);
        q:= FIRST(L2);
        while q <> ENDLIS(L2) do
          begin
 
 
 
            INSERTP (ENDLIS(L3), RETRIEVEC(q, L2) * c1,
                              RETRIEVEE(q, L2) + e1, L3);
            q:= NEXT(q, L2)
          end;
 
 
 
        POLYADD(L3, L4, L5);
 
 
        REPLACE(L4, L5);
 
 
 
        CASTOFF(L3);
        p:= NEXT(p, L1)
      end
  end;
 
 
 
begin
clrscr;
assign(infile1,'infile1.txt');
assign(infile2,'infile2.txt');
  reset(infile1);
  reset(infile2);
  MAKENULL(L1);
  MAKENULL(L2);
  vibor:=0;
  writeln('Menu: 1- file, 2 - keyboard:');
  read(vibor);
 
  if vibor=1 then
  begin
  read_in (infile1, L1);
  sortrtn (L1);
  print_out (L1);
  read_in (infile2,L2);
  sortrtn (L2);
  print_out (L2);
  POLYMULT (L1, L2, L3);
  print_out (L3);
  readln;
  end;
 
  if vibor=2  then
  begin
 
  writeln('1 polinom');
  read_kb (L1);
  sortrtn (L1);
  print_out (L1);
  writeln;
  writeln('2 polinom');
  read_kb (L2);
  sortrtn (L2);
  print_out (L2);
  POLYMULT (L1, L2, L3);
  print_out (L3);
   end;
 
  readln;
  close(ff);
 
end.