DataMuseum.dk

top - metrics - download

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

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

TextFile

begin
   integer i,j,k,ch;
   integer array ia(1:20);
   real r;
   boolean list;
   real array outname,ra(1:2);
   long array table(1:1000);
   integer number;
   long array l(1:2);
   long help;
   zone output(256,2,stderror);
\f


   procedure connect_output;
   begin
      integer array bases(1:20);
      integer i;

      open(output,4,outname,0);

      system(11,0,bases);
      i:=monitor(76,output,0,ia);

      if i=0 then
      begin
         if ia(2)<bases(7) or ia(3)>bases(8) then i:=1;
      end;

      if i<>0 then
      begin
         ia(1):=ia(2):=1;
         for i:=3 step 1 until 10 do ia(i):=0;
         ia(6):=systime(7,0,0.0);
         if monitor(40,output,0,ia)<>0 then
noout:   begin
            i:=1; write(out,<:***genscan: connect :>,
                            string outname(increase(i)),<:<10>:>);
            goto stop
         end;
      end else
      begin
         monitor(42,output,0,ia);
         ia(6):=systime(7,0,0.0);
         monitor(44,output,0,ia);
      end;
      if monitor(52,output,0,ia)<>0 then goto noout
   end;
\f


   write(out,<:<12>genscan :>); writedate(out,systime(5,0,r),r,9);
   write(out,<:<10><10>:>);
   list:=false;

   j:=0;
   i:=system(4,j,ra);
   if i extract 12=10 then
   begin
      outname(1):=ra(1);
      outname(2):=ra(2);
      j:=j+1;
      i:=system(4,j,ra);
      if i shift (-12)<>6 then
      begin
         write(out,<:***genscan: no output file<10>:>);
         goto stop
      end;
      j:=j+1;
      i:=system(4,j,ra);
      if i extract 12<>10 or i shift (-12)<>4 then goto err;
      j:=j+1;
      i:=system(4,j,ra);
      if i=0 then goto ok;
      if i extract 12<>10 or i shift (-12)<>4 then
err:  begin
         write(out,<:***genscan: param, :>);
         if i shift (-12)=8 then write(out,<:.:>);
         if i extract 12=10 then
         begin
            i:=1; write(out,string ra(increase(i)),<:<10>:>);
         end else
            write(out,<<d>,entier ra(1),<:<10>:>);
         goto stop
      end;
      if ra(1)<>real <:list:> then goto err;
      i:=system(4,j+1,ra);
      if i extract 12<>10 or i shift (-12)<>8 then goto err;
      list:=ra(1)=real <:yes:>;
      i:=system(4,j+2,ra);
      if i<>0 then goto err;
ok:
      connect_output;
   end else goto err;
\f



   number:=1;

nextline:

   while readchar(in,ch)<>6 and ch<>25 do if list then outchar(out,ch);

   if ch=25 then goto exitlabel;

   i:=0; j:=1; l(1):=l(2):=0;

   repeat
      if list then outchar(out,ch);
      i:=i+1;
      if ch>96 then ch:=ch-32;
      l(j):=l(j) shift 8 add ch;
      if i=6 then j:=2
   until readchar(in,ch)<>6;

   repeatchar(in);

   i:=i mod 6;
   if i<>0 then l(j):=l(j) shift (8*(6-i));

   read(in,k);
   repeatchar(in);
   if list then write(out,<<_d>,k);
   table(number):=l(1); table(number+1):=l(2) add k;
   number:=number+2;

   goto nextline;
\f


exitlabel:

   for i:=1 step 2 until number-4 do
      for j:=1 step 2 until number-2-i do
         if table(j)>table(j+2) or table(j)=table(j+2) and
                                   table(j+1)>table(j+3) then
         begin
            help:=table(j);
            table(j):=table(j+2);
            table(j+2):=help;
            help:=table(j+1);
            table(j+1):=table(j+3);
            table(j+3):=help
         end;

   if list then outchar(out,12);
   for i:=1 step 2 until number-2 do
   begin
      write(output,table(i),table(i+1),<:<10>:>);
      if list then
      begin
         j:=table(i+1) extract 12;
         table(i+1):=table(i+1)-j;
         k:=i;
         write(out,false add 32,11-write(out,string table(increase(k))),
                   <<zddd>,j,<:<10>:>)
      end
   end;
   outchar(output,25);
   close(output,true);
   getzone6(output,ia);
   i:=ia(9);
   monitor(42,output,0,ia);
   ia(1):=i;
   monitor(44,output,0,ia);
stop:
   trapmode:=-1

end
▶EOF◀