DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »fungprcktxt«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »fungprcktxt« 

TextFile

fungpr=set 50
fungpr=algol
program for printing a excursion list of fungi
call:  <objectfile>=fungpr <sourcefile> <fpparam>(0,n)
begin
     integer c,ib,ix,i,dix,ic,il,iw,del,lw,nl,ld,cg,cs,cy,
        sg,ss,sv,sf,ca,cn,cd,ci,cl,cc,ch;
     boolean bscan,bsearch,bverify;
     integer array BUF(1:200),DIX(1:20),PRIX(1:20);
     real array field raf;
     long array IFILE,OFILE(1:3);
     zone zi,zo(128,1,stderror);
     raf:= 0;
     cleararray(IFILE); readinfp(IFILE.raf,1);
     open(zi,4,IFILE,0);
     cleararray(OFILE); readlsfp(OFILE.raf);
     open(zo,4,OFILE,0);
     cg:= 35; cs:= 64; cy:= 36;
     i:= 0; ic:= 1;
     readifp(<:lw:>,lw,65);
     readifp(<:nl:>,nl,69*ld);
     readifp(<:ld:>,ld,3);
     unstackcuri;

begin
     boolean bg,bga,bgn,bs,bsa,bsd,bsn,bsi,bsd5;
     integer dixg,dixga,dixgn,dixs,dixsa,dixsd,dixsn,
             dixsi,dixsd5;


boolean procedure prefix(d1,d2,d3,d4,dixt);
integer d1,d2,d3,d4,dixt;
begin
     boolean b;
     b:= true;
     for i:= DIX(dix) step 1 until PRIX(dix)-1 do
     b:= b and BUF(i)=(case i+1-DIX(dix) of (d1,d2,d3,d4));
     if b and dixt=0 then dixt:= dix;
     prefix:= b;
end prefix;

procedure printelement(z,dix,ipos,maxpos,ic);
integer dix,ipos,maxpos,ic;
zone z;
begin
     if dix>0 then
     begin if DIX(dix)=0 then syntax(1);
        ic:= ic+write(z,"sp",ipos-ic);
        for i:= PRIX(dix) step 1 until DIX(dix+1)-1 do
        ic:= ic+write(z,false add BUF(i),
                if BUF(i)>0 and ic<maxpos then 1 else 0);
     end
end; 

procedure writeitem(dix);
integer dix;
begin for i:= DIX(dix) step 1 until DIX(dix+1)-1 do
     write(out,false add BUF(i),1);
     setposition(out,0,0);
end;

procedure syntax(dix);
value dix;
integer dix;
begin write(out,<:<10>syntax error:>);
     writeitem(dix);
     goto lend
end;

     sg:= 103; ss:= 115; sv:= 118; sf:= 102;
     ca:= 97; cn:= 110; cd:= 100; ci:= 105; 
     cl:= 108; cc:= 99; ch:= 104;
     del:= 47;
     DIX(1):= 0; il:= 1;
  l1:readchar(zi,c);
     BUF(1):= c;
     if -,(c=cg or c=cs or c=cy) then goto l1;
     readchar(zi,c);
     if c<>32 then syntax(1);
     BUF(2):= 32;
  l2:i:= 3; DIX(1):= 1; dix:= 2;
  l3:readchar(zi,c);
     if c=10 then goto l3;
     if c=32 and BUF(i-1)=32 then goto l3;
     if c=32 and DIX(dix-1)=i-1 then
     begin DIX(dix):= 0; goto l4; end;
     if c=cg or c=cs or c=cy then
     begin 
        if BUF(i-1)<>32 then begin BUF(i):= 32; i:= i+1 end;
        DIX(dix):= i; dix:= dix+1
     end;
     BUF(i):= c; i:= i+1;
     if c=25 then
     begin DIX(dix):= i-1; DIX(dix+1):= 0; goto l4 end;
     goto l3;
  l4:for dix:= 1,dix+1 while DIX(dix+1)>0 do
     begin for i:= DIX(dix),i+1 while BUF(i)<>32 do;
        PRIX(dix):= i+1;
     end;
     dixg:= dixga:= dixgn:= dixs:= dixsa:= dixsn:= dixsd5:= 0;
     for dix:= 1,dix+1 while DIX(dix+1)>0 do
     begin
        prefix(cg,32,32,32,dixg);
        prefix(cg,ca,32,32,dixga);
        prefix(cg,cn,32,32,dixgn);
        prefix(cs,32,32,32,dixs);
        prefix(cs,ca,32,32,dixsa);
        prefix(cs,cn,32,32,dixsn);
        prefix(cs,cd,53,32,dixsd5);
     end;
     if dixg>0 then
     begin
        if il+6>nl then 
        begin write(zo,"ff",1); il:= 0 end
        else begin write(zo,"nl",2*ld); il:= il+2*ld end;
        ic:= 1;
        printelement(zo,dixg,0,22,ic);
     end;
     if dixs>0 then
     begin
        if il+1>nl then
        begin write(zo,"ff",1); il:= 0; end
        else begin write(zo,"nl",1*ld); il:= il+1*ld end;
        ic:= 1;
        printelement(zo,dixs,3,13,ic);
        write(zo,"sp",16-ic);
        for i:=1 step 1 until 5 do write(zo,<:.  :>);
     end;
  l5:dix:= 1;
  l6:if DIX(dix)>0 then
     begin dix:= dix+1; goto l6 end;
     BUF(1):= BUF(DIX(dix-1)); BUF(2):= 32;
     if BUF(1)<>25 then goto l2;
end;
lend:write(zo,"em",1);
     close(zi,true); close(zo,true);
end
▶EOF◀