|
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◀