|
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: 37632 (0x9300)
Types: TextFile
Names: »tusercatup«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b817e319⟧ »ctramos«
└─⟦this⟧
mode list.yes
userlist=set 150 disc3
scope day userlist
o userlist
mode listing.yes
; tramos usercat update * page 1 82 03 24, 15.43;
usercatup = set 1 disc1
usercatup = algol connect.no blocks.yes
begin
comment the program handles the tramos_user_catalog <osusercat>.
the format of <osusercat> is as follows:
entry 0 other entries
+0 not used hash value
+2 <entry length> <prio><command mask>
+4 <last used entry 0> <process name>
+6 <size of catalog> -
+8 <no of users> -
+10 <not used> -
+12 - <address>
+14 - <not used>
+16 <not used> <buf><area>
+18 <date user cat> <intenal><function>
+20 <name device 0> <mode>
+22 - <max ll>
+24 - <max ul>
+26 - <std ll>
+28 <slicelength 0> <std ul>
+30 <reference 0> <size>
+32 <name device 1> <program>
+34 - -
+36 - -
+38 - -
+40 <slicelength 1> <user ll>
+42 <reference 1> <user ul>
+44 <name device 2> <project no<8+user>
+46 - <userno>
+48 - <inname>
+50 - -
+52 <slicelength 2> -
+54 <reference 2> -
+56 <name device 3> <outname>
+58 - -
+60 - -
+62 - -
+64 <slicelength 3> <termname>
+66 <reference 3> -
+68 <name device 4> -
+70 - -
+72 - <job state>
+74 - <job id>
+76 <slicelength 4> <not used>
+78 <reference 4> -
+80 <name device 5> -
+82 - -
+84 - -
+86 - <entries temp 0>
+88 <slicelength 5> <segments temp 0>
+90 <reference 5> <entries perm 0>
+92 <name device 6> <segments perm 0>
+94 - <kind=0 drum,1 disc,2 disc1,3 aux, 4 max>
+96 - <entries perm used 0>
+98 - <segments perm used 0>
+100<slicelength 6> <not used>
+102<reference 6> <not used>
hashvalue= -1 empty entry
hashvalue= -2 deleted entry
use of command mask:
bit 0 (not used)
bit 1 batch only
bit 2 abs size allowed
bit 3 std base=user base
bit 4 evening
bit 5 max claim allowed
bit 6 indefenitely waiting
bit 7 automatic upstart only
bit 8 console1 allowed
The remaining bits are not used
the following functions has been implemented:
1. create a new <osusercat>. An area <osusercat> must be present
_________
syntax of call:
_ *
usercatup newcat.<catalog size in segm> !device name!
_ 1
2. insert an entry in <osusercat>
_________
syntax of call:
_ *
_ !<dev. name>.<perm sli>.<perm ent> !
_ !temp.<temp sli dev0>.<temp ent dev0>!
_ !prio.<integer> !
_ !comm.<integer> !
_ !buf.<integer> !
_ !area.<integer> !
_ !inter.<integer> !
usercatup insert.<entry name> !func.<integer> !
_ !std.<lower>.<upper> !
_ !max.<lower>.<upper> !
_ !user.<lower>.<upper> !
_ !addr.<integer> !
_ !size.<integer> !
_ !prog.<prog> !
_ 0
a negative base must be represented as n.<integer>
the default values are:
<dev 0>.0.0
prio.0 comm.0
buf.6 area.7
std.8388605.8388605
max.8388605.8388605
user.8388605.8388605
size.25600 prog.fp
mode.4097
all others are set to zero
3. delete an entry in <osusercat>
_________
syntax of call:
usercatup delete.<entry name>
4. list an entry in <osusercat>
___________ entry 0 - -
___________ all entries - -
___________ the device names and
___________ the names of all entries - -
syntax of call:
_ 1
_ !cat !
usercatup list.!<entry name>!
_ !all !
_ !names !
_ 1
;
procedure error(no);
______________________
integer no;
begin
case no of
begin
<*1*> write(out, "nl", 1, <:syntax:>);
<*2*> write(out, "nl", 1, param.ln_f, <: entry unknown:>);
<*3*> write(out, "nl", 1, param.ln_f, "sp", 2,
_ <:device not found in nametable:>);
<*4*> write(out, "nl", 1, <:devicename expected after catsize:>);
<*5*> write(out, "nl", 1, param.ln_f, <: parameter error:>);
<*6*> write(out, "nl", 1, param.ln_f, "sp", 2, <:action unknown:>);
<*7*> write(out, "nl", 1, <:action missing:>);
<*8*> write(out, "nl", 1, <:parameter missing:>);
<*9*> write(out, "nl", 1, <:catalog full:>);
<*10*> write(out, "nl", 1, keyword.ln_f,
_ <: unknown device name:>);
<*11*> write(out, "nl", 1, param.ln_f, <: entry already exists:>);
<*12*> write(out, "nl", 1, <:no output file allowed:>);
<*13*> write(out, "nl", 1, <:too many parameters:>);
end;
write(out, "nl", 1, <:***usercatup no update performed:>);
goto stop;
end;
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 neg;
______________________
comment the procedure reads a parameter. If the parameter = n
_ for negativ the procedure is true and it reads
_ the next parameter;
begin
neg := false;
ip := readparam(param);
if ip <> 3 and ip <> 4 then error(1);
if ip = 4 then
begin
if long param(1) = long <:n:> then
_ neg := true
else error(5);
if readparam(param) <> 3 then error(5);
end;
end neg;
boolean procedure search(start_segm, end_segm, proc_name, func, upd);
___________________________________________________________
comment search segment;
comment func=1 means: find <proc_name> entry in s_catalog
- 2 - : find first unused entry starting at <hash_value>;
value start_segm, end_segm;
integer start_segm, end_segm, func;
long array proc_name;
boolean upd;
begin
boolean found;
search := found := false;
setposition(s_cat, 0, start_segm);
for track := start_segm + 1 step 1 until end_segm do
begin
repeat
begin
if upd then rest := swoprec_6(s_cat, rec_lng)
else rest := inrec_6(s_cat, rec_lng);
h_key := s_cat.h_key_f;
begin
case func of
begin
<*1*>
begin
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;
track := end_segm + 1;
end;
end;
<*2*>
begin
if h_key = -1 or h_key = -2 then
begin
search := found := true;
track := end_segm + 1;
end;
end;
end;
end;
end;
until rest < rec_lng or found;
end;
end search;
procedure init(update);
_______________
value update; boolean update;
comment inrec entry 0 and initialize;
begin
if update then swoprec6(s_cat,6) else
inrec_6(s_cat, 6);
rec_lng := s_cat.lng_f;
rest := changerec_6(s_cat, rec_lng);
discs := s_cat.lng_0// 6 - 2;
max_tracks := s_cat.segm_f;
maxusers := s_cat.max_user_f;
if update then s_cat.max_user_f:=maxusers+1;
ln_f := 0;
for t := 1 step 2 until discs do
begin
rec_f := rec_f + 12;
d_f := d_f + 8;
disc.d_f(1) := s_cat.rec_f.lg_f1;
disc.d_f(2) := s_cat.rec_f.lg_f2;
sr(t) := s_cat.rec_f.slice_f;
sr(t+1) := s_cat.rec_f.ref_f;
end;
end init;
procedure newcat;
_________________
comment create new s_catalog;
begin
integer j, ref;
ln_f := 0;
ref := first_bs_ref - size_bs_ref;
if readparam(param) = 3 then
max_tracks := param(1)
else error(1);
rest := outrec_6(s_cat, 512);
for l_f := 4 step 4 until 512 do
s_cat.l_f := 0;
s_cat.segm_f := max_tracks;
s_cat.uptime_f:=systime(7,0,0.0);
t := 0;
for j := readparam(param) while j <> 0 do
begin
t := t + 1;
if j = 2 then
begin
integer i, bsno;
long array par(1:2);
par(1) := long param(1);
par(2) := long param(2);
bsno := -1;
rec_f := rec_f + 12;
ref := ref + size_bs_ref;
s_cat.rec_f.lg_f1 := long param(1);
s_cat.rec_f.lg_f2 := long param(2);
j:=readparam(param);
if j=3 then
s_cat.rec_f.slice_f:=param(1) else error(8);
s_cat.rec_f.ref_f := ref;
end
else error(4);
end;
rec_lng := s_cat.lng_f := first_bs_ref + size_bs_ref * t;
rec_0_lng := s_cat.lng_0 := 14 + 12 * t;
setposition(s_cat, 0, 0);
rest := swoprec_6(s_cat, rec_lng);
for track := 1 step 1 until max_tracks do
begin
repeat
begin
rest := swoprec_6(s_cat, rec_lng);
for l_f := 4 step 4 until rec_lng do
s_cat.l_f := 0;
s_cat.h_key_f := -1;
end;
until rest < rec_lng;
end;
end newcat;
procedure delete;
_________________
comment delete entry <proc_name> in s_catalog;
begin
update := true;
init(false);
if readparam(param) = 4 then
begin
boolean found;
integer h;
h := hash(param.ln_f, s_cat.segm_f);
found := search(h, max_tracks, param.ln_f, 1, update);
if -, found then found := search(0, h, param.ln_f, 1, update);
if found then
begin
for l_f := 4 step 4 until rec_lng do
s_cat.l_f := 0;
s_cat.h_key_f := -2;
end
else error(2);
end
else error(5);
if readparam(param) <> 0 then error(13);
end delete;
procedure insert;
_________________
comment insert entry <proc_name> in s_catalog;
begin
boolean found;
integer h;
integer field ent_pm_d0_f, segm_pm_d0_f;
integer field iaf;
update := true;
init(true);
if readparam(param) = 4 then
begin
h := hash(param.ln_f, s_cat.segm_f);
found := search(h, max_tracks, param.ln_f, 1, update);
if -, found then found := search(0, h, param.ln_f, 1, update);
if found then error(11);
found := search(h, max_tracks, param.ln_f, 2, update);
if -, found then found := search(0, h, param.ln_f, 2, update);
if found then
begin
comment standard values in process entry;
_____________________________________
for iaf := 2 step 2 until rec_lng do
s_cat.iaf := 0;
s_cat.h_key_f := h;
s_cat.name_f(1) := long param(1);
s_cat.name_f(2) := long param(2);
s_cat.prio_com_f := std_prio_comm;
s_cat.buf_area_f := std_buf_area;
s_cat.int_fnc_f := std_int_func;
s_cat.mode_f := 4097; <*user mode*>
s_cat.max_lo := 8388605;
s_cat.max_hi := 8388605;
s_cat.std_lo := 8388605;
s_cat.std_hi := 8388605;
s_cat.size := std_size;
s_cat.prog_f(1) := std_program(1);
s_cat.prog_f(2) := std_program(2);
s_cat.usr_lo := 8388605;
s_cat.user_no_f := maxusers+1;
s_cat.usr_hi := 8388605;
ent_pm_d0_f := 50;
segm_pm_d0_f := 52;
s_cat.ent_pm_d0_f := 0;
s_cat.segm_pm_d0_f := 0 * sr(1);
comment put in parameter values;
________________________
for j := readparam(keyword) while j <> 0 do
begin
action:=20;
tp:=0;
if j=2 then
begin
repeat tp:=tp+1;
if keyword(1)=real (case tp of(
<:prio:>,
<:comm:>,
<:buf:>,
<:area:>,
<:inter:>,
<:func:>,
<:max:>,
<:std:>,
<:size:>,
<:prog:>,
<:user:>,
<:temp:>,
<:addr:>,
<:proje:> add 'c',
<:in:>,
<:out:>,
<:term:>,
<:state:>,
<:jobid:>)) then action:=tp;
until action<>20 or tp=19;
if false then write(out,"nl",1,<:insert: :>,tp,action);
if action=20 then action:=1 else action:=action+1;
end
else error(1);
begin
case action of
begin
<*_____1_____device name_____*>
begin
if readparam(param) = 3 then
begin
di_f := first_bs_ref - size_bs_ref;
d_f := 4 - 8;
found := false;
for t := 1 step 2 until discs do
begin
di_f := di_f + size_bs_ref;
d_f := d_f + 8;
if disc.d_f(1) = keyword.ln_f(1) and
_ disc.d_f(2) = keyword.ln_f(2) then
begin
found := true;
s_cat.di_f(4) := param(1) * sr(t);
if readparam(param) = 3 then
s_cat.di_f(3) := param(1)
else error(1);
if readparam(param)=4 then
begin
i:=0; j:=6;
repeat i:=i+1;
if param(1)=real (case i of(
<:drum:>,<:disc:>,<:disc1:>,
<:aux:> ,<:max:>)) then j:=i;
until j<>6 or i=5;
if j=6 then error(5) else
s_cat.di_f(5):=j-1;
end .<type>;
end;
end;
if -, found then error(10);
end
else error(1);
end;
<*_____2_____prio_____*>
begin
if readparam(param) = 3 then
begin
ip := param(1);
s_cat.prio_com_f := ip shift 12;
end
else error(5);
end;
<*_____3_____comm_____*>
begin
i:=readparam(param);
if i = 3 then
s_cat.prio_com_f := s_cat.prio_com_f + param(1)
else
if i=4 then
begin
integer i,j;
i:=0; j:=12;
repeat i:=i+1;
if param(1)=real (case i of(
<:***:>,<:batch:>,<:size:>,
<:stdba:> add 's',<:eveni:> add 'n',
<:claim:>,<:wait:>,<:auto:>,<:c1:>,
<:priv:>,<:size:>)) then j:=i;
until i=11 or j<>12;
if j<>12 then s_cat.prio_com_f:=s_cat.prio_comf+
(1 shift (j-1));
end else error(5);
end;
<*_____4_____buf_____*>
begin
if readparam(param) = 3 then
begin
ip := param(1);
s_cat.buf_area_f := ip shift 12
_ + s_cat.buf_area_f extract 12;
end
else error(5);
end;
<*_____5_____area_____*>
begin
if readparam(param) = 3 then
begin
ip := param(1);
s_cat.buf_area_f := s_cat.buf_area_f shift (-12)
shift 12 + ip;
end
else error(5);
end;
<*_____6_____inter_____*>
begin
if readparam(param) = 3 then
begin
ip := param(1);
s_cat.int_fnc_f := ip shift 12
+ s_cat.int_fnc_f extract 12;
end
else error(5);
end;
<*_____7_____func_____*>
begin
if readparam(param) = 3 then
begin
ip := param(1);
s_cat.int_fnc_f := s_cat.int_fnc_f shift (-12)
shift 12 + ip;
end
else error(5);
end;
<*_____8_____max_____*>
begin
if neg then s_cat.max_lo := - param(1)
else s_cat.max_lo := param(1);
if neg then s_cat.max_hi := - param(1)
else s_cat.max_hi := param(1);
end;
<*_____9_____std_____*>
begin
if neg then s_cat.std_lo := - param(1)
else s_cat.std_lo := param(1);
if neg then s_cat.std_hi := - param(1)
else s_cat.std_hi := param(1);
end;
<*____10_____size_____*>
begin
if readparam(param) = 3 then
s_cat.size := param(1)
else error(5);
end;
<*____11_____prog_____*>
begin
if readparam(param) = 4 then
begin
s_cat.prog_f(1) := param.ln_f(1);
s_cat.prog_f(2) := param.ln_f(2);
end
else error(1)
end;
<*____12_____user_____*>
begin
if neg then s_cat.usr_lo := - param(1)
else s_cat.usr_lo := param(1);
if neg then s_cat.usr_hi := - param(1)
else s_cat.usr_hi := param(1);
if s_cat.stdlo=8388605 and s_cat.stdhi=8388605 then
begin
s_cat.std_lo:=s_cat.usrlo;
s_cat.std_hi:=s_cat.usrlo;
end;
end;
<*____13_____temp dev. 0_____*>
begin
if readparam(param) = 3 then
begin
di_f := first_bs_ref;
s_cat.di_f(2) := param(1) * sr(1);
if readparam(param) = 3 then s_cat.di_f(1) := param(1)
else error(5);
end
else error(5);
end;
<*____14_____addr_____*>
begin
if readparam(param) = 3 then
s_cat.addr_f := param(1)
else error(5)
end;
<*____15____project_user*>
begin
if readparam(param)=3 then
begin
j:=param(1);
if readparam(param)=3 then
begin
i:=param(1);
s_cat.project_user:=j shift 8 add i;
if s_cat.stdlo=8388605 and s_cat.stdhi=8388605 and
s_cat.usrlo=8388605 and s_cat.usrhi=8388605 and
s_cat.maxlo<>8388605 then
begin
s_cat.stdlo:=s_cat.usrlo:=s_cat.stdhi:=
s_cat.maxlo+(i-1)*10;
s_cat.usrhi:=s_cat.usrlo+9;
end;
end else error(5);
end else error(5);
end;
<*____16____in*>
begin
if readparam(param)=4 then
begin
for i:=1,2 do s_cat.innamef(i):=param.lnf(i);
end else error(1);
end;
<*____17_____out*>
begin
if readparam(param)=4 then
begin
for i:=1,2 do s_cat.outnamef(i):=param.lnf(i);
end else error(1);
end;
<*____18_____term*>
begin
if readparam(param)=4 then
begin
for i:=1,2 do s_cat.outnamef(i):=param.lnf(i);
end else error(1);
end;
<*____19____state*>
begin
if readparam(param)=4 then
begin
<*run,load,init,stop*>
j:=5;
i:=0;
repeat i:=i+1;
if param(1)=real (case i of(
<:run:>,<:load:>,<:init:>,<:stop:>)) then j:=i;
until j<>i or i=4;
if j=5 then error(5) else
s_cat.state_f:=j-1;
end else error(5);
end;
<*____17____jobid*>
begin
if readparam(param)=3 then
s_cat.job_id_f:=param(1) else error(5);
end;
end case action;
end;
end while;
end
else error(9);
end
else error(5);
end insert;
procedure pr_cat(out_z);
________________________
comment output from entry 0 ;
zone out_z;
begin
comment output of cat reservation;
ch := ch + write(out_z,
"nl", 3, <:osusercat = set :>,max_tracks,<: disc1 d.0 0 0 11.0 0:>,
"nl", 1, <:scope user osusercat:>);
comment output of gen cat entry;
ch := ch + write(out_z, "nl", 2, <:usercatup newcat:>, <<-ddddddd>,
_ <:.:>, s_cat.segm_f, <:,:>, "sp", 4,
_ <:catsize:>, "nl", 1);
ch:=ch+ write(out_z,<:,updated :>,
<< dd dd dd>,systime(6,s_cat.uptime_f,r),r);
ch:=ch+ write(out_z,<:,entry 0:>,scat.lng_0,<: discs :>,
discs//2,"nl",1);
d_f := 4 - 8;
for t := 1 step 2 until discs do
begin
d_f := d_f + 8;
ch := ch + write(out_z, <:,:>, "nl", 1, true, 12, disc.d_f,
<:.:>,<<ddd>,sr(t));
end;
ch := ch + write(out_z, "nl", 2);
end pr_cat;
procedure pr_proc(out_z);
_________________________________
comment output from process entry;
zone out_z;
begin
integer procedure write_base(basel, baseu, text);
_________________________________________
value basel, baseu;
integer basel, baseu;
string text;
write_base :=
write(out_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, <:,:>);
integer procedure write_disc(disc_a, disc_name);
________________________________________________
integer array disc_a;
long array disc_name;
if disca(3)>0 or disca(4)>0 then
begin
integer s;
s := write(out_z, <:,:>, "nl", 1, true, 12, disc_name, <:.:>);
s := s + write(out_z, <<dddddd>, disc_a(4)//sr(t), <:.:>);
s := s + write(out_z, <<dddddd>, disc_a(3),<:.:>);
s := s + write(out_z,"sp",3,true,8,case disc_a(5)+1 of(
<:drum:>,<:disc:>,<:disc1:>,<:aux:>,<:max:>));
if disc_a(6)>0 or disc_a(7)>0 then
s := s + write(out_z,<:,:>,"nl",1,<:,used:>,"sp",7,<< dddddd>,
disc_a(7)//sr(t), disc_a(6),
if disc_a(7)>disc_a(4) or disc_a(6)>disc_a(3) then
<:,<10>, *** claims exceeded:>
else <::>);
write_disc := s;
end write_disc;
begin
integer s;
s := write(out_z, "nl", 1, <:usercatup_insert.:>,
_ s_cat.name_f, <:,:>);
ch := ch + s;
if all then ch := ch + write(out_z,"nl",1,<:,:>,"*",s - 2);
if s_cat.prio_com_f<>std_prio_comm then
ch := ch + write(out_z, "nl", 1, <:prio.:>, s_cat.prio_com_f shift (-12),
_<:.:>, "sp", 1, <:comm.:>, s_cat.prio_com_f extract 12, <:,:>);
if s_cat.buf_area_f<>std_buf_area then
ch := ch + write(out_z, "nl", 1, <:buf.:>, s_cat.buf_area_f shift (-12),
_ "sp", 1, <:area.:>, s_cat.buf_area_f extract 12, <:,:>);
if s_cat.int_fnc_f<>std_int_func then
ch := ch + write(out_z, "nl", 1, <:inter.:>, s_cat.int_fnc_f shift (-12),
_ "sp", 1, <:func.:>, s_cat.int_fnc_f extract 12, <:,:>);
if (s_cat.stdlo<>8388605 or s_cat.stdhi<>8388605) and
(s_cat.stdlo<>s_cat.usrlo) then
ch := ch + write_base(s_cat.std_lo, s_cat.std_hi, <:std .:>);
ch := ch + write_base(s_cat.usr_lo, s_cat.usr_hi, <:user.:>);
ch := ch + write_base(s_cat.max_lo, s_cat.max_hi, <:max .:>);
if s_cat.addr_f>0 then
ch := ch + write(out_z, "nl", 1, <:addr.:>, s_cat.addr_f,<:,:>);
if s_cat.job_id_f>0 then
ch := ch + write(out_z, "nl", 1,<:jobid.:>,s_cat.job_id_f,<:,:>);
if s_cat.size<>std_size or
s_cat.progf(1)<>std_program(1) or s_cat.progf(2)<>std_program(2) then
ch := ch + write(out_z, "nl", 1, <:size.:>, <<ddddddd>, s_cat.size,
_ "sp",1,<:prog.:>,s_cat.prog_f,<:,:>);
ch := ch + write(out_z,"nl",1,<:project.:>,<< dddd>,
s_cat.project_user shift (-8) extract 16,
<:.:>,s_cat.project_user extract (8),<:,:>);
if s_cat.state_f>0 then
ch:=ch + write(out_z,"nl",1,case s_cat.statef+1 of(
<:run:>,<:load:>,<:init:>,<:stop:>),<:,:>);
ch := ch + write(out_z,"nl",1,<:,resource____slices___entr___type:>);
di_f := first_bs_ref - size_bs_ref;
d_f := 4 - 8;
for t := 1 step 2 until discs do
begin
di_f := di_f + size_bs_ref;
d_f := d_f + 8;
if t = 1 and (s_cat.di_f(1)>0 or s_cat.di_f(2)>0) then ch := ch +
write(out_z,<:,:>, "nl", 1, true, 12, <:temp:>,
_ <:.:>, <<dddddd>, s_cat.di_f(2)//sr(1),
_ <:.:>, s_cat.di_f(1));
ch := ch + write_disc(s_cat.di_f, disc.d_f);
end;
end;
ch := ch + write(out_z, "nl", 3);
end pr_proc;
procedure list(out_z);
_____________________
comment subprogram list;
zone out_z;
begin
boolean sort;
integer users;
init(false);
ch := 0; <*character counter*>
update := false;
all := false;
if readparam(param) = 4 then
begin
tp:=0; action:=6;
repeat tp:=tp+1;
if param(1)=real (case tp of(
<:cat:>,
<:all:>,
<:names:>,
<:sort:>,
<::>)) then action:=tp;
until action<>6 or tp=5;
sort:=action=4;
if sort then action:=2;
if false then write(out,"nl",1,<:list : :>,tp,action);
if action=6 then action:=1 else action:=action+1;
case action of
begin
<*1_____list process_____ *>
begin
boolean found;
integer h;
h := hash(param.ln_f, s_cat.segm_f);
found := search(h, max_tracks, param.ln_f, 1, update);
if -, found then found := search(0, h, param.ln_f, 1, update);
if found then
begin
ch := ch + write(out_z, "nl", 1, <:usercatup delete.:>, s_cat.name_f);
pr_proc(out_z);
end
else error(2);
end;
<*2_____list entry 0_____ *>
pr_cat(out_z);
<*3_____list all_____ *>
begin
integer array projno(1:(maxtracks*(513//rec_lng)));
long array names(1:(maxtracks*(513//rec_lng))*2);
long array field laf;
users:=0;
all := true;
pr_cat(out_z);
ip := 1;
for track := 1 step 1 until max_tracks do
begin
repeat
rest := inrec_6(s_cat, rec_lng);
h_key := s_cat.h_key_f;
if h_key <> -1 and h_key <> -2 then
begin
if -,sort then
begin
if ip mod 4 = 0 then ch := ch + write(out_z, "ff",1);
pr_proc(out_z);
ip := ip + 1;
end no sort;
users:=users+1;
projno(users):=s_cat.project_user;
laf:=(users-1)*8;
names.laf(1):=s_cat.name_f(1);
names.laf(2):=s_cat.name_f(2);
end entry found;
until rest < rec_lng;
end for track;
if sort then
begin
boolean found;
integer h,user;
write(out_z,"nl",1,<:,users :>,users,maxtracks);
quicksort(1,users,projno,names);
for user:=1 step 1 until users do
begin
laf:=(user-1)*8;
if false then write(out_z,"nl",1,<:,:>,
names.laf,<< dddd>,projno(user) shift (-8) extract 8,
projno(user) extract 8);
h:=hash(names.laf,maxtracks);
found:=search(h,maxtracks,names.laf,1,update);
if -,found then found:=search(0,h,names.laf,1,update);
if user mod 5=0 then ch := ch + write(out_z,"ff",1);
if found then pr_proc(out_z);
end user;
end sort;
ch := ch + write(out_z, <:usercatup list.names:>);
end;
<*4_____list process names_____ *>
begin
ch := ch + write(out_z, "ff", 1, "nl", 2, <:,device names in osusercat:>);
d_f := 4 - 8;
for t := 1 step 2 until discs do
begin
d_f := d_f + 8;
ch := ch + write(out_z, "nl", 1, <:,:>, disc.d_f);
end;
ch := ch + write(out_z, "nl", 1, <:,process names in osusercat :>);
for track := 1 step 1 until max_tracks do
begin
repeat
begin
rest := inrec_6(s_cat, rec_lng);
begin
h_key := s_cat.h_key_f;
if h_key <> -1 and h_key <> -2 then
_ ch := ch + write(out_z, "nl", 1, <:,:>, s_cat.name_f);
end;
end;
until rest < rec_lng;
end;
end;
end;
end
else error(8);
write(out_z,"nl",1);
if readparam(param) <> 0 then error(13);
end list;
procedure split(out_z);
________________________
comment split find subprogram;
zone out_z;
begin
comment initialize gen cat entry;
___________________________________
open(s_cat, 4, <:osusercat:>, 0);
lng_f := 4;
lng_0 := 6;
segm_f := 8;
max_user_f:=10;
uptime_f:= 20;
lg_f1 := 4;
lg_f2 := 8;
slice_f := 10;
ref_f := 12;
rec_f := 20 - 12;
d_f := 4 - 8;
comment initialize track process entries;
_______________________________________
h_key_f := 2;
prio_com_f := 4;
name_f := 4;
buf_area_f := 18;
int_fnc_f := 20;
mode_f := 22;
max_lo := 24;
max_hi := 26;
std_lo := 28;
std_hi := 30;
size := 32;
prog_f := 32;
usr_lo := 42;
usr_hi := 44;
projectuser := 46;
user_no_f := 48;
in_name_f := 48;
out_name_f := 56;
term_name_f := 64;
state_f := 74;
job_id_f := 76;
firstbsref := 86;
sizebsref := 18;
addr_f := 14;
action :=6;
tp:=0;
repeat tp:=tp+1;
if param(1)=real (case tp of(
<:newca:> add 116,
<:delet:> add 101,
<:inser:> add 116,
<:list:>,
<:resou:> add 'r',
<::>)) then action:=tp;
until action<>6 or tp=5;
if false then write(out,"nl",1,<:split : :>,tp,action);
if action=6 then action:=1 else action:=action+1;
case action of
begin
error(6);
newcat;
delete;
insert;
list(out_z);
resource_used(out_z);
end;
close(s_cat, true);
end split;
algol copy.tresource;
comment main prog;
________________
zone s_cat(128, 1, std_error);
integer rec_lng, discs, t, rec_0_lng, pos, max_pos,
_ first_bs_ref, size_bs_ref,
_ max_tracks, track, h_key, rest,
_ std_buf_area, std_int_func, std_size,
std_prio_comm, max_users;
integer field lng_f, lng_0, segm_f, slice_f, ref_f, size,
_ h_key_f, prio_com_f, buf_area_f, int_fnc_f, mode_f,
_ max_lo, max_hi, std_lo, std_hi, usr_lo, usr_hi, addr_f,
job_id_f;
integer field project_user, max_user_f, user_no_f, uptime_f, state_f;
long field lg_f1, lg_f2, l_f;
long array disc (1:40), scope(1:2), std_program(1:2);
integer array sr(1:40), tail(1:10), head_and_tail(1:7);
integer array field di_f;
long array field d_f, rec_f, name_f, prog_f, ln_f,
in_name_f, out_name_f, term_name_f;
integer i, j, action, tp, ip,ch;
real r;
array param(1:2), keyword(1:2), outfile(1:2);
zone out_z(128, 1, stderror);
boolean update,all;
boolean bit_0, bit_batch, bit_abssize, bit_std_base,
bit_evening, bit_max_claim, bit_auto, bit_waiting,
bit_c1, bit_priv, bit_size;
algol list.off copy.tmonpr;
bit_0 :=false add (1 shift 0);
bit_batch :=false add (1 shift 1);
bit_abs_size :=false add (1 shift 2);
bit_std_base :=false add (1 shift 3);
bit_evening :=false add (1 shift 4);
bit_maxclaim :=false add (1 shift 5);
bit_waiting :=false add (1 shift 6);
bit_auto :=false add (1 shift 7);
bit_c1 :=false add (1 shift 8);
bit_priv :=false add (1 shift 9);
bit_size :=false add (1 shift 10);
std_prio_comm := 0 shift 12 + 0;
std_buf_area := 10 shift 12 + 10;
std_int_func := 0 shift 12 + 224;
std_size := 40*512;
std_program(1) :=long <:fp:>;
std_program(2) :=long <::>;
j := read_param(param);
if j <> -1 then
begin
j:=readparam(param);
if j = 2 then split(out) else error(7)
end
else
begin
outfile(1) := param(1); outfile(2) := param(2);
readparam(param);
ln_f := 0;
i:=lookup_head_and_tail(outfile.lnf,headandtail);
if i <> 0 then
begin
for i := 1 step 1 until 10 do tail(i) := 0;
tail(1) := 1; <*size*>
comment tail(6) := shortclock;
i:=createentry(outfile.lnf, tail);
if i=0 then i:=permanent_entry(outfile.lnf,3);
if i=0 then i:=set_entry_base(outfile.lnf,2040,2049);
end create new entry;
if i = 0 then
begin
open(out_z, 4, outfile, 0);
if readparam(param) = 2 then
begin
if long param(1) = long <:list:> then split(out_z)
else error(12);
end
else error(7);
ch := ch + write(out_z, "nl", 1, <:end:>, "nl", 1, "em", 3);
close(out_z, true);
tail(1) := ch // 768;
if ch mod 768 <> 0 then tail(1) := tail(1) + 1;
change_entry(outfile.ln_f,tail);
end
else
system(9)alarm:(i, <:<10>settroubl:>);
end;
stop: <*stop*>
trapmode:=1 shift 10;
end
if ok.no
mode warning.yes
if warning.yes
(mode 0.yes
c=message user_cat_up not ok
c=lookup user_cat_up)
if 0.no
(scope user user_cat_up
c=lookup user_cat_up tramusercat)
finisb
mode list.no listing.no
o c
▶EOF◀