|
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: 27648 (0x6c00)
Types: TextFile
Names: »n «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »n «
begin
integer length, segmentnr, basis, antal, i, trin,
nextadress,j, slicelength, testslicenr, adresse, count,
catsize, fundetslice, slice, lastdisc, list, stop, max,
result, sepleng, paramno, first_param;
long testsegment, firstsegment, lastslice, antalsegments,
topsegment;
integer array tabel (1:2), ia (0:10);
integer array field iff;
real array param, kommando1, kommando2, navn, catname, docname,
entryname (1:2), chain (1:10, 1:50);
long array progname, chainname, outfile (1:2);
zone z(128,1,stderror);
boolean ok, fundetdisc, segm_param;
integer
procedure stack_current_output (file_name);
long array file_name ;
begin
integer result ;
result := 1 shift 2; <*1<2 <=> 1 segment, temporary*>
fp_proc (29, 0, out, chain_name); <*stack c o*>
fp_proc (28, result, out, file__name); <*connect *>
if result <> 0 then
fp_proc (30, 0, out, chain_name); <*unstack *>
stack_current_output := result;
end stack_current_output;
procedure unstack_current_output ;
begin
fp_proc (34, 0, out, 25); <*close up*>
fp_proc (79, 0, out, 0); <*terminate*>
fp_proc (30, 0, out, chain_name); <*unstack *>
end unstack_current_output;
procedure error (errorno);
value errorno ;
integer errorno ;
begin
write (out,
"nl", 1, <:***:>, progname,
"sp", 1, case errorno of (
<:call:>,
<:syntax:>,
<:illegal device number:>,
<:segment is not found on the specified physical disc:>),
<:negative segment number:>);
if errorno = 1 then
write (out,
"nl", 1,
<:call :
*
(<outfile> =) disctell (<param>)
1
<param> = physical / disc
describes the physical disc drivers included
in the monitor
<param> = <physical disc no>
describes the logical discs located on the
physical disc specified
*
<param> = <physical disc no>(.<segment no>)
0
describes the location on the logical disc and the
possible area where the segment specified belongs
:>, "nl", 1);
errorbits := 3;
end procedure error;
iff := -2;
ok := fundetdisc := false;
for i:=1 step 1 until 10 do
for antal:=1 step 1 until 50 do chain(i,antal):=0;
antal:=0;
kommando1(1):=kommando1(2):=0;
kommando2(1):=kommando2(2):=0;
system(5, 74,tabel);
comment device tabel start;
length:=tabel(2)-tabel(1);
trapmode := 1 shift 10; <*no end alarm written*>
system (4, 0, out_file);
sepleng :=
system (4, 1, progname);
if sepleng shift (-12) <> 6 <*=*> then
begin <*noleft side, progname is param after programname*>
for i := 1, 2 do
begin
prog_name (i) := out_file (i);
out__file (i) := long <::> ;
param_no := 1 ;
end;
end <*no left side*> else
param_no := 2;
if out_file (1) <> long <::> then
begin <*stack current out and connect*>
result := stack_current_output (out_file);
if result <> 0 then
begin
write (out, "nl", 1, <:***:>, progname, "sp", 1, <:connect :>, outfile,
"sp", 1, case result of (
<:no resources:>,
<:malfunction:>,
<:not user, not exist:>,
<:convention error:>,
<:not allowed:>,
<:name format error:> ));
out_file (1) := long <::>;
end;
end <*stack current out and connect*>;
first_param := param_no;
for sepleng := system (4, increase (paramno), kommando1)
while sepleng = 4 shift 12 + 10
or sepleng = 4 shift 12 + 4 do
begin <*parameter accepted*>
if -, (sepleng = 4 shift 12 + 10 and
(kommando1 (1) = real <:disc:>
or kommando1 (1) = real <:physi:> add 'c')
or sepleng = 4 shift 12 + 4 ) then
begin <*param is neither 'disc', 'physic', nor device no*>
error (2); <*syntax*>
goto udhop;
end <* param is neither 'disc', 'physical' nor device no*>;
if kommando1 (1) <> real <:disc:> and
kommando1 (1) <> real <:physi:> add 'c' and
(kommando1 (1) < 0
or kommando1 (1) > length ) then
begin
error (3); <*illegal device number*>
goto udhop;
end;
begin <*second block*>
integer array devicetabel(1:length), chainint(0:2070),
slicelist(0:2048), main (0:0);
long array contents(0:20), chaintable(0:525);
integer array field iff;
long array field name, laf;
name := iff := -2; <*fields name in disc descr*>
laf := -4;
system(5,tabel(1), devicetabel);
if kommando1 (1) = real <:disc:>
or kommando1 (1) = real <:physi:> add 'c' then
begin
for i:=1 step 1 until length do
begin
system(5, devicetabel(i), contents.laf);
if contents (0) shift (-24) extract 24 = 6 <*ida*> then
system (5, contents (2) extract 24, main.iff); <*get main kind*>
if contents (0) shift (-24) extract 24 = 62 <*not ida disc*> and
contents (2) extract 24 = 0 <*physical disc*>
or contents (0) shift (-24) extract 24 = 6 <*ida disc*> and
main (0) = 20 <*physivcal disc*> then
begin
write(out, <:physical disc : device no. :>,
<<ddd>, i-1,
<: kind : :>, <<dd>, contents (0) shift (-24) extract 24,
<: :>, true, 12, contents.name,
<:process descr. addr. :>,
<<ddddd>, devicetabel(i), false add 10,1);
end;
end;
end <*kommando1 (1) = real <:disc:> or = real <:physical:>*>;
if kommando1 (1) <> real <:disc:> and
kommando1 (1) <> real <:physi:> add 'c' then
begin <*param = disc no*>
system(5, devicetabel(kommando1(1)+1), contents.laf);
if contents (0) shift (-24) extract 24 = 6 <*ida disc*> then
system (5, contents (2) extract 24, main.iff); <*get main*>
if contents (0) shift (-24) extract 24 = 62 <*not ida disc*> and
contents (2) extract 24 = 0 <*physical disc*>
or contents (0) shift (-24) extract 24 = 6 <*ida disc*> and
main (0) = 20 <*physical disc*> then
ok := true;
if -,ok then
begin
write (out, "nl", 1, <:***:>, progname,
<: device is not a physical disc<10>:>);
errorbits := 3;
end else
begin <*physical disc*>
write (out, "nl", 1);
basis:=devicetabel(kommando1(1)+1);
for i:=1 step 1 until length do
begin <*for i := 1 until length*>
system(5, devicetabel(i), contents.laf);
if (contents (0) shift (-24) extract 24 = 62 <*not ida*>
or contents (0) shift (-24) extract 24 = 6 <* ida*>) and
contents (2) extract 24 = basis then
begin
antal:=antal+1;
navn(1):=navn(2):=0.0;
navn(1):=
(navn(1) shift (-24) add contents(0) extract 24);
navn(1):=navn(1) shift (-24) shift 24;
navn(1):=
navn(1) add (contents(1) shift (-24) extract 24);
navn(2):=
(navn(2) shift (-24) add contents(1) extract 24);
navn(2):=navn(2) shift (-24) shift 24;
navn(2):=
navn(2) add (contents(2) shift (-24) extract 24);
if system (4, paramno, param) <> 8 shift 12 + 4 then
begin <*no segm parameter next*>
j:=1;
write(out, false add 32,35-
write (out, <:logical disc : device no. :>,
<<ddd>, i-1,
<: kind : :>, <<dd>, contents (0) shift (-24) extract 24,
<: :>, true, 12, contents.name));
write(out,
<<ddddd>, <:process descr. addr. :>,
devicetabel(i),
false add 10,1);
end <*no segm parameter next*>;
chain(antal,1):=i-1;
comment device nummer;
chain(antal,2):=contents(6) shift (-24) extract 24;
comment chaintable addr;
chain(antal,3):=navn(1);
chain(antal,4):=navn(2);
chain(antal,5):=0;
chain(antal,6):=0;
comment navn paa device;
chain(antal,7):=contents(7) shift (-24) extract 24;
comment first segment;
chain(antal,8):=if chain(antal,7)=0 then 0 else 1;
comment hvis første segment er 0
er det en speciel disc uden chaintable;
chain(antal,9):=devicetabel(i);
comment proc.besk.adr;
chain(antal,10):=contents(7) extract 24;
comment size af systemdisc;
end;
lastdisc:=antal;
end <*for i := 1 until length*>;
while system (4, increase (paramno), param) = 8 shift 12 + 4 do
if param (1) < 0 then
begin
error (5);
goto udhop;
end else
begin <*segment number*>
kommando2 (1) := param (1);
<*segment no*>
topsegment:=8388605;
comment beregning af fysisk segmentnummer;
testsegment:=kommando2(1);
for antal:=1 step 1 until lastdisc do
begin
basis:=chain(antal,2)-36;
firstsegment:=chain(antal,7);
if firstsegment=0 and testsegment<=
chain(antal,10) then goto systemdisc;
if firstsegment > testsegment then
begin
if chain(antal,8)=0 then goto systemdisc else
goto nextdisc;
end;
if basis>0 then
begin
system(5,basis,chaintable.laf);
slicelength:=
chaintable(7) shift (-24) extract 24;
lastslice:=chaintable(7) shift (-12) extract 12;
antalsegments:=slicelength * (lastslice + 1);
topsegment:=firstsegment + antalsegments;
if topsegment < testsegment then goto nextdisc;
comment
fundet : ;
fundetdisc:=true;
catname(1):=catname(2):=0.0;
catname(1):=catname(1) shift (-24)
add (chaintable(2) shift (-24) extract 24)
shift 24 add (chaintable(2) extract 24);
catname(2):=catname(2) shift (-24)
add (chaintable(3) shift (-24) extract 24)
shift 24 add (chaintable(3) extract 24);
catsize:=chaintable(4) shift (-24) extract 24;
docname(1):=docname(2):=0.0;
docname(1):=(docname(1) shift (-24)
add chaintable(4) extract 24);
docname(1):=docname(1) shift (-24) shift 24;
docname(1):=docname(1)
add (chaintable(5) shift (-24) extract 24);
docname(2):=docname(2) shift (-24)
add chaintable(5) extract 24;
docname(2):=docname(2) shift (-24) shift 24;
docname(2):=docname(2)
add (chaintable(6) shift (-24) extract 24);
testslicenr:=
((testsegment-1)-firstsegment)//slicelength;
if testslicenr > lastslice then goto nextdisc;
comment plads i chaintable;
adresse:=chaintable(testslicenr//4 + 9)
shift (case testslicenr mod 4 + 1 of (
-36, -24, -12, 0)) extract 12;
j:=1;
write(out, "nl", 2, <:segment no. :>,
<<dddddd>, testsegment, <: is located on :>,
<:device :>, <<ddd>, chain(antal,1),
<: :>,string docname(increase(j)),
false add 10,1,
false add 32,29,
<<d>, <: on logical slice no. :>,
testslicenr, "nl", 1);
fundetslice:=testslicenr;
if adresse= 2048 then goto ledig;
count:=0;
for i:=9 step 1 until 525 do
begin
for j:=(-36) step 12 until 0 do
begin
chainint(count):=chaintable(i)
shift j extract 12;
count:=count+1;
end;
end;
if adresse <> 0 then
begin
comment vi har nu fat i et optaget areal,
men ved ikke fra hvor og hvortil;
findlast:
adresse:=chainint(testslicenr);
if adresse>2048 then
adresse:=-(4096-adresse);
nextadress:=chainint(testslicenr+adresse);
testslicenr:=testslicenr + adresse;
if nextadress <> 0 then
begin
adresse:=nextadress;
goto findlast;
end;
end;
slicelist(0):=testslicenr;
comment sidste slice (som er 0) er fundet : ;
comment nu skal vi finde første slice,
og samtidig lave en sliceliste;
list:=0;
stop:=0;
tryagain:
trin:=-1;
if list<stop then goto fundet;
for i:=testslicenr step (-1) until 0 do
begin
trin:=trin+1;
if trin<>0 then
begin
if trin=chainint(i) then
begin
testslicenr:=i;
stop:=list;
list:=list+1;
slicelist(list):=testslicenr;
goto fundet;
end;
end;
stop:=stop+1;
end;
comment den søgte slice ligger senere
end den foregående (baglæns nummering);
max:=2048-testslicenr;
trin:=-1;
for i:=testslicenr step 1 until max do
begin
trin:=trin+1;
if trin <>0 then
begin
if trin=4096-chainint(i) then
begin
testslicenr:=i;
stop:=list;
list:=list+1;
slicelist(list):=testslicenr;
goto fundet;
end;
end;
stop:=stop+1;
end;
fundet:
if stop>list then
begin
comment nu har vi fundet first slice;
comment catalog opslag ;
close (z, true);
open (z, 4, catname, 0);
setposition(z,0,0);
for i:=1 step 1 until catsize*15 do
begin
inrec6(z,34);
if z(1) shift (-36) extract 12 =
testslicenr then
begin
entryname(1):=entryname(2):=0.0;
entryname(1):=entryname(1) shift (-24)
add (z(2) extract 24) shift 24;
entryname(1):=
entryname(1) shift (-24) shift 24;
entryname(1):= entryname(1)
add (z(3) shift (-24) extract 24);
entryname(2):=entryname(2) shift (-24)
add (z(3) extract 24) shift 24;
entryname(2):=
entryname(2) shift (-24) shift 24;
entryname(2):=entryname(2)
add (z(4) shift (-24) extract 24);
comment beregning af logisk segment-
nummer indenfor arealet;
segmentnr:=testsegment -
(slicelength*fundetslice) -
chain(antal,7);
count:=0;
for i:=list step (-1) until 0 do
begin
count:=count+1;
if slicelist(i)=fundetslice
then slice:=count;
end;
j:=1;
write(out, <:<10><10>entryname :>,
string entryname(increase(j)),
<:<10>size :>, <<d>, z(4) extract 24,
<:<10>bases :>,
z(1) extract 24, <: :>,
z(2) shift (-24) extract 24,
<:<10>namekey :>,
z(1) shift (-27) extract 9, <: on :>);
j:=1;
write(out, <<d>, string catname(increase(j)),
<:<10>permkey :>,
z(1) shift (-24) extract 3,
<:<10>slicelength :>, slicelength,
<:<10>slicelist<10>:>);
count:=0;
for i:=list step (-1) until 0 do
begin
write(out, <<dddddddd>, slicelist(i));
count:=count+1;
if count mod 8 = 0 then
write(out, false add 10,1);
end;
write(out, false add 10,1,
<:number of slices :>,
<<d>, false add 32,4, count,
false add 10,1,
<:the segment is :>,
if (slice-1)*slicelength+segmentnr>
z(4) extract 24
then <:out:> else <: in:>, <:side the area:>,
<: (segment no. :>, (slice-1)*slicelength+segmentnr,
<: of the area<10>:>,
false add 32,34,
<:segment no. :>, segmentnr, <: of the slice):>,
false add 10,1);
goto udhop1;
end;
end;
if i = catsize * 15 + 1 then
begin
close (z, true);
open (z, 4, <:catalog:>, 0);
setposition(z,0,0);
monitor(42,z,1,ia.iff);
for i:=0 step 1 until ia(0)*15-1 do
begin
inrec6(z,34);
if z(1) shift (-36) extract 12 =
testslicenr
and z(5) shift (-24) extract 24 =
chaintable(4) extract 24
and z(5) extract 24=
chaintable(5) shift (-24) extract 24
and z(6) shift (-24) extract 24 =
chaintable(5) extract 24
and z(6) extract 24=
chaintable(6) shift (-24) extract 24
then
begin
entryname(1):=entryname(2):=0.0;
entryname(1):=
entryname(1) shift (-24)
add (z(2) extract 24) shift 24;
entryname(1):=
entryname(1) shift (-24) shift 24;
entryname(1):=entryname(1)
add (z(3) shift (-24) extract 24);
entryname(2):=
entryname(2) shift (-24)
add (z(3) extract 24) shift 24;
entryname(2):=
entryname(2) shift (-24) shift 24;
entryname(2):=entryname(2)
add (z(4) shift (-24) extract 24);
count:=0;
for i:=list step (-1) until 0 do
begin
count:=count+1;
if slicelist(i)=fundetslice then
slice:=count;
end;
j:=1;
segmentnr:=testsegment -
(slicelength*fundetslice) -
chain(antal,7);
write(out, <:<10><10>entryname :>,
string entryname(increase(j)),
<:<10>size :>, <<d>,
z(4) extract 24, <:<10>bases :>,
z(1) extract 24,
<: :>, z(2) shift (-24) extract 24,
<:<10>namekey :>,
z(1) shift (-27) extract 9,
<: on :>);
j:=1;
write(out, <<d>, <:catalog:>,
<:<10>permkey :>,
z(1) shift (-24) extract 3,
<:<10>slicelength :>, slicelength,
<:<10>slicelist<10>:>);
count:=0;
for i:=list step (-1) until 0 do
begin
write(out, <<dddddddd>, slicelist(i));
count:=count+1;
if count mod 8 = 0 then
write(out, false add 10,1);
end;
write(out, false add 10,1,
<:number of slices :>, <<d>,
false add 32,4, count, false add 10,1,
<:the segment is :>,
if (slice-1)*slicelength+segmentnr>
z(4) extract 24 then <:out:> else <: in:>,
<:side the area<10>:>);
goto udhop1;
end;
end;
end;
goto udhop1;
end
else
begin
goto tryagain;
end;
ledig:
write(out,
<:<10>slice :>, testslicenr,
<: is free<10>:>);
goto udhop1;
end;
nextdisc:
end;
if kommando2(1)>topsegment then
begin
error (4);
goto udhop1;
end;
if -,fundetdisc then
begin
antal:=antal-1;
if chain(antal,8)=0 then
begin
systemdisc:
j:=3;
write(out,
<:<10>disc reserved for system purpose: :>,
<<ddddddddd>,
string chain(antal,increase(j)),
false add 10,1, <:device number :>,
false add 32,16, chain(antal,1),
false add 10,1,<:process descr. addr. :>,
false add 32,9,
chain(antal,9), false add 10,1,
<:segment number :>, testsegment,
<: of :>, chain(antal,10), false add 10,1);
goto udhop1;
end;
write(out, <:please turn on the discdrive !<10>:>);
end;
udhop1:
end <*while segment no*>;
paramno := paramno - 1;
end <*physical disc*>;
end <*param = disc no*>;
end <*second block*>;
end <*parameter accepted*>;
if paramno = first_param + 1 then
error (1);
udhop:
close(z,true);
trapmode:=1 shift 10;
if outfile (1) <> long <::> then
unstack_current_output;
end
▶EOF◀