⟦92a941042⟧

TextFile

<*reads a submit command from a console
1982.04.15 Anders Lindgård*>

boolean procedure readsubmit(c_buffer,very,descriptor,bsnameset);
value bsnameset; boolean bsnameset;
zone c_buffer,very;
integer array descriptor;
begin
integer i,j,syntax,notallowed,bs_name,
        command,commandtype,del,int,nexttype,
    res,errortype;
integer array param(1:3),bserror(1:no_of_bs);
long array n,name(1:2);
boolean ok,verify;
verify:=testop(7) or testop(4) or testop(8);
<*+2*>
if testop(5) then write(very,"nl",1,<:read submit called:>,"nl",1);
if verify then  write(very,"nl",1,"*",1);
setposition(very,0,0);
<*-2*>
nexttype:=0;
errortype:=0;
syntax:=17;
notallowed:=syntax+1;
bsname:=syntax+2;
commandtype:=0;
for command:=if errortype=0 then nextparam(c_buffer,n,int,del) else
    0 while (command>0  ) and
   commandtype<>syntax do
begin
AGAIN:
<*+2*>
  if testop(8) then write(very,"nl",1,<:;:>,command,<:,:>,nexttype,<:;:>);
<*-2*>
  if command mod 4=1 and nexttype=1 then
  begin
    for i:=1,2 do name(i):=n(i);
    nexttype:=case commandtype of(0,0,0,0,0,2,2,
              0,0,0,0,0,0,0,0,0,0);
<*+2*>
    if testop(8) then write(very,n,"sp",1);
<*-2*>
  end else
  if command mod 4=1 and nexttype<2 then
  begin
    <*find a name in the list and convert it to a number*>
    commandtype:=syntax;
    i:=0;
    for i:=i+1 while i<syntax and commandtype=syntax do
    if n(1)=long (case i of (<:job:>,<:lp:>,<:lines:> ,
       <:evene:> add 'n',<:time:>,<:bs:>,
       <:prog:>,<:in:>,<:out:>,
       <:prio:>,<:buf:>,<:area:>,<:int:>,
       <:size:>,<:start:>,
       <:seq:>)) then commandtype:=i;
    if commandtype=syntax and -,bsnameset then commandtype:=bsname;
    nexttype:=case commandtype of(1,1,2,0,2,1,
      1,1,1,2,2,2,2,2,2,2,0,0,0);
<*+2*>
   if testop(8) then write(very,case commandtype of (
      <:job:>,<:lp:>,<:lines:>,
      <:evening:>,<:time:>,<:bs:>,<:prog:>,<:in:>,
      <:out:>,<:prio:>,<:buf:>,<:area:>,<:int:>,
      <:size:>,<:start:>,<:seq:>,
      <:syntax:>,<:notallowed:>,<:bsname:>),<:(nt=:>,nexttype,
      <:) :>);
<*+2*>
   for i:=1,2,3 do param(i):=0;
   end name or name.
   else
   if command mod 4=2 and nexttype>=2 then
   begin
    <*integer*>
     if commandtype=5 or commandtype=15 then
     begin
       if nexttype>2 then param(5-nexttype):=param(6-nexttype);
       if nexttype>3 then param(6-nexttype):=param(7-nexttype);
       param(3):=int;
     end time and start else
     param(nexttype-1):=int;
     nexttype:=case commandtype of(
      0,0,0,0,if nexttype<5 then nexttype+1 else 0,
      if nexttype=2 then 3 else 0,
      0,0,0,0,0,0,0,0,if nexttype<5 then nexttype+1 else 0,0,0);
     if verify and false then write(very,<<d>,int,"sp",1);
    end integer or integer. else
    begin
      commandtype:=syntax;
      if verify and false then write(very,<:***syntax:>);
   end syntax error;

<*execute commands*>
if nexttype=0 or commandtype>=syntax or del='nl'  or
((commandtype=5 or commandtype=15) and command mod 4=1 and
    nexttype>2) then
