DataMuseum.dk

top - metrics - download

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

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦e4d872f9f⟧ »cproc« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦e4d872f9f⟧ »cproc« 
            └─⟦this⟧ 

TextFile

;ali
mode list.yes
mode 15.yes list.yes
disccopy=algol
1978-04-22
external
boolean procedure disccopy(infile,outfile);
string infile,outfile;
begin
integer result,insegments,outsegments,i,free,
  blocklength;
integer array itail,otail(1:10),todesc,fromdesc(1:20);
array inname,outname(1:3);

free:=((system(2,i,inname)-1536)//512)+1;
blocklength:=free*512;
disccopy:=true;

cleararray(inname);
movestring(inname,1,infile);
result:=lookuptail(inname,itail);
if result>0 or itail(1)<=0 then
begin
  i:=1;
  write(out,<:<10>**disccopy infile :>,string inname(increase(i)),
    <: entry:>);
  if result=0 then write(out,<: size:>,itail(1)) else
    write(out,<: lookup result :>,result);
disccopy:=false;
end infile improper;
insegments:=itail(1);

cleararray(outname);
movestring(outname,1,outfile);
result:=lookuptail(outname,otail);
if result>0 or otail(1)<=0 then
begin
  i:=1;
  write(out,<:<10>**disccopy outfile :>,string outname(increase(i)),
    <: entry:>);
  if result=0 then write(out,<: size:>,otail(1)) else
    write(out,<: lookup result :>,result);
disccopy:=false;
end outfile improper;
outsegments:=otail(1);

if outsegments<insegments then
begin
  i:=1;
  write(out,<:<10>**disccopy infile :>,string inname(increase(i)),insegments);
  i:=1;
  write(out,<: greater than outfile :>,string outname(increase(i)),outsegments);
  disccopy:=false;
end else
begin
zone z(free*128,1,stderror);

procedure flip;
begin
  getzone6(z,fromdesc);
  setzone6(z,todesc);
end;

procedure flop;
begin
  getzone6(z,todesc);
  setzone6(z,fromdesc);
end;

getzone6(z,todesc);
i:=1;
open(z,4,string inname(increase(i)),0); flip;
i:=1;
open(z,4,string outname(increase(i)),0); flop;
for i:=inrec6(z,0) while i>2 do
begin
  inrec6(z,i); flip;
  outrec6(z,i);
  if i=blocklength then outrec6(z,0) else close(z,true);
  flop;
end;
close(z,true); flip;
close(z,true); flop;
end zone;
end disccopy;
end
testcopy=set 100
testcopy=algol list.yes
begin
integer i,j;
array n1,n2(1:3);
cleararray(n1); cleararray(n2);
readlsfp(n2);
readinfp(n1,1);
i:=j:=1;
disccopy(string n1(increase(i)),string n2(increase(j)))
end;
testa1=set 25
testa2=set 30
testa2=move fplibman
testa1=move listman
testa2=testcopy testa1
lookup testa1 testa2
compare testa1.testa2.text
▶EOF◀