⟦62ae0b314⟧

TextFile

<*reads commands from a given terminal and put them into
a console description
1982.01.12 Anders Lindgård*>

boolean procedure readcommand_list(c_buffer,descriptor,opened);
value opened; boolean opened;
zone c_buffer;
integer array descriptor;
begin
integer i,j,syntax,notallowed,command,commandtype,del,int,nexttype,
    res,errortype,bs,usn,jobno,jte;
long t;
real r;
integer array param(1:3),bserror(1:no_of_bs);
long array consolename,n,name,nextname(1:2);
boolean ok,verify,nname,sys,other,exist;
zone very(17,1,stderror);
integer array field ct,pda,bref,ref,qref,cpda,cur;
long array field nf;
sys:=sysconpda=descriptor.contermpda;
verify:=opened or testop(3);
for i:=1,2 do consolename(i):=descriptor.condesterm(i);
if -,opened then open(c_buffer,8,consolename,1 shift 9);
open(very,8,consolename,1 shift 9);
<*+2*>
if testop(5) then write(very,"nl",1,<:read called:>,"nl",1);
if verify then  write(very,"nl",1,"*",1);
setposition(very,0,0);
<*-2*>
nexttype:=0;
errortype:=0;
syntax:=50;
notallowed:=syntax+1;
commandtype:=0;
nname:=false;
for i:=1,2,3 do param(i):=0;
name(1):=name(2):=nextname(1):=nextname(2):=0;
for command:=if errortype=0 then nextparam(c_buffer,n,int,del) else
    0 while command>0 and
   commandtype<syntax do
begin
AGAIN:
  if false then write(very,"nl",1,<:;:>,command,<:,:>,nexttype,<:;:>);
  if command mod 4=1 and nexttype=1 then
  begin
    if nname then
    begin for i:=1,2 do nextname(i):=n(i); nname:=false; end else
    begin
    for i:=1,2 do name(i):=n(i);
    nname:=true;
    end;
    nexttype:=case commandtype of(2,0,0,0,0,0,2,
              0,0,0,0,0,0,0,0,0,0,0,0,
              0,0,0,0,0,0,0,0,0,0,0,if nname then 1 else 0,
              0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0);
    if verify and false then write(very,n,"sp",1);
  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:>,<:call:>,<:remov:> add 'e',
       <:stop:>,<:proc:>,<:run:>,<:bs:>,
       <:prog:>,<:in:>,<:out:>,
       <:term:>,<:con:>,<:prio:>,
       <:buf:>,<:area:>,<:int:>,
       <:size:>,
       <:creat:> add 'e',<:load:>,<:start:>,
       <:list:>,<:max:>,<:init:>,
       <:limit:> add 's',<:break:> ,
       <:listb:> add 's',<:listd:> add 'e',
       <:claim:>,<:stat:>,<:end:>,
       <:submi:> add 't',<:queue:>,<:what:>,
       <:searc:> add 'h',<:kill:>,
       <:login:>,<:logou:>add 't',
       <:clear:> add 'd',<:get:>,<:lists:> add 't',
       <:relea:> add 's',<:setpr:> add 'i',
       <:test:>,<:monit:> add'o',<:btime:>,
       <:inclu:> add 'd',<:exclu:> add 'd',
       <:lock:>,<:unloc:> add 'k'
       )) then commandtype:=i;
    nexttype:=case commandtype of(1,2,0,0,
     1,0,1,1,1,1,1,0,2,2,2,2,2,
     0,0,0,0,0,0,0,0,1,0,0,0,0,1,
     0,0,2,2,0,0,0,1,0,2,2,2,1,2,2,2,0,0,-1);
<*+2*>
   if verify and false then write(very,case commandtype of (
      <:job:>,<:call:>,<:remove:>,
      <:stop:>,<:proc:>,<:run:>,<:bs:>,<:prog:>,<:in:>,
      <:out:>,<:term:>,<:con:>,<:prio:>,<:buf:>,<:area:>,<:int:>,
      <:size:>,
      <:create:>,<:load:>,<:start:>,<:list:>,
      <:max:>,<:init:>,<:limits:>,<:break:>,
      <:listbs:>,<:listdescriptor:>,<:claim:>,
      <:stat:>,<:end:>,<:submit:>,
      <:queue:>,<:what:>,<:search:>,<:kill:>,
      <:login:>,<:logout:>,<:cleardescriptor:>,
      <:get:>,<:liststd:>,<:release:>,<:setprio:>,
      <:test:>,<:monitor:>,<:btime:>,
      <:include:>,<:exclude:>,<:lock:>,<:unlock:>,
      <:syntax:>),<:(nt=:>,nexttype,
      <:) :>);