begin
 case commandtype of
 begin
  begin
    <*_1_job*>
    if verify then write(very,<:job :>,name);
    ok:=readusercat(name,descriptor,testop(4),very) and
     curchildren<maxchildren;
    if ok then 
    begin
      descriptor.conprocin:=descriptor.conprocout:=descriptor.contermpda;
      std_claim(descriptor);
      std_bs(descriptor,very);
    end else
    begin
     errortype:=4;
     writeerror(very,errornameunknown,bserror);
    end;
  end job;
  if -,bsnameset or descriptor.qprinter(1)=0 then
  begin
    <*_2_lp*>
    if verify then write(very,<:lp.:>,name,"sp",1);
    for i:=1,2 do descriptor.q_printer(i):=name(i);
  end lp;
  begin
    <*_3_lines*>
    if verify then write(very,<:lines.:>,param(1));
  end lines;
  begin
    <*_4_evening*>
    if verify then write(very,<:evening :>);
    descriptor.q_jobmask:=2; <*hold job (evening)*>
  end evening;
  begin
    <*_5_time*>
    if verify then write(very,<:time :>,param(1),param(2),param(3));
     descriptor.qmaxtime:=(param(1)*60+param(2))*60+param(3);
     if command mod 4=1 then
     begin
       nexttype:=0;
       goto AGAIN;
     end;
  end time;
  begin
  integer array field ref;
  long array field nf;
  integer bs,i,usn;
    <*_6_bs*>
    if verify then write(very,<:bs :>,name,param(1),param(2),"sp",1);
    usn:=descriptor.conusercatno;
    bs:=noofbs+1;
    for i:=1 step 1 until noofbs do
    begin
      bserror(i):=0;
      nf:=ref:=i*12-12;
      ref:=usercatbs.ref(6);
      if usercatbs.nf(1)=name(1) and
         usercatbs.nf(2)=name(2) then bs:=i;
    end for;
    if bs=no_of_bs+1 then
       writeerror(very,errorbsdeviceunknown,bserror) else
    begin
     ref:=(bs-1)*12;
     ref:=usercatbs.ref(6);
     descriptor.ref(8):=param(1); descriptor.iaf(9):=param(2);
   end;
  end bs;
  begin
    <*_7_prog*>
    if verify then write(very,<:prog :>,name,"sp",1);
    <*
    for i:=1,2 do descriptor.conprogram(i):=name(i);
    *>
    errortype:=not_allowed;
  end prog;
  begin
    <*_8_in*>
    if verify then write(very,<:in.:>,name,"sp",1);
    errortype:=notallowed;
  end in;
  begin
    <*_9_out*>
    if verify then write(very,<:out.:>,name,"sp",1);
    for i:=1,2 do descriptor.conoutname(i):=name(i);
  end out;
  begin
    <*_10_prio*>
    if verify then write(very,<:prio.:>,<<d>,param(1),"sp",1);
    i:=descriptor.con_prio_and_commands;
    i:=(i extract 12) add (param(1) shift 12);
    if param(1)>=0 and param(1)<1024 then
      begin
      descriptor.con_prio_and_commands:=i;
      end else
      begin
        errortype:=29;
        writeerror(very,errorillegalpriority,bserror);
      end;
  end prio;
  begin
    <*_11_buf*>
    if verify then write(very,<:buf.:>,<<d>,param(1),"sp",1);
    if int<0 or int>1023 then writeerror(very,errornobuffers,bserror) else
    descriptor.conbufandarea:=descriptor.conbufandarea extract 12
       add (int shift 12);
  end buf;
  begin
    <*_12_area*>
    if verify then write(very,<:area.:>,<<d>,param(1),"sp",1);
    if int<0 or int>1023 then writeerror(very,errornoareas,bserror) else
    descriptor.conbufandarea:=(descriptor.conbufandarea shift (-12) extract 12)
       shift 12 add int;
  end area;
  begin
    <*_13_int*>
   if verify then write(very,<:int.:>,<<d>,param(1),"sp",1);
   i:=descriptor.conint_and_func;
   i:=(i extract 12) add (int shift 12);
   if int>=0 and int<1024 then descriptor.con_int_and_func:=i else
   writeerror(very,errorsyntax,bserror);
  end int;
  begin
    <*_14_size*>
    if verify then write(very,<:size:>,param(1));
    i:=param(1);
    if i<0 or i>512*noofcoreblocks*coreblocksize then
    begin
      errortype:=81;
      writeerror(very,errornotallowed,bserror);
   end else descriptor.consize:=i;
  end size;
  begin
    <*_15_start*>
    if verify then write(very,<:start :>,param(1),param(2),param(3));
    descriptor.q_starttime:=(param(1)*60+param(2))*60+param(3);
    if command mod 4=1 then
    begin
      nexttype:=0;
      goto AGAIN;
    end;
  end start;
  begin
    <*__16__seq*>
     if verify then write(very,<:seq:>,param(1));
     descriptor.q_job_seq:=param(1);
  end seq;
  begin
    <*_17_syntax*>
    if verify then write(very,<:syntax:>);
    errortype:=syntax;
  end syntax;
  begin
    <*_18_notallowed*>
    errortype:=notallowed;
  end not allowed;
  begin
    <*__19_bsname*>
    if verify then write(very,<:bsname.:>,n);
    errortype:=job_to_queue(descriptor,n,very);
