DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦429656070⟧ TextFile

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »kkct«

Derivation

└─⟦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⟧ 

TextFile

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◀