|
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: 13056 (0x3300)
Types: TextFile
Names: »movedump4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »movedump4tx «
\f
<* movedump maintenance program page 1
1984 10 08 *>
begin
message movedump page 1;
<*****************************************************************>
<* *>
<* The program moves the coredump caused by autoload action from *>
<* the autoload disc to the file specified. *>
<* The program moves <no of segments> or until <em> from the *>
<* disc, starting with <first segment>. *>
<* *>
<* Default values are : *>
<* <first segment > : 840 *>
<* <no of segments> : 168 *>
<* and for ida discs : *>
<* <first segment > : 0 *>
<* <no of segments> : max integer (until end of doc) *>
<* *>
<* If <outfile> does not exist, movedump will create a temporary *>
<* entry with that name. *>
<* *>
<* Error messages : *>
<* - syntax errors refer to the parameter number in the call *>
<* - monitor errors are described in RCSL No 31-D0477 : RC8000 *>
<* Monitor, Part Two. *>
<* *>
<* Call : *>
<* *>
<* <outfile> = movedump, *>
<* ( device.<device spec> ) ! ( first.<no> ) ! ( segm.<no> ) *>
<* *>
<* <device spec> ::= <device name> ! <device no> *>
<* <device name> ::= name *>
<* <device no > ::= *>
<* <no> ::= number *>
<* *>
<*****************************************************************>
\f
<* movedump maintenance program page 2
1984 11 08 *>
message movedump page 2;
procedure error (z, text, no);
value no ;
integer no ;
string text ;
zone z ;
begin
write (z, "nl", 1, <:***:>, true, 12, progname, "sp", 1, text,
if no >= 0 then <: :> else <:<10>:>);
if no >= 0 then
write (z, no);
errorbits := 3; <*ok.no, warning.yes*>
goto stop;
end error;
integer array ia (1:10), discdescr (0:15), dummy (1:1);
real array outfile, param (1:2);
long array progname (1:2);
long array field laf;
integer array field iaf;
integer first_segment, maxblock, i, j, k, l, s, mon_rel, offset,
hwds, blocks;
boolean device_specified, process_created;
zone array iozones (2, buflengthio (2, 2, 512), 2, stderror);
<*init*>
process_created :=
device_specified := false;
first_segment := 840;
maxblock := 168;
laf := 0;
iaf := -2;
trapmode := 1 shift 10; <*no end alarm written*>
<*parameter check*>
<*check outfile param*>
k := system (4, 0, progname);
if system (4, 1, param ) shift (-12) <> 6 then
error (out, <:call:>, -1);
tofrom (outfile, progname, 8);
system (4, 1, progname);
open (iozones (2), 4, outfile.laf, 0);
\f
<* movedump maintenance program page 3
1984 10 08 *>
message movedump page 3;
<*check suceeding parameters*>
j := 1;
repeat
j := j + 1;
k := system (4, j, param);
if k = 4 shift 12 add 10 then
begin <*space name*>
s := 0;
for l := 1 step 1 until 3 do
if param (1) = real ( case l of (
<:devic:> add 'e',
<:first:> ,
<:segm:> ) ) then
begin s := l; l := 3 end;
if s = 0 then
error (out, <:unknown, param no:>, j);
case s of
begin
begin <*device*>
device_specified := true;
j := j + 1;
k := system (4, j, param);
if k = 8 shift 12 add 10 <*devicename*> then
open (iozones (1), 6, param.laf, 0) else
if k = 8 shift 12 add 4 <*deviceno *> then
begin
open (iozones (1), 6, <::>, 0);
k := monitor (54, iozones (1), round (param (1)), dummy);
process_created := k = 0;
if k <> 0 then
error (out, <:create peripheral process, result:>, k);
end else
error (out, <:syntax, param no:>, j);
end <*device*>;
\f
<* movedump maintenance program page 4
1981 08 21 *>
message movedump page 4;
begin <*first*>
j := j + 1;
k := system (4, j, param);
if k = 8 shift 12 add 4 <*number*> then
first_segment := round (param (1)) else
error (out, <:syntax, param no:>, j);
end <*first*>;
begin <*segments*>
j := j + 1;
k := system (4, j, param);
if k = 8 shift 12 add 4 <*number*> then
maxblock := round ( param (1)) else
error (out, <:syntax, param no:>, j);
end <*segments*>;
end <*case s*>;
end <* space name*> else
if k <> 0 <*parameter not space name*> then
error (out, <:syntax, param no:>, j);
until k = 0; <*end simple command*>
\f
<* movedump maintenance program page 5
1984 10 08 *>
message movedump page 5;
if -,device_specified then
begin <*find autoload disc*>
system (5) move core :( 64, ia); <*monitor release < 12 + subrelease*>
mon_rel := ia (1) shift (-12);
if monrel >= 9 then
begin <*ext proc descr augmented wit user bit array*>
system (5) move core :( 78, ia); <*first internal in nametable*>
system (5) move core :(ia (1), ia); <*proc descr address *>
system (5) move core :(ia (1), ia); <*proc descr *>
<*left half of (proc descr addr + 12) is rel offset in user bit array*>
<*for procfunc = size of user bit array *>
offset := ia (7) shift (-12) - 4096 - 16;
<*offset in proc descr of main proc to find device number*>
end else
offset := -20; <*fixed offset*>
system (5) movecore :( 74, ia );
<* ia (1) := first device in name table *>
<* ia (2) := first area in name table *>
begin <* block for nametable *>
integer array nametable ( 0 : ((ia (2) - ia (1))//2 - 1) ),
physical ( 1 : 1) ;
integer dev, maxdev;
integer array field iaf;
iaf := -2;
system (5) movecore :( ia (1), nametable.iaf) ;
maxdev := ( ia (2) - ia (1) )//2 - 1; <*no of devices in nametable*>
for dev := 0 step 1 until maxdev do
begin
<* search disc descriptions for a disc with kind = 62, first *>
<* segment = 0, main proc <> 0 (physical disc) and device no *>
<* of main = 4 *>
<* or a disc with kind = 6 (ida physical disc), first seg- *>
<* ment = 0, main proc <> 0 and device no of main = 4 (ida *>
<* main) *>
<* if ida main then take the main *>
system (5) movecore :( nametable (dev), discdescr.iaf);
<* get next disc description *>
if (discdescr ( 0) = 62 <*kind = disc *>
or discdescr ( 0) = 6) <*kind = ida physical disc*>
and discdescr (14) = 0 <*first segment*>
and discdescr ( 5) <> 0 <*main process *> then
begin <* check device number of main *>
system (5) movecore :( discdescr (5) + offset, physical );
<* get physical disc description *>
if physical (1) extract 12 = 4 shift 3 then
begin <*main devno = 4*>
if discdescr ( 0) = 6 <*ida disc*> then
system (5) move core :(discdescr (5), discdescr.iaf);
goto found;
end <*main devno = 4*>;
end <*check device number*> ;
end <*search disc descriptions*> ;
<*autoload device could not be found*>
error (out, <:please specify autoload device:>, -1);
\f
<*movedump maintenance program page 6
1984 10 08 *>
message movedump page 6;
found:
open (iozones (1), 6, discdescr.laf, 0);
if discdescr (1) = 0 <*name (1) = 0*> then
begin <*create peripheral process*>
k := monitor (54, iozones (1), dev, dummy);
if k <> 0 then
error (out, <:create peripheral process, result:>, k);
end;
end <* block for nametable*> ;
end <*find autoload disc*> ;
<* justify maxblock *>
if discdescr (0) = 20 <*ida main*> then
begin
first_segment := 0;
maxblock := 8388607;
end else
begin <*autoload disc*>
k := monitor (4)process descr addr :(iozones (1), 1, dummy);
if k = 0 then
error (out, <:peripheral process does not exist:>, -1);
system (5) movecore :( k, discdescr.iaf);
if maxblock > discdescr (15) - first_segment then
maxblock := discdescr (15) - first_segment;
<*from first segment to no of segments at most*>
end <*autoload disc*>;
<*check outfile*>
k := monitor (42, iozones (2), 0, ia);
if k <> 0 then
begin <*entry does not exist*>
ia (1) := if discdescr (0) = 20 <*ida main*> then 500 else maxblock;
ia (2) := 1; <*preferrably disc*>
for i := 3 step 1 until 10 do ia (i) := 0;
ia (6) := systime (7, 0, 0.0);
k := monitor (40) create entry :( iozones (2), 0, ia);
if k <> 0 then
error (out, <:create entry outfile, result:>, k);
end <*entry did not exist*> ;
\f
<* movedump maintenance program page 7
1984 10 08 *>
message movedump page 7;
<*position infile*>
setposition (iozones (1), 0, first_segment);
if discdescr (0) = 20 <*ida main*> then
begin <*send the move operation and check it*>
integer array shdescr (1:12), answer (1:8), dummy (1:1);
integer status;
k := monitor (8) reserve process :(iozones (1), 0, dummy);
if k > 0 then
error (out, <:reserve process, result:>, k);
getshare6 (iozones (1), shdescr, 1);
shdescr (4) := 8 shift 12; <*move op, mode*>
shdescr (5) :=
shdescr (6) :=
shdescr (7) := 0;
setshare6 (iozones (1), shdescr, 1);
monitor (16) send message :(iozones (1), 1, dummy);
status := 1 shift
monitor (18) wait answer :(iozones (1), 1, answer);
if status <> 1 shift 1 then
begin <*maybe remove the process and give up*>
if process_created then
monitor (64) remove process :(iozones (1), 1, dummy);
stderror (iozones (1), status, 0);
end;
end <*send the move oparation and check it*>;
\f
<* movedump maintenance program page 8
1984 10 08 *>
message movedump page 8;
<*transfer segments*>
openinout (iozones, 1); <*zone 1 as input*>
blocks := 0;
repeat
hwds := inoutrec (iozones, 0);
if hwds > 2 then
begin
changerecio (iozones, hwds);
blocks := blocks + 1;
end;
until
hwds = 2 <*end of doc *>
or blocks >= maxblock <*segs enough*>;
closeinout (iozones);
close (iozones (2), true);
close (iozones (1), true);
monitor (42) lookup entry tail :(iozones (2), 0, ia);
ia (1) := blocks;
ia (6) := systime (7, 0, 0.0); <*shortclock*>
for i := 7 step 1 until 10 do
ia (i) := 0;
monitor (44) change entry tail :(iozones (2), 0, ia);
stop:
if process_created then
monitor (64) remove process :(iozones (1), 1, dummy);
end;
▶EOF◀