⟦226b47948⟧

TextFile

program compare;\r
uses dos, rtpunit;\r
\r
(* xxxxxx jaba 1.1 First version                       *)\r
(* 870609 bb   1.2 Converted to lf3502 and fp3502      *)\r
(* 890120 bb   1.3 Concept 'page' instead of 'segment'.*)\r
(*                 'con' substituted with lf_conname.  *)\r
(* 890216 ebk  1.4 Converted to TURBO                  *)\r
\r
const\r
test_out= false;\r
filmax = 256;\r
\r
type\r
filerec = array[1..filmax] of integer;\r
\r
var\r
saveexit   : pointer;\r
\r
fil1, fil2 : file;\r
fil1_ix    : integer;\r
fil1_rec   : integer;\r
fil1_ptr   : ^filerec;\r
fil2_ix    : integer;\r
fil2_rec   : integer;\r
fil2_ptr   : ^filerec;\r
\r
first_page, last_page, pagecount,\r
wcount, intval1, intval2, skip1, skip2 : integer;\r
max_difs, dif_count: integer;\r
\r
sep, paramno, call_line_number : integer;\r
ok, eof1, eof2, swap1, swap2, all_diff, stop1, stop2 : boolean;\r
max1_last, max1_rec, max2_last, max2_rec: integer;\r
help_long: longint;\r
\r
byt1, byt2: byte;\r
ch1, ch2: char;\r
\r
call_line_name: alfa;\r
output_file_name, fil1_name, fil2_name: alfa;\r
\r
const\r
\r
(* constants and variables concerning call parameter reading *)\r
equal = 6; space = 4; dot = 8;\r
name  = 10; int = 4;\r
power8 = 256;\r
\r
\r
(*$F+*) procedure exception; (*$F-*)\r
begin\r
exitproc := saveexit;\r
\r
runtime_error('End of compare');\r
end;\r
\r
procedure in_fil1(var p: integer);\r
var count: integer;\r
begin\r
  fil1_ix := fil1_ix + 1;\r
  if fil1_ix > filmax then\r
  begin\r
    fil1_rec := fil1_rec + 1;\r
    fil1_ix := 1;\r
    if fil1_rec < max1_rec then count := filmax else count := max1_last;\r
    blockread(fil1, fil1_ptr^, count);\r
  end;\r
  p := fil1_ptr^[fil1_ix];\r
  if swap1 then p := swap(p);\r
  eof1 := (fil1_ix = max1_last) and (fil1_rec = max1_rec);\r
end;\r
\r
\r
procedure in_fil2(var p: integer);\r
var count: integer;\r
begin\r
  fil2_ix := fil2_ix + 1;\r
  if fil2_ix > filmax then\r
  begin\r
    fil2_rec := fil2_rec + 1;\r
    fil2_ix := 1;\r
    if fil2_rec < max2_rec then count := filmax else count := max2_last;\r
    blockread(fil2, fil2_ptr^, count);\r
  end;\r
  p := fil2_ptr^[fil2_ix];\r
  if swap2 then p := swap(p);\r
  eof2 := (fil2_ix = max2_last) and (fil2_rec = max2_rec);\r
end;\r
\r
procedure paramerror(place: integer);\r
begin\r
write(output,'*** compare, error in call(',place:1,paramno:1,'): ');\r
if sep=0 then\r
write(output, 'missing parameter')\r
else\r
repeat\r
if sep div power8 = space then\r
write(output,' ')\r
else\r
write(output,'-');\r
if sep mod power8 = name then\r
write(output,call_line_name)\r
else\r
write(output,call_line_number:1);\r
paramno:= paramno + 1;\r
sep:= paramread (paramno, call_line_number, call_line_name);\r
if sep = 0 then sep:= space * power8;\r
until sep div power8 = space;\r
writeln(output);\r
ok:= false;\r
paramno:= paramno - 1;\r
end;\r
\r
function getint : integer;\r
var\r
p: integer;\r
begin\r
p:= paramread (paramno + 1, call_line_number, call_line_name);\r
if p = dot * power8 + int then\r
begin\r
getint:= call_line_number;\r
paramno:= paramno + 1;\r
end\r
else\r
begin\r
paramerror(0);\r
getint:= 0;\r
end;\r
end;\r
\r
procedure get_parameters;\r
\r
begin (* body of getparams *)\r
ok:= true;\r
sep:= paramread (1, call_line_number, call_line_name);\r
if sep div power8 = equal then\r
begin\r
sep:= paramread (0, call_line_number, output_file_name);\r
paramno:= 2;\r
end\r
else\r
paramno:= 1;\r
\r
sep:= paramread (paramno, call_line_number, fil1_name);\r
if sep <> space * power8 + name then\r
paramerror(1);\r
paramno:= paramno + 1;\r
assign(fil1, concat(source_path,fil1_name));\r
reset(fil1, 2);\r
\r
sep:= paramread (paramno, call_line_number, fil2_name);\r
if sep = dot * power8 + name then\r
begin\r
  if fil2_name = 'swap' then swap1 := true;\r
  if fil2_name = 'stop' then stop1 := true;\r
  if fil2_name = 'skip' then\r
  begin\r
    skip1 := getint;\r
  end;\r
  paramno := paramno + 1;\r
end;\r
\r
sep := paramread(paramno, call_line_number, fil2_name);\r
if sep <> space * power8 + name then\r
paramerror(2);\r
paramno:= paramno + 1;\r
assign(fil2, concat(source_path, fil2_name));\r
reset (fil2, 2);\r
sep := paramread(paramno, call_line_number, call_line_name);\r
if sep = dot * power8 + name then\r
begin\r
  if call_line_name = 'swap' then swap2 := true;\r
  if call_line_name = 'stop' then stop2 := true;\r
  if call_line_name = 'skip' then\r
  begin\r
    skip2 := getint;\r
  end;\r
  paramno := paramno + 1;\r
  sep:= paramread (paramno, call_line_number, call_line_name);\r
