|
|
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: 6144 (0x1800)
Types: TextFile
Names: »tprimin«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦0b817e319⟧ »ctramos«
└─⟦this⟧
primary input for batch 1982.01.06
Anders Lindgård
:1: primary input: global definitions
integer array field l_line_buf;
integer field l_next,l_type;
long array field l_procname,l_jobname,l_outname,l_printer,l_last;
:2: primary input: initialization of globals
i:=l_next:=2;
i:=l_type:=i+2;
i:=l_procname:=i;
i:=l_jobname:=i+8;
i:=l_outname:=i+8;
i:=l_printer:=i+8;
i:=l_last:=i+8;
:3: primary input: claiming basic
maxcoru:=maxcoru+1;
maxprocext:=maxprocext+1;
:4: primary input global variables and procedures
algol list.on;
integer priminproc,primpda;
long array primin(1:3);
integer array line_buf(1:bmaxchildren*(l_last//2));
procedure receive_input_message;
begin
integer i,j,res,cbn,op,mode,next,type,curline,
hwreq;
integer array M,A(1:8);
integer array field bufref,inputref,child_pda,cur,fi,
bufd,reg,ct;
long array field nf,lref,address;
array field f;
integer array lrefs(1:8);
long array name,text(1:3),line(1:60);
zone mon(17,1,noerror);
stackclaim(950);
open(mon,8,monitorconsole,0);
f:=0;
address:=firstaddr(line);
for i:=1 step 1 until 60 do line(i):=0;
lref:=lrefs(1):=0;
movestring(line.lref.f,1,<:mode list.yes<10>:>);
lref:=lrefs(2):=lrefs(1)+28;
movestring(line.lref.f,3,<: = set 50<10>:>);
lref:=lrefs(3):=lrefs(2)+28;
movestring(line.lref.f,1,<:scope day :>);
lref:=lref+8+8;
line.lref(1):=long <:<10>:>;
lref:=lrefs(4):=lrefs(3)+28;
movestring(line.lref.f,1,<:o :>);
lref:=lref+4+8;
line.lref(1):=long <:<10>:>;
lref:=lrefs(5):=lrefs(4)+28;
movestring(line.lref.f,1,<:i :>);
lref:=lref+4+8;
line.lref(1):=long <:<10>:>;
lref:=lrefs(6):=lrefs(5)+28;
movestring(line.lref.f,1,<:o c<10>:>);
lref:=lrefs(7):=lrefs(6)+28;
movestring(line.lref.f,3,<:=convert :>);
lref:=lref+8+8+8;
line.lref(1):=long <:<10>:>;
lref:=lrefs(8):=lrefs(7)+28;
movestring(line.lref.f,1,<:finis<10>:>);
for i:=1 step 1 until 8 do A(i):=0;
fi:=0;
<*+2*>
if testop(1) then writelog(<:primary input started:>,0,<::>);
<*-2*>
repeat
c_wait_message(priminproc,M,bufref,0);
child_pda:=core.bufref(4);
<*+2*>
if testop(10) then writelog(<:input 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 sendanswer(2,bufref,A) else
if childtable.ct.ct_batch=0 then send_answer(2,bufref,A) else
begin
<*it was a child*>
op:=core.bufref(5) shift (-12) extract 12;
mode:=core.bufref(5) extract 12;
if op=0 then sendanswer(1,bufref,A) else
if op<>3 then send_answer(3,bufref,A) else
begin
nf:=childpda+2;
hwreq:=core.bufref(7)-core.bufref(6)+2;
for i:=1,2 do name(i):=core.nf(i);
cur:=childtable.ct.ct_ref; <*console description*>
<*+2*>
if testop(10) then disable
begin write(mon,"nl",1,<:input mess : batch:>,
cbn,cur,ct,q.cur.concurchild,<: hwords:>,hwreq);
setposition(mon,0,0);
end;
<*-2*>
bufd:=bufref+10;
lref:=q.cur.q_lref;
next:=line_buf.lref.l_next;
type:=line_buf.lref.l_type;
curline:=nf:=lrefs(next);
<*+2*>
if testop(10) then disable
begin
write(mon,"cr",1,"nl",1,name,next,type);
setposition(mon,0,0);
end;
<*-2*>
if hwreq<28 then
begin
for i:=1,2,3 do A(i):=0;
sendanswer(1,bufref,A);
end else
begin
case next of
begin
begin <*mode list.yes*>
next:=if type=0 then 5 else 2;
end 1;
begin <* <outname> = set 50*>
for i:=1,2 do line.nf(i):=linebuf.lref.l_outname(i);
next:=3;
end 2;
begin <* scope day <outname> *>
nf:=nf+8;
for i:=1,2 do line.nf(i):=linebuf.lref.l_outname(i);
next:=4;
end 3;
begin <*o <outname> *>
nf:=nf+2;
for i:=1,2 do line.nf(i):=linebuf.lref.l_outname(i);
next:=5;
end 4;
begin <*i <jobname> *>
nf:=nf+2;
for i:=1,2 do line.nf(i):=linebuf.lref.l_jobname(i);
next:=if type=0 then 8 else 6;
end 5;
begin <* o c*>
next:=7;
end 6;
begin <* <printer> = convert <outname>*>
for i:=1,2 do line.nf(i):=linebuf.lref.l_printer(i);
nf:=nf+8+8;
for i:=1,2 do line.nf(i):=linebuf.lref.l_outname(i);
next:=8;
end 7;
begin <*finis*>
next:=8;
end 8;
end case next;
i:=address+curline;
res:=copy(bufref,i,i+28-2);
if res<>0 or monw1<28 then A(1):=A(2):=A(3):=0 else
begin
A(1):=0; A(2):=monw1; A(3):=monw3;
linebuf.lref.l_next:=next;
end;
sendanswer(1,bufref,A);
end halwords requested >=28;
end legal operation;
end it was a child;
end childpda>0;
until false;
end input message;
algol list.off;
:5: primary input message: program
algol list.on;
setbasestd;
primin(1):=long <:primi:> add 'n';
primin(2):=0;
createpseudoprocess(primin);
primpda:=process_description(primin);
priminproc:=nextprocext(primpda);
j:=nextcoru(8,40,true);
newactivity(j,j,receive_input_message);
<*+2*>
if testop(2) or testop(7) then
write(out,"nl",1,<:inputmess coroutine :>,j);
<*-2*>
algol list.off;
▶EOF◀