! file compare program (with profuse apologies to H.M. Dewar esq.)

%begin
%include "Sysinc:command.inc"
%externalroutinespec CPU LIMIT(%integer n)
%owninteger  max=8;          !  minimum acceptable lookahead
%constinteger  linemax=127;  !  maximum line length
%constinteger  astream=1, bstream=2;      !  input streams
%constinteger  out=1;        !  output stream
%constinteger  skip=0;       !  set non-zero to skip blank lines
                             !  (but then line numbers are incorrect)

%owninteger  abase=0, bbase=0, acount=0, bcount=0
%integer  anum, bnum, aline, bline
%integer  aeof, beof
%integer  mismatch

%begin;            ! set 'max' to use all available store
%constinteger  spare=512
%integer  lim
   lim = (free space - spare)//(2*(line max + 1))
   %if lim < max %start
      print string("* More store required")
      newline
      %stop
   %finish
   max = max << 1 %while max <= lim
   max = max >> 1
%end

%string(127)%array  aa,bb(0:max-1)

%string(*)%map a(%integer  i)
   %result == aa((abase+i)&(max-1))
%end

%string(*)%map b(%integer  i)
   %result == bb((bbase+i)&(max-1))
%end

%routine  replenish(%string(*)%map  x(%INTEGER N), %integername  xline,  %c
                          %integer n, %integername count, eof)
   %integer  i,j,k,last
   %string(*)%name  p
   %on 9 %start
      eof = 1;  %return
   %finish
   %for i = max-n+1, 1, max  %cycle
      p == x(i)
      %cycle
         last = 0;  j = 0
         %return %if eof # 0
         %cycle
            read symbol(k)
            j = j+1;  charno(p,j) = k
            %exit %if k = nl %or j = linemax
            last = j %if k # ' '
         %repeat
         read symbol(k) %while k # nl;  ! ...skip any remaining chars
         xline = xline + 1;    ! ...within-file line no.
         %exit %if last # 0 %or skip = 0;  ! ...blank line?
      %repeat
      length(p) = last+1;  charno(p,last+1) = nl
      count = count+1;   ! ...within-buffer line count
   %repeat
%end


%routine  PRINT(%string(*)%map  X(%integer N),
                %integer  XBASE, N,
                %string(*)%name  ID)
   %integer  i
   PRINT STRING("** ");  printstring(id)
   PRINT STRING(" at line");  WRITE(XBASE+1,1)
   newline
   %return %if n <= 0
   %for I = 1,1,n %cycle
      %if i=n %then printstring("  ") %else printstring(" |")
      print string(x(i))
   %repeat
%end

%predicate  same(%integer  al, bl)
   %if al > acount %or bl > bcount %start
      %true %if al > acount %and bl > bcount
      %false
   %finish
   %true %if a(al) = b(bl)
   %false
%end


%routine  find match(%integername  an, bn)
   %integer i,j
   %for i = 1,1,max %cycle
      an=i %and bn=i %and %return %if same(i,i)
      %if i # 1 %start
         %for j = 1,1,i-1 %cycle
            an=i %and bn=j %and %return %if same(i,j)
            an=j %and bn=i %and %return %if same(j,i)
         %repeat
      %finish
   %repeat
   an = max+1;  bn = max+1
%end


!    ------- it all starts here --------
   cpu limit(10000)
   select output(out)
   anum = max;  bnum = max
   aline = 0;  bline = 0
   aeof = 0;  beof = 0
   mismatch = 0
   %cycle
      select input(a stream);  replenish(a,aline,anum,acount,aeof)
      select input(b stream);  replenish(b,bline,bnum,bcount,beof)
      %exit %if acount<=0 %and bcount<=0
      find match(anum,bnum)
      %if anum # 1 %or bnum # 1 %start
         mismatch = mismatch + 1
         print(a,abase,anum,command_in1)
         print(b,bbase,bnum,command_in2)
         newline
      %finish
      abase = abase+anum;  acount = acount-anum
      bbase = bbase+bnum;  bcount = bcount-bnum
   %repeat

   newline
   print string("  Complete -")
   %if mismatch = 0 %start
      print string(" Files identical (")
      write(aline,0);  print string(" lines)")
   %else
      write(mismatch,1);  print string(" mismatch")
      print string("es") %if mismatch # 1
   %finish
   newline

%endofprogram