<*+2*>
    if testop(7) then disable
    begin
      write(very,<:bsname :>,n,<: errortype :>,errortype);
      setposition(very,0,0);
    end;
<*-2*>
  end bsname;
 end case;
end nexttype=0;
end for command;
if command<0  then errortype:=syntax;
if errortype=0 then writeerror(very,errorready,descriptor) else
if errortype=syntax then writeerror(very,errorsyntax,bserror) else
if errortype=notallowed then writeerror(very,errornotallowed,bserror);
if verify then write(very,"nl",1,<:errortype :>,errortype);
read_submit:=commandtype<>syntax;
end read submit;

procedure get_job_segm_0(update);
value update; boolean update;
if update then
begin
  wait(qsem);
  setbaseusercat;
  setposition(qz,0,0);
  swoprec6(qz,512);
  fi:=0;
  for i:=1 step 1 until 256 do qz.fi(i):=0;
  qz.fi.q0_max_time_day:=b_max_time_day;
  qz.fi.q0_max_size_day:=b_max_size_day;
  qz.fi.q0_max_time_night:=b_max_time_night;
  qz.fi.q0_max_size_night:=b_max_size_night;
  qz.fi.q0_night_to_day:=b_night_to_day;
  qz.fi.q0_day_to_night:=b_day_to_night;
  qz.fi.q0_upd_time:=b_upd_time:=systime(7,0,0.0);
  setposition(qz,0,0);
  resetbase;
  signal(qsem);
end update else
begin
  wait(qsem);
  setbaseusercat;
  setposition(qz,0,0);
  inrec6(qz,512);
  fi:=0;
  b_upd_time:=qz.fi.q0_upd_time;
  setposition(qz,0,0);
  resetbase;
  signal(qsem);
end get job segm 0;

boolean procedure get_job_segm(desc,segmno,update);
value segmno,update; 
integer segmno; boolean update;
integer array desc;
begin
integer array field fi;
integer i;
  wait(qsem);
  setbaseusercat;
  fi:=0;
  setposition(qz,0,segmno);
  if update then swoprec6(qz,512) else
     inrec6(qz,512);
  for i:=qdescsize//2 step -1 until 2 do 
  begin
    if update then qz.fi(i):=desc(i) else
                   desc(i):=qz.fi(i);
  end;
get_job_segm:=update or qz.fi.q_job_no>0;
setposition(qz,0,0);
resetbase;
signal(qsem);
end get job_segm;

integer procedure b_create_child(des,z);
integer array des; zone z;
begin
integer i,res;
integer array field ct;
integer array bserror(1:noofbs);
  des.confirstaddress:=b_child_first;
  des.contopaddress:=b_child_last;
  b_cur_children:=bcur_children+1;
  res:=create_child(des,true,z,ct);
  if res=0 then
  begin
    res:=setbs(des,bserror,z,true);
    if res>0 then removechild(des,z) else
    begin
      i:=des.con_prio_and_commands;
      i:=(i extract 12) add (((i shift (-12) extract 12)+1) shift 12);
      des.conprioandcommands:=i;
      set_prio_child(des);
    end setbs;
  end created;
bcreatechild:=res;
end b_create_child;

integer procedure b_load_and_start(des,z);
integer array des; zone z;
begin
integer i,res;
integer array field ct;
  res:=loadandmodify(des,z,false);
<*+2*>
   if testop(7) then disable
     write(z,"nl",1,<:b_load_start: modify: :>,res);
<*-2*>
  if res>0 then removechild(des,z) else
  begin
    res:=startchild(des);
<*+2*>
    if testop(7) then disable
      write(z,"nl",1,<:b_load_start: start: :>,res);
<*-2*>
    if res>0 then removechild(des,z) else
    begin
    i:=des.concurchild;
    ct:=(i-1)*ctsize;
    jobtable(childtable.ct.ctsegmqueue,7):=des.concurchild;
    des.qjobstate:=staterunning;
    getjobsegm(des,childtable.ct.ctsegmqueue,true);
<*+2*>
    if testop(7) then disable
    begin
      write(z,"cr",1,"nl",1,<:b load start: started:>);
      setposition(z,0,0);
    end;
<*-2*>
    end;
  end loaded;
bloadandstart:=res;
end b_load_and start;

