DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tchangeerr«

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »tchangeerr« 

TextFile

changeerror=algol connect.no
 
begin
integer maxchars,mintextno,maxtextno;
 
 
<* below 3 values may be changed *>
 
maxchars:=47; <*(maxchars+1) mod 6 must be 0*>
mintextno:=0;
maxtextno:=223;
 
begin real r;
integer i,j,k,reals,halfs,persegm,size;
zone zto,zfrom,zcor(128,1,stderror);
real array programname, ra(1:2);
integer array ia(1:10),alfa(0:255);
long array field laf,laf0;
boolean c,cor,to,from,list;
long array toname,fromname,corname(1:2);
 
procedure correct(z); zone z;
begin real array ra(1:reals);
 
  if -,to then
  begin
    close(zto,true);
    open(zto,4,fromname,0);
  end
  else
  for i:=1 step 1 until size do
  begin
    if from then inrec6(zfrom,512);
    outrec6(zto,512);
    if from then tofrom(zto,zfrom,512);
  end;
 
  system(8,0,ia.laf0);
  if ia.laf0(1)=long<:boss:> then c:=false;
  if c then list:=true;
 
rep:
  if c then setposition(out,0,0);
  for j:=readchar(z,i) while j=8 and i<>25 do;
  if i=101<*e*> or i=25<*em*> then goto programexit;
  repeatchar(z);
  j:=read(z,i);
  if c then setposition(in,0,0);
  if j=0 then goto program_exit;
  if i<mintextno or i>maxtextno then
  begin
    if -,c then 
    begin
      error;
      write(out,<:<10>:>,<<zdd>,i);
    end;
    write(out,<: illegal error number<10>:>);
    if -,c then
    begin
      repeatchar(z);
      for j:=readchar(z,k) while j<>8 do;
    end;
    goto rep;
  end;
 
  setposition(zto,0,(i-mintextno)//persegm);
  inrec6(zto,512);
  laf:=((i-mintextno) mod persegm)*halfs;
  if -,c and list then write(out,<:<10>:>,<<zdd>,i,<: :>);
  if list and from then write(out,zto.laf);
  if c then
  begin
    write(out,<:<10>:>);
    setposition(out,0,0);
  end;
 
  for k:=1 step 1 until reals do ra(k):=real<::>;
  if -,c then repeatchar(z);
  j:=readchar(z,k);
  if j<>8 and -,c then j:=readchar(z,k);
  if j<>8 then repeatchar(z);
  if j=8 then k:=0 
  else
  k:=readstring(z,ra,1);
  if k<0 then 
  begin
    if -,c then error;
    write(out,<:<10>:>);
    if -,c then write(out,<<zdd>,i);
    write(out,<: text too long<10>:>);
    for j:=readchar(z,k) while j<>8 do;
    goto rep;
  end;
  if c and ra(1)=real<:ok:> then goto rep;
  tofrom(zto.laf,ra,halfs);
  if -,c and list then
  begin
    if from then write(out,<:<10>    :>);
    write(out,zto.laf);
  end;
  setposition(zto,0,(i-mintextno)//persegm);
  if to then outrec6(zto,512);
  goto rep;
end correct;
 
procedure error;
write(out,<:<10>***:>,programname.laf0,<: :>);
 
  isotable(alfa);
  for i:=32 step 1 until 126 do
  if alfa(i) shift (-12)=7 then
  alfa(i):=6 shift 12+i;
  for i:=128 step 1 until 255 do alfa(i):=0;
  intable(alfa);
 
  laf0:=0;
  c:=cor:=to:=from:=list:=false;
 
  reals:=(maxchars+1)//6;
  halfs:=4*reals;
  persegm:=128//reals;
  size:=(maxtextno-mintextno+persegm)//persegm;
 
  for i:=1 step 1 until 128 do zto(i):=real<::>;
 
  system(4,0,programname);
 
  if (maxchars+1) mod 6<>0 then
  begin
    error;
    write(out,<: (maxchars+1) mod 6 must be = 0<10>:>);
    goto program_exit;
  end;
 
  if mintextno>maxtextno then
  begin
    error;
    write(out,<: mintextno>maxtextno<10>:>);
    goto program_exit;
  end;
 
 
  i:=1;
read_fp_param:
  if system(4,i,ra)=0 then goto finis_read_fp_param;
  i:=i+1;
  r:=ra(1);
  j:=system(4,i,ra);
 
  if r=real<:to:> then
  begin
    to:=true;
    toname(1):=long ra(1);
    toname(2):=long ra(2);
  end
  else
 
  if r=real<:from:> then
  begin
    from:=true;
    fromname(1):=long ra(1);
    fromname(2):=long ra(2);
  end
  else
 
  if r=real<:list:> then
  begin
    list:=ra(1)=real<:yes:>;
  end
  else
 
  if r=real<:cor:> then
  begin
    cor:=true;
    c:=ra(1)=real<:c:>;
    corname(1):=long ra(1);
    corname(2):=long ra(2);
  end
  else
 
  begin
    error;
    i:=i-1; system(4,i,ra);
    i:=1; write(out,<:error in fpparam: :>,
    string ra(increase(i)),<:<10>:>);
    goto program_exit;
  end;
  i:=i+1;
  goto read_fp_param;
 
finis_read_fp_param:
 
  if -,from and -,to then
  begin
    error;
    write(out,<:neither input nor output specified:>);
    goto program_exit;
  end;
 
  if from then
  begin
    open(zfrom,4,fromname,0);
    if monitor(42<*lookup*>,zfrom,0,ia)<>0 then
    begin
      error;
      write(out,<:fromname not found<10>:>);
      goto program_exit;
    end;
  end;
 
  if to then
  begin
    open(zto,4,toname,0);
    i:=monitor(42<*lookup*>,zto,0,ia);
    ia(1):=size;
    for j:=2 step 1 until 10 do ia(j):=0;
    ia(6):=systime(7,0,0.0);
    if i=0 then
    i:=monitor(44<*change*>,zto,0,ia)
    else
    i:=monitor(40<*create*>,zto,0,ia);
    if i<>0 then
    begin
      error;
      write(out,<:toname not found<10>:>);
      goto program_exit;
    end;
  end;
 
  if -,cor then
  begin
    k:=0;
    for i:=1 step 1 until size do
    begin
      inrec6(zfrom,512);
      if list then
      begin
        for laf:=0 step halfs until halfs*(persegm-1) do
        begin
          if zfrom.laf(1)<>0 then
          write(out,<:<10>:>,<<zdd>,k,<: :>,zfrom.laf);
          k:=k+1;
        end
      end;
      if to then
      begin
        outrec6(zto,512);
        tofrom(zto,zfrom,512);
      end;
    end;
  end
  else
 
  if c then correct(in)
  else
 
  begin
    open(zcor,4,corname,0);
    if monitor(42<*lookup*>,zcor,0,ia)<>0 then
    begin
      error;
      write(out,<:corname not found<10>:>);
      goto program_exit;
    end;
    correct(zcor);
    close(zcor,true);
  end;
 
program_exit:
  if to then close(zto,true);
  close(zfrom,true);
end
end
▶EOF◀