DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »kti1t«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »kti1t« 

TextFile

kkti=algol
begin
  integer c,g,f,n,top,knp,i,j,k,u,max;
  real r,s;
  g:=3;
  read(in,c,f,max);
  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;
  begin
    boolean array a(0:top);
    integer array rk(1:c),rk1(1:c),stak(1:knp),bb(1:max+1);
    integer nx,nx1,ai,ap,mask,ri,t,gr,gr1,up,lo;
    procedure skriva;
    begin
      integer ji;
      for ji:=0 step 1 until top do
      begin
        write(out,<< ddddd>,a(ji) extract 12);
        if ji mod 12=0 then outchar(out,10);
      end;
    end;
    for i:=0 step 1 until top do a(i):=false;
    gr1:=1;
    repeat
      nx:=random(ri)*n;
      ai:=nx//12;
      ap:=nx mod 12;
      mask:= 1 shift ap;
      if a(ai) shift (-ap) extract 1 =0 then
      begin
        gr:=1;
        t:=nx;
        for i:=1 step 1 until c do
        begin
          rk(i):=t mod g;
          t:=t//g;
        end;
        for i:=1 step 1 until f do
        begin
          for j:=1 step 1 until c do rk1(j):=rk(j);
          for j:=1 step 1 until c-i+1 do
          begin
            up:=j-1+i; lo:=j;
            for k:=up step -1 until lo do
            begin
              rk1(k):=rk1(k)+1;
              if rk1(k)=g then rk1(k):=0;
            end;
TT:         nx1:=0;
            for k:=1 step 1 until c do
            nx1:=nx1+rk1(k)*g**(k-1);
            if a(nx1//12) shift (-(nx1 mod 12)) extract 1=0 then
            begin
              stak(gr):=nx1;
              gr:=gr+1;
            end else goto EX;
            k:=lo;
TL:
            rk1(k):=rk1(k)+1;
            if rk1(k)=g then rk1(k):=0;
            if rk1(k)=rk(k) then
            begin
              if rk1(k)=0 then rk1(k):=g-1 else rk1(k):=rk1(k)-1;
              k:=k+1;
              if k>up then goto NE else goto TL;
            end;
            goto TT;
NE:       end;
        end;
for i:=c step -1 until 1 do
outchar(out,48+rk(i));
outchar(out,10);
        a(ai):=a(ai) or (false add  mask);
        bb(gr1):=nx;
        gr1:=gr1+1;
        for i:=1 step 1 until gr-1 do
        begin
          mask:=stak(i)//12;
          a(mask):=a(mask) or (false add (1 shift (stak(i) mod 12)));
          write(out,stak(i),mask,stak(i) mod 12,<:<10>:>);
        end;
      end;
skriva;
EX:
    until gr1>max;
  end;
end;
▶EOF◀