|
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: »claimproctx«, »claimproctx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »claimproctx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦592c22808⟧ »proctxpack «
└─⟦c7b1c7cfc⟧
└─⟦this⟧ »claimproctx«
; claim proc mon9 vers * page 1 25 03 83, 12.60;
if listing.yes
char 10 12 10
claimproc=set 1 0
claimproc=algol
external boolean
procedure claimproc(key, disc_no, disc_name, entr, segm, slicel);
value key;
integer key, disc_no, entr, segm, slicel;
long array disc_name;
<*****************************************************************>
<* *>
<* The procedure returns the backingstorage claim of own pro- *>
<* cess on a given disc for a given key together with the name *>
<* of the disc and the slicelength. *>
<* NB: GI-version: if call value of disc_no = -1 then corre- *>
<* sponding disc_name is returned. *>
<* *>
<* Call: *>
<* *>
<* claimproc (return value, boolean). *>
<* True if -1 <= disc_no <= number of last disc *>
<* and 0 <= key <= max_perm_key, *>
<* false otherwise. *>
<* If the return value is false, all other return *>
<* parameters are returned zero. *>
<* *>
<* key (call value, integer) *>
<* The permanemt key, meaning: *>
<* 0 = temp *>
<* 1 = temp special *>
<* 2 = login *>
<* 3 = permanent *>
<* *>
<* disc_no (call and return value, integer). *>
<* The number of the disc/drum among all discs *>
<* numbered from 1 to number of last disc/drum. *>
<* The number 0 means the disc containing the *>
<* main catalog and the number of this disc will *>
<* be returned. *>
<* The number -1 means return disc_no correspon- *>
<* ding to disc_name. *>
<* *>
<* disc_name (call and return value, long array). *>
<* if disc_no = -1 then discname is looked up in *>
<* nametable. if disc_no >= 0 the *>
<* document name of the disc/drum specified *>
<* is returned in name(1:2). *>
<* *>
<* entr (return value, integer). *>
<* The entry claim of own process for the given *>
<* key on the disc/drum specified. *>
<* *>
<* segm (return value, integer). *>
<* The segment claim of own process for the given *>
<* key on the disc/drum specified. *>
<* *>
<* slicel (return value, integer). *>
<* The slicelength for the disc/drum specified. *>
<* *>
<*****************************************************************>
\f
<* claim proc mon9 vers * page 2 25 03 83, 12.60
0 1 2 3 4 5 6 7 8 9 *>
begin
own
boolean before;
own
integer no_of_discs, first_disc, main_disc,
_ ownaddr, mon_rel;
integer array core (1: 4),
_ chainhead (1:18),
_ claimlist (1: 8);
long array own_name (1: 2);
long array field doc_name;
claimproc:= false;
entr:= segm:= slicel:= 0;
if disc_no >= 0 then
disc_name(1):= disc_name(2):= long <::>;
if -, before then
begin <* first execution *>
before:= true;
system(5) move core :(92, core); <* chain part of nametab*>
no_of_discs:= (core(3)-core(1))//2 + 1;
first_disc:= core(1); <*name table addr for first disc*>
main__disc:= core(4); <* chaintab addr for maincat disc*>
own_addr:= system(6) oun process :(1, own_name <*dummy*>);
system(5)move core :(64, core);
mon_rel:= core(1) shift (-12); <* monitor release *>
end;
\f
<* claim proc mon9 vers * page 3 25 03 83, 12.60
0 1 2 3 4 5 6 7 8 9 *>
begin <*block for name table *>
integer array name_table(1:no_of_discs);
if -1 <= disc_no and disc_no <= no_of_discs and
_ 0 <= key and key <= 3 then
begin <* legal parameters *>
integer i;
doc_name:= 18;
system(5) move core :(first_disc, name_table);
if disc_no = 0 then
repeat <* find disc_no of maincat disc *>
_ disc_no:= disc_no+1;
until nametable(disc_no)=main_disc;
i:= if disc_no < 0 then 1 else disc_no;
repeat
begin
system(5, nametable(i)-36, chainhead);
if disc_name(1) = chainhead.doc_name(1) and
_ (disc_name(2) = chainhead.doc_name(2) or
_ disc_name(1) extract 8 = 0 <*short name*>) then
_ disc_no := i;
i := i + 1;
end
until i > no_of_discs or disc_no >= 1;
if chainhead(10)<>0 and i <= no_of_discs then
begin <*non-empty*>
claimproc:= true;
disc_name(1):= chainhead.docname(1);
disc_name(2):= chainhead.docname(2);
slicel:= chainhead(15);
system(5) move core :(own_addr+chainhead(1),
_ claimlist );
if mon_rel <= 8 then
begin <* claims in halfwords *>
entr:= claimlist(key+1) shift(-12) ;
segm:= claimlist(key+1) extract 12 * slicel;
end
else
begin <* claims in words *>
entr:= claimlist(2*key + 1);
segm:= claimlist(2*key + 2)*slicel;
end;
end <*non-empty*>;
end <*legal parameters*>;
end <*block for nametable *>;
end <*procedure body*>;
end;
if warning.yes
mode ok.no
if ok.no
(mode 0.yes
message claimproc not ok
lookup claimproc
end)
end
scope login claimproc
lookup claimproc
finis
▶EOF◀