DataMuseum.dk

top - metrics - download

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

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

TextFile

fungpr=set 50
fungpr=algol
program for listing of fungi
call:  <objectfile>=fungpr <sourcefile> <fpparam>(0,n)
fpparam: linewith lw.65  linesofpage nl.65
begin
     integer c,i,ic,il,iw,lw,nl,cg,cs,cy,st,st0,st1,st2,
        sg,ss,sv,sf,ca,cn,cd,ci,cl,cc,ch;
     boolean bpoint;
     integer array ITEM,GENUS,SPECIES(0:50);
     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; il:= 0; iw:= 0; ic:= 1;
     readbfp(<:bpoint:>,bpoint,false);
     readifp(<:lw:>,lw,65);
     readifp(<:nl:>,nl,65);

begin
procedure saveitem(DEST);
integer array DEST;
begin
   l:readchar(zi,c);
     if c=32 or c=10 then goto l;
     i:= 0;
     for i:= i+1 while c<>cg and c<>cs and c<>cy and c<>25 do
     begin DEST(i):= c;
     l1:readchar(zi,c); if c=10 then goto l1 end;
     DEST(0):= i-1; DEST(i):= 0;
end;

integer procedure printitem(ipos,SOUR,maxpos);
value ipos,maxpos;
integer ipos,maxpos;
integer array SOUR;
begin write(zo,"sp",ipos-ic); ic:= ipos-1; i:= 0;
     for ic:= ic+1 while ic<ipos+SOUR(0) and ic<maxpos do
     begin i:= i+1;
     write(zo,false add SOUR(i),1) end;
     printitem:= ic;
end;

procedure syntax;
begin write(out,<:<10>syntax error:>);
     printitem(1,SPECIES,lw);
     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;
  l1:readchar(zi,c);
  l2:st:= st0:= st1:= st2:= 0;
     if c=cg then st:= 1
     else if c=cs then st:= 2
     else if c=cy then st:= 3
     else if c=25 then goto lend
     else goto l1;
  l3:readchar(zi,c);
     if c=32 then goto l5
     else if c=sg then st0:= 1
     else if c=ss then st0:= 2
     else if c=sv then st0:= 3
     else if c=sf then st0:= 4
     else if c=ca then st1:= 1
     else if c=cn then st1:= 2
     else if c=cd then st1:= 3
     else if c=ci then st1:= 4
     else if c=cl then st1:= 5
     else if c=cc then st1:= 6
     else if c=ch then st1:= 7
     else syntax;
  l4:readchar(zi,c);
     if c=32 then goto l5
     else if c>48 and c<58 then st2:= c-48
     else syntax;
  l5:if st1=0 and st0=0 then
     begin if st=1 then saveitem(GENUS)
        else if st=2 then saveitem(SPECIES);
     end
     else saveitem(ITEM);

     if st=1 and st1=0 and st0=0 then
     begin
        if il+5>nl then
        begin write(zo,"ff",1); il:= 0 end else write(zo,"nl",2);
        printitem(1,GENUS,lw); write(zo,"nl",1);
        ic:= 1; il:= il+3;
     end;

     if st=2 and  st1=0 and st0=0 then
     begin
        if bpoint then
        begin write(zo,"sp",40-ic); ic:= 40;
        for ic:= ic+3 while ic<=lw do write(zo,<:.  :>) end;
        if il+1>nl then
        begin write(zo,"ff",1); il:= 0 end else write(zo,"nl",1);
        ic:= 1;
        printitem(1,SPECIES,lw);
        il:= il+1;
     end;
     if st=2 and (st1=1 or st0=3 or st0=4) then
     begin
        if st0=3 then begin write(zo,<:v.:>); ic:= ic+2 end;
        if st0=4 then begin write(zo,<:f.:>); ic:= ic+2 end;
        printitem(ic+1,ITEM,40);
     end;
     goto l2;
end;
lend:write(zo,"em",1);
     close(zi,true); close(zo,true);
end
▶EOF◀