|
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: 6912 (0x1b00)
Types: TextFile
Names: »tchangedisc «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tchangedisc «
changedisc = algol index.no; list.yes details.8.8 xref.yes blocks.yes bossline.yes
begin
<*changedisk, dh 86.01.07 page ...01...*>
message program for moving areas from one disk to another.
call:
changedisk (<filename>.<discname>) 0/*
the error messages should be self explanatory;
long array diskname, filename(1:2);
integer paramno, i, zsize, spname, ptname, progsize, centralloop,
files, errors;
centralloop := 7; progsize := 24;
comment the values of progsize and centralloop are best obtained from
the segmentation yielded by a translation with details.8.8, and
the survey from pass 9. remember that inrec and outrec use one
running system segment (check), and that zone declaration uses
another. if in doubt keep centralloop low and progsize high;
spname := 4 shift 12 + 10; ptname := 8 shift 12 + 10;
files := errors := 0; paramno := 1;
i := (system(2)free_core:(i, filename) - 200)//512;
zsize := (if i <= centralloop then 1 else
if i <= (4*progsize-centralloop+4)//3 then (i-centralloop)//4+1
else (i - progsize) ) * 512;
comment at least one segment, but if there is room for the central
loop, take one extra buffer segment whenever there is room for 4
extra segments, until there is room for the whole loop stepping
through the parameters. -
\f
<*changedisk, dh 86.01.07 page ...02...*>
- the following for statement with all its procedures etc. is
what should be contained in progsize ;
for i := system(4)fpparam:(paramno, filename) while i = spname do
begin
zone z(zsize//4, 1, stderror);
integer array todesc, fromdesc(1:20), entry(1:17), base(1:2);
integer j, key, err; integer field size;
integer array field iaf; long array field laf;
procedure blpr(z, s, b); zone z; integer s, b;
begin own boolean called; integer array zdesc(1:20);
if called then b := 2 else
begin
called := true; getzone6(z, zdesc);
if zdesc(13<*z.state*>) = 5<*after inrec*> then
begin
flip; errmess(<:input trouble:>);
end else errmess(<:output trouble:>);
close(z<*out*>, true);
monitor(48)remove:(z<*out*>, 0, zdesc); flop;
close(z<*in*>, true);
called := false;
goto opgiv;
end;
end blpr;
procedure errmess(s); string s;
err := write(out, "sp", 12-write(out, filename), <:cannot be moved to :>,
diskname, <:, :>, s, <:!<10>:>);
procedure flip;
begin
getzone6(z<*in*>, fromdesc); setzone6(z<*out*>, todesc);
end;
procedure flop;
begin
getzone6(z<*out*>, todesc); setzone6(z<*in*>, fromdesc);
end;
getzone6(z<*empty*>, todesc);
size := 16;
open(z<*in*>, 4, filename, 0);
paramno := paramno + 2;
laf := 16; iaf := err := 0;
if system(4)fpparam:(paramno-1, diskname) <> ptname
then err:=write(out, filename,
<: not followed by proper diskname<10>:>) else
if monitor(76)headandtail:(z<*in*>, 0, entry) <> 0
then errmess(<:cannot be found:>) else
\f
<*changedisk, dh 86.01.07 page ...03...*>
begin
key := entry(1) extract 2;
base(1) := entry(2); base(2) := entry(3);
if entry.size >= 0 then
begin
entry.laf(1) := diskname(1); entry.laf(2) := diskname(2);
end;
size := 2;
for j := 1 step 1 until 10 do entry(j) := entry(j+7);
flip;
open(z<*out*>, 4, <::>, 0);
if monitor(40)create:(z<*out*>, 0, entry) <> 0
then errmess(<:no temporary claims:>) else
if monitor(if entry.size<0 and key>1 then 90 else 50)permanent:(
z<*out*>, key, diskname.iaf) <> 0 then
begin
monitor(48)remove:(z<*out*>, 0, entry);
errmess(<:no permanent claims:>);
end else
if monitor(74)set_bases:(z<*out*>, 0, base) <> 0 then
begin
monitor(48)remove:(z<*out*>, 0, entry);
errmess(<:bases improper:>);
end else
begin
if entry.size <= 0 then flop else
begin
monitor(52)create:(z<*out*>, 0, entry);
monitor(8)reserve:(z<*out*>, 0, entry);
flop;
monitor(52)create:(z<*in*>, 0, entry);
comment as the monitor procedure segments are in core, it may be
faster to create and reserve the area processes "by hand", in stead
of letting the standard error actions perform this. -
\f
<*changedisk, dh 86.01.07 page ...04...*>
- the following for statement with all its procedures except
close is considered to be the central loop;
for j := inrec6(z<*in*>, 0) while j > 2 do
begin
inrec6(z<*in*>, j); flip;
outrec6(z<*out*>, j);
if j = zsize then outrec6(z<*out*>, 0)
else close(z<*out*>, true); flop;
end;
close(z<*in*>, true); flip;
close(z<*out*>, true); flop;
end moving of data, i.e. central loop;
if monitor(48)remove:(z<*in*>, 0, entry) <> 0 then
begin
flip; monitor(48)remove:(z<*out*>, 0, entry);
errmess(<:rename trouble:>);
end
else
begin
iaf := 0; laf := 2; flip;
if monitor(46)rename:(z<*out*>, 0, filename.iaf) <> 0 then
err:=write(out, <:rename trouble!!! new name: :>, todesc.laf,
<: in stead of :>, filename, <:!!!<10>:>)
else write(out, "sp", 12-write(out, filename),
<:moved to :>, diskname, <:<10>:>);
end renaming;
end moving the file or the descriptor;
end determining keys and bases;
opgiv:
if err <> 0 then errors := errors+1 else files := files+1;
end going through parameters, i.e. progsize;
\f
<*changedisk, dh 86.01.07 page ...05...*>
if files + errors = 0 then errorbits := 1
else if files = 0 then
begin
errorbits := 3;
write(out,
<:no files moved because of errors, see above!:>);
end
else if errors = 0 then write(out, files,
if files=1 then <: file:> else <: files:>, <: moved correctly.:>)
else
begin
errorbits := 2;
write(out, files, if files = 1 then <: file:> else <: files:>,
<: moved correctly, but:>, errors,
if errors = 1 then <: file was:> else <: files were:>,
<: in error, see above!:>);
end;
if i <> 0 then
begin
errorbits := errorbits extract 1 + 2;
write(out, <:<10>parameter pair:>, (paramno+1)//2,
<: not proper, moving stopped!:>);
end;
end*; program
end ; possible unstacking of current in
finis
▶EOF◀