<*-2*>
   end name or name.
   else
   if command mod 4=2 and nexttype>=2 then
   begin
    <*integer*>
     param(nexttype-1):=int;
     nexttype:=case commandtype of(
      0,1,0,0,0,0,if nexttype=2 then 3 else 0,
      0,0,0,0,0,0,0,0,0,
      0,0,0,0,0,0,0,
      0,0,0,0,0,0,0,0,0,0,0,0,
      0,0,0,0,0,0,0,0,0,0,0,0,0,0);
<*+2*>
     if verify and false then write(very,<<d>,int,"sp",1);
<*-2*>
    end integer or integer. else
    if command mod 4=1 and nexttype=2 and
       (commandtype=1 or commandtype=39) then
    begin
      <*skip integer*>
      nexttype:=0;
    end else
    begin
      commandtype:=syntax;
<*+2*>
      if verify and false then write(very,<:***syntax:>);
<*-2*>
   end syntax error;
if lock and -,sys then commandtype:=notallowed;

<*execute commands*>
if descriptor.conjob=0 and descriptor.contermpda<>sysconpda then
  commandtype:=case commandtype of(
  commandtype,commandtype,notallowed,
   notallowed,notallowed,notallowed,notallowed,
   notallowed,notallowed,notallowed,
   notallowed,commandtype,notallowed,
   notallowed,notallowed,notallowed,
   notallowed,
   notallowed,notallowed,notallowed,
   commandtype,commandtype,notallowed,
   commandtype,notallowed,
   commandtype,commandtype,
   notallowed,commandtype,commandtype,
   commandtype,
   commandtype,commandtype,commandtype,commandtype,
   commandtype,commandtype,commandtype,
   commandtype,commandtype,syntax,syntax,
   commandtype,commandtype,commandtype,
   commandtype,commandtype,syntax,syntax,syntax,notallowed);