integer procedure b_check_child(des,ref);
integer array des;
integer array field ref;
begin
  integer array field ct,pda,tpda;
  long array field cname;
  integer i,childno;
  boolean b_child;
  long array name(1:2);
  cname:=2;
  bcheckchild:=1;
  for i:=1,2 do name(i):=des.con_proc_name(i);
  tpda:=des.con_term_pda;
  childno:=0;
  repeat childno:=childno+1;
    ct:=(childno-1)*ctsize;
    pda:=childtable.ct.ct_childpda;
    b_child:=childtable.ct.ct_batch>0 and pda>0;
    if b_child then
      bchild:=bchild and name(1)=core.pda.cname(1) and
                         name(2)=core.pda.cname(2);
  until b_child or childno=max_children;
  if b_child and (tpda=sysconpda or tpda=childtable.ct.ct_termpda) then
  begin
   ref:=ct;
   bcheckchild:=0;
  end ok;
end bcheckchild;

integer procedure job_to_queue(descriptor,n,very);
integer array descriptor;
long array n;
zone very;
begin
integer res,res1,i,j,time;
integer array ht(1:17),tail(1:10);
integer array field t,bref,pda;
long array field laf;
    t:=14;
    for i:=1,2 do descriptor.q_job_name(i):=n(i);
    setbase(descriptor.conloweruser,descriptor.conupperuser);
    res:=lookup_headandtail(descriptor.q_job_name,ht);
    resetbase;
    if res>0 or ht(1) extract 3<2 or ht.t(1)<=0 then
    begin
<*+2*>
      if testop(7) then write(very,"nl",1,<:lookup tail :>,
        descriptor.q_job_name,res,ht(1) extract 3, ht.t(1));
<*-2*>
      writeerror(very,errorjobfileunknown,descriptor);
    end else
    begin
      descriptor.coninname(1):=long <:primi:> add 'n';
      descriptor.coninname(2):=0;
      setbase(descriptor.conloweruser,descriptor.conupperuser);
      res1:=lookupheadandtail(descriptor.q_printer,ht);
      laf:=2;
      pda:=process_description(ht.t.laf);
      if pda=0 and descriptor.q_printer(1)<>0 then
      begin
        write(very,"nl",1,<:printer :>,descriptor.qprinter,
          <: does not exist:>);
       descriptor.qprinter(1):=descriptor.qprinter(2):=0;
     end;
      if descriptor.q_printer(1)<>0 then generatename(descriptor.q_wrk_o);
      i:=0; j:=bmaxjobs+1;
      repeat i:=i+1;
      if jobtable(i,2)=0 then j:=i;
      until j<>bmaxjobs+1 or i=bmaxjobs;
      if j=bmaxjobs+1 then else
      begin
        jobtable(j,1):=j;
        descriptor.qjobstate:=
        jobtable(j,2):=1;
        descriptor.qjobno:=
        jobtable(j,3):=bjobnumber+1;
        if descriptor.qmaxtime=0 then
           descriptor.qmaxtime:=b_std_time;
        jobtable(j,4):=
        jobtable(j,5):=descriptor.qmaxtime;
        jobtable(j,6):=descriptor.qmaxtime;
        jobtable(j,7):=0;
        jobtable(j,8):=descriptor.contermpda;
        jobtable(j,9):=descriptor.qmaxtime;
        jobtable(j,10):=descriptor.conprojno shift(-8) extract 16;
        jobtable(j,11):=0;
        jobtable(j,12):=0;
        jobtable(j,13):=descriptor.q_jobmask;
        bcurjob:=bcurjob+1;
        bjobnumber:=bjobnumber+1;
        for i:=1,2 do descriptor.conprogram(i):=std_program(i);
        get_job_segm(descriptor,j,true);
        inspectch(bmessline,free,i);
<*+2*>
        if testop(7) then disable
        begin
          write(very,"nl",1,<:bmessline free :>,i);
          setposition(very,0,0);
        end;
<*-2*>
        waitch(bmessline,bref,free,0);
        d.bref(1):=2;
        d.bref(2):=j;
        signalch(bmessline,bref,bmess);
        write(very,"nl",1,true,12,descriptor.q_jobname,
           <: job number :>,bjobnumber,<: time :>,descriptor.qmaxtime);
        setposition(very,0,0);
      end job ok;
    end jobfile ok;
job_to_queue:=res;
<*+2*>
if testop(7) then disable
begin
  write(very,"nl",1,<:job to queue: res: :>,res);
  setposition(very,0,0);
end;
<*-2*>
end job_to_queue;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦92a941042⟧ TextFile

Derivation

TextFile
