|
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: 11520 (0x2d00)
Types: TextFile
Names: »kktit«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »kktit«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »kktit«
kkti=algol
begin
integer c,g,f,n,top,knp,i,j,k,u,max;
real r,s;
g:=3;
read(in,c,f);
n:=g**c-1;
top:=n//12+1;
knp:=1; r:=1.0;
for i:=1 step 1 until f do
begin
r:=r*(c-i+1)/i;
knp:=knp+r*2**i;
end;
max:=knp;
begin
boolean ff,fri,forfra;
integer array buf(1:256);
boolean array a(0:top+5);
integer array ans(1:8),mes(1:8),tail(1:10);
integer array rk(1:c),rk1(0:c),stak(1:knp+1),stak1(1:knp+20);
integer array største(1:2),pr(1:f);
real array name(1:3);
integer fab,faa,lab,laa,ri,nx,nx1,t,gr,gr1,tæller,nxstop,fejl,w,ww;
integer m,nxstop1,rest,fas,las,snr;
integer i3,i2,i1,i0,j3,j2,j1,j0,in0,in1,in2,in3;
integer array s(0:g-1,0:c-1);
procedure sendandwait(ioo,af,al,sf);
integer ioo,af,al,sf;
begin
mes(1):=ioo shift 12+0;
mes(2):=af;
mes(3):=al;
mes(4):=sf;
k:=waitanswer(sendmessage(name,mes),ans);
if k<>1 then
begin
write(out,<:<10>io error :>,k);
goto E;
end;
end;
procedure testout(nr,nn);
value nn; integer nr, nn;
begin
integer array cf(1:9),tx(1:6);
integer ij,ji,jk;
mes(1):=5 shift 12+0;
mes(2):=firstaddr(tx)-1;
mes(3):=mes(2)+11;
ji:=0;
for ij:=9 step -1 until 1 do
begin
cf(ij):=(nn mod 10) + 48;
nn:=nn//10;
end;
for ij:=1 step 1 until 6 do tx(ij):=0;
tx(1):=(nr+48) shift 16 + 45 shift 8 + 32;
for ij:=0 step 1 until 8 do
begin
if ij<8 and ji=0 and cf(ij+1)=48 then cf(ij+1):=32 else ji:=1;
tx(ij//3+2):=tx(ij//3+2) + cf(ij+1) shift ((2-ij mod 3)*8);
end;
tx(5):=32 shift 16 + 10 shift 8 + 0;
waitanswer(sendmessage(<:terminal3:>,mes),ans);
end;
procedure gem;
begin
repeat
i:=reserveproc(name,0);
until i=0;
sendandwait(5,fab,lab,0);
sendandwait(5,faa,laa,1);
releaseproc(name);
tail(8):=største(2);
tail(9):=buf(1);
changetail(name,tail);
end;
procedure skriva;
begin
integer ji,jj,ptl;
ptl:=0;
for ji:=0 step 1 until top do
begin
if ptl mod 6=0 then outchar(out,10);
ptl:=ptl+1;
for jj:=0 step 1 until 11 do
outchar(out,48+(a(ji) shift (-jj) extract 1));
end;
outchar(out,10);
end;
name(1):=real(<:kktif:> add 105); name(2):=real <:l:>;
fab:=firstaddr(buf)-1;
lab:=fab+511;
faa:=firstaddr(a)-1;
laa:=faa+((top+5) shift (-9) shift 9)+511;
fas:=firstaddr(stak1);
las:=fas+((knp+20) shift (-9) shift 10) +511;
snr:=(laa-faa) shift (-9) +3;
comment write(out,faa,laa,fab,lab,fas,las,snr) goto E;
i:=lookuptail(name,tail);
if i=0 and tail(9)>0 then
begin
i:=careaproc(name);
if i<>0 then
begin
write(out,<:<10>,c a p error:>,i); goto E
end;
sendandwait(3,fab,lab,0);
sendandwait(3,faa,laa,1);
sendandwait(3,fas,las,snr);
forfra:=false;
nx:=tail(10);
nxstop1:=stak1(knp+11);
største(1):=stak1(knp+12);
største(2):=stak1(knp+13);
end else
begin
forfra:=true;
for i:=0 step 1 until top do a(i):=false;
for i:=1 step 1 until 256 do buf(i):=0;
for i:=1 step 1 until 10 do tail(i):=0;
tail(1):=(laa-faa+las-fas) shift (-9)+5;
tail(2):=1;
removeentry(name);
i:=createentry(name,tail);
j:=careaproc(name);
k:=reserveproc(name,0);
if i<>0 then
begin
write(out,<:<10>create error :>,i,j,k); goto E;
end;
sendandwait(5,fab,lab,0);
sendandwait(5,faa,laa,1);
releaseproc(name);
end;
gr1:=1;
for i:=0 step 1 until c-1 do s(0,i):=0;
for i:=0 step 1 until c-1 do s(1,i):=3**i;
for i:=0 step 1 until c-1 do s(2,i):=s(1,i)*2;
repeat
if forfra then
begin
nx:=nxstop1:=(round(random(ri)*100000) mod n) -1 ;
største(1):=største(2):=0;
end else
begin
forfra:=true;
nx:=nx-1;
end;
nxstop:=-1;
fri:=true;
repeat
tæller:=1;
gr:=0;
ff:=true;
repeat
nx:=nx+1;
if nx > n then nx:=0;
until nx=nxstop1 or a(nx//12) shift (-(nx mod 12)) extract 1 = 0;
if nx=nxstop1 then fri:=false;
if fri then
begin
nxstop:=nx;
tail(10):=nx;
changetail(name,tail);
gr:=gr+1;
stak(gr):=nx;
t:=nx;
nx1:=0;
for i:=1 step 1 until c do
begin
rk(i):=t mod g;
t:=t//g;
rk1(i-1):=s(rk(i),i-1);
nx1:=nx1+rk1(i-1);
end;
rest:=knp;
tæller:=1;
for fejl:=4-f+1 step 1 until 4 do
case fejl of
begin
begin
for i3:=c-1 step -1 until 3 do
for j3:=g-1 step -1 until 0 do
if rk1(i3)<>s(j3,i3) then
begin
in3:=s(j3,i3)-rk1(i3);
nx1:=nx1+in3;
for i2:=i3-1 step -1 until 2 do
for j2:=g-1 step -1 until 0 do
if rk1(i2)<>s(j2,i2) then
begin
in2:=s(j2,i2)-rk1(i2);
nx1:=nx1+in2;
for i1:=i2-1 step -1 until 1 do
for j1:=g-1 step -1 until 0 do
if rk1(i1)<>s(j1,i1) then
begin
in1:=s(j1,i1)-rk1(i1);
nx1:=nx1+in1;
for i0:=i1-1 step -1 until 0 do
for j0:=g-1 step -1 until 0 do
if rk1(i0)<>s(j0,i0) then
begin
in0:=s(j0,i0)-rk1(i0);
nx1:=nx1+in0;
rest:=rest-1;
if a(nx1//12) shift(-(nx1 mod 12)) extract 1 = 0 then
begin
tæller:=tæller+1;
gr:=gr+1;
stak(gr):=nx1;
end else
begin
if rest+tæller<største(2) then goto EF;
end;
nx1:=nx1-in0;
end;
nx1:=nx1-in1;
end;
nx1:=nx1-in2;
end;
nx1:=nx1-in3;
end;
end;
comment *****************************************;
begin
for i2:=c-1 step -1 until 2 do
for j2:=g-1 step -1 until 0 do
if rk1(i2)<>s(j2,i2) then
begin
in2:=s(j2,i2)-rk1(i2);
nx1:=nx1+in2;
for i1:=i2-1 step -1 until 1 do
for j1:=g-1 step -1 until 0 do
if rk1(i1)<>s(j1,i1) then
begin
in1:=s(j1,i1)-rk1(i1);
nx1:=nx1+in1;
for i0:=i1-1 step -1 until 0 do
for j0:=g-1 step -1 until 0 do
if rk1(i0)<>s(j0,i0) then
begin
in0:=s(j0,i0)-rk1(i0);
nx1:=nx1+in0;
rest:=rest-1;
if a(nx1//12) shift(-(nx1 mod 12)) extract 1 = 0 then
begin
tæller:=tæller+1;
gr:=gr+1;
stak(gr):=nx1;
end else
begin
if rest+tæller<største(2) then goto EF;
end;
nx1:=nx1-in0;
end;
nx1:=nx1-in1;
end;
nx1:=nx1-in2;
end;
end;
comment *******************************************************;
begin
for i1:=c-1 step -1 until 1 do
for j1:=g-1 step -1 until 0 do
if rk1(i1)<>s(j1,i1) then
begin
in1:=s(j1,i1)-rk1(i1);
nx1:=nx1+in1;
for i0:=i1-1 step -1 until 0 do
for j0:=g-1 step -1 until 0 do
if rk1(i0)<>s(j0,i0) then
begin
in0:=s(j0,i0)-rk1(i0);
nx1:=nx1+in0;
rest:=rest-1;
if a(nx1//12) shift(-(nx1 mod 12)) extract 1 = 0 then
begin
tæller:=tæller+1;
gr:=gr+1;
stak(gr):=nx1;
end else
begin
if rest+tæller<største(2) then goto EF;
end;
nx1:=nx1-in0;
end;
nx1:=nx1-in1;
end;
end;
comment ***********************************************************;
begin
for i0:=c-1 step -1 until 0 do
for j0:=g-1 step -1 until 0 do
if rk1(i0)<>s(j0,i0) then
begin
in0:=s(j0,i0)-rk1(i0);
nx1:=nx1+in0;
rest:=rest-1;
if a(nx1//12) shift(-(nx1 mod 12)) extract 1 = 0 then
begin
tæller:=tæller+1;
gr:=gr+1;
stak(gr):=nx1;
end else
begin
if rest+tæller<største(2) then goto EF;
end;
nx1:=nx1-in0;
end;
end;
end;
EF:
if tæller>=max then
begin
ff:=false;
for i:=1 step 1 until gr do
begin
j:=stak(i)//12; k:=stak(i) mod 12;
a(j):=a(j) or (false add (1 shift k));
end;
j:=buf(1);
j:=j+2;
buf(1):=j;
buf(j+1):=tæller;
k:=22;
buf(j):=0;
for i:=c step -1 until 1 do
begin
outchar(out,48+rk(i));
buf(j):=buf(j)+(rk(i) shift k);
k:=k-2;
end;
write(out,<< ddd>,tæller,<:*:>); outendcur(10);
gem;
end;
if tæller>største(2) then
begin
for i:=1 step 1 until gr do stak1(i):=stak(i);
stak1(knp+11):=nxstop1;
stak1(knp+10):=stak1(knp+12):=største(1):=nx;
stak1(knp+13):=største(2):=tæller;
reserveproc(name,0);
sendandwait(5,fas,las,snr);
releaseproc(name);
write(out,<< dddddd>,største(1),største(2)); outendcur(10);
end;
end fri;
if -,fri and ff and største(2)>0 then
begin
max:=største(2);
ff:=false;
for i:=største(2) step -1 until 1 do
begin
j:=stak1(i)//12; k:=stak1(i) mod 12;
a(j):=a(j) or (false add (1 shift k));
end;
j:=buf(1);
j:=j+2;
buf(1):=j;
buf(j+1):=største(2);
k:=22;
t:=største(1);
for i:=c step -1 until 1 do
begin
outchar(out,48+(t mod g));
buf(j):=buf(j)+(t mod g) shift k;
k:=k-2;
t:=t//g;
end;
write(out,<< ddd>,største(2)); outendcur(10);
gem;
end;
until -,fri or -,ff;
until -,fri and nxstop=-1;
skriva;
end;
E:
end;
▶EOF◀