DataMuseum.dk

top - download

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

└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─ ⟦this⟧ »flyttabeltx « 

TextFile

begin message flyttabel side 1 - 820319/cl;
  zone zti,ztu(128,1,stderror);
  integer array tab_i_navn,tab_u_navn(1:4),tail,ia(1:50);
  integer max_ti,max_tu,filnr,fil,blokt,segs,i,antal,fnr;
  long array field laf;
  real før_i,før_u,kat_i,kat_u;

  blokt:= 8; <* størrelse af katt-delen i tabelfiler *>
  laf:= 0;
  
  if findfpparam(<:fra:>,false,tab_i_navn)<>1 then
  begin
    write(out,<:*** kildefil mangler<10>:>); goto slut;
  end;

  if findfpparam(<:til:>,false,tab_u_navn)<>1 then
  begin
    write(out,<:*** destinationsfil mangler<10>:>); goto slut;
  end;
  antal:= findfpparam(<:filnr:>,true,ia);
  if antal<1 then
  begin
    write(out,<:*** filnr mangler<10>:>); goto slut;
  end;

  open(zti,4,tab_i_navn,0); open(ztu,4,tab_u_navn,0);
  if monitor(4,zti,0,tail)<>0 or monitor(52,zti,0,tail)<>0 or
     monitor(8,zti,0,tail)<>0 or monitor(42,zti,0,tail)<>0 then
  begin
    write(out,<:*** :>,tab_i_navn.laf,
      <: er i brug/findes ikke<10>:>); goto slut;
  end
  else max_ti:= tail(10);
  if monitor(4,ztu,0,tail)<>0 or monitor(52,ztu,0,tail)<>0 or
     monitor(8,ztu,0,tail)<>0 or monitor(42,ztu,0,tail)<>0 then
  begin
    write(out,<:*** :>,tab_u_navn.laf,
      <: er i brug/findes ikke<10>:>); goto slut;
  end
  else max_tu:= tail(10);

 for fnr:= 1 step 1 until antal do
 begin
  filnr:= ia(fnr); fil:= filnr-1024;
  if fil<1 or fil>max_ti or fil>max_tu then
  begin
    write(out,<:*** ulovligt filnr::>,<< dddd>,filnr,nl,1);
    goto slut;
  end;

  if fil=1 then
    før_i:= før_u:= real(extend 0 add blokt)
  else
  begin
    setposition(zti,0,(fil-2)//128); inrec6(zti,512);
    setposition(ztu,0,(fil-2)//128); inrec6(ztu,512);
    før_i:= zti((fil-2) mod 128 + 1);
    før_u:= ztu((fil-2) mod 128 + 1);
  end;
  setposition(zti,0,(fil-1)//128);
  setposition(ztu,0,(fil-1)//128);
  inrec6(zti,512); kat_i:= zti((fil-1) mod 128 + 1);
  inrec6(ztu,512); kat_u:= ztu((fil-1) mod 128 + 1);

  if kat_i shift (-24) extract 9 <> kat_u shift (-24) extract 9 or
     kat_i extract 18 - før_i extract 18 <>
     kat_u extract 18 - før_u extract 18
  then
  begin
    write(out,<:*** uoverensstemmelse i katalog for fil nr.:>,
      << dddd>,filnr,nl,1); goto slut;
  end;

  ztu((fil-1) mod 128 + 1):= kat_i shift (-24) shift 24  add
                             kat_u extract 24;
  segs:= kat_i extract 18 - før_i extract 18;
  setposition(zti,0,før_i extract 18);
  setposition(ztu,0,før_u extract 18);

  for i:= 1 step 1 until segs do
  begin
    inrec6(zti,512); outrec6(ztu,512);
    tofrom(ztu,zti,512);
  end;
 end;

slut:
  close(zti,false); close(ztu,false);
end
▶EOF◀