|
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: 9216 (0x2400)
Types: TextFile
Names: »discinfo4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »discinfo4tx «
(discinfo = algol connect.no
end)
begin
<* initboot fra rc8000, tilrettet rc9000
_ discinfo 890224/pon *>
boolean change_disc, change_dev_no, lookupkit;
integer autodesc, i, j, k, p, process_addr,
_ newline_separator, space_separator, point_separator,
_ integer_kind, name_kind, device_no, l_disc, test,
_ max_discs, dev_no_idx;
integer array dummy(1:1), process_description(1 : 6),
dev_no(1 : 256), discdesc(1:256);
integer array field iaf;
real array discname, arr, paramname(1:2);
zone discfile(128,1,stderror);
procedure syntax(no);
integer no ;
begin
write(out,"nl",1, <:***discinfo syntax, param no:>,<<ddd>,no,
_ "nl",2, <:discinfo <discname> (lookupkit/discs/disc/chdevno):>,
_ "nl",1, <: * lookupkit /:>,
_ "nl",1, <: discs.<no of log. discs> /:>,
_ "nl",1, <: disc.<discno>.<1.segm>.<no of segm>.<type>.<log. devno> /:>,
_ "nl",1, <: chdevno.<old devno>.<new devno>:>,
_ "nl",2 );
goto stop;
end;
procedure monitor_error(text,no);
integer text,no ;
begin
write(out,<:<10>***discinfo :>);
if text = 1 then
write(out,<:create, :>, case no of (
<:function forbidden in calling process:>,
<:calling proc not user; catalog i/o error:>,
<:name conflict:>,
<:device no does not exist:>,
<:device is reserved by another user:>,
<:name format illegal:>),<:<10>:>)
else
write(out,<:reserve, :>, case no of (
<:reserved by another process:>,
<:calling proc not user; proc cannot be reserved:>,
<:process does not exist:>),<:<10>:>);
goto stop;
end;
procedure print_discinfo (d);
integer array d;
begin
if test > 255 then test := 255
else
test := ((test + 3) // 4) * 4 - 1;
for i := 0 step 4 until test do
begin
write (out, "nl",1, <<ddd>, i * 2);
for j := 1 step 1 until 4 do
write (out, <<ddddd>, d.iaf(i+j) shift (-12) extract 12,
_ d.iaf(i+j) extract 12,
_ <<-dddddddd>, d.iaf(i+j) );
if d.iaf (i + 4) = -1 then i := test;
end;
end;
trapmode := 1 shift 10;
newline_separator := 2;
space_separator := 4;
point_separator := 8;
integer_kind := 4;
name_kind := 10;
deviceno := -1;
lookupkit := true;
change_dev_no := false;
test := 0;
l_disc := 6; <* length of a logical disc description *>
iaf := 0;
maxdiscs := 7000;
dev_no(1) := -1;
dev_no_idx := -1;
discdesc(1) := 0;
for i:= 2 step 1 until 256 do
begin
dev_no(i) := discdesc(i):= -1;
end;
<********** check <discname> **********>
k:= system(4, 1, discname);
if k extract 12 <> name_kind then
syntax (1);
<********** check <params> **********>
p := 2; <* parameter no of next param *>
for k:= system(4,p,paramname) while k <> 0 do
begin
if k <> space_separator shift 12 add name_kind
then syntax(p);
p:= p + 1; k:= system(4,p,arr);
if paramname(1) = real <:test:> then
test := arr(1)
else
if paramname(1) shift (-16) shift 16 = real <:look:> then
lookupkit:= true
else
if paramname(1) = real<:discs:> then <* discs.<no of log. discs> *>
maxdiscs:= arr(1)
else
if paramname(1) = real<:disc:> then
begin <* disc.<discno>.<1.segm>.<no of segm>.<type>.<log. devno> *>
change_disc := true;
if change_dev_no then syntax(p);
if k <> point_separator shift 12 add integer_kind then syntax(p);
i:= arr(1);
if i > discdesc(1) then discdesc(1):= i;
for j:= 0 step 1 until 3 do
begin
k:= system(4,p+1,arr);
if k <> point_separator shift 12 add integer_kind then syntax(p+1);
if j=3 then
discdesc(i*3+1):= discdesc(i*3+1) shift 12 + arr(1)
else
discdesc(i*3+j-1):= arr(1);
p:= p+1;
end;
end else
if paramname(1) shift (-24) shift 24 = real <:chd:> then
begin <* chdevno.<old devno>.<new devno> *>
change_dev_no := lookupkit := true;
if change_disc then syntax(p);
if k <> point_separator shift 12 add integer_kind then syntax(p);
dev_no_idx := dev_no_idx + 2;
dev_no (dev_no_idx) := arr(1);
k := system (4, p+1, arr);
if k <> point_separator shift 12 add integer_kind then syntax(p+1);
dev_no (dev_no_idx + 1) := arr(1);
p := p + 1;
end else
syntax (p); <* not found *>
p:= p + 1;
end;
<********** open discfile, create and reserve discprocess **********>
trap (error);
i:= 1;
open(discfile, 0, string discname(increase(i)),0);
process_addr := monitor(4)process_description:(discfile, 0, dummy);
i:= monitor(8)reserve_process:(discfile,0,dummy);
if i <> 0 then monitor_error(2,i);
<* check if discprocess*>
system(5)copy core:(process_addr, process_description);
if process_description(1) = 6 then
begin
setposition(discfile,0,0);
inrec6(discfile,512);
if test > 0 then
print_discinfo (discfile.iaf);
i:= discfile.iaf(1)*2+1;
autodesc := discfile.iaf(1);
if maxdiscs <= discfile.iaf(i+1) extract 12 then discdesc(1):= maxdiscs
else if discfile.iaf(i+1) extract 12 > discdesc(1) then
discdesc(1):=discfile.iaf(i+1) extract 12;
discdesc(1):= discdesc(1) + l_disc shift 12;
j:= (discfile.iaf(i+1) extract 12) * (l_disc/2);
i:= i+1;
for k:= 1 step 1 until j do
if discdesc(k+1)=-1 then
discdesc(k+1):= discfile.iaf(k+i);
setposition(discfile,0,0);
end else
begin
i := 1;
write (out, <:<10>***discinfo, :>, string discname(increase(i)),
_ <:, not an disc:>, "nl",1,
_ <: kind =:>, process_description(1) );
if test > 0 then
for i := 1 step 1 until 6 do
write (out, "nl",1, <<ddddddddd>, process_description (i) );
goto stop;
end;
if change_disc or change_dev_no then
begin
i:= autodesc * 2 + 2;
j:= (discdesc(1) extract 12) * (l_disc/2);
if i+j > 256 then
write(out,<:<10>***discinfo descriptor segment too big:>)
else
begin
setposition(discfile,0,0);
outrec6(discfile,512);
if change_dev_no then
begin
boolean not_found;
integer i;
for i := 1 step 2 until dev_no_idx do
begin
not_found := true;
for k := 2 step 3 until j+1 do
if dev_no(i) = discdesc(k+2) extract 12 then
begin <* log. device number found *>
boolean dev_no_used;
integer x;
<* undersøg om nyt devno er i brug *>
dev_no_used := not_found := false;
for x := 2 step 3 until j+1 do
if dev_no(i+1) = discdesc (x+2) extract 12 then
dev_no_used := true;
if -,dev_no_used then
begin <* indsæt nyt devno *>
discdesc(k+2) := discdesc(k+2) shift (-12) shift 12 + dev_no (i+1);
write (out, <:<10>logical devno changed from:>, dev_no (i),
<: to:>, dev_no(i+1) );
dev_no(i) := dev_no(i+1) := 0;
end else
_ write (out, <:<10>*** new logical devno :>, dev_no(i+1),
_ <: in use:>);
end for k;
if not_found then
write (out, <:<10>*** logical devno :>, dev_no(i), <: not found:>);
end for i;
end;
<* flyt discbeskriv tilbage *>
for k:= 1 step 1 until j+1 do
discfile.iaf (i+k-1) := discdesc (k);
if test > 0 then
print_discinfo (discdesc);
end;
end;
if lookupkit then
begin
j := 1;
i := discdesc(1) extract 12;
write(out, "nl",2, <:lookupkit, disc: :>, string discname(increase(j)),
"nl",1, <:no of logical discs:>, <<ddd>,i,
"nl",2, <:discno:>, "sp",11,
<:1st segm no of segms type devno:>, "nl",1 );
for j:= 1 step 1 until i do
write(out, <<dddd>, j, "sp",10, <:: :>, <<dddddddd>, discdesc(j*3-1),
"sp",5, discdesc(j*3),
<<dddd>, "sp",5, discdesc(j*3+1) shift (-12),
"sp",5, discdesc(j*3+1) extract 12, "nl",1 );
end;
error: <* trap label *>
close (discfile, false);
monitor (10)release process:(discfile, 0, dummy);
stop:
end
▶EOF◀