DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »tmulticopy«

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

TextFile

(mode list.yes
multicopy=algol connect.no blocks.yes
global multicopy
mode list.no)
1980-10-22
begin
integer array t(1:10);
array ver,inp,wrk,outp(1:3);
boolean cont,print;
integer i,j,fpc,copy,copies,char,ch,res,chff,
modekindlp,vtype,lines,totlines,linespp,maxlp;
real r;
integer array line(1:500);

modekindlp:=1 shift 23+14;
totlines:=0;
readifp(<:lines:>,maxlp,-1);
i:=vtype:=0;
readsfp(<:version:>,ver,<::>);
repeat i:=i+1;
  if ver(1)=real (case i of (<:algol:>,<:slang:>,<:fp:>,
     <:compo:> add 's')) then vtype:=i;
until vtype>0 or i=4;
readifp(<:copies:>,copies,1);
generaten(wrk);
print:=true;
cleararray(outp);
movestring(outp,1,<:lp:>);
if -,readlsfp(outp) then else
begin
  res:=lookuptail(outp,t);
  print:=res=0 and t(1)=modekindlp;
  if -,print then begin wrk(1):=outp(1); wrk(2):=outp(2); end;
end;
print:=print and fpinareas>0;
if print then
begin
  res:=reservesegm(wrk,1);
  if res<>0 then alarm(<:***bs claims exceeded:>);
  res:=permentry(wrk,2);
end;
res:=connectcuro(wrk);
if res<>0 then 
begin
  unstackcuro;
  alarm(<:***connect :>,string inc(wrk),res);
end;
cont:=false;
linespp:=0;
for copy:=1 step 1 until copies do
begin
  for fpc:=1 step 1 until fpinareas do
  begin
    readinfp(inp,fpc);
    res:=connectcuri(inp);
    if res<>0 then
    begin
      closeout;
      alarm(<:***connect input :>,string inc(inp),res);
    end;

    lines:=0;
    lookuptail(inp,t);
    if vtype>0 then
      begin
      write(out,"ff",1,
            "nl",1,
          case vtype of (<:<*:>,<:;:>,<:;:>,<:*cm:>),
          ";",12,"sp",4,true,12,string inc(inp),
          << dd dd dd>,systime(6,t(6),r),r,
          "sp",4,";",12,
          case vtype of (<:*>:>,<:;:>,<:;:>,<:*:>),
          "nl",2);
       if vtype=1 then linespp:=3;
       lines:=lines+3;
     end;
    repeat
    if -,cont then ch:=0;
    repeat ch:=ch+1;
      readchar(in,char);
      line(ch):=char;
      if char='nl' then lines:=lines+1;
    until char='em' or char='nl' or ch=499;
    cont:=char='em';
    chff:=0;
    if -,cont then
    begin
    for i:=1 step 1 until ch do
    begin
      chff:=chff +
       (if line(i)='ff' then 1 else 0);
      if chff>1 then line(i):=0;
      if line(i)<>'em' then outchar(out,line(i));
    end;
    end;
    until char='em';
    totlines:=totlines+lines;
    unstackcuri;
  end for fpc;
end for copy;
if cont then
begin
  for i:=1 step 1 until ch do outchar(out,line(i));
end;
closeout;
i:=j:=1;
if print then
  begin
    printfile(string outp(increase(i)),string wrk(increase(j)));
    write(out,"sp",4,<:lines :>,totlines);
  end else
  write(out,"nl",1,true,12,string outp(increase(i)),
     "sp",4,<:lines :>,totlines);
end
▶EOF◀