program CheckLIB(input,output);
(*
  Program compares two catalogues generated by:
          LIB library [M]

  Output of the command should be redirected by:
          PUT CONSOLE TO FILE lib

  Two of the files 'lib' will be read and module names
  will be compared. Any difference will be listed

  How to call : CHECKLIB lib_1 {lib_2}

  If only one file name is given, CHECKLIB expects as first
  file the filename with extension .1 and as second file extension .2

*)

const
  HEADER       = 'LIB';
  CtrlC        = ^C;
  CR           = #$0D;
type
  Name         = string[ 8];
  Fname        = string[14];
  Long         = string;
  DatPtr       = ^DatList;
  DatList      = record
                   Link      : DatPtr;
                   ModNam    : Name;
                   Which     : integer;
                 end;
var
  OneFile      : boolean;
  Count        : integer;
  Root         : DatPtr;
  Names        : array[1..2] of Fname;

function IsInList(Item:DatPtr):boolean;
var
  p            : DatPtr;
  GotIt        : boolean;
begin
  if Root=NIL then GotIt:=FALSE
              else
              begin
                p:=Root;
                repeat
                  GotIt:=p^.ModNam=Item^.ModNam;
                  p:=p^.Link;
                until (GotIt) OR (p=NIL);
              end;
  IsInList:=GotIt;
end;

procedure PutToList(Item:DatPtr);
var
  p,q          : DatPtr;
begin
  if Root=NIL then
  begin
    Item^.Link:=NIL;
    Root:=Item;
  end else
  if Root^.ModNam>Item^.ModNam then
  begin
    Item^.Link:=Root;
    Root:=Item;
  end else
  begin
    p:=Root;
    q:=Root;
    while (p^.Link<>NIL) and (p=q) do
    begin
      p:=p^.Link;
      if p^.ModNam>Item^.ModNam then
      begin
        q^.Link:=Item;
        Item^.Link:=p;
      end else q:=p;
    end;
    if (p^.Link=NIL) and (p^.ModNam<Item^.ModNam) then
    begin
      Item^.Link:=NIL;
      p^.Link:=Item;
    end;
  end;
end;

procedure Remove(ModNam:Name);
var
  p,q          : DatPtr;
  Deleted      : boolean;
begin
  Deleted:=FALSE;
  if Root^.ModNam=ModNam then
  begin
    p:=Root;
    Root:=Root^.Link;
    dispose(p);
    Deleted:=TRUE;
  end else
  begin
    p:=Root;
    q:=Root;
    while (p^.Link<>NIL)     AND
          (p=q)              AND
          (p^.ModNam<ModNam) AND
          (NOT Deleted)           do
    begin
      p:=p^.Link;
      if p^.ModNam=ModNam then
      begin
        q^.Link:=p^.Link;
        dispose(p);
        Deleted:=TRUE;
      end else q:=p;
    end;
  end;
end;

procedure Help;
Begin
  writeln('Call : CHECKLIB lib_1 {lib_2}');
  writeln;
  writeln('Reports differences in ''files_i'' generated by LIB.COM');
  writeln;
  writeln('If only one file name is given, CHECKLIB expects as first');
  writeln('file the filename with extension .1 and as second file extension .2');
  halt;
End;

procedure IO_ABORT(mes:long;num:integer);
Begin
  writeln('ABORT: ',mes,Names[num]);
  halt;
End;

procedure PutFile(fileno:integer);
var
  FEOF         : boolean;
  F            : text;
  line         : long;

  procedure Sync;
  begin
    readln(F,line);
    if NOT (pos(HEADER,line)=1) then IO_ABORT('Invalid header in ',fileno);
    readln(F);
  end;

  function freemem:real;
  var
    avail      : integer;
  begin
    avail:=memavail;
    if avail<0 then freemem:=65536.0+avail
               else freemem:=avail;
  end;

  procedure Status(mes:long);
  var
    free       : real;
  begin
    free:=freemem;
    writeln('Process module',Count:6,' ',mes,' ... ',line:9,' in ',Names[fileno],
            ' - Free ',free:5:0);
  end;

  procedure makenew(var pt:DatPtr);
  begin
    if (freemem>sizeof(pt)) then new(pt)
    else
    begin
      writeln('No more memory for data');
      halt;
    end;
  end;

  procedure ProcModule;
  var
    p          : DatPtr;
  begin
    while line[length(line)]=' ' do delete(line,length(line),1);
    makenew(p);
    with p^ do
    begin
      Link:=NIL;
      ModNam:=line;
      Which:=fileno;
    end;
    if IsInList(p) then
    begin
      dec(Count);
      Remove(line);
      dispose(p);
      Status('deleted ');
    end else
    begin
      inc(Count);
      PutToList(p);
      Status('inserted');
    end;
  end;

  procedure WantAbort;
  var
    ch         : char;
  begin
    read(kbd,ch);
    if ch=CtrlC then
    begin
      write('Received abort signal - Abort really [y,n] ');
      repeat
        repeat until keypressed;
        read(kbd,ch);
        ch:=UpCase(ch);
      until (ch in ['N','Y']);
      if (ch='Y') then
      begin
        writeln(ch);
        writeln('User interrupt.. aborted');
        halt;
      end else
      begin
        write(CR);
        ClrEol;
      end;
    end;
  end;

Begin { PutFile }
  if NOT OneFile then Names[fileno]:=ParamStr(fileno)
                 else Names[fileno]:=ParamStr(1)+'.'+chr(ord('0')+(fileno MOD 10));
  assign(F,Names[fileno]);
  if NOT exist(F) then IO_ABORT('Cannot find source file ',fileno);
  reset(F);
  Sync;
  FEOF:=FALSE;
  while NOT FEOF do
  begin
    readln(F,line);
    if keypressed then WantAbort;
    FEOF:=(length(line)=0) OR (EOF(F));
    if NOT FEOF then ProcModule;
  end;
  close(F);
End;

BEGIN
  Root:=NIL;
  Count:=0;
  if (ParamCount>2) OR
     (ParamCount=0)    then Help
  else
  begin
    OneFile:=(ParamCount=1);
    PutFile(1);
    PutFile(2);
    if NOT (Root=NIL) then
    begin
      writeln;
      writeln('Differnces found:');
      writeln;
      while NOT (Root=NIL) do
      begin
        writeln('Missing ',Root^.ModNam:9,' in file ',Names[Root^.Which]);
        Root:=Root^.Link;
      end;
    end else writeln('Files ',Names[1],' and ',Names[2],' hold same modules');
  end;
END.