:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:
:	I got this program from a UCSD PASCAL USERS GROUP and as
:  such it will not run immediately.  Why is it here?  I included
:  it to give you folks out there practice in converting from UCSD
:  to Pascal/Z.  Once you have done it (and it runs) it would be
:  nice to give it to our users group.  We help you, you help us.
:  I'll be including a UCSD on each volume so we can get the group
:  to help updating various programs that are around and are public
:  domain.
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
{Program to compare two sourcecode files and output the differences,
 if any.  Useful to compare two similar textfiles to find out whether and 
 where they have been changed.  Part of original UCSD I.4 release--author
 is unknown.}
 
 PROGRAM SRCCOM;  (* SOURCE COMPARE *)


CONST
  VERSION = 'v202 27-Oct-77';
  MINLINESFORMATCH = 6;
  MAXTRY = 150;  (*<<<10/27/77 GLH. LIMIT ON SEARCH AHEAD FOR MATCH*)
  LINELENGTH = 90;


 TYPE

  LINEPOINTER = ^LINE;
  LINE =
   RECORD  (*<<<10/26/77 GLH*)
    NEXTLINE : LINEPOINTER;
    IMAGE : STRING[LINELENGTH]
   END;

  STREAM =
   RECORD
    CURSOR, HEAD, TAIL : LINEPOINTER;
    CURSORLINENO, HEADLINENO, TAILLINENO : INTEGER;
    ENDFILE : BOOLEAN
   END;


 VAR

  TITLEA, TITLEB : STRING;  (*<<<10/27/77 GLH*)
  FILEA, FILEB : TEXT;
  A, B : STREAM;
  MATCH : BOOLEAN;
  ENDFILE : BOOLEAN;

  TEMPLINE : STRING[LINELENGTH];  (*<<<10/26/77 GLH*)

  FREELINES : LINEPOINTER;



  SAME : BOOLEAN;



 PROCEDURE COMPARE;


                                          FUNCTION ENDSTREAM(VAR X : STREAM) : BOOLEAN;
  BEGIN (* ENDSTREAM *)
   ENDSTREAM := (X.CURSOR = NIL) AND X.ENDFILE
  END;  (* ENDSTREAM *)


  PROCEDURE MARK(VAR X : STREAM);

   (* CAUSES BEGINNING OF STREAM TO BE POSITIONED BEFORE *)
   (* CURRENT STREAM CURSOR.  BUFFERS GET RECLAIMED, LINE *)
   (* COUNTERS RESET, ETC. *)

   PROCEDURE COLLECT(FWA, LWAPLUS1 : LINEPOINTER);
    VAR P : LINEPOINTER;
   BEGIN (* COLLECT *)
    WHILE FWA <> LWAPLUS1 DO
     BEGIN P := FWA^.NEXTLINE;
      FWA^.NEXTLINE := FREELINES;  FREELINES := FWA;
      FWA := P
     END
   END;  (* COLLECT *)


  BEGIN (* MARK *)
   IF X.HEAD <> NIL THEN
    BEGIN
     COLLECT(X.HEAD, X.CURSOR);
     X.HEAD := X.CURSOR;  X.HEADLINENO := X.CURSORLINENO;
     IF X.CURSOR = NIL THEN
      BEGIN  X.TAIL := NIL;  X.TAILLINENO := X.CURSORLINENO  END
    END
  END;  (* MARK *)


  PROCEDURE MOVECURSOR(VAR X : STREAM;  VAR FILEX : TEXT);

   (* FILEX IS THE INPUT FILE ASSOCIATED WITH STREAM X.  THE *)
                                            (* CURSOR FOR X IS MOVED FORWARD ONE LINE, READING FROM X *)
   (* IF NECESSARY, AND INCREMENTING THE LINE COUNT.  ENDFILE *)
   (* IS SET IF EOF ENCOUNTERED ON EITHER STREAM. *)

   PROCEDURE READLINE;
    VAR
     I : INTEGER;
     CH : CHAR;
     NEWLINE : LINEPOINTER;
     C, C2 : 0..LINELENGTH;
   BEGIN (* READLINE *)
    IF NOT X.ENDFILE THEN
     BEGIN
      C := 0;
      (*<<<10/26/77 GLH. CHANGED WAY CHARS GET INTO TEMPLINE*)
      READ(FILEX, TEMPLINE);
      NEWLINE := FREELINES;
      IF NEWLINE = NIL THEN NEW(NEWLINE)
      ELSE  FREELINES := FREELINES^.NEXTLINE;
      NEWLINE^.IMAGE := TEMPLINE;  (*<<<10/26/77 GLH*)
      NEWLINE^.NEXTLINE := NIL;
      IF X.TAIL = NIL THEN
       BEGIN  X.HEAD := NEWLINE;
        X.TAILLINENO := 1;  X.HEADLINENO := 1
       END
      ELSE
       BEGIN X.TAIL^.NEXTLINE := NEWLINE;
        X.TAILLINENO := X.TAILLINENO + 1
       END;
      X.TAIL := NEWLINE;
      X.ENDFILE := EOF(FILEX);
     END
   END;  (* READLINE *)


  BEGIN (* MOVECURSOR *)
               IF X.CURSOR <> NIL THEN
    BEGIN
     IF X.CURSOR = X.TAIL THEN READLINE;
     X.CURSOR := X.CURSOR^.NEXTLINE;
     IF X.CURSOR = NIL THEN ENDFILE := TRUE;
     X.CURSORLINENO := X.CURSORLINENO + 1
    END
   ELSE
    IF NOT X.ENDFILE THEN (* BEGINNING OF STREAM *)
     BEGIN
      READLINE; X.CURSOR := X.HEAD;
      X.CURSORLINENO := X.HEADLINENO
     END
    ELSE  (* END OF STREAM *)
     ENDFILE := TRUE;
  END;  (* MOVECURSOR *)


  PROCEDURE BACKTRACK(VAR X : STREAM;  VAR XLINES : INTEGER);

   (* CAUSES THE CURRENT POSITION OF STREAM  THE NEW CURRENT *)
   (* THE LINE COUNTER IS RETURNED IN XLINES.  IT IS THE NUMBER *)
   (* OF THE CURRENT LINE (BEFORE BACKTRACK) RELATIVE TO BEGINNING *)
   (* OF STREAM. *)

  BEGIN (* BACKTRACK *)
   XLINES := X.CURSORLINENO + 1 - X.HEADLINENO;
   X.CURSOR := X.HEAD;  X.CURSORLINENO := X.HEADLINENO;
   ENDFILE := ENDSTREAM(A) OR ENDSTREAM(B)
  END;  (* BACKTRACK *)


  PROCEDURE COMPARELINES(VAR MATCH : BOOLEAN);

                                                       (* COMPARE THE CURRENT LINES OF STREAMS A AND B, RETURNING *)
   (* MATCH TO SIGNAL THEIR (NON-) EQUIVALENCE.  EOF ON BOTH STREAMS *)
   (* IS CONSIDERED A MATCH, BUT EOF ON ONLY ONE STREAM IS A MISMATCH *)

  BEGIN (* COMPARELINES *)
   IF (A.CURSOR = NIL) OR (B.CURSOR = NIL) THEN
    MATCH := ENDSTREAM(A) AND ENDSTREAM(B)
   ELSE
      MATCH := (A.CURSOR^.IMAGE = B.CURSOR^.IMAGE)
  END;  (* COMPARELINES *)


  PROCEDURE FINDMISMATCH;


  BEGIN (* FINDMISMATCH *)
   (* NOT ENDFILE AND MATCH *)
   REPEAT  (* COMPARENEXTLINES *)
    MOVECURSOR(A, FILEA); MOVECURSOR(B,FILEB);
    MARK(A); MARK(B);
    COMPARELINES(MATCH)
   UNTIL ENDFILE OR NOT MATCH;
  END;  (* FINDMISMATCH *)


  PROCEDURE FINDMATCH;

   VAR
      TRYCOUNT : INTEGER;


   PROCEDURE SEARCH(VAR X : STREAM; (* STREAM TO SEARCH *)
                    VAR FILEX : TEXT;
                    VAR Y : STREAM; (* STREAM TO LOOKAHEAD *)
                    VAR FILEY : TEXT);

    (* LOOK AHEAD ONE LINE ON STREAM Y, AND SEARCH FOR THAT LINE *)
            (* BACKTRACKING ON STREAM X. *)

    VAR
     COUNT : INTEGER;  (* NUMBER OF LINES BACKTRACKED ON X *)


    PROCEDURE CHECKFULLMATCH;
     (* FROM THE CURRENT POSITIONS IN X AND Y, WHICH MATCH, *)
     (* MAKE SURE THAT THE NEXT MINLINESFORMATCH-1 LINES ALSO *)
     (* MATCH, OR ELSE SET MATCH := FALSE.  *)
     VAR
      N : INTEGER;
      SAVEXCUR, SAVEYCUR : LINEPOINTER;
      SAVEXLINE, SAVEYLINE : INTEGER;
    BEGIN (* CHECKFULLMATCH *)
     SAVEXCUR := X.CURSOR;  SAVEYCUR := Y.CURSOR;
     SAVEXLINE := X.CURSORLINENO;  SAVEYLINE := Y.CURSORLINENO;
     COMPARELINES(MATCH);
     N := MINLINESFORMATCH - 1;
     WHILE MATCH AND (N <> 0) DO
      BEGIN  MOVECURSOR(X, FILEX);  MOVECURSOR(Y, FILEY);
       COMPARELINES(MATCH);  N := N - 1
      END;
     X.CURSOR := SAVEXCUR;  X.CURSORLINENO := SAVEXLINE;
     Y.CURSOR := SAVEYCUR;  Y.CURSORLINENO := SAVEYLINE;
    END;  (* CHECKFULLMATCH *)


   BEGIN (* SEARCH *)
    MOVECURSOR(Y, FILEY);  BACKTRACK(X, COUNT);
    CHECKFULLMATCH;  COUNT := COUNT - 1;
     WHILE (COUNT <> 0) AND NOT MATCH DO
     BEGIN
      MOVECURSOR(X, FILEX);  COUNT := COUNT - 1;
      CHECKFULLMATCH
     END
   END;  (* SEARCH *)


   PROCEDURE PRINTMISMATCH;
    VAR
     EMPTYA, EMPTYB : BOOLEAN;

    PROCEDURE WRITETEXT(P, Q : LINEPOINTER);
    BEGIN (* WRITETEXT *)
     WRITELN;
     WHILE (P <> NIL) AND (P <> Q) DO
      BEGIN  WRITE(' * ');
        WRITELN (P^.IMAGE);
       P := P^.NEXTLINE
      END;
     IF P = NIL THEN WRITELN(' *** EOF ***');
     WRITELN
    END;  (* WRITETEXT *)


    PROCEDURE WRITELINENO(VAR X : STREAM);
     VAR
      F, L : INTEGER;
    BEGIN (* WRITELINENO *)
     F := X.HEADLINENO;  L := X.CURSORLINENO - 1;
     WRITE('LINE');
     IF F = L THEN WRITE(' ', F)
     ELSE WRITE('S ', F, ' TO ', L);
     IF X.CURSOR = NIL THEN WRITE(' (BEFORE EOF)');
    END;  (* WRITELINENO *)


    PROCEDURE PRINTEXTRATEXT(VAR X : STREAM; XNAME : STRING;
                             VAR Y : STREAM; YNAME : STRING);
    BEGIN (* PRINTEXTRATEXT *)
                             WRITE(' EXTRA TEXT ON ', XNAME, ', ');
     WRITELINENO(X);  WRITELN;
     IF Y.HEAD = NIL THEN
      WRITELN(' BEFORE EOF ON ', YNAME)
     ELSE
      WRITELN(' BETWEEN LINES ', Y.HEADLINENO-1, ' AND ',
              Y.HEADLINENO, ' OF ', YNAME);
     WRITETEXT(X.HEAD, X.CURSOR)
    END;  (* PRINTEXTRATEXT *)



   BEGIN (* PRINTMISMATCH *)
    WRITELN(' ***********************************');
    EMPTYA := (A.HEAD = A.CURSOR);
    EMPTYB := (B.HEAD = B.CURSOR);
    IF EMPTYA OR EMPTYB THEN
     IF EMPTYA THEN PRINTEXTRATEXT(B, TITLEB, A, TITLEA)
     ELSE PRINTEXTRATEXT(A, TITLEA, B, TITLEB)
    ELSE
     BEGIN
      WRITELN(' MISMATCH:');  WRITELN;
      WRITE(' ', TITLEA, ', ');  WRITELINENO(A);  WRITELN(':');
      WRITETEXT(A.HEAD, A.CURSOR);
      WRITE(' ', TITLEB, ', ');  WRITELINENO(B);  WRITELN(':');
      WRITETEXT(B.HEAD, B.CURSOR)
     END
   END;  (* PRINTMISMATCH *)


  BEGIN (* FINDMATCH *)
        TRYCOUNT := 0;
        WHILE (NOT MATCH) AND (TRYCOUNT <= MAXTRY) DO
          BEGIN
                  SEARCH(A, FILEA, B, FILEB);
            TRYCOUNT := TRYCOUNT+1;
          END;
        IF NOT MATCH THEN
          BEGIN
            TRYCOUNT:=0;
            WHILE (NOT MATCH) AND (TRYCOUNT<=MAXTRY) DO
                BEGIN
                  SEARCH(B, FILEB, A, FILEA);
                  TRYCOUNT:=TRYCOUNT+1;
                END;
          END;
        PRINTMISMATCH;
        IF (NOT MATCH) AND (TRYCOUNT>MAXTRY) THEN
          BEGIN  MARK(A); MARK(B) END;
  END;  (* FINDMATCH *)




 BEGIN (* COMPARE *)
  ENDFILE := FALSE;  MATCH := TRUE;  (* I.E., BOI MATCHES BOI *)
  REPEAT
   IF MATCH THEN FINDMISMATCH ELSE BEGIN SAME := FALSE; FINDMATCH END
  UNTIL ENDFILE AND MATCH;
  MARK(A);  MARK(B);  (* MARK END OF FILES, THEREBY DISPOSING BUFFERS *)
 END;  (* COMPARE *)


 PROCEDURE INITSTREAM(VAR X : STREAM; VAR FILEX : TEXT);
 BEGIN (* INITSTREAM *)
  X.CURSOR := NIL;  X.HEAD := NIL;  X.TAIL := NIL;
  X.CURSORLINENO := 0;  X.HEADLINENO := 0;  X.TAILLINENO := 0;
  X.ENDFILE := EOF(FILEX);
                 END;  (* INITSTREAM *)


BEGIN (* SRCCOM *)
 WRITELN('INPUT FILE NAME:'); READLN(TITLEA);
 OPENOLD(FILEA, TITLEA);
 WRITELN('SECOND INPUT FILE NAME:'); READLN(TITLEB);
 OPENOLD(FILEB, TITLEB);
 RESET(FILEA);  RESET(FILEB);
 INITSTREAM(A, FILEA);  INITSTREAM(B, FILEB);
 FREELINES := NIL;
 WRITELN('Source Compare [', VERSION, ']' );
 WRITELN;
 IF EOF(FILEA) THEN
  BEGIN WRITELN(TITLEA, ' IS EMPTY.');
   IF EOF(FILEB) THEN WRITELN(TITLEB, ' IS EMPTY.')
  END
 ELSE
  IF EOF(FILEB) THEN WRITELN(TITLEB, ' IS EMPTY.')
  ELSE
   BEGIN  SAME := TRUE;
    COMPARE;
    IF SAME THEN WRITELN('No differences encountered.');
   END
END.  (* SRCCOM *)