{$debug-}

program merge (output,infile_1,infile_2,outfile);

var
  infile_1        : text;
  infile_2        : text;
  outfile         : text;
  in1,in2         : lstring (255);
  up1,up2         : lstring (255);
  onecount        : word;
  twocount        : word;
  outcount        : word;

procedure read1;
  var [static] 
    i : word;
  begin
    while in1.len = 0 do
      begin
        if eof (infile_1) then
          return;
        readln (infile_1,in1);
        if in1.len > 80 then
          in1.len := 80;
        for i := in1.len downto 1 do
          if in1 [i] =  ' ' then
            in1.len := in1.len - 1
          else
            break;
        up1 := in1;
        for i := 1 to up1.len do
          if up1 [i] in ['a'..'z'] then
            up1 [i] := chr (ord (up1 [i]) - 32);
        if up1 <> null then
          onecount := onecount + 1;
      end;
  end;
          
procedure read2;
  var [static] 
    i : word;
  begin
    while in2.len = 0 do
      begin
        if eof (infile_2) then
          return;
        readln (infile_2,in2);
        if in2.len > 80 then
          in2.len := 80;
        for i := in2.len downto 1 do
          if in2 [i] =  ' ' then
            in2.len := in2.len - 1
          else
            break;
        up2 := in2;
        for i := 1 to up2.len do
          if up2 [i] in ['a'..'z'] then
            up2 [i] := chr (ord (up2 [i]) - 32);
        if up2 <> null then
          twocount := twocount + 1;
      end;
  end;
          
procedure write1;
  begin
    if up1 <> null then
      begin
        outcount := outcount + 1;
        writeln (outfile,in1);
        in1 := null;
        up1 := null;
      end;
    read1;
  end;

procedure write2;
  begin
    if up2 <> null then
      begin
        outcount := outcount + 1;
        writeln (outfile,in2);
        in2 := null;
        up2 := null;
      end;
    read2;
  end;

function one_greater : boolean;
  var [static]
    k       : word;
    last    : word;
  begin
    if up1.len > up2.len then
      last := up2.len
    else
      last := up1.len;
    if last = 0 then
      begin
        if up2.len > 0 then
          one_greater := true
        else
          one_greater := false;
        return;
      end;
    if last < 8 then
      begin
        one_greater := false;
        return;
      end;
    for k := 8 to last do
      begin
        if up1 [k] < up2 [k] then
          begin
            one_greater := false;
            return;
          end;
        if up1 [k] > up2 [k] then
          begin
            one_greater := true;
            return;
          end;
      end;
    if up1.len > up2.len then
      begin
        one_greater := true;
        return;
      end;
    if up1.len < up2.len then
      begin
        one_greater := false;
        return;
      end;
    for k := 1 to 6 do
      begin
        if up1 [k] < up2 [k] then
          begin
            one_greater := false;
            return;
          end;
        if up1 [k] > up2 [k] then
          begin
            one_greater := true;
            return;
          end;
      end;
    one_greater := false;
  end;
          
procedure initialize;
  begin
    onecount := 0;
    twocount := 0;
    outcount := 0;
    in1 := null;
    up1 := null;
    in2 := null;
    up2 := null;
    writeln;
    writeln ('Index merging program, (C) Copyright Peter Norton 1983');
    writeln;
    reset (infile_1);
    reset (infile_2);
    rewrite (outfile);
    read1;
    read2;
  end;

procedure finish_up;
  begin
    if one_greater then
      write2;
    write1;
    write2;
    writeln (onecount,' entries in from one file;');
    writeln (twocount,' entries in from the other file;');
    writeln (outcount,' combined entries written.');
  end;
  
begin
  initialize;
  while (not eof (infile_1)) or (not eof (infile_2)) do
    if one_greater then
      write2
    else
      write1;
  finish_up;
end.
