⟦4a29618f4⟧

TextFile

<*run batch
procedure for running batch jobs
1982-04-15 Anders Lindgård*>

procedure run_batch;
begin
integer array field bref,des,ct,ctn,runchildct,childpda;
integer i,j,res,rep,op,childno,segmno,jobno,clock,oldclock,job,
     jte,cjte,b_c_clock,t_used,now,t,o_clock,q_no,type,
     prio,drunt,runtime,childrun,nprio,jte1,nct;
long array field l_name,l_ref;
boolean first,brun,found,oldday;
long ltime;
real r;
zone mon,very(17,1,bnoerror);
integer array db(1:3);
integer d_b_loadstart,d_b_kill,d_b_break,d_b_finis,d_b_stop,d_b_start;

procedure bnoerror(z,i,j);
integer i,j;
zone z;
if i shift (-4) extract 1= 1 then
begin
  <*disconnected*>
  disable write(out,"nl",1,<:***monitor console :>,monitor_console,
     <: disconnected:>);
  outendcur(10);
  monchange:=monlist:=false;
end bnoerror;
d_b_stop:=-1;
d_b_start:=-2;
d_b_load_start:=-3;
d_b_break:=-4;
d_b_finis:=-5;
d_b_kill:=-6;
stackclaim(1200);
open(mon,(if testop(2) then 0 else 2) shift 12+8,monitorconsole,1 shift 9);
write(mon,"cr",1,"nl",1,<:batch started :>);
writecurtime(mon);
setposition(mon,0,0);
b_c_clock:=(getclock//10000) mod 1000000;;
systime(5,0,r);
oldclock:=r/100;
<*scan job table*>
b_run_children:=0;
init_batch_queue;
rep:=0;
repeat rep:=(rep+1) mod b_interval;
if b_cur_children=b_max_children then
waitch(bmessline,bref,cmess,0) else
waitch(bmessline,bref,bmess or cmess,0);
for i:=1,2,3 do db(i):=d.bref(i);
signalch(bmessline,bref,free);
if monchange then
begin
  monlist:=true;
  monchange:=false;
  close(mon,true);
  open(mon,(if testop(2) then 0 else 2) shift 12+8,monitorconsole,1 shift 9);
end monchange;
op:=db(1);
case op of
begin
  begin
   <*clock message*>
   clock:=db(2);
   if clock>0 then
   begin
   oldday:=day;
   clock:=clock//100;
   inspectch(bmessline,free,i);
   if clock>=b_day_to_night and oldclock<=b_day_to_night then
   day:=false else
   if clock>=b_night_to_day and oldclock<=b_night_to_day then
   day:=true;
<*+2*>
   if testop(7) and mon_list then disable
      write(mon,"cr",1,"nl",1,<<dd dd dd>,db(2),
   if day then <: day:> else <: night:>,<: free bmess :>,i);
<*-2*>
   oldclock:=clock;
   if -,(day==oldday) then
   begin
<*+2*>
     if testop(7) or testop(11) then
     disable
     if mon_list then
     begin
       write(mon,"cr",1,"nl",1,<:!!!!night day shift:>);
       setposition(mon,0,0);
     end;
<*-2*>
     bmaxtime:=if day then b_max_time_day else b_max_time_night;
     waitch(bmessline,bref,free,0);
     d.bref(1):=2; d.bref(2):=-1;
     signalch(bmessline,bref,bmess);
  end day<>oldday;
   end clock>0;
   if monlist then setposition(mon,0,0);
   if b_cur_children>0 or clock<0 then
   begin
     <* possible swop child*>
     ct:=runchildct;
     now:=(getclock//10000) mod 1000000;
     t_used:=now-b_c_clock;
     o_clock:=b_c_clock;
     b_c_clock:=now;
     ctn:=if clock>=0 then ct else db(3);
<*+2*>
     if testop(7) and monlist then disable
     begin
      write(mon,"nl",1,"cr",1,<:swop possible :>);
      if clock<0 and abs clock<=6 then write(mon,"sp",4,case abs clock of
          (<:stop:>,<:start:>,<:loadstart:>,<:break:>,
           <:finis:>,<:kill:>));
     if ctn>=0 then write(mon,childtable.ctn.ct_childno) else
     write(mon,<:**ctn:>,ctn,clock);
     setposition(mon,0,0);
     end;
<*-2*>
     if ctn<0 then
     begin
       ctn:=0; clock:=0;
     end error;
     des:=childtable.ct.ctref;
     jte:=childtable.ct.ctsegmqueue;
     childno:=childtable.ct.ct_childno;
     childpda:=
       if childtable.ct.ctbatch=0 or childtable.ct.ctstate<=statecreated or
          childtable.ct.ctstate=statestopped then 0
       else childtable.ct.ct_childpda;
     if bcurchildren=0 or childpda=0 or jte<1 then t:=1 else
     if jobtable(jte,2)<2 then t:=1 else
     t:=jobtable(jte,6):=jobtable(jte,6)-t_used;
<*+2*>
     if testop(7) and monlist then disable
     begin
        write(mon,"nl",1,<:ctn,jte,des,brun,bcur,pda,no,t:>,
              ctn,jte,des,brunchildren,bcurchildren,childpda,childno,t);
     end;
<*-2*>
     if (clock>0 and (brunchildren>0 or t<=0)) or
        (clock<0 and childpda>0) then
     begin
        res:=stopchild(q.des);
        <*update priority:
          newpriority:=oldpriority+cpu_used+time_used*timefac;
        *>
        runtime:=core.childpda.runtimeref//10000; <* sec*>
        drunt:=runtime-jobtable(jte,11);
        jobtable(jte,11):=runtime;
        prio:=jobtable(jte,4)+drunt+t_used*b_time_fac;
        jobtable(jte,4):=prio;
        swop_child(swop,ct,false,mon);
        childtable.ct.ctstate:=stateswopped;
<*+2*>
        if testop(7) and monlist then disable
        begin
          write(mon,"nl",1,<: stop res:>,res,<: prio :>,prio,drunt);
          if t<0 and clock>0 then 
          write(mon,<: time exceeded:>) else 
          write(mon,<: time used :>,t_used);
          setposition(mon,0,0);
        end;
<*-2*>
        if t<0 and clock>0 then
        begin
           if childtable.ct.ct_batch=1 then
           begin
             clock:=d_b_kill; ctn:=ct;
             childtable.ct.ct_batch:=2;
             jobtable(jte,2):=3; <*removed*>
             jobtable(jte,4):=0; <*highest priority*>
             jobtable(jte,6):=2*b_time_slice;
           end else
           if childtable.ct.ct_batch=2 then
           begin
             clock:=d_b_finis; ctn:=ct;
             childtable.ct.ct_batch:=3;
           end;
        end;
    end swop out;
     <*check that the child is ok*>
     if clock<0 then
     begin
       childpda:=if childtable.ctn.ct_batch=0 then 0 else
           childtable.ctn.ct_childpda;
       if childpda=0 then clock:=0;
     end;
     if clock=d_b_stop then
     begin
      if childtable.ctn.ctstate=stateswopped then
      begin
         childtable.ctn.ctstate:=statestopped;
      end;
     end stop else
     if clock=d_b_start then
     begin
       if childtable.ctn.ctstate=statestopped then
       begin
          childtable.ctn.ctstate:=stateswopped;
       end;
     end start;
     if clock=d_b_break or clock=d_b_finis then
     begin
       runchildct:=ct:=ctn;
       des:=childtable.ct.ct_ref;
       stopchild(q.des);
       if clock=d_b_break then
       childtable.ct.ctstate:=statebreaked;
       jte:=childtable.ct.ct_segm_queue;
       childno:=childtable.ct.ct_childno;
       if childtable.ct.ctbatch=1 and
       (clock=d_b_break or (q.des.qprinter(1)<>0)) then
       begin
         childtable.ct.ctbatch:=2;
         jobtable(jte,2):=3; <*removed*>
         jobtable(jte,4):=0; <*highest priority*>
         jobtable(jte,6):=2*b_time_slice;
         clock:=d_b_load_start;
       end else res:=removechild(q.des,mon);
     end break;
     if clock=d_b_load_start then
     begin
       runchildct:=ct:=ctn;
       des:=childtable.ct.ctref;
       res:=b_load_and_start(q.des,mon);
       if childtable.ct.ctbatch=1 then
       jobtable(childtable.ct.ctsegmqueue,2):=2;
     end load and start else
     if clock=d_b_kill then
     begin
       if runchildct<>ctn and childtable.ctn.ctstate<>statebreaked then
       begin
         runchildct:=ct:=ctn;
         swop_child(swop,ct,true,mon);
         des:=childtable.ct.ctref;
         childno:=childtable.ct.ct_childno;
         childpda:=childtable.ct.ct_childpda;
<*+2*>
         if testop(7) and monlist then disable write(mon,"nl",1,
            <:swop in (kill) :>,childno);
<*-2*>
       end swop in;
       runchildct:=ct:=ctn;
       cjte:=childno:=childtable.ct.ct_childno;
       des:=childtable.ct.ctref;
       jte:=childtable.ct.ctsegmqueue;
<*+2*>
       if testop(7) and monlist then disable
         write(mon,"nl",1,"cr",1,<:kill child :>,childtable.ct.ctchildno);
<*-2*>
       if childtable.ct.ctstate=statecreated then res:=removechild(q.des,mon) else
       if childtable.ct.ctstate<>statebreaked and childtable.ct.ctbatch<3 then
       begin
       res:=breakchild(q.des,mon);
       if jobtable(jte,2)=2 then
       begin
         jobtable(jte,3):=3; <*removed*>
         jobtable(jte,4):=0; <*highest priority*>
         jobtable(jte,6):=2*b_time_slice;
         childtable.ct.ct_batch:=2;
       end running;
       clock:=d_b_load_start; <*to prevent nextjob from
                                selecting another process*>
       end else
       begin
       res:=removechild(q.des,mon);
       end breaked;
    end kill;
    if bcurchildren>0 and clock<>d_b_load_start then
    begin
      <* next job*>
     des:=childtable.ct.ctref;
     cjte:=childno:=childtable.ct.ctchildno;
     childrun:=0;
     if childtable.ct.ctbatch>0 and
        childtable.ct.ctstate>statecreated and
        childtable.ct.ctstate<>statestopped then
     begin
      jte:=childtable.ct.ctsegmqueue;
      prio:=jobtable(jte,4);
     end else prio:=800000;
     nct:=ct;
     <*find next job*>
<*+2*>
     if testop(7) and monlist then disable 
        write(mon,"nl",1,"cr",1,<:next job:>,childno,maxchildren,<:(:>);
<*-2*>
     repeat childno:=childno mod maxchildren +1;
     ct:=(childno-1)*ctsize;
     found:=brun:=childtable.ct.ctbatch>0 and
           childtable.ct.ctstate>statecreated and
           childtable.ct.ctstate<>statestopped;
     if brun then
     begin
       jte1:=childtable.ct.ctsegmqueue;
       nprio:=jobtable(jte1,4);
       if nprio<=prio then
       begin
         jte:=jte1;
         nct:=ct;
         prio:=nprio;
         childrun:=childtable.ct.ctchildno;
       end better prio;
     end batch child;
<*+2*>
     if testop(7) and (brun or found)  and monlist then disable
     begin
     write(mon,<<d>,childno,if brun and found then <:+:> else <:-:>,<:;:>);
     setposition(mon,0,0);
     end;
<*-2*>
     until  childno=cjte ;
     brun:=childrun>0;
     if brun then childno:=childrun;
     ct:=nct;
<*+2*>
     if testop(7) and monlist then disable
     begin
       write(mon,<:) job found child:>,childrun,
         if childrun>0 then <: to run:> else <: improper:>);
       setposition(mon,0,0);
       end;
<*-2*>
      if childno<>cjte and brun then
     begin
       <* swop in and start*>
       runchildct:=ct;
<*+2*>
       if testop(7) and monlist then disable
       begin
         write(mon,<: swop in:>,childno);
         setposition(mon,0,0);
       end;
<*-2*>
       swopchild(swop,ct,true,mon);
    end swop in;
    if brun then
    begin
    des:=childtable.ct.ctref;
    res:=startchild(q.des);
<*+2*>
    if testop(7) and monlist then disable write(mon,"nl",1,"cr",1,
     <:start child :>,childtable.ct.ctchildno);
<*-2*>
    end start job;
    end next job;
   end;
  end  clock;
  begin
    <*run job*>
    segmno:=find_next_job(mon);
<*+2*>
    if testop(7) and monlist then 
     disable begin write(mon,"cr",1,"nl",1,<:run batch:  :>,
        <: job segment:>,segmno);
     setposition(mon,0,0);
     end;
<*-2*>
     if segmno>=0 then
     begin
     q_no:=2;
     des:=0;
     repeat q_no:=q_no+1; des:=des+qdescsize;
     until ( q.des.concurchild=0) or q_no=qdes-1;
     if  q.des.concurchild>0 then
        write(mon,"nl",1,"cr",1,<:no descriptors:>) else
     begin
       getjobsegm(q.des,segmno,false);
       lref:=q.des.q_lref:=(qno-3)*l_last;
       q.des.conref:=des; <*else it will always be zero*>
       jobno:=q.des.qjobno;
<*+2*>
       if testop(7) and monlist then
       disable begin
       write(mon,<: job :>,jobno,<: lref:>,lref);;
       setposition(mon,0,0);
       end;
<*-2*>
       open(very,8,q.des.condesterm,0);
       if testop(7) then res:=b_create_child(q.des,mon) else
       res:=b_createchild(q.des,very);
       if res<>0 then 
       begin
         for i:=2 step 1 until 15 do jobtable(segmno,i):=0;
         q.des.qjobno:=0;
         getjobsegm(q.des,segmno,true);
       end else
       begin
         type:=linebuf.l_ref.l_type:=if q.des.qprinter(1)<>0 then 1 else 0;
         line_buf.l_ref.l_next:=if testop(7) then 1 else
            if type=0 then 5 else 2;
         for i:=1,2 do linebuf.l_ref.l_jobname(i):=q.des.q_jobname(i);
         if type=1 then
         begin
           for i:=1,2 do linebuf.l_ref.l_outname(i):=q.des.q_wrko(i);
           for i:=1,2 do linebuf.l_ref.l_printer(i):=q.des.q_printer(i);
         end type;
         childno:=q.des.concurchild;
         ct:=(childno-1)*ctsize;
         if bcurchildren=1 then runchildct:=ct;
<*+2*>
         if testop(7) and monlist then disable
           write(mon,"nl",1,"cr",1,
           <:child created :>,
           childno,ct);
<*-2*>
         childtable.ct.ct_batch:=1;
         childtable.ct.ct_segmqueue:=segmno;
         childtable.ct.ctjobno:=jobno;
         jobtable(segmno,2):=2; <*running*>
         segmno:=-1;
         i:=0;
         repeat i:=i+1;
         if b_segmtable(i,1)=0 then segmno:=i;
         until i=b_maxchildren or b_segm_table(i,1)=0;
         if segmno<0 then 
         begin
            write(mon,"nl",1,"cr",1,<:b segment table trouble :>,
              i,segmno);
         end else
         begin
           bsegmtable(segmno,1):=childno;
           segmno:=bsegmtable(segmno,2);
           childtable.ct.ct_segmswop:=segmno;
         end;
    end;
    if res=0 then
    begin
      waitch(bmessline,bref,free,0);
      d.bref(1):=1;
      d.bref(2):=d_b_load_start;
      d.bref(3):=ct;
      signalch(bmessline,bref,cmess);
    end  send start mess;
  end descriptor found;
  close(very,true);
  end segmno>=0;
  end run job;
end case;
if rep=1 and op=1 and db(2)>0 and monlist  then
begin
  write(mon,"ff",if testop(2) then 0 else 1,
    "cr",1,"nl",if testop(2) then 1 else 0, "can",1,
    <:TRAMOS :>,<< dd dd dd>,db(2),
     if day then <: day:> else <: night:>,<: max time :>,b_max_time);
  write(mon,"cr",1,"nl",1,<:batch children:>,
      bcurchildren,<: running :>,b_run_children,
      if bcurchildren=0 then <: free:> else
      <::>);
<*+2*>
    if testop(2) or testop(7) then write(mon,
       << ddd>,i); <*childno*>
<*-2*>
if monlist then list_proc(mon,monlist);
if monlist then listjobtable(mon,0);
end list;
until false;
end run batch;

procedure list_job_table(z,termpda);
value termpda; integer termpda;
zone z;
begin
boolean first;
integer i,t;
long array field tname;
  first:=false;
  for i:=1 step 1 until b_max_jobs do
  begin
    if jobtable(i,2)>0 and (termpda=0 or termpda=jobtable(i,8)) then
    begin
     if -,first then
     begin
       first:=true;
       write(z,"nl",1,"cr",1,
         <:job no_ prio_ state______time left:>);
       if termpda=0 then write(z,<:__terminal:>);
     end;
       t:=jobtable(i,6);
       if t<0 then t:=0;
       write(z,"cr",1,"nl",1,<<  dddd>,jobtable(i,3),jobtable(i,4),
         "sp",2,true,10,case jobtable(i,2)+1 of (
         <:impossible:>,<:enrolled:>,<:running:>,<:removed:>));
       if jobtable(i,2)<3 then
      write(z,<< dd >,t//3600,
         t mod 3600 // 60, t mod 60) else write(z,"sp",12);
    tname:=jobtable(i,8)+2;
    if termpda=0 then write(z,true,11,core.tname);
     t:=jobtable(i,5);
     if t>b_max_time then
     write(z,<: hold:>);
    end job found;
  end scan;
setposition(z,0,0);
end list job table;

<*find next job to get a process description
1981-11-27
*>

integer procedure find_next_job(z);
zone z;
begin
integer i,j,job,cand,jobrun,jobinqueue,lowest,projrun,
   somejob;
boolean found;
integer array bprojno(1:bmaxchildren,1:2),
         prio,jobtorun(1:bmaxjobs);
integer array field bref;
find_next_job:=-1;
somejob:=job_in_queue:=projrun:=0;
for i:=1,2 do for j:=1 step 1 until bmaxchildren do bprojno(j,i):=-1;
for job:=1 step 1 until bmaxjobs do
begin
  if jobtable(job,2)=2 then
  begin
    <*running job*>
    found:=false;
    projrun:=projrun+1;
    for i:=1 step 1 until projrun do
    begin
      if bprojno(i,1)=jobtable(job,10) then
      begin
        found:=true;
        bprojno(i,2):=bprojno(i,2)+1;
        projrun:=projrun-1;
      end else
      if -,found and b_projno(i,1)<0 then
      begin
        bprojno(i,1):=jobtable(job,10);
        bprojno(i,2):=1;
      end new project;
    end for i;
  end job running else
  if jobtable(job,2)=1 then
  begin
     somejob:=somejob+1;
     if jobtable(job,12)=0 and jobtable(j,13)<2 and
     (jobtable(job,5)<=b_max_time or jobtable(job,13)=1) then
    begin
      <*enrolled and not in a sequence and not a hold job*>
      job_in_queue:=job_in_queue+1;
      jobtorun(jobinqueue):=job;
<*+2*>
    if testop(11) then
    disable begin
    write(z,"nl",1,<:job :>,job,jobtable(job,5),jobtable(job,12),
        jobtable(job,13));
    end;
<*-2*>
    end enrolled and candidate;
  end enrolled;
end for job;

<*+2*>
if testop(11) then disable
begin
  write(z,"nl",1,"cr",1,<:find next job: job in queue, projects :>,
      jobinqueue,somejob,projrun);
  setposition(z,0,0);
end;
<*-2*>

<*find best job*>
if jobinqueue=0 and somejob>0 then
begin
   waitch(bmessline,bref,free,0);
   signalch(bmessline,bref,jobtimermess);
end else
if jobinqueue>0 then
begin
  for cand:=1 step 1 until jobinqueue do
  begin
    job:=jobtorun(cand);
    prio(cand):=if jobtable(job,13)=0 then 0 else jobtable(job,5);
    j:=0;
    repeat j:=j+1;
      found:=bprojno(j,1)=jobtable(job,10) or projrun=0;
    until j>=projrun or found;
    if found then 
    begin
      prio(cand):=prio(cand)*(bprojno(j,2)*b_job_fac+1);
      if day and prio(cand)>b_max_prio_day then
      begin
        prio(cand):=maxinteger;
        jobtorun(cand):=-1;
      end priority exceeded;
<*+2*>
    if testop(7) then disable
    write(z,<: (:>,<<d>,job,<:,:>,prio(cand),<:):>);
<*-2*>
    end found;
  end candidate priority;

  cand:=1; lowest:=prio(1);

  for j:=1 step 1 until jobinqueue do
  begin
     if prio(j)<lowest then
     begin
       cand:=j; lowest:=prio(j);
     end better;
  end search;
<*+2*>
  if testop(11) then disable
  begin
    write(z,"nl",1,"cr",1,<:best candidate :>,cand,jobtorun(cand),prio(cand));
    setposition(z,0,0);
  end;
<*-2*>
  if jobtorun(cand)<0 then
  begin
    waitch(bmessline,bref,free,0);
    signalch(bmessline,bref,jobtimermess);
  end;
  find_next_job:=jobtorun(cand);
end job found;
end findnextjob;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦4a29618f4⟧ TextFile

Derivation

TextFile
