⟦4763fbbb0⟧

TextFileVerbose

job vr 1 3447 time 60
mode list.yes
punchlist=set 300
o punchlist
head 1
b=algol list.yes xref.yes bossline.yes punch16text
head 1
o c
;convert punchlist std
do wait printer
lp=copy punchlist
do clear printer
end
finis
\f


begin 
  comment <area=>punch16 mode.<modetype> <areas>   dato 30.8.74
           <modetype>::=8:8,4:<auto>,0:<boot>;
  integer check,esc,mode,i,i0,j,p1,p2,sourceno,word, count;
  long l;
  real r;
  integer field inf1;
  integer array filename(0:11);
  zone zi(128*2,2,stderror),zo(128,1,stderror);

boolean procedure opennextsource(z, sourceno);
  integer sourceno;
  zone z;
begin
  integer i, j, k, cnt, pno, file, block;
  boolean first;
  real array field ra;
  integer array arr(1:10);
  real array rarr(1:2);
  procedure alarm;
  begin
    write(out, <:<10>connect file:>, <<-d>, sourceno, <:<10>:>);
    goto slut;
  end;

  first:=true;
  if sourceno>1 then close(z, true);
  opennextsource:=true;
  pno:=1;
  if system(4, pno, rarr)=6 shift 12 + 10 then pno:=pno+1;
  cnt:=k:=0;
  for j:=system(4, pno, rarr) while cnt<>sourceno and(j<>0 or k<>0) do
  begin
    if k=4 shift 12 + 10 and (j shift(-12)=4 or j=0) then
      cnt:=cnt+1;
    k:=j;
    pno:=pno+1;
  end;
  if cnt<>sourceno or pno<>2 and sourceno=0 then opennextsource:=false else
  begin
    system(4, pno-2, rarr);
    cnt:=0;
    for i:=0 step 1 until 11 do filename(i):=rarr(1+i//6)
                                          shift(8*(i mod 6)-40)extract 8;
\f


loop:
    i:=1;
    if sourceno<>0 then
    begin
      write(out,<:<10>sourcefile: :>);
      j:=12-write(out,string rarr(increase(i)));i:=1;
      write(out,false add 32,j,<: segm: :>,count//750,
                <: bytes: :>,((count mod 768)-3*(count//768)));
    end;
    open(z, 4, string rarr(increase(i)), 0);
    if monitor(42, z, j, arr)<>0 then
    begin
      for j:=1 step 1 until 10 do arr(j):=0; arr(1):=1;
      if monitor(40,z,j,arr)<>0 then alarm;
      goto out1;
    end;
    if first then
    begin
      file:=arr(7);
      block:=arr(8);
      first:=false;
    end;
    if arr(1)<0 then
    begin
      ra:=2;
      rarr(1):=arr.ra(1);
      rarr(2):=arr.ra(2);
    end;
    if arr(1)=1 shift 23 + 4 then
    begin
      cnt:=cnt+1;
      if cnt=100 then alarm;
      close(z, false);
      goto loop;
    end;
    if arr(1)<0 then
    begin
      j:=arr(1) shift(-12) extract 11;
      k:=arr(1) extract 12;
      if k>20 or k extract 1=1 or arr(1)=0 or j extract 1=1 or
        j>(if k=10 or k=12 then 6 else if k=16 then 4 else if
        k=18 then 2 else 0) then alarm;
      j:=arr(1)extract 23;
      if k=20 then j:=j+(14-20);
      close(z, false);
      k:=1;
      open(z, j, string rarr(increase(k)), 0);
    end not bsarea;
    k:=arr(1) extract 12;
    if k<>10 and k<>16 then setposition(z,file,block);
    if sourceno<>0 then sourceno:=sourceno+1;
  end;
out1:
end opennextsource;
\f


procedure examineparams;
begin
  integer names;
  names:=1;
  begin
    boolean first;
    integer pno, j, i, type,paramfct;
    real array rarr(1:2), name(1:names, 1:2);
    integer array field ia;

    procedure alarm;
    begin
      write(out, <:<10>params<10>:>);
      goto slut;
    end;

    for j:=1 step 1 until names do name(j,1):=name(j,2):=real<::>;
    name(1,1):= real<:mode:>;

    mode:=8;
    pno:=1;
    if system(4,pno,rarr)=6 shift 12 + 10 then pno:=pno+1;

    for j:=system(4,pno,rarr) while j<>0 do
    begin
      if j<>4 shift 12 + 10 then alarm;
      for paramfct:=1 step 1 until names do
        if name(paramfct,1)=rarr(1) and
        name(paramfct,2)=rarr(2) then goto ud; ud:

      first:=true;
      for i:=system(4,increase(pno)+1,rarr)while i shift(-12)=8 do
      begin comment .param;
        type:=if i extract 12=4 then 1 else if rarr(1)=real<:yes:>
          then 2 else if rarr(1)=real<:no:> then 3 else 4;
        case paramfct of
        begin
           begin comment mode;
              if type=1 then
              begin
                if rarr(1)<>8 then alarm;
                mode:=rarr(1);
                paramfct:= names+2;
              end else
              if rarr(1)=real<:auto:> then
              begin
                 mode:= 4;
                 paramfct:= names+2;
              end else
              if rarr(1)=real<:boot:> then
              begin
                 mode:=0;
                 paramfct:=names+2;
              end;
           end mode first param;
           if -, first then alarm;comment not known;
           alarm; comment no more points might follow;
        end case paramfct of;
        first:= false;
     end paramlist;
     end outer loop;
    end inner block;
  end examin params;
\f


;comment programstart;

  examineparams;
  if -,opennextsource(zo,0) then
  open(zo,4 shift 12 +12,<:punch:>,0);
  sourceno:= 1;
  word:= 0;
  for i0:= 0 while opennextsource(zi,sourceno) do
  begin
nextblock:
    count:= inrec6(zi,0);
    if count > 2 then
    begin
      outrec6(zo,count);
      inrec6(zi,count);
      tofrom(zo,zi,count);
      word:= word + 1;
      goto nextblock;
    end
    else goto slut;
  end;
slut:
  inf1:= 2;
  for i0:= 1 step 1 until 33 do
  begin
    outrec6(zo,2);
    zo.inf1:= 0;
  end;
  write(out,<:<10>no of segments: :>,word);
  close(zo,true);
  monitor(42,zo,i,filename);
  systime(1,0,r);l:=625*r;
  filename(6):=l shift(-15)extract 24;
  monitor(44,zo,i,filename);
end;

«eof»
DataMuseum.dk

RC3500

⟦4763fbbb0⟧ TextFileVerbose

Derivation

TextFileVerbose
