|
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: 10752 (0x2a00)
Types: TextFile
Names: »pppp«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »pppp«
<*reads commands from a given terminal and put them into
a console description
1982.03.30 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 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,1 shift 9);
open(very,8,consolename,1 shift 9);
<*+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.termpda 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 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