|
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◀