|
|
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: 4608 (0x1200)
Types: TextFile
Names: »kkct«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦508e019d6⟧ »kkfiler«
└─⟦this⟧
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦8748ba386⟧ »kkfiler«
└─⟦this⟧
kkc=algol list.no
begin
procedure char_out(n,ba);
boolean array ba;
integer n;
begin
integer ii,cc;
ii:=f(n)-1;
cc:=co(n)+ii;
begin
write(out,<:<10>file :>,n,<< dddddd>,cc,cc//768,cc mod 768,<:<10>:>);
for i:=1 step 1 until ii do write(out,ba(n,i),1);
end;
end char_out;
procedure error(n);
integer n;
begin
if output_conn then unstack_cur_o;
output_conn:=false;
i:=1;
if sep extract 12=4 then write(out,<:<10>:>,filename(1)) else
write(out,string filename(increase(i)));
write(out,case n of(<: param:>,<: do not exist:>));
goto stop;
end error;
real array filename(1:3);
zone array z(2,128,1,stderror);
integer array c,f_u,l_u,f,l,top,co(1:2),ia(1:20);
integer i,j,k,sep,min,nextp,s,min_eq,last1,max_st;
boolean output_conn,q,equal;
boolean array em(1:2);
output_conn:=false;
equal:=true;
sep:=system(4,1,filename);
if sep shift (-12) extract 12=6 then
begin
system(4,0,filename);
connect_cur_o(filename);
setposition(out,0,0);
output_conn:=true;
nextp:=2;
end else nextp:=1;
sep:=system(4,nextp,filename);
if sep <> 4 shift 12 +10 then
error(1);
i:=1;
open(z(1),4,string filename(increase(i)),0);
if monitor(42,z(1),0,ia)<>0 then error(2);
sep:=system(4,nextp+1,filename);
if sep<>8 shift 12 + 10 then
error(1);
i:=1;
open(z(2),4,string filename(increase(i)),0);
if monitor(42,z(2),0,ia)<>0 then error(2);
sep:=system(4,nextp+2,filename);
if sep=4 shift 12 + 4 then min_eq:=filename(1) else min_eq:=12;
em(1):=em(2):=false;
co(1):=co(2):=0;
k:=system(2,j,filename);
top(1):=top(2):=(k-2048)//2;
sep:=system(4,nextp+3,filename);
max_st:=(if sep=4 shift 12 +4 then filename(1) else 500);
if top(1)>max_st then top(1):=top(2):=max_st;
begin
boolean array b(1:2,1:top(1));
N:
readchar(z(1),c(1));
co(1):=co(1)+1;
if c(1)=25 then em(1):=true;
readchar(z(2),c(2));
co(2):=co(2)+1;
if c(2)=25 then em(2):=true;
if em(1) or em(2) then
begin
if equal then
write(out,<:<10>equal :>,co(1));
goto stop1;
end;
if c(1)=c(2) then goto N;
equal:=false;
b(1,1):=false add c(1);
b(2,1):=false add c(2);
f(1):=f(2):=f_u(1):=f_u(2):=l_u(1):=l_u(2):=1;
last1:=top(1);
for j:=2 step 1 until min_eq do
begin
readchar(z(1),c(1));
b(1,j):=false add c(1);
if c(1)=25 then
begin
em(1):=true;
l(1):=j;
goto E;
end;
l(1):=j
end;
E:
for j:=2 step 1 until min_eq do
begin
readchar(z(2),c(2));
b(2,j):=false add c(2);
if c(2)=25 then
begin
em(2):=true;
l(2):=j;
goto E1;
end;
l(2):=j
end;
E1:
min:=min_eq;
if min>l(1)-f(1)+1 then min:=l(1)-f(1)+1;
if min>l(2)-f(2)+1 then min:=l(2)-f(2)+1;
q:=true;
for j:=1 step 1 until min do
q:=q and (b(1,j+f(1)-1) extract 7 = b(2,j+f(2)-1) extract 7);
if q then
begin comment stop sg;
char_out(1,b);
char_out(2,b);
if em(1) and em(2) then goto stop1;
co(1):=co(1)+l(1);
s:=co(1)//768;
setposition(z(1),0,s);
k:=co(1) mod 768;
for j:=0 step 1 until k do readchar(z(1),c(1));
s:=(co(2)+l(2))// 768;
setposition(z(2),0,s);
k:=(co(2)+l(2)) mod 768;
for j:=0 step 1 until k do readchar(z(2),c(2));
if min_eq<13 then write(out,<:<10>f1,l1,f2,l2,co1,co2,last1:>,<< dddd>,
f(1),l(1),f(2),l(2),co(1),co(2),last1);
goto N;
end else if l(1)<last1 then
begin
if min_eq<12 then
begin write(out,<:<10>f1,l1,l11,t1:>,<< dddd>,f(1),l(1),last1,top(1));
for j:=f(1) step 1 until l(1) do outchar(out,b(1,j) extract 8);
end;
l(1):=l(1)+1;
f(1):=f(1)+1;
if -,em(1) then
begin
readchar(z(1),c(1));
if min_eq<12 then write(out,<:<10>char= :>,c(1));
if c(1)=25 then
begin
last1:=l(1);
em(1):=true;
end;
b(1,l(1)):=false add c(1);
end;
goto E1;
end else if -,em(2) and l(2)<top(2) then
begin
l_u(2):=l_u(2)+1;
readchar(z(2),c(2));
if c(2)=25 then em(2):=true;
l(2):=l(2)+1;
f(2):=f(2)+1;
b(2,l(2)):=false add c(2);
f(1):=1;
l(1):=f(1)+min_eq-1;
goto E1;
end;
char_out(1,b);
char_out(2,b);
write(out,<:<10>compare stopped before end of files::>);
end;
stop1:
close(z(1),false);
close(z(2),false);
stop:
write(out,<:<25><25><25>:>);
setposition(out,0,0);
if output_conn then unstack_cur_o;
end;
▶EOF◀