|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5376 (0x1500)
Types: TextFile
Names: »comparetx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »comparetx «
mode list.yes
compare=algol survey.yes connect.no list.no
begin
zone array z (2, 2 *128, 2, stderror);
real array field raf;
long array name, file1, file2 (1:2);
integer array word, hwds (1:2), segm (1:2), half (1:2, 1:2);
integer field addr;
integer i, j, sepleng, diff, first, last, absaddr, stars,
segments, segm_count;
long xor;
boolean test;
trapmode := 1 shift 10 ;
segments := 8388605 ;
segm_count := 0 ;
diff := last := 0 ;
j := 1 ;
test := false ;
raf := 0 ;
for i := 1, 2 do
begin <*open and position*>
segm (i) := 0;
sepleng := system (4, increase (j), name);
if sepleng <> 4 shift 12 + 10 then
system (9, j - 1, <:param:>);
if i = 1 then
tofrom (file1.raf, name.raf, 8)
else
tofrom (file2.raf, name.raf, 8);
open (z (i), 4, name, 0);
if system (4, j, name) = 8 shift 12 + 4 then
begin
segm (i) := round (name (1));
increase (j);
end;
setposition (z (i), 0, segm (i));
end <*open and position*>;
if system (4, j, name) = 4 shift 12 + 4 then
begin
increase (j);
segments := round (name (1))
end;
if system (4, increase (j), name) = 4 shift 12 + 10 and
name (1) = long <:test:> then
begin <*next param <s>name and 'test'*>
if system (4, increase (j), name) = 8 shift 12 + 10 then
begin <* .<name>*>
if name (1) = long <:yes:> then
test := true
else
if name (1) = long <:no:> then
test := false
else
system (9, j - 1, <:param:>);
end <*.<name>*>
else
system (9, j - 1, <:param:>);
end <*next param <s>name and 'test'*>;
write (out, "nl", 2, <:first file : :>, file1 ,
"nl", 1, <:first segm : :>, segm (1),
"nl", 2, <:second file : :>, file2 ,
"nl", 1, <:first segment : :>, segm (2),
"nl", 2, <:no of segments : :>, segments,
"nl", 2);
repeat <*until eod in one file*>
for i := 1, 2 do
begin <*for i*>
hwds (i) :=
inrec6 (z (i), 0);
inrec6 (z (i), hwds (i)); <*still not eod in z (i)*>
increase (segm (i));
end <*for i*>;
increase (segm_count);
for addr := 2 step 2 until
if hwds (1) < hwds (2) then
hwds (1)
else
hwds (2) do
begin
if z (1).addr <> z (2).addr then
begin <*different*>
diff := diff + 1;
for i := 1, 2 do
begin
word (i ) := z (i).addr ;
half (i, 1) := z (i).addr shift (-12) extract 12;
half (i, 2) := z (i).addr extract 12;
end;
xor := exor (word (1), word (2));
absaddr := (segm (1) - 1) * 512 + addr - 2;
if absaddr = last + 2 then
last := absaddr
else
first := last := absaddr;
if first = last
or first + 2 = last then
begin <*among first two diff in a row*>
stars := 65;
write (out,
<<dddd>,
"nl", 1, segm (1) - 1,
<<ddd>,
",", 1, addr - 2,
<<ddddddd>,
"sp", 1, <:addr : :>, absaddr,
<<dddd>,
"sp", 1, <:file 1 ::>, half (1, 1), half (1, 2),
"sp", 1, <:file 2 ::>, half (2, 1), half (2, 2),
"sp", 1, <:diff ::>, abs (half (1, 1) - half (2, 1)),
"sp", 1, abs (half (1, 2) - half (2, 2)),
"sp", 1);
for i := -23 step -1 until 0 do
write (out,
if xor shift i < 0 then <:1:> else <:.:>);
end <*first diff in a row*> else
begin <*not first*>
stars := stars + 1;
if stars > 64 then
begin
write (out, "nl", 1);
stars := 1;
end;
write (out, <:.:>);
end <*not first*>;
end <*different*>;
end;
if hwds (1) <> hwds (2) then
begin <*diff*>
diff := diff + 1;
write (out,
"nl", 2,
if hwds (1) < hwds (2) then
<:file 1 shorter than file 2:>
else
<:file 2 shorter than file 1:>,
"nl", 1, <:file 1 ::>, segm (1) - 1, <: segs + :>, hwds (1), <: hwds:>,
"sp", 3, <:file 2 ::>, segm (2) - 1, <: segs + :>, hwds (2), <: hwds:>);
end <*diff*>;
until
hwds (1) = 2
or hwds (2) = 2
or segm_count = segments;
if diff > 0 then
write (out,
"nl", 2, <:differences : :>, diff)
else
write (out,
"nl", 2, <:no differences:>);
outchar (out, 10);
end;
scope user compare
lookup compare
end
finis
▶EOF◀