|
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: 6912 (0x1b00)
Types: TextFile
Names: »tparentmess«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »tparentmess«
parent message 82.04.15
Anders Lindgård
:3: parent message: claiming basic
maxcoru:=maxcoru+1;
maxsemch:=maxsemch+1;
maxop:=maxop+maxpmess;
maxnettoop:=maxnettoop+8*maxpmess;
:4: parent message global variables and procedures
algol list.on;
boolean pmess;
integer pmessline;
algol list.on copy.treadjob;
procedure receive_parent_message;
begin
integer i,j,res,cbn,op,mode,word,job;
integer array M,A(1:8);
integer array field bufref,parentref,child_pda,cur,fi,
bufd,reg,ct,bref;
long array field nf;
integer field interrupt_address;
long array name,text(1:3);
boolean pause,batch;
zone pz(17,1,noerror);
stackclaim(750);
interruptaddress:=38;
for i:=1 step 1 until 8 do A(i):=0;
fi:=0;
<*+2*>
if testop(1) then writelog(<:parent message started:>,0,<::>);
<*-2*>
repeat
waitch(pmessline,parentref,pmess,0);
bufref:=d.parentref(2);
child_pda:=core.bufref(4);
<*+2*>
if testop(1) then writelog(<:parent message:>,childpda,<::>);
<*-2*>
if childpda<0 then send_answer(1,bufref,A) else
begin
cbn:=0;
ct:=-ct_size;
repeat cbn:=cbn+1;
ct:=ct+ct_size;
until cbn>maxchildren or childpda=childtable.ct.ct_childpda;
if cbn<=maxchildren then wait(childtable.ct.ct_sem);
if cbn>maxchildren or childtable.ct.ct_childpda<>childpda then
sendanswer(2,bufref,A) else
begin
<*it was a child*>
op:=core.bufref(5) shift (-12) extract 12;
mode:=core.bufref(5) extract 12;
pause:=mode extract 1=1;
if op mod 2=1 or op>42 then sendanswer(3,bufref,A) else
if op=0 then sendanswer(1,bufref,A) else
begin
nf:=childpda+2;
for i:=1,2 do name(i):=core.nf(i);
cur:=childtable.ct.ct_ref; <*console description*>
batch:=childtable.ct.ct_batch>0;
if op//2<3 then childtable.ct.ct_bufref:=bufref;
if batch then
begin
open(pz,8,q.cur.condesterm,tw_mask);
<*+2*>
if testop(7) then
disable write(pz,"nl",1,<:parent mess : batch:>,
cbn,cur,ct,q.cur.concurchild);
<*-2*>
if pause then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=1; <*signal to clock driver*>
d.bref(2):=-1; <*stop*>
d.bref(3):=ct;
signalch(bmessline,bref,cmess);
end pause;
end else
begin
wait(condesc.cur.conaccess);
if condesc.cur.concurchildpda<>childpda then
begin
for i:=1,2 do condesc.cur.conprocname(i):=name(i);
condesc.cur.concurchildpda:=childpda;
condesc.cur.concurchild:=childtable.ct.ct_childno;
end;
open(pz,8,condesc.cur.condesterm,tw_mask);
<*+2*>
if testop(2) then disable write(pz,"nl",1,
<:parent mess: online :>,cbn,cur,ct,childtable.ct.ctbatch);
<*-2*>
if pause then res:=stopchild(condesc.cur);
end;
write(pz,"nl",1,if pause then <:pause:> else <:message:>,
"sp",1,name,"sp",1);
op:=op//2;
mode:=mode shift (-5);
text(2):=0;
bufd:=bufref+10;
for i:=1 step 1 until 7 do
begin
word:=core.bufd(i);
if mode shift (i-7)=1 then
write(pz,word) else
begin
text.fi(1):=word; text.fi(2):=0;
write(pz,text);
if word=0 then write(pz,"sp",1);
end text;
end write buffer content;
if op<3 then childtable.ct.ct_bufref:=bufref;
case op of
begin
begin <*finis*>
if batch then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=1; <*clock*>
d.bref(2):=-5; <*finis*>
d.bref(3):=ct;
signalch(bmessline,bref,cmess);
end batch else
begin
res:=stopchild(condesc.cur);
if res<>0 then disable
write(pz,<:**stop int :>,condesc.cur.conprocname,res);
res:=removechild(condesc.cur,pz);
if res<>0 then write(pz,<:**remove error :>,name,res,
childtable.ct.ct_state);
end online;
end finis;
begin <*break*>
if core.childpda(40+7)>0 and core.childpda(40+7)<18 then
write(pz,core.childpda(40+7),<: ic :>,core.childpda(40+6),
<: w0 :>,core.childpda(41),
<: w1 :>,core.childpda(42),
<: w2 :>,core.childpda(43),
<: w3 :>,core.childpda(44));
if batch then
begin
waitch(bmessline,bref,free,0);
d.bref(1):=1;
d.bref(2):=-4;
d.bref(3):=ct;
signalch(bmessline,bref,cmess);
end else
begin
res:=stopchild(condesc.cur);
childtable.ct.ct_state:=state_breaked;
end;
end break;
begin <*hard error*>
end hard error;
begin <*account*>
end account;
begin <*replace*>
end replace;
begin <*new job*>
read_job_file(ct,bufref,A,pz);
end newjob;
begin <*mount tape*>
end mount;
begin <*print*>
end print;
begin <*mount ring*>
end ring;
begin <*suspend tape*>
end suspend;
begin <*release tape*>
end release;
begin <*load*>
end load;
begin <*change paper*>
end change;
begin <*timer*>
end timer;
begin <*convert*>
end convert;
begin <*mount special*>
end mount special;
begin <*mount kit*>
end kit;
begin <*lock*>
lock:=true;
end lock;
begin <*open*>
lock:=false;
end open;
begin <*remove*>
end remove;
begin <*swop and wait*>
end swop and wait;
end case;
if op>=3 then sendanswer(1,bufref,A);
if -,batch then signal(condesc.cur.conaccess);
close(pz,true);
end legal operation;
end it was a child;
if cbn<=maxchildren then signal(childtable.ct.ctsem);
end childpda>0;
signalch(pmessline,parentref,free);
until false;
end parent message;
algol list.off;
:5: parent message: program
algol list.on;
pmess:=false add (1 shift 4);
pmessline:=nextsemch;
for i:=1 step 1 until maxpmess do
begin
j:=nextop(8);
signalch(pmessline,j,free);
end;
j:=nextcoru(3,300,true);
newactivity(j,j,receive_parent_message);
<*+2*>
if testop(2) or testop(7) then
write(out,"nl",1,<:parentmess coroutine :>,j);
<*-2*>
algol list.off;
▶EOF◀