/* DIFCOM PL/I VERSION */

difcom: /* List all differences between two (.com) files */
procedure options(main);

  %replace ver by 'DIFCOM PL/I VERSION 1.6 - April 10, 1983  1900 Hrs';

/* To build and list module:
     A>m80 ,lst:=b:plidio         (plidio.mac on B: for MACRO-80)

     A>pli b:difcom $l ^p         (diomod.dcl on A:)
     A>link b:difcom,plidio[S] ^p (plidio.rel on A:)

     B>difcom      (a    b    $lst)
*/

  %replace
    true     by '1'b,
    false    by '0'b;

  %include 'A:diomod.dcl';

  declare
    add     fixed decimal(5),  /* address of 16 byte line of input data */
    adds    char(4) varying,   /* address in ascii string '0100' - 'FFF0' */
    as      char(82) varying,  /* utility output string */
    a1(16)  fixed(8),          /* 16 bytes input from file 1, fixed 0-255 */
    a2(16)  fixed(8),          /* 16 bytes input from file 2, fixed 0-255 */
    a1s     char(16),          /* 16 bytes input from file 1, string 0-255 */
    a2s     char(16),          /* 16 bytes input from file 2, string 0-255 */
    by      fixed(8),          /* utility byte, fixed 0-255 */
    c       char(1),           /* utility byte, character 0-255 */
    crlf    char(2),           /* carriage return, line feed */
    da      char(2),           /* directory drive, ascii d: */
    di      fixed(7),          /* directory drivr, 0-15, 0 => A:, 15 => P: */
    dda     char(2),           /* default drive, ascii d: */
    ddi     fixed(7),          /* default drivr, 0-15, 0 => A:, 15 => P: */
    diff    fixed(12),         /* no. of lines found that differ */
    ditto   char(3),           /* ' ""' to indicate equal byte in file 2 */
    eof1    bit(1),            /* end of file flag for file 1 */
    eof2    bit(1),            /* end of file flag for file 2 */
    esc     char(1),           /* escape character */
    fn      fixed(7),          /* no. of chars. in file name 1-8 */
    found   fixed(7),          /* no. of periods (.) found in file name */
    ft      fixed(7),          /* no. of chars. in file type 0-3 */
    hed     char(128) varying, /* header output on displays */
    i       fixed(7),          /* utility index */
    input1  file,              /* input file 1 */
    input2  file,              /* input file 2 */
    in1     char(14) varying,  /* name of input file 1, d:xxxxxxxx.xxx */
    in2     char(14) varying,  /* name of input file 2, d:xxxxxxxx.xxx */
    j       fixed(7),          /* utility index */
    k       fixed(7),          /* utility index */
    line    fixed(12),         /* no. of 16-byte lines input 0-4091 */
    long    fixed(7),          /* no. of longest file 0,1,2. 0 => same */
    outn    char(14) varying,  /* name of ouyput file, d:xxxxxxxx.xxx */
    output  file,              /* output file */
    q       char(1),           /* converted answer to guestion, Y N or space */
    qin     char(99) varying,  /* raw answer to question */
    uin     char(14) varying;  /* upshifted answer to guestion, null => bad */

call init();

on undefinedfile(input1) begin;
  put skip list('FILE ', in1, ' DOES NOT EXIST'); put skip;
  da = substr(in1, 1, 2); call dir(); goto fileone;
end;

oî undefinedfile(input2) begin;
  put skip list('FILE ', in2, ' DOES NOT EXIST'); put skip;
  da = substr(in2, 1, 2); call dir(); goto filetwo;
end;

on undefinedfile(output) goto eraseout;

on endfile(input1) begin;
  eof1 = true;
  read file(input2) into (a1s);
  long = 2;
  goto output_line;
end;

on endfile(input2) begin;
  eof2 = true;
  if eof1 then goto end_of_files;
  long = 1;
  goto output_line;
end;

restart: /* Start or restart program */
put skip list('YOU MAY CHANGE DISKS NOW BEFORE ANSWERING NEXT QUESTION!');
put skip list('FILE NAMES MAY HAVE DRIVE INDICATOR, AS:  B:filename.ext');
put skip list('AN OUTPUT FILE NAME OF $LST DESIGNATES THE PRINTER.');
put skip list('AN OUTPUT FILE NAME OF $CON DESIGNATES THE CONSOLE.');
put skip list('TYPE CONTROL-C TO EXIT PROGRAM.');
put skip;

