DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »algtextprg«

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

TextFile

;gosav
textprg=set 50
permanent textprg.15
textprg=algol list.yes
\f



textprg

begin
integer i,j,k;
real a,b,c;
boolean closeres;
integer array tail(1:10);
array t(1:20);
zone z,res(128,1,stderror);
integer procedure readline(z,a,i,k);
value i; integer i,k; zone z; array a;
begin comment
   Proceduren læser een linie.  Return value er antallet
   af tegn i den indlæste tekststreng. Return value for
   k er sidst læste tegn;
integer array alfabet(0:127);   integer j,l;
procedure inset(k);  value k; integer k;
begin alfabet(j):= k shift 12 + j end;

for j:=38 step 1 until 125 do inset(6);
for j:=0  step 1 until  37, 63,64,94,95,96,126,127 do inset(0);
for j:=32 do inset(6);
for j:=10,12,25 do inset(7);

readchar(in,k);
if k>25 then begin
   repeatchar(in);  intable(alfabet);  tableindex:= 0;
   k:= readstring(z,a,i); l:= 6*k; k:= i+k-1;
   for j:=-40 step 8 until 0 do
   if a(k) shift j extract 8 = 0 then l:= l-1;
   repeatchar(in); readchar(in,k);
end else begin
   l:= 0;  a(i):= 0 shift 24
end;
readline:= l;
intable(0)
end;
closeres:=outmedium(res);
open(z,4,<:auxtext:>,0);
tail(1):=1; monitor(40,z,0,tail);
k:= 0;
for k:= k while k<>25 do begin
  t(5):= 0;
  j:=readline(in,t,1,k);
  if j=0 then write(res,false add k,1) else begin
    i:= t(5) extract 8;
    j:= t(5) shift (-32) extract 8;
    if i=46 and j=32 then begin
      integer array q(1:7);
      setposition(z,0,0);
      i:= 1; write(z,string t(increase(i)));
      setposition(z,0,0); read(z,q,a);
      i:= abs(q(2)-q(5));
      i:= if i=0 or i=2 then 1 else 2;
      for j:=1 step 1 until 6 do write(res,<<ddd>,q(j));
      write(res,<<dd>,i,<<dddddd.dd>,q(7)*1000+a,false add k,1)
    end else begin
      i:=1; write(res,string t(increase(i)),false add k,1);
  end end;
end;
close(z,true); close(res,closeres);
end;
▶EOF◀