|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 96768 (0x17a00)
Types: TextFile
Names: »flyttx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »flyttx «
begin
<* flyt flytter filer fra en disc til en anden, med bevarelse af
entrybase og permanent-key.
kald:
* *
flyt ( disc.<nydisc> ( <filnavn> ) )
1 1
<nydisc> navnet på disc der skal flyttes til.
<filnavn> den pågældende fil flyttes til <nydisc>
Der skal altid angives disc.<nydisc> som første parameter efter
programnavnet. Efterfølgende <filnavne> flyttes til den pågældende disc.
Det er muligt at angive flere disc-filnavne sekvenser i samme programkald
f.eks. vil:
flyt disc.disc1 fil1 fil2 fil3 disc.disc2 fil4 fil5
flytte fil1, fil2 og fil3 til disc1 og fil4 og fil5 til disc2.
Ændringshistorie:
=================
930611 cl Original version.
*>
\f
boolean testbit1;
integer argc;
argc:=fpparmantal+1;
testbit1:= false;
begin
integer array partype(0:argc), parval(1:4*(argc+1)),
ia,gltail,nytail(1:10),glhead(1:17),zd(1:20);
integer i, j, maxpar;
integer fclo, fchi, freecore, zsize, hw;
long fsize, b;
integer array field iaf;
long array field laf,doc;
long array docname(1:2);
zone zhelp(1,1,stderror);
doc:=2;
docname(1):=docname(2):= long<::>;
maxpar:=fpparmliste(partype,parval);
fclo:=system(15,fchi,ia);
freecore:= (if fclo > fchi then fclo else fchi) - 16384;
zsize:= freecore // 2048;
if zsize < 1 then zsize:= 1;
begin
zone zin,zud(128*2*zsize,2,stderror);
for i:= 2 step 1 until maxpar do
begin
iaf:=laf:= i*8;
<*
write(out,<<dd>,i,<:: :>,<< dd>,partype(i) shift (-12),
partype(i) extract 12,"sp",1,parval.laf,"nl",1);
*>
if partype(i)=(5 shift 12 + 4) <* <sp><navn> *> and
parval.laf(1)=long<:disc:> and partype(i+1)=(7 shift 12 + 4) then
<*ingenting*>
else
if partype(i)=(7 shift 12 + 4) <* .<navn> *> and
partype(i-1)=(5 shift 12 + 4) and parval.laf(-1)=long<:disc:> then
begin
tofrom(docname,parval.laf,8);
if docname(1) extract 8=0 then docname(2):=long<::>;
end
else
begin
if docname(1)=long<::> then
begin
write(out,<:*** flyt: discnavn skal angives før første filnavn!:>);
flushout(10);
goto slut;
end;
open(zin,4,parval.laf,0);
j:=monitor(42)lookup_entry:(zin,0,gltail);
if j=0 then
begin
monitor(76)lookup_headandtail:(zin,0,glhead);
tofrom(nytail,gltail,20);
tofrom(nytail.doc,docname,8);
open(zud,4,<::>,0);
j:=monitor(40)create_entry:(zud,0,nytail);
if j<>0 then
begin
write(out,<:*** :>,parval.laf,<: kunne ikke oprettes på :>,
docname,<:, monitor-result=:>,<<d>,j);
flushout(10);
close(zin,true); goto next;
end;
if testbit1 then
begin
getzone6(zud,zd);
write(out,zd.doc,<: oprettet på :>,docname,<: ok:>);
flushout(10);
end;
j:=monitor(50)permanent_entry:(zud,glhead(1) extract 3,ia);
if j<>0 then
begin
write(out,<:*** :>,parval.laf,
<: kunne ikke oprettes med permkey :>,
<<d>,glhead(1) extract 3,<:, monitor-result=:>,<<d>,j);
flushout(10);
monitor(48)remove_entry:(zud,0,ia);
close(zin,true); close(zud,true); goto next;
end;
if testbit1 then
begin
write(out,zd.doc,<: permanent :>,<<d>,glhead(1) extract 3,<: ok:>);
flushout(10);
end;
ia(1):=glhead(2);
ia(2):=glhead(3);
j:=monitor(74)set_entry_base:(zud,0,ia);
if j<>0 then
begin
write(out,<:*** :>,parval.laf,<: kunne ikke sætte entry-base :>,
<<d>,ia(1),"sp",1,ia(2),<:, monitor-result=:>,<<d>,j);
flushout(10);
monitor(48)remove_entry:(zud,0,ia);
close(zin,true); close(zud,true); goto next;
end;
if testbit1 then
begin
write(out,zd.doc,<: set_entry_base :>,<<d>,ia(1),"sp",1,ia(2),<: ok:>);
flushout(10);
end;
fsize:= if gltail(1) > 0 then gltail(1)*512 else 0;
b:= 0;
while b < fsize do
begin
hw:= if (fsize-b) < (zsize*512) then (fsize-b) else (zsize*512);
inrec6(zin,hw); outrec6(zud,hw);
tofrom(zud,zin,hw);
b:= b+hw;
end;
if testbit1 then
begin
write(out,parval.laf,<: kopieret til :>,zd.doc,<: ok:>);
flushout(10);
end;
open(zhelp,0,<::>,0);
monitor(68)generate_name:(zhelp,0,ia);
getzone6(zhelp,zd);
close(zhelp,true);
tofrom(ia,zd.doc,8);
if testbit1 then
begin
write(out,zd.doc,<: generate name ok:>);
flushout(10);
end;
j:=monitor(46)rename_entry:(zin,0,ia);
if j<>0 then
begin
write(out,<:*** :>,parval.laf,<: kunne ikke omdøbes :>,
<:, monitor-result=:>,<<d>,j);
flushout(10);
monitor(48)remove_entry:(zud,0,ia);
close(zin,true); close(zud,true); goto next;
end;
getzone6(zin,zd);
tofrom(zd.doc,ia,8);
setzone6(zin,zd);
if testbit1 then
begin
write(out,parval.laf,<: omdøbt til :>,zd.doc,<: ok:>);
flushout(10);
end;
j:=monitor(46)rename_entry:(zud,0,parval.iaf);
if j<>0 then
begin
write(out,<:*** :>,<: kopi kunne ikke omdøbes til :>,
parval.laf,<:, monitor-result=:>,<<d>,j);
flushout(10);
monitor(48)remove_entry:(zud,0,ia);
monitor(46)rename_entry:(zin,0,parval.iaf);
close(zin,true); close(zud,true); goto next;
end;
getzone6(zud,zd);
tofrom(zd.doc,parval.laf,8);
setzone6(zud,zd);
if testbit1 then
begin
getzone6(zud,zd);
write(out,zd.doc,<: omdøbt til :>,parval.laf,<: ok:>);
flushout(10);
end;
j:=monitor(48)remove_entry:(zin,0,ia);
if j<>0 then
begin
write(out,<:*** :>,<: oprindelig fil kunne ikke slettes (:>,
zhelp.doc,<:), monitor-result=:>,<<d>,j);
flushout(10);
monitor(48)remove_entry:(zud,0,ia);
close(zin,true); close(zud,true); goto next;
end;
if testbit1 then
begin
getzone6(zin,zd);
write(out,zd.doc,<: slettet ok:>);
flushout(10);
end;
close(zud,true);
write(out,parval.laf,<: flyttet til :>,docname);
flushout(10);
end; <*entry looked up*>
close(zin,true);
end; <*filparameter*>
next:
end; <* for i *>
slut:
end;
end;
trapmode:=1 shift 10;
end
▶EOF◀