fileone: /* Ask for name of file 1 */
call putdd();
put list ('INPUT FILE1 NAME:  ');
read into(qin); call upshiftf(); in1 = uin;
if in1 = '' | in1 = '$CON' | in1 = '$LST' then goto fileone;
if in1 = esc then goto restart;
open file(input1) record input sequential env(b(10240)) title(in1);
call reset();
call select(ddi);

filetwo: /* Ask for name of file 2 */
call putdd();
put list ('INPUT FILE2 NAME:  ');
read into(qin); call upshiftf(); in2 = uin;
if in2 = '' | in2 = '$CON' | in2 = '$LST' then goto filetwo;
if in2 = esc then goto fileone;
opeî file(input2© recorä inpuô sequentiaì env(b(10240)© title(in2);

outputfile: /* Ask for name of output file */
call putdd();
put list('OUTPUT FILE NAME:  ');
read into(qin); call upshiftf(); outn = uin;
if outn = '' then goto outputfile;
if outn = '$CON' | outn = '$LST' then goto eraseout;
if outn = esc then goto filetwo;
if in1 = outn | in2 = outn then do;
  put skip list('THE OUT PUT FILE CANNOT BE ONE OF THE INPUT FILES!');
  put skip; goto outputfile;
end;
close file(output);
open file(output) record input sequential env(b(10240)) title(outn);

eraseoutq: /* Ask permition to erase existing output file */
put skip list('ERASE EXISTING FILE: ', outn, ' (Y/N) ? '); read into(qin);
call upshiftq();
if q = 'N' then goto outputfile;
if q ^= 'Y' then goto eraseoutq;

eraseout: /* Open output file for output and start compare */
close file(output);
if  outn = '$CON' then open file(output) stream print output env(b(10240))
  linesize(80) pagesize(0) title(outn);
else open file(output) stream print output env(b(10240))
  linesize(80) pagesize(60) title(outn);
put file(output)      list(hed);
put file(output) skip list('  DIFFERENCES IN FILE1 = ', IN1);
put file(output) skip list('             AND FILE2 = ', IN2);
put file(output) skip list('                OUTPUT = ', OUTN);
put file(output) skip;
line=-1; diff=0; long=0; eof1=false; eof2=false;

readmore: /* Read next line from both files */ /* Inner loop ****** */
line = line+1;
read file(input1) into(a1s);
read file(input2) into(a2s);
if a1s = a2s then goto readmore; /* End of inner loop ************* */

output_line: /* Output a line for both input files */
diff = diff+1; add = 256 + 16*line; adds = '';
do i=1 to 4;
  j = mod(add, 16); add = add/16;
  if j>9 then j = j+7;
  adds = ascii(j+48) !! adds;
end;
if outn ^= '$CON' then put skip list(adds);
as = adds;
do i = 1 to 16;
  c = substr(a1s, i, 1);
  by = rank(c); a1(i) = by;
  k = mod(by, 16); j = divide(by, 16, 7);
  if k>9 then k = k+7;
  if j>9 then j = j+7;
  as = as !! ' ' !! ascii(j+48) !! ascii(k+48);
  if i=8 then as = as !! ' ';
end;
as = as !! ' ';
do i = 1 to 16;
  by = a1(i);
  if by > 126 then by = by - 128;
  if by < 32 | by > 126 then by = 46;
  as = as !! ascii(by);
end;
put file(output) skip list(as);
if eof1 | eof2 then goto readmore;

as = adds;
do i = 1 to 16;
  c = substr(a2s, i, 1);
  by = rank(c); a2(i) = by;
  if by = a1(i) then as = as !! ditto;
  else do;
    k = mod(by, 16); j = divide(by, 16, 7);
    if k>9 then k = k+7;
    if j>9 then j = j+7;
    as = as !! ' ' !! ascii(j+48) !! ascii(k+48);
  end;
  if i=8 then as = as !! ' ';
end;
as = as !! ' ';
do i = 1 to 16;
  by = a2(i);
  if by = a1(i) then as = as !! ' ';
  else do;
    if by > 126 then by = by - 128;
    if by < 32 | by > 126 then by = 46;
    as = as !! ascii(by);
  end;
end;
put file(output) skip list(as); put file(output) skip;
goto readmore;

end_of_files: /* Both input files have ended */
if outn ^= '$CON' then do;
  put skip;
  put skip list (line, ' LINES CHECKED  ', diff, ' LINES(S) DIFFER.');
  put skip;
end;
put file(output) skip;
put file(output)
    skip list (line, ' LINES CHECKED  ', diff, ' LINES(S) DIFFER.');
put file(output) skip;
if long = 0 then as = 'FILES ARE THE SAME LENGTH';
else do;
  as = ' IS THE LONGER FILE.';
  if long = 1 then as = 'FILE1' !! as;
  else as = 'FILE2' !! as;
end;
if outn ^= '$CON' then do; put skip list(as); put skip; end;
put file(output) skip list(as); put file(output) skip;
close file(input1); close file(input2); close file(output);

restartq: /* Ask for permition to restart or exit */
put skip list('DO YOU WISH TO CHECK ANOTHER PAIR OF FILES (Y/N) ? ');
read into(qin);
call upshiftq();
if q = 'Y' then goto restart;
if q ^= 'N' then goto restartq;
stop;

init: /* Initialise program */
  proc;
    esc = ascii(27);
    crlf = ascii(13) !! ascii(10);
    hed = ver !! crlf !!
      '    by Harry Smith'          !! crlf !!
      '       19628 Via Monte Dr.'  !! crlf !!
      '       Saratoga, CA 95070'   !! crlf !! crlf;
    ditto = ' ""';
    put skip list(hed);
    put skip list('*** LISTS ALL DIFFERENCES BETWEEN TWO FILES ***');
    put skip;
    put skip list('1) Intended to list "PATCH" differences in "COM" files.');
    put skip list('2) Output can be to a text file to be displayed later.');
    put skip list('3) Enter file name of d: to list files on drive d:.');
    put skip;
    call getdd();
  end;

upshiftf: /* Subroutine to upshift file name */
  proc;
    uin = '';
    if length(qin) < 3 then qin =  dda !! crlf;
    if length(qin) > 16 then return;
    call upshift();
    if uin = '' | uin = esc then return;
    if length(uin) = 2 then if substr(uin, 2, 1) = ':'
    then do;
      c = substr(uin, 1, 1);
      call select(rank(c) - rank('A'));
      call getdd(); da = dda; call dir(); uin = ''; return;
    end;
    if uin = '$LST' | uin = '$CON' then return;
    if substr(uin, 1, 1) = '$' then do; uin = ''; return; end;
    if length(uin) < 3  then uin = dda !! uin;
       else if substr(uin, 2, 1) ^= ':' then uin = dda !! uin;
    c = substr(uin, 1, 1);
    if c < 'A' | c > 'P' then do; uin = ''; return; end;
    found = 0; fn=0; ft=0;
    do i=3 to length(uin);
      if substr(uin, i, 1) = '.' then found = found+1;
      if found = 0 then fn = fn+1;
      else if found = 1 then ft = ft+1;
      else do; uin = ''; return; end;
    end;
    if fn=0 | fn>8 | ft>4 then uin = '';
  end;

upshiftq: /* Subroutine to upshift yes/no answer */
  proc;
    q = ' ';
    if length(qin) < 3 | length(qin) > 5 then return;
    call upshift();
    if uin = '' then return;
    if uin = 'YES' then uin = 'Y';
    if uin = 'NO'  then uin = 'N';
    if length(uin) ^= 1 then return;
    q = uin;
  end;

upshift: /* Upshift operator input */
  proc;
    uin = '';
    do i = 1 to length(qin)-2; c = substr(qin, i, 1);
      if c = ' ' then do; uin = ''; return; end;
      if c >= 'a' & c <= 'z' then c = ascii(rank(c) - 32);
      uin = uin !! c;
    end;
  end;

putdd: /* Display default drive for operator */
  proc;
    put skip list('DEFAULT DRIVE =', dda, ' ');
  end;

getdd: /* Get default drive from system */
  proc;
    ddi = curdsk();
    dda = ascii(rank('A') + ddi) !! ':';
  end;

dir: /* directory listing of default drive */
  proc;
    put skip list('directory of ', da,' should be here'); put skip;
  end;

end difcom;