|
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: 16128 (0x3f00)
Types: TextFile
Names: »insexttext «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »insexttext «
mode list.yes
insextlists=algol connect.no survey.yes
begin
<* dh 86.09.29, inspectinggexternal lists, page ...00... *>
comment short description (better than no manual at all).
-----------------
abstracts: searches parts of the catalog for external procedures and
---------- inspects their external lists according to a list of procedure
specifications to fins the ones which may have been changed by
the faulty release of updextlists.
call:
-----
( )1 ( )1( )*
(<output file> =) insextlists (scope.<scope spec.>) (<proc. spec.>)
( )0 ( )0( )1
<output file> ::= <name>
<scope spec.> ::= project ! user ! login ! temp ! own ! perm
<proc. spec.> ::= <name>
function: the main catalog will be scanned for external procedures
--------- according to the scope specifications (see below). each of
the procedures thus found will be inspected. If such a procedure calls
one or more of the external procedures mentioned in the procedure
specification part of the call, an update will be made in the inspected
procedure. the update will be according to a lookup at the catbase on
which the program started. the inspecting of an inspected procedure will
only cover the so called external list, and not the code. this means that
not all changes of kinds and specifications in the procedures of the
procedure specification list will be acceptable. however, this is not
tested by the present program.
\f
<* dh 87.09.08, inspecting external lists, page ...01... *>
the scope specification determines which part of the catalog should be
scanned for candidates for inspection. - if the scope specification part
is omitted, only procedures at the standard base will be inspected.
- if it states scope.project, only procedures at the max base, and with
catalog key 3 will be inspected. - if it states scope.user, only procedures
at the user base, and with catalog key 3 will be inspected. - if it states
scope.login, only procedures at the standard base, and with catalog key 2
will be inspected. - if it states scope.temp, only procedures at the
standard base, and with catalog key <= 1 will be inspected. - if it states
scope.own, all procedures which could possibly be changed will be
inspected. - if it states scope.perm, all procedures at or within the
standard base will be inspected, provided they have catalog key 3.
error messages: and a description of the output as well as a
--------------- detailed description, will be found in a future
manual of this program! ;
integer entrycount, extcount, firstparam, i, keylow, keyup, j,
content, oldcount, changecount, ne, nex, ng, nb, nc, nzc;
long maxlow, minlow, maxup, minup, firstparameter;
integer field baselow, baseup, contry, key, size, if2, iff, kindspec1;
integer array bases(1:8), ia(1:20), time (1:2);
zone catind, catud, extlist(128, 1, stderror),
me(1, 1, stderror);
long array name, parameter, stackchain(1:2), alarmgot(1:4);
long array field laf, entryname;
integer array field iaf;
long field lf, lf1;
real r;
boolean changes, fortran, found;
\f
<* dh 87.09.08, inspecting external lists, page ...02... *>
integer procedure nextinlist(psn);
integer psn ;
begin
while inrec6(extlist, 2) = 8 do
begin
psn := extlist.if2 extract 12; inrec6(extlist, 8);
inrec6(extlist, psn);
end;
psn := psn + 2;
nextinlist := extlist.if2;
end;
procedure passandcount;
begin
outrec6(catud, 34);
tofrom(catud, catind, 34);
entrycount := entrycount + 1;
end;
boolean procedure goodscope(entry);
real array entry ;
begin
long b1, b2;
integer keyval;
keyval := entry.key extract 3;
b1 := entry.baselow;
b2 := entry.baseup;
goodscope := if keyval<keylow or keyval>keyup then false
else if minlow>minup then (b1=maxlow and b2=maxup)
else if b1<=minlow and b2>=minup then
(b1>=maxlow and b2<=maxup) else
(b1>=minlow and b2<=minup);
end;
alarmgot(3) := alarmgot(4) :=
stackchain(1) := stackchain(2) :=
parameter(1) := parameter(2) := 0;
open(me, 0, <::>, 0);
system(11)bases:(0, bases);
key := if2 := 2;
baselow := 4; baseup := entryname := 6;
size := 16; contry := 32;
kindspec1 := 28;
time (1) := systime (5, 0, r);
time (2) := r ; <*prepare time (1:2)*>
trap(slutaf);
\f
<* dh 86.09.29, inspecting external lists, page ...03... *>
i := system(4)fpparam:(1, parameter);
if i = 6 shift 12 + 10 <* eq name *> then
begin comment stack and connect out;
firstparam := 3;
name(1) := parameter(1); name(2) := parameter(2);
system(4)fpparam:(0, parameter);
fpproc(29)stack_zone:(0, out, stackchain);
i := 10 shift 1 + 1; <*10 segments, preferably on disc *>;
fpproc(28)connect:(i, out, parameter);
if i <> 0 then system(9, i, <:<10>l.h.side:>);
<* after connect out, create the area process and fetch n.t.a. *>
monitor(52)create_area_process:(out, 0, ia);
getshare6(out, ia, 1);
ia(4) := ia(4) extract 12; <* sense, keep the mode *>
setshare6(out, ia, 1);
monitor(16)send_message:(out, 1, ia);
monitor(18)wait_answer:(out, 1, ia);
monitor(8)reserve:(out, 0, ia);
<* note, nothing is checked, we shall wait until actual output *>
write(out, "*", 1, name);
i := system(4)fpparam:(2, parameter);
end else firstparam := 2;
keylow := 0; keyup := 3;
minlow := maxup := bases(4); <* note that this trick ensures that *>
minup := maxlow := bases(3); <* exactly std base will be scanned *>
if i <> 4 shift 12 + 10 <* sp name *> then
fejl1: system(9, firstparam-1, <:<10>param:>);
\f
<* dh 86.10.08, inspecting external lists, page ...04... *>
if parameter(1) = long <:scope:> then
begin
if system(4)fpparam:(firstparam, parameter) <> 8 shift 12 + 10 then
fejl2: system(9, firstparam, <:<10>scope?:>);
firstparam := firstparam + 1;
firstparameter := parameter(1);
if firstparameter = long<:proje:>+'c' then
begin
keylow := 3;
minlow := maxup := bases(8); <* project base, otherwise *>
minup := maxlow := bases(7); <* same trick as above *>
end
else if firstparameter = long<:user:> then
begin
keylow := 3;
minlow := maxup := bases(6); <* user base, otherwise *>
minup := maxlow := bases(5); <* same trick as above *>
end
else if firstparameter = long<:login:> then keylow := keyup := 2
else if firstparameter = long<:temp:> then keyup := 1
else if firstparameter = long<:own:> then
begin
maxlow := bases(7); minlow := bases(3);
maxup := bases(8); minup := bases(4);
end
else if firstparameter = long<:perm:> then
begin
keylow := 3;
minlow := maxlow; minup := maxup; <* i.e. within, or at std base *>
end
else goto fejl2;
if system(4)fpparam:(firstparam, parameter) <> 4 shift 12 + 10 then
system(9, firstparam,<:<10>param:>);
firstparam := firstparam + 1;
end determining scope;
\f
<* dh 86.10.08, inspecting external lists, page ...05... *>
open(catind, 4, <:catalog:>, 0);
open(catud, 4, <::>, 0); name(1) := name(2) := 0;
i := 10 shift 1 + 1; <* 10 segm, preferably on disc *>
fpproc(28)connect_out:(i, catud, name);
if i <> 0 then system(9, i, <:<10>claims:>);
entrycount := 0;
for i := inrec6(catind, 0) while i >= 34 do
begin
inrec6(catind, if i > 36 then 34 else 36);
if catind.key <> -1 then
begin
content := catind.contry shift(-12); j := catind.size;
if content = 4 and j > 0 then
begin
if goodscope(catind) then passandcount;
end
else if content >= 32 then
begin
if j < 0 and goodscope(catind) then passandcount;
end;
end;
end;
extcount := 1;
for i := system(4)fpparam:(firstparam, parameter) while i <> 0 do
begin
firstparam := firstparam + 1;
extcount := extcount + 1;
if i <> 4 shift 12 + 10 then goto fejl1;
end;
firstparam := firstparam - extcount;
close(catind, true);
getzone6(catud, ia);
laf := 2; open(catind, 4, ia.laf, 0); <*n.t.a. will be set below*>
\f
<* dh 87.08.08, inspecting external lists, page ...06... *>
if entrycount > 0 then
begin integer array externals(1:extcount, 1:6);
comment the entries in the file connected to catud may be sorted
alphabetically here. this might ease proof reading of
the output. some kind of base sort is performed below.
note, that catud has not been positioned yet ;
for i := 1 step 1 until extcount do
begin
iaf := i * 12;
system(4)fpparam:(firstparam, name);
firstparam := firstparam + 1;
open(extlist, 4, name, 0);
if monitor(42)lookup_entry:(extlist, i, ia) <> 0 then
begin
write(out, <:<10>***:>, name, <: does not:>);
system(9, 0, <:<32>exist:>);
end;
close(extlist, false);
tofrom(externals.iaf, name, 8);
externals.iaf(5) := ia(7); externals.iaf(6) := ia(8);
end fetching all externals to correct;
while entrycount > 0 do
begin
oldcount := entrycount; entrycount := 0;
setposition(catind, 0, 0); setposition(catud, 0, 0);
inrec6(catind, 34); iaf := 0;
ia(1) := catind.iaf(2); ia(2) := catind.iaf(3);
lf := 4; maxlow := ia.lf; <*base pair *>
changerec6(catind, 0);
monitor(72)set_catbase:(me, 0, ia);
write(out, <:<10>on base::>, <<-ddddddd>, ia(1), ia(2),
"nl", 1);
\f
<* dh 87.09.07, inspecting external lists, page ...07... *>
for oldcount := oldcount step -1 until 1 do
begin
inrec6(catind, 34); lf := 6;
if catind.lf <> maxlow <*i.e. basepair *> then passandcount else
begin
content := catind.contry shift(-12);
fortran := catind.kindspec1 < 0;
if content = 4 then
begin
laf := 6; content := 0;
end
else
begin
laf := 16; content := content - 32;
end;
open(extlist, 4, catind.laf, 0); setposition(extlist, 0, content);
monitor(52)create_area:(extlist, 0, ia);
if monitor(8)reserve:(extlist, 0, ia) = 0 then
begin
i := catind.contry extract 12; inrec6(extlist, i);
ne := nex := nextinlist(i) extract 12;
ng := extlist.if2 shift (-12);
nb := nextinlist (i);
write(out, <:<10> :>, true, 12, catind.entryname, <:inspected:>);
found := false;
if ne >0 then
begin
for j := 2 * ng + (if fortran then 0 else nb) step -2 until 2 do
nextinlist(i); <* i.e. skip globals and bytes to copy *>
\f
<* dh 87.09.08, inspecting external lists, page ...08... *>
changecount := 0;
for ne := ne step -1 until 1 do
begin
for iff := 2 step 2 until 8 do name.iff := nextinlist(i);
j := extcount * 12 + 4;
for lf := 16 step 12 until j do if name(1)=externals.lf then
begin lf1 := lf + 4;
if name(2) = externals.lf1 then goto fundet;
end;
if true then begin nextinlist(i); nextinlist(i) end else
fundet: begin iaf := lf1;
found := true;
nextinlist (i);
changes :=
extlist.if2 <> externals.iaf (1);
extlist.if2 := externals.iaf (1);
nextinlist (i);
changes := changes or
extlist.if2 <> externals.iaf (2);
extlist.if2 := externals.iaf (2);
comment a test of the consistency of the change in the
external list may be performed above. - if you
can invent a good one! ;
changecount := changecount + 1;
if changecount = 1 then
write (out, "," , 1, "sp", 1)
else
write (out, "nl", 1, "sp", 27);
write (out, true, 12, name,
if changes then <: changes:> else <:no changes:>);
end;
end going through externals;
if fortran then
begin <*skip commons and zone commons*>
nc := nb shift (-12);
nzc := nb extract 12 ;
for nc := nc step -1 until 1 do
for j := 1 step 1 until 6 do
nextinlist (i);
for nzc := nzc step -1 until 1 do
for j := 1 step 1 until 9 do
nextinlist (i);
end <*skip commons and zone commons*>;
end any externals at all;
if nex <= 0 and
ng + nb <> 0 then
write (out, <:, list maybe damaged:>)
else
begin
if found then
write (out, "nl", 1, "sp", 25);
write (out, <:, date maybe changed:>);
end;
write (out,
<: (:>, true, 12, catind.laf, <:):>,
<: : :>, <<dddddd>, nextinlist (i), <: , :>, nextinlist (i));
end
else write(out, <:<10>****:>, true, 12, catind.entryname,
<:not inspected, **** reserver trouble, :>,
true, 12, catind.laf, <:****:>);
close(extlist, true);
end entry at the correct bases;
end searching for entries;
end entry count > 0;
write(out, <:<10>:>);
end else write(out, <:*, nothing to correct!<10>:>);
\f
<* dh 86.09.29, inspecting external lists, page ...09... *>
<* the trap routines do not work unless the zones are single buffered *>
if false then
slutaf:
begin
if alarmcause extract 24 = -11 then
begin
i := getalarm(alarmgot);
getzone6(catud, ia); laf := 2;
if ia.laf(1) = alarmgot(3) and ia.laf(2) = alarmgot(4) then
begin
ia.laf(1) := 0; ia(13) := 4;
setzone6(catud, ia); <* a pseudo version of close, *>
<* and we do not want the troubled area to be removed *>
end
else if stackchain(1) <> 0 then
begin
getzone6(out, ia);
if ia.laf(1) = alarmgot(3) and ia.laf(2) = alarmgot(4) then
fpproc(30)simply unstack:(0, out, stackchain);
end
end else i := 3 <* warning.yes ok.no *>
end else i := 0;
trap(shutup); <* only device status around closing relevant *>
monitor(72)set_catbase:(me, 0, bases);
close(catud, true); monitor(48)remove:(catud, 0, ia);
if stackchain(1) <> 0 then
begin
write(out, <:<10><25><25><25>:>);
close(out, true);
if false then shutup: i := getalarm(alarmgot);
trap(0); <* in case of break 10 just giveup *>
fpproc(30)unstack:(0, out, stackchain);
end;
laf := 8;
close(me, false); open(me, 0, alarmgot.laf, 0);
<* if any, then insert the troubled name here *>
fpproc(7)end_program:(0, me, i);
end*
▶EOF◀