PROGRAM compare (input, output);
  CONST

  (* standard file descriptors. subscripts in open, etc. *)
    (* these are not to be changed *)
    STDIN = 1;
    STDOUT = 2;
    STDERR = 3;

  (* other io-related stuff *)
    IOERROR = 0;  (* status values for open files *)
    IOAVAIL = 1;
    IOREAD = 2;
    IOWRITE = 3;
    MAXOPEN = 10; (* maximum number of open files *)

  (* universal manifest constants *)
    ENDFILE = -1;
    ENDSTR = 0;   (* null-terminated strings *)
    MAXSTR = 100; (* longest possible string *)

  (* ascii character set in decimal *)
    NEWLINE = 10;
    BLANK = 32;
    COLON = 58; (* : *)

  TYPE
    character = -1..127;  (* byte-sized. ascii + other stuff *)
    string = ARRAY [1..MAXSTR] OF character;
    filedesc = IOERROR..MAXOPEN;
    ioblock = RECORD  (* to keep track of open files *)
      filevar: TEXT;
      mode: IOERROR..IOWRITE;
    END;

  VAR
    openlist : ARRAY [1..MAXOPEN] of ioblock; (* open files *)

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ equal -- test two strings for equality }
function equal (var str1, str2 : string) : boolean;
var
	i : integer;
begin
	i := 1;
	while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
		i := i + 1;
	equal := (str1[i] = str2[i])
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ itoc - convert integer n to char string in s[i]... }
function itoc (n : integer; var s : string; i : integer)
		: integer;	{ returns end of s }
begin
	if (n < 0) then begin
		s[i] := ord('-');
		itoc := itoc(-n, s, i+1)
	end
	else begin
		if (n >= 10) then
			i := itoc(n div 10, s, i);
		s[i] := n mod 10 + ord('0');
		s[i+1] := ENDSTR;
		itoc := i + 1
	end
end;

(*getarg: get n-th command line argument into s.
  which returns the 0th to paramcount-1th argument is s.
  maxsize appears ignored: it seems to support the WhiteSmith's compiler.*)
FUNCTION getarg (n: INTEGER; VAR s: string; maxsize: INTEGER): BOOLEAN;
  VAR
    arg: ARRAY [1..MAXSTR] of CHAR;
    i, lnb: INTEGER;

BEGIN lnb := 0;
  IF (n >= 0) AND (n <= paramcount) THEN BEGIN (* Delphi/FPC paramcount. *)
    arg := paramstr(n); (* Delphi/FPC paramstr. *)
    FOR i := 1 TO MAXSTR-1 DO BEGIN
      s[i] := ORD(arg[i]);
      IF arg[i] <> ' ' THEN lnb := i
    END;
    getarg := TRUE; END
  ELSE getarg := FALSE;
  (* END IF *)
  s[lnb+1] := ENDSTR
END;

{ getc (UCB) -- get one character from standard input }
function getc (var c : character) : character;
var
    ch : char;
begin
    if eof then
        c := ENDFILE
    else if eoln then begin
        readln;
        c := NEWLINE
    end
    else begin
        read(ch);
        c := ord(ch)
    end;
    getc := c
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getcf (UCB) -- get one character from file }
function getcf (var c: character; fd : filedesc) : character;
var
	ch : char;
begin
	if (fd = STDIN) then
		getcf := getc(c)
	else if eof(openlist[fd].filevar) then
		c := ENDFILE
	else if eoln(openlist[fd].filevar) then begin
		read(openlist[fd].filevar, ch);
		c := NEWLINE
	end
	else begin
		read(openlist[fd].filevar, ch);
		c := ord(ch)
	end;
	getcf := c
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ getline (UCB) -- get a line from file }
function getline (var s : string; fd : filedesc;
		maxsize : integer) : boolean;
var
	i : integer;
	c : character;
begin
	i := 1;
	repeat
		s[i] := getcf(c, fd);
		i := i + 1
	until (c = ENDFILE) or (c = NEWLINE) or (i >= maxsize);
	if (c = ENDFILE) then	{ went one too far }
		i := i - 1;
	s[i] := ENDSTR;
	getline := (c <> ENDFILE)
end;

(* message: print a message to STDERR. *)
PROCEDURE message (CONST s: shortstring);
BEGIN (* FPC standard error specific output: *)
  WRITELN(erroutput, s)
END;

