program polynom2 (infile1, infile2, output);
  {polynom2 multiplies two polynomials and prints the result, the input
   polynomials reside in two text files, each line in a text file contains a
   single term (the coefficient, followed by a space, then the exponent).
   The polynomials can be any length.}
   
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT (a LINKED LIST (with header cell) implementation)

NOTES:-    1. NO ERROR CHECKING is performed in this implementation.
              The caller has responsibility for ensuring that the
              position to be RETRIEVE'd or DELETED actually exists.

           2. The position operated on by RETRIEVE, INSERT and DELETE
              is the position FOLLOWING the one pointed to by the
              position pointer (ENDLIS returns a pointer to the last
              element, and FIRST to the header cell (NOT the first element)).}


type
  infotype = integer;
  list = ^listype;
  position = list;
  listype = record
              coef: infotype;
              expnt: infotype;
              next: list
            end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1, infile2: text;
  L1, L2, L3: list;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

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;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
    {This is a bubble sort on a linked list with header cell.
     It is a descending sequence sort}

procedure sortrtn (top:list);
  var
    t,p,q,e: position;                {t,p,q are consecutive nodes and
                                      they move together from t=top to p=e
                                      during each pass through the list.
                                      e moves from the base-1 to the top
                                      with a decrement of 1 for each pass
                                      through the list.}
    sorted,sw1,sw2,sw3 :boolean;     {sw3 signifies the end of pass and
                                      sorted signifies the end of sort
                                      sw1 & sw2 are used to retain the position
                                      of e relative to t,p & q when swapping}
  begin
{ this code sets e to base-1}
    e:=top;
    while e^.next^.next<>nil do
      e:=e^.next;
{ - - - - - - - - - - - - - }
{       START OF SORT       }
    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);
    {read_in reads the input text file and puts the elements in list L. One
     single digit integer per line is the expected file format.}
  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 print_out (var L: list);
    {print_out prints list L, after a linefeed. The elements are expected to be
     single digit integers (a field width of 2 is used with no formatting) if
     this is not the case the output will look confused.}
  var
    p: position;
    c, e:infotype;
  begin
    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);
        p:= NEXT(p, L);
        if p <> ENDLIS(L) then
          write (' + ')
      end
  end;

procedure POLYADD (L1, L2: list; var L3: list); {ADDS POLYNOMIALS IN L1 & L2}
  var                                           {RETURNS RESULT IN L3}
    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
{EXPONENTS EQUAL, ADD THE COEFFICIENTS AND STORE AN ENTRY IN THE OUTPUT LIST}
                        INSERTP (p3, c1 + c2, e1, L3);
                        p1:= NEXT(p1, L1);
                        p2:= NEXT(p2, L2)
                      end
                    else
                      if e1>e2
                        then
                          begin
{EXPONENT FROM LIST 1 GREATER, COPY LIST 1 ENTRY TO OUTPUT LIST}
                            INSERTP (p3, c1, e1, L3);
                            p1:= NEXT(p1, L1)
                          end
                        else
                          begin
{EXPONENT FROM LIST 2 GREATER, COPY LIST 2 ENTRY TO OUTPUT LIST}
                            INSERTP (p3, c2, e2, L3);
                            p2:= NEXT(p2, L2)
                          end;
                  p3:= NEXT(p3, L3)
                end
              else
                begin
{LIST 1 HAS BEEN EXHAUSTED, MUST COPY ALL REMAINING ENTRIES IN LIST 2 TO OUTPUT}
                  INSERTP (p3, RETRIEVEC (p2, L2), RETRIEVEE (p2, L2), L3);
                  p3:= NEXT(p3, L3);
                  p2:= NEXT(p2, L2)
                end
          end
        else
          begin
{LIST 2 HAS BEEN EXHAUSTED, MUST COPY ALL REMAINING ENTRIES IN LIST 1 TO OUTPUT}
            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); {PUTS L5 IN L4, REPLACING CONTENTS OF}
  var                                 {L4 AND SETTING L5 TO NULL}
    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);  {DISPOSES OF CONTENTS OF L AND SETS}
  var                             {IT TO NULL.}
    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

{MULTIPLY A SINGLE TERM OF L1 BY L2 AND STORE RESULT IN L3}

            INSERTP (ENDLIS(L3), RETRIEVEC(q, L2) * c1,
                              RETRIEVEE(q, L2) + e1, L3);
            q:= NEXT(q, L2)
          end;

 {ADD L3 TO L4 (WHICH HOLDS ACCUMULATING TOTAL) AND PUT RESULT IN L5}

        POLYADD(L3, L4, L5);

 {REPLACE CONTENTS OF L4 WITH L5 AND DISPOSE OF L5}

        REPLACE(L4, L5);

 {DISPOSE OF L3}

        CASTOFF(L3);
        p:= NEXT(p, L1)
      end
  end;

{     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

begin
  reset(infile1);
  reset(infile2);
  MAKENULL(L1);
  MAKENULL(L2);
  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)
end.