DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦337c4af7c⟧ TextFile

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tprimin«

Derivation

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦0b817e319⟧ »ctramos« 
            └─⟦this⟧ 

TextFile

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◀