if nexttype=0 or commandtype>=syntax or del='nl' then
begin
 case commandtype of
 begin
  if name(1)=0 then writeerror(very,errornameunknown,bserror) else
  begin
    <*_1_job*>
    if verify then write(very,<:job :>,name);
    ok:=readusercat(name,descriptor,testop(4),very) and
     curchildren<maxchildren;
    if ok and (descriptor.con_job_id=0 or descriptor.con_job_id=param(1)) then 
    begin
      descriptor.con_job:=1;
      descriptor.conprocin:=descriptor.conprocout:=descriptor.contermpda;
      std_claim(descriptor);
      std_bs(descriptor,very);
    end else
    begin
     errortype:=4;
     writeerror(very,errornameunknown,bserror);
    end;
    if errortype=0 and (del='nl' or del='em') then
    begin
     errortype:=createchild(descriptor,false,very,ct);
     set_prio_child(descriptor);
     if errortype=0 then
      errortype:=load_and_modify(descriptor,very,opened)
        else errortype:=errortype+64;
      if errortype=0 then
        errortype:=setbs(descriptor,bserror,very,true);
        if errortype=0 and descriptor.con_jobstate=0 then
          errortype:=startchild(descriptor);
          if errortype>0 then errortype:=errortype+128;
    end execute;
  if command mod 4=1 and del<>'nl' then
  begin
    goto AGAIN;
  end;
  end job;
  begin
    <*_2_call*>
    if verify then write(very,<:call :>,int,"sp",1,name,"sp",1);
    errortype:=5;
    if sys or (int>=firstmt and int<=lastmt) then
    begin
     errortype:=create_peripheral(name,int);
    if errortype>0 then
      writeerror(very,case errortype+1 of(
        errorready,errorresultimpossible,errorcatalogerror,
        errornameconflict,errordeviceunknown,
        errordevicereserved,errorresultimpossible),bserror);
    end allowed else
        writeerror(very,error_not_allowed,bserror);
  end call;
  begin
    <*_3_remove*>
    if verify then write(very,<:remove :>);
   errortype:=checkchild(descriptor,true,very,ct);
   if errortype=0 then
   begin
    errortype:=stopchild(descriptor);
    if errortype=0 then
    begin
      other:=sys and sysconpda<>childtable.ct.ct_termpda;
      ref:=childtable.ct.ct_ref;
      if other then wait(condesc.ref.conaccess);
      errortype:=removechild(descriptor,very);
      if other then signal(condesc.ref.conaccess);
    end removed;
   end;
  end remove;
  begin
    <*_4_stop*>
    if verify then write(very,<:stop:>);
    errortype:=checkchild(descriptor,true,very,ct);
    if errortype=0 then
    begin
    errortype:=stopchild(descriptor);
    end else
    begin
      errortype:=b_check_child(descriptor,ct);
      if errortype=0 then
      begin
        waitch(bmessline,bref,free,0);
        d.bref(1):=1;
        d.bref(2):=-1;
        d.bref(3):=ct;
        signalch(bmessline,bref,cmess);
     end bchild;
   end check b child;
  end stop;
  begin
    <*_5_proc*>
    if verify then write(very,<:proc :>,name,"sp",1);
    for i:=1,2 do descriptor.conprocname(i):=name(i);
  end proc;
  if descriptor.conjob=0 then errortype:=notallowed else
  begin
    <*_6_run*>
    if verify then write(very,<:run :>);
     pda:=process_description(descriptor.conprocname);
     if if pda=0 then true else (pda>0 and ( descriptor.concurchildpda=pda or
          core.pda.parentref<>ownpda)) then
     begin
     errortype:=createchild(descriptor,false,very,ct);
     set_prio_child(descriptor);
     if errortype=0 then errortype:=setbs(descriptor,bserror,very,true);
    end else
     errortype:=checkchild(descriptor,true,very,ct);
     if errortype=0 then
     errortype:=loadandmodify(descriptor,very,opened);
     if errortype=0 and descriptor.con_job_state=0 then
       errortype:=startchild(descriptor);
  end run;
  begin
    <*_7_bs*>
    if verify then write(very,<:bs :>,name,param(1),param(2),"sp",1);
    exist:=checkchild(descriptor,false,very,ct)=0;
    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;
    if exist then descriptor.ref(8):=descriptor.ref(9):=0;
    end for;
    if bs=no_of_bs+1 then
       writeerror(very,errorbsdeviceunknown,bserror) else
    if exist then
    begin
       <*give the process claims*>
       ref:=(bs-1)*12;
       ref:=usercatbs.ref(6);
       descriptor.ref(8):=param(2); descriptor.ref(9):=param(1);
        setbs(descriptor,bserror,very,false);
   end exist else
   begin
     ref:=(bs-1)*12;
     ref:=usercatbs.ref(6);
     descriptor.ref(8):=param(2); descriptor.ref(9):=param(1);
   end;
  end bs;
  begin
    <*_8_prog*>
    if verify then write(very,<:prog :>,name,"sp",1);
    for i:=1,2 do descriptor.conprogram(i):=name(i);
  end prog;
  begin
    <*_9_in*>
    if verify then write(very,<:in.:>,name,"sp",1);
    for i:=1,2 do descriptor.coninname(i):=name(i);
  end in;
  begin
    <*_10_out*>
    if verify then write(very,<:out.:>,name,"sp",1);
    for i:=1,2 do descriptor.conoutname(i):=name(i);
  end out;
  begin
    <*_11_term*>
    if verify then write(very,<:term.:>,name,"sp",1);
    for i:=1,2 do descriptor.contermname(i):=name(i);
  end term;
  begin
    <*_12_con*>
    if verify then write(very,<:con :>);
    write(very,descriptor.condesterm,"nl",1);
  end con;
  begin
    <*_13_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;
      if checkchild(descriptor,false,very,ct)=0 then
         set_prio_child(descriptor);
      end else
      begin
        errortype:=29;
        writeerror(very,errorillegalpriority,bserror);
      end;
  end prio;
  begin
    <*_14_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
    <*_15_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
    <*_16_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
    <*_17_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
     <*_18_create*>
   if verify then write(very,<:create :>);
   errortype:=createchild(descriptor,false,very,ct);
  set_prio_child(descriptor);
  end create;
  begin
     <*_19_load*>
    if verify then write(very,<:load :>);
    errortype:=checkchild(descriptor,true,very,ct);
    if errortype=0 and -,(sys and childtable.ct.ct_termpda<>sysconpda) then
    errortype:=load_and_modify(descriptor,very,opened) else errortype:=4;
  end load;
  begin
    <*_20_start*>
    if verify then write(very,<:start :>);
    errortype:=checkchild(descriptor,true,very,ct);
    if errortype=0 then
    errortype:=startchild(descriptor) else
    begin
    errortype:=b_check_child(descriptor,ct);
    if errortype=0 then
    begin
      waitch(bmessline,bref,free,0);
      d.bref(1):=1;
      d.bref(2):=-2;
      d.bref(3):=ct;
      signalch(bmessline,bref,cmess);
     end start b_child;
  end possible b_child;
  end start;
  begin
    <*_21_list*>
    if verify then write(very,<:list :>);
    nf:=2;
    ct:=-ct_size;
    writecurtime(very);
    if lock then write(very,<:  **locked** :>);
    for i:=1 step 1 until maxchildren do
    begin
      ct:=ct+ct_size;
      cpda:=childtable.ct.ct_childpda;
      if cpda>0 then
      begin
        cur:=childtable.ct.ctref;
        t:=core.cpda.runtimeref;
        write(very,"nl",1,true,12,core.cpda.nf,
        << dddddd>,core.cpda.coreaddressref(1),
                   core.cpda.coreaddressref(2),
        "sp",1,case childtable.ct.ct_state of (
         <:created :>,<:running :>,<:stopped :>,
         <:breaked :>,<:swopped :>),<: cpu:>,<< dddd.dd>, t/10000,"sp",2,
        if childtable.ct.ct_batch>0 then <:batch___:> else <:on line :>);
        if childtable.ct.ct_batch>0 then
         write(very,true,11,q.cur.condesterm) else
         write(very,true,11,condesc.cur.condesterm);
         if childtable.ct.ct_batch>0 then
         write(very,<: job :>,<<dddd>,q.cur.q_jobno);
      end;
    end for;
    write(very,"nl",1);
  end list;
  begin
    <*_22_max*>
    write(very,<:max :>,<<dddddd>,findmaxfreecore,
      << ddd>,freebuf,freearea,freeinternal,
       "nl",1);
  end max;
  begin
    <*_23_init*>
    if verify then write(very,<:init :>);
    errortype:=createchild(descriptor,false,very,ct);
    set_prio_child(descriptor);
    if errortype=0 then 
    errortype:=load_and_modify(descriptor,very,opened);
  end init;
  begin
    <*_24_limits*>
    if verify then write(very,<:limits :>,"sp",1);
    write(very,<:current limits in batch :>,
      if day then <: day:> else <:night:>,<: maxtime :>,
        b_max_time//60,<: min:>);
    write(very,"nl",1,<< ddddd>,
                      <:max time day      :>,b_max_time_day//60,<: min:>,
                      b_max_time_day mod 60,<: sec:>,
               "nl",1,<:max size day      :>,b_max_size_day//1024,<: k:>,
               "nl",1,<:max time night    :>,b_max_time_night//60//60,<: h:>,
               "nl",1,<:max size night    :>,b_max_size_night//1024,<: k:>,
               "nl",1,<:day  to  night    :>,<<____dd.dd>,bdaytonight/100,
               "nl",1,<:night to day      :>,bnighttoday/100,
               "nl",1,<:parallel jobs     :>,<< ddddd>,bmaxchildren,
               "nl",1,<:max jobs          :>,b_maxjobs);
    write(very,"nl",1);
  end limits;
  begin
    <*_25_break*>
    if verify then write(very,<:break :>,"sp",1);
    errortype:=checkchild(descriptor,true,very,ct);
    if errortype=0 then
    other:=sys and childtable.ct.ct_termpda<>sysconpda;
    ref:=childtable.ct.ct_ref;
    if other then wait(condesc.ref.conaccess);
    errortype:=break_child(descriptor,very);
    if other then signal(condesc.ref.conaccess);
  end break;
  begin
    <*_26_listbs*>
    if verify then write(very,<:listbs :>,name);
    pda:=process_description(name);
    if pda=0 then writeerror(very,errorprocessunknown,bserror) else
    if core.pda(1)<>0 then writeerror(very,errorprocessunknown,bserror) else
    disable list_bs(name,very);
  end listbs;
  begin
    <*_27_list descriptor*>
    if verify then write(very,<:list descriptor:>);
    if descriptor.conjob>0 or sys then
       disable writeentry(descriptor,very,true);
  end list descriptor;
  begin
    <*_28_claim*>
    if verify then write(very,<:claim:>);
    write(very,true,11,<:doc:>,<:___entries____:>,<:___segments:>,
      "nl",1,"sp",11,<:___used__total___used__total:>);
    for bs:=1 step 1 until noofbs do
    begin
     laf:=(bs-1)*12;
     write(very,"nl",1,true,11,usercatbs.laf);
     for i:=1,3,2,4 do write(very,<< dddddd>,
        perm_bs_claimed(descriptor.conusercatno,bs,i));
  end for bs;
  write(very,"nl",1);
  end claim;
  begin
    <*_29_stat*>
    if verify then write(very,<:stat:>);
    pda:=ownpda;
    t:=core.pda.starttimeref;
    r:=t//10000;
    writecurtime(very);
    write(very,"nl",1,
               <:blocksread        :>,blocksread,
        "nl",1,<:cpu time (sec)    :>,core.pda.runtimeref//10000,
        "nl",1,<:start time        :>,<< dd dd dd>,
                 systime(4,r,r),r,
        "nl",1,<:time used (sec)   :>,<< ddd ddd>,
               (getclock-core.pda.starttimeref)//10000,
        "nl",1,<:children created  :>,<< ddd>,childrencreated,
        "nl",1,<:coreblocks        :>,noofcoreblocks,
        "nl",1,<:blocksize         :>,512*coreblocksize);
  end stat;
  begin
    <*_30_end*>
  errortype:=if opened then 0 else  syntax;
  end;
  begin
    <*__31__submit*>
     if verify then write(very,<:submit :>,name,<:.:>,nextname);
    if (name(1)=0 and descriptor.conjob>0) or
    (name(1)=long <:job:> and nextname(1)<>0) then
    begin
      waitch(qmessline,qref,free,0);
      d.qref(1):=1; <*operation code*>
      d.qref(2):=descriptor.conref;
      for i:=1,2 do d.qref.d_jobname(i):=nextname(i);
<*+2*>
      if testop(7) then write(very,"nl",1,<:**submit :>,
         d.qref(1),d.qref(2),d.qref.djobname,qref,djobname);
<*-2*>
      signalch(qmessline,qref,qmess);
    end else errortype:=syntax;
  end submit;
  begin
    <*__32__queue*>
    if verify then write(very,<:queue:>);
    waitch(qmessline,qref,free,0);
    d.qref(1):=2;
    d.qref(2):=descriptor.conref;
    signalch(qmessline,qref,qmess);
  end queue;
  begin
    <*__33_what*>
     if verify then write(very,<:what:>);
     waitch(qmessline,qref,free,0);
     d.qref(1):=3;
     d.qref(2):=descriptor.conref;
     signalch(qmessline,qref,qmess);
  end what;
  begin
    <*__34__search*>
    if verify then write(very,<:search :>,param(1));
    waitch(qmessline,qref,free,0);
    d.qref(1):=4;
    d.qref(2):=descriptor.conref;
    d.qref(3):=param(1);
    signalch(qmessline,qref,qmess);
  end search;
  begin
    <*__35__kill*>
    if verify then write(very,<:kill :>,param(1));
    jobno:=param(1);
    jte:=0;
    repeat jte:=jte+1;
    until jte=b_max_jobs or jobno=jobtable(jte,3);
    if jobno<>jobtable(jte,3) then
    begin errortype:=5; writeerror(very,errorjobnumbernotfound,bserror);
    end else
    begin
      if sys and
         descriptor.conprojno shift (-8) extract 16 <>jobtable(jte,10) then
      errortype:=notallowed else
      begin
        waitch(qmessline,qref,free,0);
        d.qref(1):=5;
        d.qref(2):=descriptor.conref;
        d.qref(3):=param(1);
        signalch(qmessline,qref,qmess);
      end sysconpda or projectnumber;
    end job found;
  end;
  if -,sys then errortype:=syntax else
  begin
    <*__36_login*>
     if verify then write(very,<:login:>);
     b_max_time:=b_max_time_day;
     if -,day then
     begin
       waitch(bmessline,bref,free,0);
       d.bref(1):=2;
       d.bref(2):=-1;
       signalch(bmessline,bref,bmess);
     end;
     day:=true;
  end;
  if -,sys then errortype:=syntax else
  begin
    <*__37_logout*>
    if verify then write(very,<:logout:>);
    b_max_time:=b_max_time_night;
    if day then
    begin
      waitch(bmessline,bref,free,0);
      d.bref(1):=2;
      d.bref(2):=-1;
      signalch(bmessline,bref,bmess);
    end;
    day:=false;
  end logout;
  begin
    <*__38_clearde*>
    if verify then write(very,<:cleardescriptor:>);
    descriptor.conjob:=0;
  end cleardescriptor;
  begin
    <*_39_get*>
    if verify then write(very,<:get :>,name,param(1));
    ok:=readusercat(name,descriptor,testop(4),very);
    if ok and (descriptor.con_job_id=0 or descriptor.con_job_id=param(1)) then
    begin
      descriptor.conjob:=1;
      descriptor.conprocin:=descriptor.conprocout:=descriptor.contermpda;
      std_claim(descriptor);
      std_bs(descriptor,very);
    end else
    begin
      errortype:=4;
      writeerror(very,errornameunknown,bserror);
   end;
  if command mod 4=1 and del<>'nl' then
  begin
    goto AGAIN;
  end;
  end get;
  begin
    <*_40_liststd*>
     if verify then write(very,<:liststd:>);
     write(very,<:standard resources:>,
       << dddd>,
<*     "nl",1,<:standard size    :>,std_size,<: online:>,  *>
       "nl",1,<:standard size    :>,b_max_size_day,<: batch:>,
       "nl",1,<:standard buf     :>,std_buf,
       "nl",1,<:standard area    :>,std_area,
       "nl",1,<:standard internal:>,std_int,
       "nl",1,<:bs-entries       :>,std_entries,
       "nl",1,<:1. disc          :>,stdentrydisc,<: entries :>,
              stdsegmdisc,<: segments:>,
       "nl",1,<:2. disc          :>,stdentrydisc1,<: entries :>,
              stdsegmdisc1,<: segments:>,"nl",1);
  end liststd;
  if -,sys then errortype:=syntax else
  begin
    <*_41_release*>
    if verify then write(very,<:release:>,param(1));
    waitch(qmessline,qref,free,0);
    d.qref(1):=6;
    d.qref(2):=descriptor.conref;
    d.qref(3):=param(1);
    signalch(qmessline,qref,qmess);
  end release;
  if -,sys  then errortype:=syntax else
  begin
     <*_42__setprio*>
     if verify then write(very,<:setprio:>,param(1));
     waitch(qmessline,qref,free,0);
     d.qref(1):=7;
     d.qref(2):=descriptor.conref;
     d.qref(3):=param(1);
     signalch(qmessline,qref,qmess);
  end setprio;
  if -,sys then errortype:=syntax else
  begin
    <*_43_test*>
    if verify then write(very,<:test:>,param(1));
    i:=param(1);
    if i<1 or i>12 then errortype:=notallowed else
    testop(i):=-,testop(i);
  end test;
  if -,sys then errortype:=syntax else
  begin
    <*_44_monitor*>
    if verify then write(very,<:monitor.:>,name);
    i:=process_description(name);
    if i=0 then writeerror(very,errornameunknown,bserror) else
    for i:=1,2 do monitorconsole(i):=name(i);
  end monitor;
  if -,sys then errortype:=syntax else
  begin
    <*_45_btime*>
    if verify then write(very,<:btime:>,param(1));
    b_max_time:=param(1);
  end btime;
  begin
    <*_46_include*>
     if verify then write(very,<:include:>,param(1));
     if param(1)>=0 and param(1)<=256 and sys then
     errortype:=includeuser(descriptor.conprocname,param(1)) else
     errortype:=syntax;
  end include;
  begin
     <*_47_exclude*>
     if verify then write(very,<:exclude:>,param(1));
     if param(1)>=0 and param(1)<=256 and sys then
     errortype:=excludeuser(descriptor.conprocname,param(1)) else
     errortype:=syntax;
  end exclude;
  if -,sys then errortype:=syntax else
  begin
    <*_48_lock*>
    if verify then write(very,<:lock:>);
    lock:=true;
  end lock;
  if -,sys then errortype:=syntax else
  begin
    <*_49_unlock*>
    if verify then write(very,<:unlock:>);
    lock:=false;
  end unlock;
  begin
    <*_49_syntax*>
    if verify then write(very,<:syntax:>);
    errortype:=syntax;
  end syntax;
  begin
    <*_50_notallowed*>
    errortype:=notallowed;
  end not allowed;
 end case;
for i:=1,2,3 do param(i):=0;
name(1):=name(2):=nextname(1):=nextname(2):=0;
nname:=false;
end nexttype=0;
end for command;
if command<0 and -,opened 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);
close(c_buffer,true);
if verify then write(very,"nl",1,<:errortype :>,errortype);
close(very,true);
readcommandlist:=commandtype<>syntax;
end read command list;
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦62ae0b314⟧ TextFile

Derivation

TextFile
