DataMuseum.dk

top - metrics - download

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

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

TextFile

docmove=algol connect.no
begin
  integer i,j;
  integer array ia,ia1(1:17);
  real array ra,ra1(1:2);
  zone z1,z2(128,1,stderror);
  j:=readparam(ra);
  if j<>-1 then
  begin
    alarm("nl",1,"*",3,<:document name missing:>);
  end;
test:
  for i:=1 step 1 until 6 do
  begin
    if ra(1)=real (case i of(<:drum:>,
    <:drum1:>,<:disc:>,<:disc1:>,<:disc2:>,<:disc3:>)) then
    goto found;
  end;
  i:=1;
  alarm("nl",1,"*",3,string ra(increase(i)),<: is not a document:>);
found:
  if j=-1 then readparam(ra1);
om:
  for i:=readparam(ra1) while i<>0 do
  begin
    if i=1 or i=3 then
    begin
      write(out,"nl",1,<:**param :>,<<d>,ra1(1),<::>);
      goto om;
    end;
    if lookuptail(ra1,ia)<>0 then
    begin
      j:=1;
      write(out,"nl",1,"*",2,
            string ra1(increase(j)),<: does not exist:>);
      goto om;
    end;
    if ia(1)<1 then
    begin
      j:=1;
      write(out,"nl",1,"*",2,
           string ra1(increase(j)),<: segments < 1 :>);
      goto om;
    end;
    removeentry(<:xxxxxxxxxxx:>);
    ia(2):=(ra(1) shift (-24) extract 24);
    ia(3):=(ra(1) extract 24);
    ia(4):=ia(5):=0;
    headandtail(ra1,ia1);
    if createentry(<:xxxxxxxxxx:>,ia)<>0 then
    begin
      j:=1;
      write(out,"nl",1,"*",2,string ra1(increase(j)),
      <: xxxxxxxxxx create trouble:>);
      goto om;
    end;
    permentry(<:xxxxxxxxxx:>,ia1(1) extract 3);
    if setenbase(<:xxxxxxxxxx:>,ia1(2),ia1(3))<>0 then
    begin
      j:=1;
      write(out,"nl",1,"*",2,
         string ra1(increase(j)),<: base interval:>);
      goto om;
    end;
    j:=1;
    open(z2,4,<:xxxxxxxxxx:>,0);
    open(z1,4,string ra1(increase(j)),0);
    for j:=inrec(z1,0) while j<>0 do
    begin
      inrec(z1,128);
      outrec(z2,128);
      tofrom(z2,z1,512);
    end;
    close(z1,true);
    close(z2,true);
    removeentry(ra1);
    renameentry(<:xxxxxxxxxx:>,ra1);
  end;
end;
global docmove
▶EOF◀