end;\r
\r
while (sep>0) do\r
begin\r
if sep <> space * power8 + name then\r
paramerror(3)\r
else\r
begin\r
if call_line_name = 'first' then first_page:= getint\r
else\r
if call_line_name = 'last' then last_page:= getint\r
else\r
if call_line_name = 'maxdifs' then max_difs:= getint\r
else\r
if call_line_name = 'all' then all_diff := true\r
else\r
paramerror(4);\r
\r
end;\r
paramno:= paramno + 1;\r
sep:= paramread (paramno, call_line_number, call_line_name);\r
end;\r
if not ok then\r
begin\r
writeln(output,' call syntax is:');\r
writeln(output,\r
'(<outfil>=)compare <infil1(-stop)> <infil2(-stop)>');\r
writeln(output,\r
'                   (first-<pageno>) (last-<pageno>) (maxdifs-<md>)');\r
writeln(output,\r
'                   <md> is upper limit of shown different words');\r
writeln(output,\r
'                   default values: first-0 last-32000 maxdifs-32000');\r
writeln(output);\r
rtphalt(false);\r
end; (* not ok *)\r
end;\r
\r
begin\r
\r
saveexit         := exitproc;\r
exitproc         := @exception;\r
\r
sep              := 0;\r
paramno          := 0;\r
call_line_number := 0;\r
ok               := true;\r
\r
first_page       := 0;\r
last_page        := 32000;\r
max_difs         := 32000;\r
swap1            := false;\r
swap2            := false;\r
all_diff         := false;\r
stop1            := false;\r
stop2            := false;\r
skip1            := 0;\r
skip2            := 0;\r
fil1_rec         := -1;\r
fil2_rec         := -1;\r
fil1_ix          := filmax;\r
fil2_ix          := filmax;\r
new(fil1_ptr);\r
new(fil2_ptr);\r
\r
assign_alfa(output_file_name, 'output');\r
get_parameters;\r
\r
\r
help_long := filesize(fil1);\r
max1_rec  := (help_long-1) div filmax;\r
max1_last := help_long - max1_rec*filmax;\r
eof1      := help_long = 0;\r
help_long := filesize(fil2);\r
max2_rec  := (help_long-1) div filmax;\r
max2_last := help_long - max2_rec*filmax;\r
eof2      := help_long = 0;\r
\r
dif_count:= 0;\r
if output_file_name<>'output' then (* left hand side in call *)\r
begin\r
close(output);\r
assign(output, output_file_name);\r
rewrite(output);\r
end; (* result on disc file *)\r
\r
writeln(output,'page byte   ',fil1_name,'                      ',fil2_name);\r
\r
(* set position on input files *)\r
for pagecount:= 0 to first_page-1 do\r
for wcount:= 0 to 255 do in_fil1( intval1 );\r
for pagecount:= 0 to first_page - 1 do\r
for wcount:= 0 to 255 do in_fil2( intval2 );\r
for pagecount := 1 to skip1 do in_fil1(intval1);\r
for pagecount := 1 to skip2 do in_fil2(intval2);\r
\r
pagecount:= first_page;\r
while pagecount <= last_page do\r
begin\r
if eof1 or eof2 then\r
begin\r
  pagecount := last_page;\r
end else\r
begin\r
if test_out then\r
write(output, pagecount:8);\r
wcount := 0;\r
while wcount<= 255 do\r
begin\r
if eof1 then intval1:= 0 else in_fil1( intval1 );\r
if eof2 then intval2:= 0 else in_fil2( intval2 );\r
if eof1 then if stop1 then intval1 := intval2;\r
if eof2 then if stop2 then intval2 := intval1;\r
\r
if (intval1<>intval2) or (all_diff) then\r
begin\r
dif_count:= dif_count+1;\r
write(output, pagecount: 3, wcount*2: 4, ':', intval1: 8);\r
byt1 := intval1 shr 8;\r
byt2 := intval1 and 255;\r
write(output, byt1: 4, byt2: 4, ' ');\r
ch1 := chr(byt1);\r
ch2 := chr(byt2);\r
if (ch1 >=' ') and (byt1<127) then write(output, ch1) else write(output,'.');\r
write(output, ' ');\r
if (ch2 >=' ') and (byt2<127) then write(output, ch2) else write(output,'.');\r
write(output, ' ');\r
byt1 := intval2 shr 8;\r
byt2 := intval2 and 255;\r
write(output, intval2 :20, byt1: 4, byt2: 4, ' ');\r
ch1 := chr(byt1);\r
ch2 := chr(byt2);\r
if (ch1 >=' ') and (byt1<127) then write(output, ch1) else write(output,'.');\r
write(output, ' ');\r
if (ch2 >=' ') and (byt2<127) then write(output, ch2) else write(output,'.');\r
writeln(output);\r
if dif_count>=max_difs then\r
begin\r
  wcount := 255;\r
end;\r
\r
end;\r
wcount := wcount + 1;\r
end; (* for wcount... *)\r
end;\r
\r
if dif_count>=max_difs then\r
begin\r
  pagecount := last_page;\r
end;\r
pagecount := pagecount + 1;\r
end; (* for page count... *)\r
writeln(output); writeln(output);\r
writeln(output, dif_count: 8, ' mismatches');\r
close(fil1);\r
close(fil2);\r
\r
end.\r
 \r
«eof»
DataMuseum.dk

DANOSI

⟦226b47948⟧ TextFile

Derivation

TextFile