(* error (FPC): Print an error to STDERR and halt. *)
PROCEDURE error(CONST s: shortstring);
BEGIN message(s);
  halt(1)
END;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putc (UCB) -- put one character on standard output }
procedure putc (c : character);
begin
	if c = NEWLINE then
		writeln
	else
		write(chr(c))
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putcf (UCB) -- put a single character on file fd }
procedure putcf (c : character; fd : filedesc);
begin
	if (fd = STDOUT) then
		putc(c)
	else if c = NEWLINE then
		writeln(openlist[fd].filevar)
	else
		write(openlist[fd].filevar, chr(c))
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putdec -- put decimal integer n in field width >= w }
procedure putdec (n, w : integer);
var
	i, nd : integer;
	s : string;
begin
	nd := itoc(n, s, 1);
	for i := nd to w do
		putc(BLANK);
	for i := 1 to nd-1 do
		putc(s[i])
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ putstr (UCB) -- put out string on file }
procedure putstr (var s : string; f : filedesc);
var
	i : integer;
begin
	i := 1;
	while (s[i] <> ENDSTR) do begin
		putcf(s[i], f);
		i := i + 1
	end
end;

(*$i-*)
FUNCTION open (VAR name: string; mode: INTEGER): filedesc;
  VAR
    i: INTEGER;
    intname: shortstring; (* FPC shortstring *)
    found: BOOLEAN;

BEGIN i := 1;
  WHILE (name[i] <> ENDSTR) DO BEGIN
    intname[i] := CHR(name[i]); i := i + 1
  END;
  intname[0] := CHR(i - 1);
  (* Find a free slot in openlist. *)
  open := IOERROR;
  found := FALSE;
  i := 1;
  WHILE (i <= MAXOPEN) AND (NOT found) DO BEGIN
    IF (openlist[i].mode = IOAVAIL) THEN BEGIN
      openlist[i].mode := mode;
      assign(openlist[i].filevar, intname);
      IF (mode = IOREAD) THEN
        RESET(openlist[i].filevar)
      ELSE
        REWRITE(openlist[i].filevar);
      open := i; found := TRUE
    END;
    i := i + 1
  END;
  IF (ioresult <> 0) THEN open := IOERROR
END;
(*$i-*)

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ mustopen -- open file or die }
function mustopen (var name : string; mode : integer)
		: filedesc;
var
	fd : filedesc;
begin
	fd := open(name, mode);
	if (fd = IOERROR) then begin
		putstr(name, STDERR);
		error(': can''t open file')
	end;
	mustopen := fd
end;

{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
{ compare -- compare two files for equality }
procedure compare;
var
	line1, line2 : string;
	arg1, arg2 : string;
	lineno : integer;
	infile1, infile2 : filedesc;
	f1, f2 : boolean;

	{ Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
	{ diffmsg -- print line numbers and differing lines }
	procedure diffmsg (n : integer; var line1, line2 : string);
	begin
		putdec(n, 1);
		putc(COLON);
		putc(NEWLINE);
		putstr(line1, STDOUT);
		putstr(line2, STDOUT)
	end;

begin
	if (not getarg(1, arg1, MAXSTR))
	  or (not getarg(2, arg2, MAXSTR)) then
		error('usage: compare file1 file2');
	infile1 := mustopen(arg1, IOREAD);
	infile2 := mustopen(arg2, IOREAD);
	lineno := 0;
	repeat
		lineno := lineno + 1;
		f1 := getline(line1, infile1, MAXSTR);
		f2 := getline(line2, infile2, MAXSTR);
		if (f1 and f2) then
			if (not equal(line1, line2)) then
				diffmsg(lineno, line1, line2)
	until (f1 = false) or (f2 = false);
	if (f2 and not f1) then
		message('compare: end of file on file1')
	else if (f1 and not f2) then
		message('compare: end of file on file2')
end;

PROCEDURE initio;
  VAR
    i: filedesc;
BEGIN
  openlist[STDIN].mode := IOREAD;
  openlist[STDOUT].mode := IOWRITE;
  openlist[STDERR].mode := IOWRITE;

  (* Connect STDERR to user's terminal. *)
  assign(openlist[STDERR].filevar, ''); (* FPC specific. *)
  REWRITE(openlist[STDERR].filevar);
  FOR i := STDERR+1 TO MAXOPEN DO
    openlist[i].mode := IOAVAIL;
END;

BEGIN (* main program *)
  initio; compare
END.