|
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: 25344 (0x6300)
Types: TextFile
Names: »treadclist«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »treadclist«
<*reads commands from a given terminal and put them into
a console description
1982.04.16 Anders Lindgård*>
boolean procedure readcommand_list(c_buffer,descriptor,opened);
value opened; boolean opened;
zone c_buffer;
integer array descriptor;
begin
integer i,j,syntax,notallowed,command,commandtype,del,int,nexttype,
res,errortype,bs,usn,jobno,jte;
long t;
real r;
integer array param(1:3),bserror(1:no_of_bs);
long array consolename,n,name,nextname(1:2);
boolean ok,verify,nname,sys,other,exist;
boolean connect;
zone very(17,1,disconnect);
integer array field ct,pda,bref,ref,qref,cpda,cur;
long array field nf;
procedure disconnect(z,i,j);
integer i,j;
zone z;
if (i shift (-4)) extract 1 =1 then
begin
verify:=connect:=false;
termdisconnect:=termdisconnect+1;
end disconnect;
sys:=sysconpda=descriptor.contermpda;
connect:=true;
verify:=opened or testop(3);
for i:=1,2 do consolename(i):=descriptor.condesterm(i);
if -,opened then open(c_buffer,8,consolename,tw_mask);
open(very,8,consolename,tw_mask);
<*+2*>
if testop(5) then write(very,"nl",1,<:read called:>,"nl",1);
if verify then write(very,"nl",1,"*",1);
setposition(very,0,0);
<*-2*>
nexttype:=0;
errortype:=0;
syntax:=50;
notallowed:=syntax+1;
commandtype:=0;
nname:=false;
for i:=1,2,3 do param(i):=0;
name(1):=name(2):=nextname(1):=nextname(2):=0;
for command:=if errortype=0 then nextparam(c_buffer,n,int,del) else
0 while command>0 and
commandtype<syntax do
begin
AGAIN:
if false then write(very,"nl",1,<:;:>,command,<:,:>,nexttype,<:;:>);
if command mod 4=1 and nexttype=1 then
begin
if nname then
begin for i:=1,2 do nextname(i):=n(i); nname:=false; end else
begin
for i:=1,2 do name(i):=n(i);
nname:=true;
end;
nexttype:=case commandtype of(2,0,0,0,0,0,2,
0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,if nname then 1 else 0,
0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0);
if verify and false then write(very,n,"sp",1);
end else
if command mod 4=1 and nexttype<2 then
begin
<*find a name in the list and convert it to a number*>
commandtype:=syntax;
i:=0;
for i:=i+1 while i<syntax and commandtype=syntax do
if n(1)=long (case i of (<:job:>,<:call:>,<:remov:> add 'e',
<:stop:>,<:proc:>,<:run:>,<:bs:>,
<:prog:>,<:in:>,<:out:>,
<:term:>,<:con:>,<:prio:>,
<:buf:>,<:area:>,<:int:>,
<:size:>,
<:creat:> add 'e',<:load:>,<:start:>,
<:list:>,<:max:>,<:init:>,
<:limit:> add 's',<:break:> ,
<:listb:> add 's',<:listd:> add 'e',
<:claim:>,<:stat:>,<:end:>,
<:submi:> add 't',<:queue:>,<:what:>,
<:searc:> add 'h',<:kill:>,
<:login:>,<:logou:>add 't',
<:clear:> add 'd',<:get:>,<:lists:> add 't',
<:relea:> add 's',<:setpr:> add 'i',
<:test:>,<:monit:> add'o',<:btime:>,
<:inclu:> add 'd',<:exclu:> add 'd',
<:lock:>,<:unloc:> add 'k'
)) then commandtype:=i;
nexttype:=case commandtype of(1,2,0,0,
1,0,1,1,1,1,1,0,2,2,2,2,2,
0,0,0,0,0,0,0,0,1,0,0,0,0,1,
0,0,2,2,0,0,0,1,0,2,2,2,1,2,2,2,0,0,-1);
<*+2*>
if verify and false then write(very,case commandtype of (
<:job:>,<:call:>,<:remove:>,
<:stop:>,<:proc:>,<:run:>,<:bs:>,<:prog:>,<:in:>,
<:out:>,<:term:>,<:con:>,<:prio:>,<:buf:>,<:area:>,<:int:>,
<:size:>,
<:create:>,<:load:>,<:start:>,<:list:>,
<:max:>,<:init:>,<:limits:>,<:break:>,
<:listbs:>,<:listdescriptor:>,<:claim:>,
<:stat:>,<:end:>,<:submit:>,
<:queue:>,<:what:>,<:search:>,<:kill:>,
<:login:>,<:logout:>,<:cleardescriptor:>,
<:get:>,<:liststd:>,<:release:>,<:setprio:>,
<:test:>,<:monitor:>,<:btime:>,
<:include:>,<:exclude:>,<:lock:>,<:unlock:>,
<:syntax:>),<:(nt=:>,nexttype,
<:) :>);
<*-2*>
end name or name.
else
if command mod 4=2 and nexttype>=2 then
begin
<*integer*>
param(nexttype-1):=int;
nexttype:=case commandtype of(
0,1,0,0,0,0,if nexttype=2 then 3 else 0,
0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0);
<*+2*>
if verify and false then write(very,<<d>,int,"sp",1);
<*-2*>
end integer or integer. else
if command mod 4=1 and nexttype=2 and
(commandtype=1 or commandtype=39) then
begin
<*skip integer*>
nexttype:=0;
end else
begin
commandtype:=syntax;
<*+2*>
if verify and false then write(very,<:***syntax:>);
<*-2*>
end syntax error;
if lock and -,sys then commandtype:=notallowed;
<*execute commands*>
if descriptor.conjob=0 and descriptor.contermpda<>sysconpda then
commandtype:=case commandtype of(
commandtype,commandtype,notallowed,
notallowed,notallowed,notallowed,notallowed,
notallowed,notallowed,notallowed,
notallowed,commandtype,notallowed,
notallowed,notallowed,notallowed,
notallowed,
notallowed,notallowed,notallowed,
commandtype,commandtype,notallowed,
commandtype,notallowed,
commandtype,commandtype,
notallowed,commandtype,commandtype,
commandtype,
commandtype,commandtype,commandtype,commandtype,
commandtype,commandtype,commandtype,
commandtype,commandtype,syntax,syntax,
commandtype,commandtype,commandtype,
commandtype,commandtype,syntax,syntax,syntax,notallowed);
if descriptor.con_job=1 and commandtype<>1 <*job*> and
commandtype<>39 <*get*> then
sys:=sys or logand(descriptor.con_prio_and_commands,bit_priv)<>0;
if nexttype=0 or commandtype>=syntax or del='nl' then
begin
case commandtype of
begin
if name(1)=0 and connect then writeerror(very,errornameunknown,bserror) else
if name(1)=0 then else
begin
<*_1_job*>
if verify then write(very,<:job :>,name);
ok:=readusercat(name,descriptor,testop(4),very) and
curchildren<maxchildren;
if sys then ok:=ok and
(logand(descriptor.con_prio_and_commands,bit_c1)<>0 or
logand(descriptor.con_prio_and_commands,bit_priv)<>0);
if ok and (descriptor.con_job_id=0 or descriptor.con_job_id=param(1)) then
begin
descriptor.con_job:=1;
descriptor.conprocin:=descriptor.conprocout:=descriptor.contermpda;
std_claim(descriptor);
std_bs(descriptor,very);
end else
begin
errortype:=4;
if connect then writeerror(very,errornameunknown,bserror);
end;
if errortype=0 and (del='nl' or del='em') then
begin
errortype:=createchild(descriptor,false,very,ct);
set_prio_child(descriptor);
if errortype=0 then
errortype:=load_and_modify(descriptor,very,opened)
else errortype:=errortype+64;
if errortype=0 then
errortype:=setbs(descriptor,bserror,very,true);
if errortype=0 and descriptor.con_jobstate=0 then
errortype:=startchild(descriptor);
if errortype>0 then errortype:=errortype+128;
end execute;
if command mod 4=1 and del<>'nl' then
begin
goto AGAIN;
end;
end job;
begin
<*_2_call*>
if verify then write(very,<:call :>,int,"sp",1,name,"sp",1);
errortype:=5;
if sys or (int>=firstmt and int<=lastmt) then
begin
errortype:=create_peripheral(name,int);
if errortype>0 then
begin
if connect then writeerror(very,case errortype+1 of(
errorready,errorresultimpossible,errorcatalogerror,
errornameconflict,errordeviceunknown,
errordevicereserved,errorresultimpossible),bserror);
end error;
end allowed else
if connect then writeerror(very,error_not_allowed,bserror);
end call;
begin
<*_3_remove*>
if verify then write(very,<:remove :>);
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 then
begin
errortype:=stopchild(descriptor);
if errortype=0 then
begin
other:=sysconpda=descriptor.contermpda and
sysconpda<>childtable.ct.ct_termpda;
ref:=childtable.ct.ct_ref;
if other then wait(condesc.ref.conaccess);
errortype:=removechild(descriptor,very);
if other then signal(condesc.ref.conaccess);
end removed;
end;
end remove;
begin
<*_4_stop*>
if verify then write(very,<:stop:>);
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 then
begin
errortype:=stopchild(descriptor);
end else
begin
errortype:=b_check_child(descriptor,ct);
if errortype=0 then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=1;
d.bref(2):=-1;
d.bref(3):=ct;
signalch(bmessline,bref,cmess);
end bchild;
end check b child;
end stop;
begin
<*_5_proc*>
if verify then write(very,<:proc :>,name,"sp",1);
for i:=1,2 do descriptor.conprocname(i):=name(i);
end proc;
if descriptor.conjob=0 then errortype:=notallowed else
begin
<*_6_run*>
if verify then write(very,<:run :>);
pda:=process_description(descriptor.conprocname);
if if pda=0 then true else (pda>0 and ( descriptor.concurchildpda=pda or
core.pda.parentref<>ownpda)) then
begin
errortype:=createchild(descriptor,false,very,ct);
set_prio_child(descriptor);
if errortype=0 then errortype:=setbs(descriptor,bserror,very,true);
end else
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 then
errortype:=loadandmodify(descriptor,very,opened);
if errortype=0 and descriptor.con_job_state=0 then
errortype:=startchild(descriptor);
end run;
begin
<*_7_bs*>
if verify then write(very,<:bs :>,name,param(1),param(2),"sp",1);
exist:=checkchild(descriptor,false,very,ct)=0;
usn:=descriptor.conusercatno;
bs:=noofbs+1;
for i:=1 step 1 until noofbs do
begin
bserror(i):=0;
nf:=ref:=i*12-12;
ref:=usercatbs.ref(6);
if usercatbs.nf(1)=name(1) and
usercatbs.nf(2)=name(2) then bs:=i;
if exist then descriptor.ref(8):=descriptor.ref(9):=0;
end for;
if bs=no_of_bs+1 or -,bs_exist(bs) then
begin
if connect then writeerror(very,errorbsdeviceunknown,bserror);
end else
if exist then
begin
<*give the process claims*>
ref:=(bs-1)*12;
ref:=usercatbs.ref(6);
descriptor.ref(8):=param(2); descriptor.ref(9):=param(1);
setbs(descriptor,bserror,very,false);
end exist else
begin
ref:=(bs-1)*12;
ref:=usercatbs.ref(6);
descriptor.ref(8):=param(2); descriptor.ref(9):=param(1);
end;
end bs;
begin
<*_8_prog*>
if verify then write(very,<:prog :>,name,"sp",1);
for i:=1,2 do descriptor.conprogram(i):=name(i);
end prog;
begin
<*_9_in*>
if verify then write(very,<:in.:>,name,"sp",1);
for i:=1,2 do descriptor.coninname(i):=name(i);
end in;
begin
<*_10_out*>
if verify then write(very,<:out.:>,name,"sp",1);
for i:=1,2 do descriptor.conoutname(i):=name(i);
end out;
begin
<*_11_term*>
if verify then write(very,<:term.:>,name,"sp",1);
for i:=1,2 do descriptor.contermname(i):=name(i);
end term;
begin
<*_12_con*>
if verify then write(very,<:con :>);
write(very,descriptor.condesterm,"nl",1);
end con;
begin
<*_13_prio*>
if verify then write(very,<:prio.:>,<<d>,param(1),"sp",1);
i:=descriptor.con_prio_and_commands;
i:=(i extract 12) add (param(1) shift 12);
if param(1)>=0 and param(1)<1024 then
begin
descriptor.con_prio_and_commands:=i;
if checkchild(descriptor,false,very,ct)=0 then
set_prio_child(descriptor);
end else
begin
errortype:=29;
if connect then writeerror(very,errorillegalpriority,bserror);
end;
end prio;
begin
<*_14_buf*>
if verify then write(very,<:buf.:>,<<d>,param(1),"sp",1);
if int<0 or int>1023 or (-,sys and int>std_max_buf) then
begin
if connect then writeerror(very,errornobuffers,bserror);
end else
descriptor.conbufandarea:=descriptor.conbufandarea extract 12
add (int shift 12);
end buf;
begin
<*_15_area*>
if verify then write(very,<:area.:>,<<d>,param(1),"sp",1);
if int<0 or int>1023 or (-,sys and int>std_max_area) then
writeerror(very,errornoareas,bserror) else
descriptor.conbufandarea:=(descriptor.conbufandarea shift (-12) extract 12)
shift 12 add int;
end area;
begin
<*_16_int*>
if verify then write(very,<:int.:>,<<d>,param(1),"sp",1);
i:=descriptor.conint_and_func;
i:=(i extract 12) add (int shift 12);
if int>=0 and int<1024 and (sys or int<=std_max_int) then
descriptor.con_int_and_func:=i else
if connect then writeerror(very,errorsyntax,bserror);
end int;
if day and -,sys and
logand(descriptor.con_prio_and_commands,bit_abs_size)=0 then
errortype:=not_allowed else
begin
<*_17_size*>
if verify then write(very,<:size:>,param(1));
i:=param(1);
if i<0 or i>512*noofcoreblocks*coreblocksize then
begin
errortype:=81;
if connect then writeerror(very,errornotallowed,bserror);
end else descriptor.consize:=i;
end size;
begin
<*_18_create*>
if verify then write(very,<:create :>);
errortype:=createchild(descriptor,false,very,ct);
set_prio_child(descriptor);
end create;
begin
<*_19_load*>
if verify then write(very,<:load :>);
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 and -,(sys and childtable.ct.ct_termpda<>sysconpda) then
errortype:=load_and_modify(descriptor,very,opened) else errortype:=4;
end load;
begin
<*_20_start*>
if verify then write(very,<:start :>);
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 then
errortype:=startchild(descriptor) else
begin
errortype:=b_check_child(descriptor,ct);
if errortype=0 then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=1;
d.bref(2):=-2;
d.bref(3):=ct;
signalch(bmessline,bref,cmess);
end start b_child;
end possible b_child;
end start;
begin
<*_21_list*>
if verify then write(very,<:list :>);
if connect then write(very,if day then <:day:> else <:night:>);
if connect then list_proc(very,connect);
if connect then write(very,"nl",1);
end list;
begin
<*_22_max*>
write(very,<:max :>,<<dddddd>,findmaxfreecore,
<< ddd>,freebuf,freearea,freeinternal,
"nl",1);
end max;
begin
<*_23_init*>
if verify then write(very,<:init :>);
errortype:=createchild(descriptor,false,very,ct);
set_prio_child(descriptor);
if errortype=0 then
errortype:=load_and_modify(descriptor,very,opened);
end init;
begin
<*_24_limits*>
if verify then write(very,<:limits :>,"sp",1);
if connect then write(very,<:current limits in batch :>,
if day then <: day:> else <:night:>,<: maxtime :>,
b_max_time//60,<: min:>);
if connect then write(very,"nl",1,<< ddddd>,
<:max time day :>,b_max_time_day//60,<: min:>,
b_max_time_day mod 60,<: sec:>,
"nl",1,<:max size day :>,b_max_size_day//1024,<: k:>,
"nl",1,<:max time night :>,b_max_time_night//60//60,<: h:>,
<* "nl",1,<:max size night :>,b_max_size_night//1024,<: k:>, *>
"nl",1,<:day to night :>,<<____dd.dd>,bdaytonight/100,
"nl",1,<:night to day :>,bnighttoday/100,
"nl",1,<:parallel jobs :>,<< ddddd>,bmaxchildren,
"nl",1,<:max jobs :>,b_maxjobs);
write(very,"nl",1);
end limits;
begin
<*_25_break*>
if verify then write(very,<:break :>,"sp",1);
errortype:=checkchild(descriptor,true,very,ct);
if errortype=0 then
other:=sys and childtable.ct.ct_termpda<>sysconpda;
ref:=childtable.ct.ct_ref;
if other then wait(condesc.ref.conaccess);
errortype:=break_child(descriptor,very);
if other then signal(condesc.ref.conaccess);
end break;
begin
<*_26_listbs*>
if verify then write(very,<:listbs :>,name);
pda:=process_description(name);
if pda=0 then
begin
if connect then writeerror(very,errorprocessunknown,bserror);
end else
if core.pda(1)<>0 then
begin
if connect then writeerror(very,errorprocessunknown,bserror);
end else
if connect then disable list_bs(name,very);
end listbs;
begin
<*_27_list descriptor*>
if verify then write(very,<:list descriptor:>);
if (descriptor.conjob>0 or sys) and connect then
disable writeentry(descriptor,very,true);
end list descriptor;
begin
<*_28_claim*>
if verify then write(very,<:claim:>);
if connect then
write(very,true,11,<:doc:>,<:___entries____:>,<:___segments:>,
"nl",1,"sp",11,<:___used__total___used__total:>);
for bs:=1 step 1 until noofbs do
begin
laf:=(bs-1)*12;
ok:=false;
for i:=1,2,3,4 do
begin
j:=perm_bs_claimed(descriptor.conusercatno,bs,i);
ok:=(ok or j>0) and connect;
end;
if ok then
begin
write(very,"nl",1,true,11,usercatbs.laf);
if -,bs_exist(bs) then write(out,<: ** does not exist:>) else
for i:=1,3,2,4 do write(very,<< dddddd>,
perm_bs_claimed(descriptor.conusercatno,bs,i));
end ok;
end for bs;
if connect then write(very,"nl",1);
end claim;
begin
<*_29_stat*>
if verify then write(very,<:stat:>);
pda:=ownpda;
t:=core.pda.starttimeref;
r:=t//10000;
if connect then writecurtime(very);
if connect then write(very,"nl",1,
<:blocksread :>,blocksread,
"nl",1,<:cpu time (sec) :>,core.pda.runtimeref//10000,
"nl",1,<:start time :>,<< dd dd dd>,
systime(4,r,r),r,
"nl",1,<:time used (sec) :>,<< ddd ddd>,
(getclock-core.pda.starttimeref)//10000,
"nl",1,<:children created :>,<< ddd>,childrencreated,
"nl",1,<:parent messages :>,os_parent_mess,
"nl",1,<:att messages :>,os_communication,
"nl",1,<:terminal disconnect :>,termdisconnect,
"nl",1,<:coreblocks :>,noofcoreblocks,
"nl",1,<:blocksize :>,512*coreblocksize,
"nl",1);
end stat;
begin
<*_30_end*>
errortype:=if opened then 0 else syntax;
end;
begin
<*__31__submit*>
if verify then write(very,<:submit :>,name,<:.:>,nextname);
if (name(1)=0 and descriptor.conjob>0) or
(name(1)=long <:job:> and nextname(1)<>0) then
begin
waitch(qmessline,qref,free,0);
d.qref(1):=1; <*operation code*>
d.qref(2):=descriptor.conref;
for i:=1,2 do d.qref.d_jobname(i):=nextname(i);
<*+2*>
if testop(7) then write(very,"nl",1,<:**submit :>,
d.qref(1),d.qref(2),d.qref.djobname,qref,djobname);
<*-2*>
signalch(qmessline,qref,qmess);
end else errortype:=syntax;
end submit;
begin
<*__32__queue*>
if verify then write(very,<:queue:>);
waitch(qmessline,qref,free,0);
d.qref(1):=2;
d.qref(2):=descriptor.conref;
signalch(qmessline,qref,qmess);
end queue;
begin
<*__33_what*>
if verify then write(very,<:what:>);
waitch(qmessline,qref,free,0);
d.qref(1):=3;
d.qref(2):=descriptor.conref;
signalch(qmessline,qref,qmess);
end what;
begin
<*__34__search*>
if verify then write(very,<:search :>,param(1));
waitch(qmessline,qref,free,0);
d.qref(1):=4;
d.qref(2):=descriptor.conref;
d.qref(3):=param(1);
signalch(qmessline,qref,qmess);
end search;
begin
<*__35__kill*>
if verify then write(very,<:kill :>,param(1));
jobno:=param(1);
jte:=0;
repeat jte:=jte+1;
until jte=b_max_jobs or jobno=jobtable(jte,3);
if jobno<>jobtable(jte,3) then
begin errortype:=5; writeerror(very,errorjobnumbernotfound,bserror);
end else
begin
if sysconpda<>descriptor.contermpda and
descriptor.conprojno shift (-8) extract 16 <>jobtable(jte,10) then
errortype:=notallowed else
begin
waitch(qmessline,qref,free,0);
d.qref(1):=5;
d.qref(2):=descriptor.conref;
d.qref(3):=param(1);
signalch(qmessline,qref,qmess);
end sysconpda or projectnumber;
end job found;
end;
if -,sys then errortype:=syntax else
begin
<*__36_login*>
if verify then write(very,<:login:>);
b_max_time:=b_max_time_day;
if -,day then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=2;
d.bref(2):=-1;
signalch(bmessline,bref,bmess);
end;
day:=true;
end;
if -,sys then errortype:=syntax else
begin
<*__37_logout*>
if verify then write(very,<:logout:>);
b_max_time:=b_max_time_night;
if day then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=2;
d.bref(2):=-1;
signalch(bmessline,bref,bmess);
end;
day:=false;
end logout;
begin
<*__38_clearde*>
if verify then write(very,<:cleardescriptor:>);
descriptor.conjob:=0;
end cleardescriptor;
begin
<*_39_get*>
if verify then write(very,<:get :>,name,param(1));
ok:=readusercat(name,descriptor,testop(4),very);
if sys then ok:=ok and
(logand(descriptor.con_prio_and_commands,bit_c1)<>0 or
logand(descriptor.con_prio_and_commands,bit_priv)<>0);
if ok and (descriptor.con_job_id=0 or descriptor.con_job_id=param(1)) then
begin
descriptor.conjob:=1;
descriptor.conprocin:=descriptor.conprocout:=descriptor.contermpda;
std_claim(descriptor);
std_bs(descriptor,very);
end else
begin
errortype:=4;
if connect then writeerror(very,errornameunknown,bserror);
end;
if command mod 4=1 and del<>'nl' then
begin
goto AGAIN;
end;
end get;
begin
<*_40_liststd*>
if verify then write(very,<:liststd:>);
if connect then write(very,<:standard resources:>,
<< dddd>,
<* "nl",1,<:standard size :>,std_size,<: online:>, *>
"nl",1,<:standard size :>,b_max_size_day,<: batch:>,
"nl",1,<:standard buf :>,std_buf,
"nl",1,<:standard area :>,std_area,
"nl",1,<:standard internal:>,std_int,
"nl",1,<:bs-entries :>,std_entries,
"nl",1,<:1. disc :>,stdentrydisc,<: entries :>,
stdsegmdisc,<: segments:>,
"nl",1,<:2. disc :>,stdentrydisc1,<: entries :>,
stdsegmdisc1,<: segments:>,"nl",1);
end liststd;
if -,sys then errortype:=syntax else
begin
<*_41_release*>
if verify then write(very,<:release:>,param(1));
waitch(qmessline,qref,free,0);
d.qref(1):=6;
d.qref(2):=descriptor.conref;
d.qref(3):=param(1);
signalch(qmessline,qref,qmess);
end release;
if -,sys then errortype:=syntax else
begin
<*_42__setprio*>
if verify then write(very,<:setprio:>,param(1));
waitch(qmessline,qref,free,0);
d.qref(1):=7;
d.qref(2):=descriptor.conref;
d.qref(3):=param(1);
signalch(qmessline,qref,qmess);
end setprio;
if -,sys then errortype:=syntax else
begin
<*_43_test*>
if verify then write(very,<:test:>,param(1));
i:=param(1);
if i<1 or i>12 then errortype:=notallowed else
testop(i):=-,testop(i);
end test;
if -,sys then errortype:=syntax else
begin
<*_44_monitor*>
if verify then write(very,<:monitor.:>,name);
i:=process_description(name);
if i=0 then writeerror(very,errornameunknown,bserror) else
begin
for i:=1,2 do monitorconsole(i):=name(i);
mon_change:=true;
end;
end monitor;
if -,sys then errortype:=syntax else
begin
<*_45_btime*>
if verify then write(very,<:btime:>,param(1));
b_max_time:=param(1);
end btime;
begin
<*_46_include*>
if verify then write(very,<:include:>,param(1));
if param(1)>=0 and param(1)<=256 and sys then
errortype:=includeuser(descriptor.conprocname,param(1)) else
errortype:=syntax;
end include;
begin
<*_47_exclude*>
if verify then write(very,<:exclude:>,param(1));
if param(1)>=0 and param(1)<=256 and sys then
errortype:=excludeuser(descriptor.conprocname,param(1)) else
errortype:=syntax;
end exclude;
if -,sys then errortype:=syntax else
begin
<*_48_lock*>
if verify then write(very,<:lock:>);
lock:=true;
end lock;
if -,sys then errortype:=syntax else
begin
<*_49_unlock*>
if verify then write(very,<:unlock:>);
lock:=false;
end unlock;
begin
<*_49_syntax*>
if verify then write(very,<:syntax:>);
errortype:=syntax;
end syntax;
begin
<*_50_notallowed*>
errortype:=notallowed;
end not allowed;
end case;
for i:=1,2,3 do param(i):=0;
name(1):=name(2):=nextname(1):=nextname(2):=0;
nname:=false;
end nexttype=0;
end for command;
if command<0 and -,opened then errortype:=syntax;
if errortype=0 then
begin
if connect then writeerror(very,errorready,descriptor);
end else
if errortype=syntax then writeerror(very,errorsyntax,bserror) else
if errortype=notallowed then
begin
if connect then writeerror(very,errornotallowed,bserror);
end;
close(c_buffer,true);
if verify then write(very,"nl",1,<:errortype :>,errortype);
close(very,true);
readcommandlist:=commandtype<>syntax;
end read command list;
▶EOF◀