|
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: 34560 (0x8700)
Types: TextFile
Names: »resoupdtx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »resoupdtx«
└─⟦this⟧ »resoupdtx«
; boss resource opd * page 1 7 01 81, 16.06;
if listing.yes
char 10 12 10
resoupd = set 1 disc2
resoupd = algol connect.no
begin
comment the program sums up the resources used by BOSS
_ and SOS (from the auxiliary catalogs).
_ the resources claimed by BOSS are found by
_ scanning "usercattx".
_ the resources claimed by SOS are found by
_ scanning "soscattx".
_ the resources used by boss and sos and the
_ restclaim's are printed.
_ if "bossout.<file>" is specified a "scatup delete
_ and insert command" is generated in this file.
_ When boss is closed down this file may be used
_ to make a new boss entry in "susercat".
_ The same for "sosout.<file2>".
syntax of call:
! !1 ! !1 ! !1
!<printfile>=! resoupd !bossout.<file>! !sosout.<file2>!
! !0 ! !0 ! !0
januar 1981 annette
;
\f
comment boss resource opd * page 2 7 01 81, 16.06;
integer max_bs_no, max_proj, max_proj_used;
integer i, j, r, q, t, s, ss, ds, es, bs, s_dif, e_dif, par;
integer c, c2; <*character count - s_up_z,out_z*>
array doc(1:2);
long array field name;
zone out_z(128, 1, stderror);
begin
procedure error(no);
_________________
integer no;
begin
case no of
begin
<*1*> write(out, "nl", 1, <:parameter error:>);
<*2*> write(out, "nl", 1, <:entry missing in susercat:>);
<*3*> write(out, "nl", 1, <:claimproc!:>);
end;
goto stop;
end;
procedure outputfile(doc);
_________________________
array doc;
begin
long array field ln_f;
long array scope(1:2);
integer array tail(1:10);
scope(1) := scope(2) := 0;
ln_f := 0;
i := lookup_proc(scope, doc.ln_f, tail);
if (scope(1) = long <:syste:> add 109 and scope(2) = 0)
or scope(1) = long <:***:> then i := 3;
if i <> 0 then
begin
for i := 1 step 1 until 10 do tail(i) := 0;
tail(1) :=1; <*size*>
ln_f := 2; tail.ln_f(1) := long <:disc:>;
tail(6) := shortclock;
ln_f := 0; i := setproc(doc.ln_f, tail);
end create new entry;
if i <> 0 then system(9)alarm:(i, <:<10>settroubl:>);
end;
procedure clos_cut(z, file, char);
_________________________________
zone z;
long array file;
integer char;
begin
integer array tail(1:10);
integer i;
long array scope(1:2);
close(z, true);
scope(1) := scope(2) := long <::>;
i := lookup_proc(scope, file, tail);
if (scope(1) = long <:syste:> add 109 and scope(2) = long <::>)
_ or scope(1) = long <:***:> then i := 3;
if i = 0 then
begin
tail(1) := char // 768; <*size*>
if char mod 768 <> 0 then tail(1) := tail(1) + 1;
chngentrpr(file, tail);
end
else system(9)alarm:(i, <:<10>cat i/o err:>);
end;
\f
comment boss resource opd * page 3 7 01 81, 16.06;
procedure dummy(out_z); <*declare arrays*>
___________________________________________
zone out_z;
begin
long array bs_name(1:2),
_ bs_names(-1:2*max_bs_no);
integer array slices,
_ entries(1:max_proj_used//2 - 2, 0:max_bs_no),
_ sos_rest_sl, sos_rest_entr,
_ sumslic, sument(0:max_bs_no),
_ sos_entr_res, sos_segm_res, sos_sl_res,
_ discsum, slicsum, entrsum, bssum, smalldisc,
_ smallentr(0:max_bs_no), pr_discsum,
_ pr_entrsum, pr_slicsum, pr_bssum, pr_small_disc,
_ pr_small_entr(1:2*max_proj, 0:max_bs_no),
_ proj_no, base(1:2*max_proj);
array proj_name(1:2*max_proj);
<*print head*>
procedure ph(i, proj_name, proj_nr, small);
___________________________________________
value i, proj_nr, small;
integer i, proj_nr;
string proj_name;
boolean small;
begin
c2 := c2 + write(out_z,
_ "ff", i, "nl", 3, <:fordeling af plads på disc's:>);
c2 := c2 + wrdatetime(out_z, datetime);
c2 := c2 + write(out_z, "nl", 1,
_ false add 95, 45, "nl", 2, "sp", 16, proj_name);
if proj_nr >= 0 then
c2:=c2+write(out_z, << -ddddddddd>, proj_nr);
c2:=c2+write(out_z, "nl", 2,
<:device slices segm ar_ent bs_ent:>);
if small then c2:=c2+write(out_z, "sp", 10, <:small:>, "nl", 1,
_ "sp", 48, <:segm.__entries:>)
else c2:=c2+write(out_z, "nl", 1);
end ph;
\f
comment boss resource opd * page 4 7 01 81, 16.06;
integer procedure pr_restclaim(z, point);
________________________________________
zone z;
boolean point;
begin
integer char;
char := 0;
for t := 0 step 1 until max_bs_no do
begin
name := (t - 1) * 8;
if point and t = 0 then char := char +
_ write(z, "nl", 1, true, 13, <:temp:>, <:.:>,
_ << -ddddddd>, 300, <:.:>, 300, <:,:>, "nl", 1);
char := char + write(z, true, 13, bs_names.name,
_ if point then <:.:> else <: :>,
_ << -ddddddd>, sum_slic(t) - slic_sum(t),
_ if point then <:.:> else <: :>,
_ sument(t) - entr_sum(t) - bs_sum(t),
_ if point and t <> max_bs_no then <:,:> else <::>,
_ "nl", 1);
end;
pr_restclaim := char;
end pr_restclaim;
integer procedure sos_restclaim(z, point);
________________________________________
zone z;
boolean point;
begin
integer char;
char := 0;
for t := 0 step 1 until max_bs_no do
begin
name := (t - 1) * 8;
if point and t = 0 then char := char +
_ write(z, "nl", 1, true, 13, <:temp:>, <:.:>,
_ << -ddddddd>, 0, <:.:>, 0, <:,:>, "nl", 1);
char := char + write(z, true, 13, bs_names.name,
_ if point then <:.:> else <: :>,
_ << -ddddddd>, sos_rest_sl(t),
_ if point then <:.:> else <: :>,
_ sos_rest_entr(t),
_ if point and t <> max_bs_no then <:,:> else <::>,
_ "nl", 1);
end;
sos_restclaim := char;
end sos_restclaim;
\f
comment boss resource opd * page 5 7 01 81, 16.06;
<*find resources used by boss and sos *>
procedure find_used;
____________________________
begin
zone cat(128, 1, stderror);
long b_lo, b_hi;
integer p, ci, bs_no, entries, segm, slice_lng;
long array bs_name, cat_name(1:2);
boolean found;
integer array ix(1:2*max_proj), tail(1:10);
long array field doc;
integer field base_lo, base_hi, size, key;
key := 2;
base_lo := 4;
base_hi := 6;
name := 6;
size := 16;
doc := 16;
<*nulstil opsummeringsfelter*>
for p := max_bs_no step -1 until 0 do
begin
_ discsum(p) := slicsum(p) :=
_ entrsum(p) := bssum(p) :=
_ smalldisc(p) := smallentr(p) := 0;
for r := max_proj_used step -1 until 1 do
_ pr_discsum(r, p) := pr_entrsum(r, p) :=
_ pr_slicsum(r, p) := pr_bssum(r, p) :=
_ pr_small_disc(r, p) := pr_small_entr(r, p) :=0;
end;
<*initier base-, projno- og projname tabeller*>
for r := max_proj_used step -1 until 1 do
begin
ix(r) := r;
if r mod 2 = 0 then
proj_name(r-1) :=
proj_name(r) := real (case r//2 of (
<* -1*> <:gi_system:>,
<* 51*> <:account:>,
<* 53*> <:geo/top_project:>,
<*3002*> <:ga1/ga2:>,
<*6001*> <:top_afd:>,
<*7001*> <:seism._afd:>,
<* -1*> <:sos:>));
end;
base(1) := -8388607; <*gi system (not used) *>
base(2) := 8388605;
proj_no(1) := proj_no(2) := -1;
\f
comment boss resource opd * page 6 7 01 81, 16.06;
for r := max_proj_used step -2 until 2 do
begin
s := ix(r); <*ix=14,13,12,...1 s=1,3,5,6...*>
q := r; <*r=14,12,10...*>
b_lo := base(s-1);
b_hi := base(s);
for t := r-2 step -2 until 2 do
begin
i := ix(t); <*i=3,5,7,9,11*>
if base(i-1) <= b_lo and b_hi <= base(i) then
begin
q := t;
s := i;
b_lo := base(s-1);
b_hi := base(s);
end;
end;
if r <> q then
begin
ix(q) := ix(r);
ix(r) := s;
s := ix(q-1);
ix(q-1) := ix(r-1);
ix(r-1) := s;
end;
end;
bs_no := -1;
for bs_no := bs_no + 1 while
_ claim_proc(0, bsno, bs_name, entries, segm, slice_lng) do
begin
cat_name(1) := long <:cat:> add (bs_name(1) shift (-24));
cat_name(2) :=
_ (bs_name(1) shift 24) add (bs_name(2) shift(-24));
bs_names(2*bs_no-1) := bs_name(1);
bs_names(2*bs_no) := bs_name(2);
open(cat, 4, cat_name, 0);
if monitor(42)lookup:(cat, i, tail) <> 0 then
system(9)alarm:(bs_no, <:<10>-disc no:>);
<*15 entries in each segm, tail(1) = catalog size*>
for q := 15*tail(1) step -1 until 1 do
begin
inrec6(cat, 34); <*one entry*>
b_lo := extend cat.base_lo;
b_hi := extend cat.base_hi;
if b_lo<>-1 or b_hi<>-1 then
begin
p := 0;
repeat
begin
p := p + 1;
ci := ix(p);
i := ((ci - 1) // 2) * 2;
t := ci - i;
found := case t of (
_ <*user*> base(i+1) <= b_lo and b_hi < base(i+2),
_ <*project*> base(i+1) = b_lo and b_hi = base(i+2));
end;
until found or p = max_proj_used;
\f
comment boss resource opd * page 7 7 01 81, 16.06;
if found and cat.key extract 3 = 3 then <*perm files only*>
begin
if cat.size > 0 then
begin
i := cat.size;
t := (i + slicelng - 1) // slicelng;
pr_discsum(ci, bs_no) := pr_discsum(ci, bs_no) + i;
pr_slicsum(ci, bs_no) := pr_slicsum(ci, bs_no) + t;
pr_entrsum(ci, bs_no) := pr_entrsum(ci, bs_no)+1;
if long proj_name(p) <> long <:sos:> then
begin
disc_sum(bs_no) := disc_sum(bs_no) + i;
slic_sum(bs_no) := slic_sum(bs_no) + t;
entr_sum(bs_no) := entr_sum(bs_no) + 1;
end;
if i < slicelng then
begin
pr_small_disc(ci, bs_no) :=
_ pr_small_disc(ci, bs_no) + i;
pr_small_entr(ci, bs_no) :=
_ pr_small_entr(ci, bs_no) + 1;
if long proj_name(p) <> long <:sos:> then
begin
small_disc(bs_no) := small_disc(bs_no) + i;
small_entr(bs_no) := small_entr(bs_no) + 1;
end;
end;
end
else
begin
pr_bssum(ci, bs_no) := pr_bssum(ci, bs_no) + 1;
if long proj_name(p) <> long <:sos:> then
_ bs_sum(bs_no) := bs_sum(bs_no) + 1;
end;
end;
end; <*opsummering pr used entry*>
end; <*repeat for each entry*>
close(cat, true);
end bs_no-loop;
end find_used;
\f
comment boss resource opd * page 8 7 01 81, 16.06;
___________________________________________________
comment find resources reserved by boss;
___________________________________________________
procedure find_reserved;
begin
zone ucatz(128, 1, stderror);
boolean end_of_catalog;
integer array alfabet(0:255);
integer array inarr, kind(1:160);
integer bsno, numb;
procedure testud;
begin
write(out, "nl", 1);
if j < 0 then write(out, <:array fyldt :>) else
for i := 1 step 1 until j-1 do
case kind(i) of
begin
<*1*> write(out, <:kind 1 illegal number :>);
<*2*> write(out, <<-ddd>, inarr(i));
<*3,4,5*> ; ; ;
<*6*>
begin
write(out, "sp", 1, string(0.0 shift 24 add
_ inarr(increase(i)) shift 24 add inarr(increase(i))));
i := i - 1;
end;
<*7*> write(out, false add inarr(i), 1);
end;
end;
procedure read_to_semicolon;
begin
repeat
readchar(ucatz, inarr(1));
until inarr(1) = 59;
kind(1) := readchar(ucatz, inarr(1));
if kind(1) <> 8 then repeatchar(ucatz);
end;
procedure read_spaces;
begin
repeat
readchar(ucatz, inarr(1));
until inarr(1) <> 'sp';
repeatchar(ucatz);
end;
procedure read_to_nl;
begin
intable(0); <*ff,"nl",em as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then begin
write(out, "nl", 1, <:from read_to_nl :>);
testud; end;
end;
\f
comment boss resource opd * page 9 7 01 81, 16.06;
comment housekeeping;
open(ucatz, 4, <:usercattx:>, 0);
end_of_catalog := false;
for i := 1 step 1 until max_proj_used / 2 - 2 do
for j := 0 step 1 until max_bs_no do
slices(i, j) := entries(i, j) := 0;
for i := 0 step 1 until max_bs_no do
sumslic(i) := sument(i) := 0;
numb := 0;
stdtable(alfabet);
<*first alfabet uses "sp","nl",ff,em as delimiters*>
alfabet('sp') := 8 shift 12 + 'sp';
<*second alfabet uses "nl",ff,"em",")" ,"," as delimiters*>
alfabet(128 + ')') := 8 shift 12 + ')';
alfabet(128 + 44) := 8 shift 12 + 44; <*,*>
while -, end_of_catalog do
begin
intable(alfabet); tableindex := 0; <*sp as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if kind(1) = 2 <*legal number*> then i := inarr(1)
else i := 14;
if i = 0 then i := 1 <*not used*>;
if i = -1 <*end of catalog*> then i := 15;
if fp_mode(2) then write(out, "nl", 1, <:i= :>, i);
case i of
begin
<*1*> read_to_nl;
<*2*> read_to_nl;
<*3*> read_to_semicolon;
<*4*>
begin
intable(alfabet); tableindex := 128; <*), as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
read_spaces;
tableindex := 0; <*space as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
bsno := (inarr(2) shift (-8) extract 8) - 48;
intable(alfabet); tableindex := 128; <*), as delimeter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
read_spaces;
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
slices(numb, bsno) :=
_ slices(numb, bsno) + inarr(1);
tableindex := 0; <*sp as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
entries(numb, bsno) :=
_ entries(numb, bsno) + inarr(1);
read_to_nl;
end;
\f
comment boss resource opd * page 10 7 01 81, 16.06;
<*5*> read_to_nl;
<*6*> read_to_nl;
<*7*> ;
<*8*> read_to_nl;
<*9*> ;
<*10*>
begin
integer no2;
numb := numb + 1;
no2 := numb*2+1;
bsno := 0;
intable(alfabet); tableindex := 128; <*), as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
read_spaces;
tableindex := 0; <*sp as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
proj_no(no2) := proj_no(no2+1) :=inarr(1);
tableindex := 128; <* ) , as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
read_spaces;
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
slices(numb, bsno) :=
_ slices(numb, bsno) + inarr(1);
tableindex := 0; <*sp as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
entries(numb, bsno) :=
_ entries(numb, bsno) + inarr(1);
tableindex := 128; <*), as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
read_spaces;
tableindex := 0; <* sp as delimiter*>
j := readall(ucatz, inarr, kind, 1);
if fp_mode(2) then testud;
base(no2) := inarr(1);
read(ucatz, base(no2+1));
if fp_mode(2) then write(out, base(no2+1));
read_to_nl;
end;
<*11*> read_to_nl;
<*12*> read_to_nl;
<*13*> ;
<*14*> if kind(1) <> 8 then read_to_nl;
<*15*> end_of_catalog := true;
end case;
end while;
\f
comment boss resource opd * page 11 7 01 81, 16.06;
for i := 1 step 1 until max_proj_used/2 - 2 do
for j := 0 step 1 until max_bs_no do
begin
sumslic(j) := sumslic(j) + slices(i, j);
sument(j) := sument(j) + entries(i, j);
end;
if fp_mode(2) then
begin
for i := 0 step 1 until max_bs_no do
c2:=c2+write(out, "nl", 1, sumslic(i), "sp", 2, sument(i));
end;
stdtable(alfabet); tableindex := 0;
end of find_reserved;
\f
comment boss resource opd * page 12 7 01 81, 16.06;
procedure sos_reserved;
begin
zone sos_cat_z(128, 1, stderror);
long array inarr(1:200);
integer array kind(1:200);
integer bs_no, i, j;
boolean procedure end_of_cat(elements);
___________________________________________
integer elements;
begin
integer i;
end_of_cat := false;
for i := 1 step 1 until elements do
begin
if inarr(i) = long <:end:> then end_of_cat := true;
if inarr(i) = 'em' and kind(i) = 8 then end_of_cat := true;
end;
end;
procedure testud;
begin
write(out, "nl", 1);
if j < 0 then write(out, <:array fyldt :>) else
for i := 1 step 1 until j-1 do
case kind(i) of
begin
<*1*> write(out, <:kind 1 illegal number :>);
<*2*> write(out, <<-ddd>, inarr(i));
<*3,4,5*> ; ; ;
<*6*>
begin
write(out, "sp", 1, string inarr(increase(i)));
i := i - 1;
end;
<*7*> write(out, false add inarr(i), 1);
end;
end;
open(sos_cat_z, 4, <:soscattx:>, 0);
proj_no(13) := proj_no(14) := -1;
for i := 0 step 1 until max_bs_no do
sos_entr_res(i) := sos_segm_res(i) := sos_sl_res(i) := 0;
<* find sos_bases *>
base(13) := 8388605; <*initial values*>
base(14) := -8388607;
for j:=readall(sos_cat_z, inarr, kind, 1) while -, end_of_cat(j) do
begin
if fp_mode(1) then testud;
i := 1;
while kind(i) <> 6 <*text string*> and i < j do
i := i + 1;
if inarr(i) = long <:maxb:> then
begin
i := i + 1;
while kind(i) <> 2 <*number*> do
i := i + 1;
if inarr(i) < base(13) then base(13):=inarr(i); <*baselow*>
i := i + 1;
while kind(i) <> 2 <*number*> do
i := i + 1;
if inarr(i) > base(14) then base(14):=inarr(i); <*basehigh*>
end;
end;
\f
comment boss resource opd * page 13 7 01 81, 16.06;
<*find the reserved resources*>
setposition(sos_cat_z, 0, 0);
for j:=readall(sos_cat_z, inarr, kind, 1) while -, end_of_cat(j) do
begin
if fp_mode(1) then testud;
i := 1;
while kind(i) <> 6 <*text string*> and i < j do
i := i + 1;
if inarr(i) = long <:bs:> then
begin
integer e, s, slicelng;
long array bsname(1:2);
i := i + 1;
while kind(i) <> 6 <*text string*> do
i := i + 1;
bs_no := (inarr(i) shift (-8) extract 8);
if bs_no <> 0 then bs_no := bs_no - 48;
if -, claimproc(0, bsno, bsname, e, s, slicelng) then error(3);
i := i + 2;
while kind(i) <> 2 <*number*> do
i := i + 1;
sos_entr_res(bs_no) := sos_entr_res(bs_no) + inarr(i);
i := i + 1;
while kind(i) <> 2 <*number*> do
i := i + 1;
sos_segm_res(bs_no) := sos_segm_res(bs_no) + inarr(i);
sos_sl_res(bs_no) := sos_sl_res(bs_no) +
_ (inarr(i) + slicelng - 1) // slicelng;
end;
end;
end of sos_reserved;
\f
comment boss resource opd * page 14 7 01 81, 16.06;
procedure print(out_z);
_______________________
zone out_z;
begin
for r := 3 step 1 until max_proj_used do
begin
i := ((r - 1) // 2) * 2; <*i = 2,2,4,4,6...*>
q := r - i; <*q=1,2,1,2,1,2...*>
if q = 1 then
ph(if r mod 4 = 1 then 1 else 0,
_ string proj_name(r), proj_no(r), false);
c2:=c2+write(out_z, "nl", 1, "sp", 16, true, 8,
_ case q of (<:users:>, <:project:>), "sp", 29,
_ <:small:>, "nl", 1, "sp", 48, <:segm. entries:>,
_ "nl", 1);
for t := 0 step 1 until max_bs_no do
begin
if pr_slicsum(r, t) <> 0
or pr_discsum(r, t) <> 0
or pr_entrsum(r, t) <> 0
or pr_bssum(r, t) <> 0 then
begin
name := (t - 1) * 8;
c2:=c2+write(out_z, true, 8, bs_names.name,
_ << -ddddddd>, pr_slicsum(r, t), pr_discsum(r, t),
_ pr_entrsum(r, t), pr_bssum(r, t),
_ pr_small_disc(r, t), pr_small_entr(r, t), "nl", 1);
end;
end;
if q = 2 then
begin
c2:=c2+write(out_z, "nl", 2, "sp", 16, <:project total:>,
_ "sp", 22, <:restclaim:>, "nl", 1,
_ "sp", 47, <:slices entries:>, "nl", 1);
for t := 0 step 1 until max_bs_no do
begin
ss := pr_slicsum(r-1, t) + pr_slicsum(r, t);
ds := pr_discsum(r-1, t) + pr_discsum(r, t);
es := pr_entrsum(r-1, t) + pr_entrsum(r, t);
bs := pr_bssum(r-1, t) + pr_bssum(r, t);
if long proj_name(r) <> long <:sos:> then
begin
s_dif := slices(i//2, t) - ss; <*reserved - used*>
e_dif := entries(i//2, t) - es - bs;
end
else
begin
sos_rest_sl(t) := s_dif := sos_sl_res(t) - ss;
sos_rest_entr(t) := e_dif := sos_entr_res(t) - es - bs;
end;
if ss + ds + es + bs + s_dif + e_dif <> 0 then
begin
name := (t - 1)*8;
c2:=c2+write(out_z, true, 8, bs_names.name,
_ << -ddddddd>, ss, ds, es, bs,
_ s_dif, e_dif, "nl", 1);
end;
end;
end q=2;
end r-loop;
\f
comment boss resource opd * page 15 7 01 81, 16.06;
ph(1, <:boss total:>, -1, true);
____________________________
c2:=c2+write(out_z, "nl", 1);
for t := 0 step 1 until max_bs_no do
begin
name := (t - 1)*8;
c2:=c2+write(out_z, true, 8, bs_names.name, << -ddddddd>,
_ slic_sum(t), disc_sum(t),
_ entr_sum(t), bs_sum(t),
_ small_disc(t), small_entr(t),
_ "nl", 1);
end;
c2:=c2+write(out_z, "nl", 5, "sp", 20, <:restclaim:>,
_ "nl", 1, "sp", 16, <:slices__entries :>, "nl", 1);
c2 := c2 + pr_restclaim(out_z, false);
end print;
\f
comment boss resource opd * page 16 7 01 81, 16.06;
procedure scatupfile(name);
___________________
long name;
begin
zone s_up_z(128, 1, stderror); <*outputfile*>
zone s_cat(128, 1, stderror); <*susercat*>
integer rec_lng, t, max_tracks, rest;
integer field segm_f, lng_f, prio_com_f, buf_area_f, int_fnc_f,
_ std_lo, std_hi, max_lo, max_hi, usr_lo, usr_hi,
_ h_key_f, addr_f, size;
long array field name_f, prog_f;
boolean found;
integer h;
long array proc_name(1:2);
integer procedure hash(name, catsize);
___________________________________
comment compute hashvalue;
long array name;
integer catsize;
begin
integer nv;
long name1;
name1 := name(1) + name(2);
nv := name1 extract 24 + name1 shift (-24);
if nv < 0 then nv := - nv;
hash := nv mod catsize;
end;
boolean procedure search(start_segm, end_segm, proc_name);
___________________________________________________________
comment search segment;
comment find <proc_name> entry in s_catalog
value start_segm, end_segm;
integer start_segm, end_segm;
long array proc_name;
begin
boolean found;
integer h_key;
search := found := false;
setposition(s_cat, 0, start_segm);
for t := start_segm + 1 step 1 until end_segm do
begin
repeat
begin
rest := inrec_6(s_cat, rec_lng);
h_key := s_cat.h_key_f;
if h_key <> -1 and h_key <> -2 and
_ s_cat.name_f(1) = proc_name(1) and
_ s_cat.name_f(2) = proc_name(2) then
begin
search := found := true;
t := end_segm + 1;
end;
end;
until rest < rec_lng or found;
end;
end search;
\f
comment boss resource opd * page 17 7 01 81, 16.06;
procedure pr_proc(s_up_z); <*write boss entry*>
_________________________________
zone s_up_z;
begin
integer procedure write_base(basel, baseu, text);
_________________________________________
value basel, baseu;
integer basel, baseu;
string text;
write_base :=
write(s_up_z, "nl", 1, text, <<ddddddd>,
_ if basel < 0 then <:n.:> else <: :>,
_ if basel >= 0 then basel else
_ - basel, <:.:> , if baseu < 0 then <:n.:> else <: :>,
_ if baseu >= 0 then baseu else
_ - baseu, <:,:>); <*end of writebase*>
c :=c+ write(s_up_z, "nl", 1, <:scatup_insert.:>,
_ s_cat.name_f, <:,:>);
c := c + write(s_up_z, "nl", 1,
_ <:prio.:>, s_cat.prio_com_f shift (-12), "sp", 1,
_ <:comm.:>, s_cat.prio_com_f extract 12, <:,:>);
c := c + write(s_up_z, "nl", 1,
_ <:buf.:>, s_cat.buf_area_f shift (-12), "sp", 1,
_ <:area.:>, s_cat.buf_area_f extract 12, <:,:>);
c := c + write(s_up_z, "nl", 1,
_ <:inter.:>, s_cat.int_fnc_f shift (-12),
_ "sp", 1, <:func.:>, s_cat.int_fnc_f extract 12, <:,:>);
c:=c+ write_base(s_cat.std_lo, s_cat.std_hi, <:std .:>);
c:=c+ write_base(s_cat.usr_lo, s_cat.usr_hi, <:user.:>);
c:=c+ write_base(s_cat.max_lo, s_cat.max_hi, <:max .:>);
c:=c+ write(s_up_z, "nl", 1, <:addr.:>, s_cat.addr_f);
c:=c+ write(s_up_z, "sp", 1, <:size.:>, <<ddddddd>,
_ s_cat.size, "sp", 1, <:prog.:>, s_cat.prog_f, <:,:>);
c:=c+ write(s_up_z, "nl", 1, <:,resource____slices___entr,:>);
if proc_name(1) = long <:boss:> then
c := c + pr_restclaim(s_up_z, true)
else c := c + sos_restclaim(s_up_z, true);
c:=c+ write(s_up_z, "nl", 3);
end pr_proc;
\f
comment boss resource opd * page 18 7 01 81, 16.06;
comment scatupfile;
____________________
open(s_cat, 4, <:susercat:>, 0);
<*initialize entry 0*>
lng_f := 4;
segm_f := 8;
<*initialize process entry*>
h_key_f := 2;
prio_com_f := 4;
name_f := 4;
buf_area_f := 18;
int_fnc_f := 20;
max_lo := 24;
max_hi := 26;
std_lo := 28;
std_hi := 30;
size := 32;
prog_f := 32;
usr_lo := 42;
usr_hi := 44;
addr_f := 14;
inrec6(s_cat, 4);
rec_lng := s_cat.lng_f;
rest := changerec6(s_cat, rec_lng);
max_tracks := s_cat.segm_f;
if readparam(doc) = 4 then
begin
outputfile(doc);
open(s_up_z, 4, doc, 0);
procname(1) := name;
procname(2) := long <::>;
h := hash(procname, s_cat.segm_f);
found := search(h, max_tracks, procname);
if -, found then found := search(0, h, procname);
if found then
begin
long array field l_f;
l_f := 0;
c := c + write(s_up_z,
_ "nl", 1, <:scatup delete.:>, s_cat.name_f);
pr_proc(s_up_z);
c := c + write(s_up_z, "em", 3, false, 3);
clos_cut(s_up_z, doc.l_f, c);
close(s_cat, true);
end
else error(2);
end
else error(1);
end of scatupfile;
\f
comment boss resource opd * page 19 7 01 81, 16.06;
<* DUMMY *>
c2 := c := 0; <*character count*>
find_reserved; <*boss*>
sos_reserved;
find_used;
print(out_z);
if par = -1 then par := readparam(doc);
while par = 2 do
begin
if long doc(1) = long <:bosso:> add 'u' and
_ long doc(2) = long <:t:> then scatupfile(long <:boss:>)
else if long doc(1) = long <:sosou:> add 't'
_ then scatupfile(long <:sos:>)
else error(1);
par := readparam(doc);
end;
if par <> 0 then error(1);
end dummy;
<* MAIN PROG *>
max_proj := 10;
max_proj_used := 7*2;
<*max_bs_no := antal bs_devices*>
begin
integer bs_no, slice_lng, segm, entries;
long array bs_name(1:2);
bs_no := max_bs_no := -1;
for bs_no := bs_no + 1 while
_ claim_proc(0, bs_no, bs_name, entries, segm, slice_lng) do
_ max_bs_no := bs_no;
end;
par := readparam(doc);
if par = -1 then
begin
long array file(1:2);
file(1) := long doc(1);
file(2) := long doc(2);
outputfile(doc);
open(out_z, 4, doc, 0);
dummy(out_z);
c2:=c2+write(out_z, "em", 3, false, 3);
clos_cut(out_z, file, c2);
end
else dummy(out);
end;
stop: <*****stop****>
trap_mode := 1 shift 10;
end
if ok.no
mode warning.yes
if warning.yes
(mode 0.yes
message resoupd not ok
lookup resoupd)
if 0.no
(scope user resoupd
lookup resoupd)
end
finis
▶EOF◀