$CONTROL CODE,MAP,USLINIT                                      <<04600>>00010000
<<ucop - module 07>>                                                    00015000
<< hp32002c mpe source c.00.00>>                                        00020000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$control main= ucop                                                     00055000
$control segment= ucop                                                  00060000
$thirty                                                                 00065000
$control privileged                                                     00070000
$control uncallable                                                     00075000
****     user     ****                                                  00080000
****  controller  ****                                                  00085000
****   program    ****                                                  00090000
****  u*c*o*p*    ****                                                  00095000
                                                                        00100000
                                                                        00105000
                                                                        00110000
comment: program working under ucop,in charge of maintaining,           00115000
         regulating and controlling user activity.                      00120000
         creates job main process,                                      00125000
         deletes processes,                                             00130000
         aborts jobs,                                                   00135000
         etc......                                                      00140000
         ;                                                              00145000
                                                                        00150000
begin                                                                   00155000
$include inclpxg                                               <<06573>>00160000
$include pcbfincl                                              <<06573>>00165000
$page "***   GENERAL EQIVALENCES   ***"                                 00170000
define                                                                  00175000
      a'        = absolute       #,                                     00180000
      enable    = assemble(sed 1)#,                                     00185000
      disable   = assemble(sed 0)#;                                     00190000
equate syswaittodispmsg=%1053;                                 <<01549>>00195000
define phasetransflag=(3:1)#;                                  <<01549>>00200000
integer                                                                 00205000
      x    = x,                                                         00210000
      xreg = x,                                                         00215000
      s3= s-3,                                                          00220000
      s1 = s-1,                                                         00225000
      s0 = s-0;                                                         00230000
integer array                                                           00235000
      arrq0 (*) = q+0;                                                  00240000
integer                                                                 00245000
      bd0= db+0,                                                        00250000
      db1= db+1,                                                        00255000
      db2= db+2,                                                        00260000
      db3= db+3,                                                        00265000
      db4= db+4,                                                        00270000
      db5= db+5,                                                        00275000
      db6= db+6,                                                        00280000
      db7= db+7,                                                        00285000
      db8= db+8,                                                        00290000
      db9= db+9,                                                        00295000
      db10= db+10,                                                      00300000
      db11= db+11;                                                      00305000
integer pointer                                                         00310000
      pdb2= db+2,                                                       00315000
      pdb4 = db+4,                                                      00320000
      pdb3 = db+3,                                                      00325000
      pdb12= db+12,                                                     00330000
      pdb13= db+13,                                                     00335000
      ps2= s-2,                                                         00340000
      ps4= s-4;                                                         00345000
byte pointer                                                            00350000
      bps0= s-0;                                                        00355000
integer array                                                           00360000
      arrdb0 (*) = db+0,                                                00365000
      arrdb5 (*) = db+5,                                                00370000
      arrdb8 (*) = db+8,                                                00375000
      arrdb9 (*) = db+9,                                                00380000
      arrdb12 (*) = db+12;                                              00385000
integer array                                                           00390000
      arrs24 (*) = s-24,                                                00395000
      arrs17 (*) = s-17;                                                00400000
$page "***   GLOBAL CONSTANTS   ***"                                    00405000
equate                                                                  00410000
   <<fixed cells>>                                                      00415000
      cstb        = 0        ,                                          00420000
      xcst        = 1        ,                                          00425000
      dstb        = 2        ,                                          00430000
      qi          = 5        ,                                          00435000
      consolecell  = %1074,                                    <<ljc>>  00440000
   <<tables/dst/sir/size>>                                              00445000
      urldst      = 9        ,                                          00450000
      urlsir      = 8        ,                                          00455000
   <<stack parms>>                                                      00460000
      maxsize     = 14000, << need room for 8k store buffer >> <<02544>>00465000
      locsize     = 1300     ,                                          00470000
      dlsize      = 0        ,                                          00475000
      pxfile      = 200      ,                                          00480000
      pxfixedjn   = 19       ,                                 <<00.01>>00485000
      pcbxsize    = pxg'size + fixedsize + pxfile + 3;         <<06573>>00490000
logical pcbpt;                                                 <<06574>>00495000
$include inclpcb5                                              <<06574>>00500000
logical pointer pcb = syspcbindex;                             <<06574>>00505000
$include inclcis                                               <<04735>>00510000
   <<system global>>                                                    00515000
equate                                                                  00520000
         absys          = %1000    ,                           <<01549>>00525000
         ciextl         = %157     ,                                    00530000
         ciintl         = %160     ,                                    00535000
         miscword       = %1121    ,                           <<01549>>00540000
            << jobsynch bits:                                           00545000
               15  device freed by deallocate,                          00550000
               14  job(s) waiting for device in ucop,                   00555000
               13  job made ready by startdevice                        00560000
                      (morgue/cleanupjob).                              00565000
           5 - 12  port timeout bit map                                 00570000
                   1 = timeout has occurred on the port                 00575000
                       data segment.                                    00580000
                   0 = no timeout exists for the port data seg          00585000
            >>                                                          00590000
         ucopsw         = %300     ;                                    00595000
$include inclldt5                                              <<06572>>00600000
                                                               <<06572>>00605000
define                                                                  00610000
         absys'ciextl   = a'(absys+ciextl)    #,                        00615000
         absys'ciintl   = a'(absys+ciintl)    #,                        00620000
         absys'miscword   = a'(miscword)#,                     <<01549>>00625000
         jobsync        = (13:3)#,                             <<01549>>00630000
         portimer       = (5:8)#;                              <<01549>>00635000
define                                                                  00640000
         ld'devtype     = 2).(10:6     #;                               00645000
   <<jpcnt>>                                                            00650000
$include incljpct                                              <<06534>>00655000
integer array jpcntarr(*) = db+0; << job process count table >><<06534>>00660000
$page "***   COMMON FIELDS OF JMAT, IDD, ODD   ***"                     00665000
$set x8=off                                                    <<06578>>00670000
$include incljmat                                              <<06578>>00675000
                                                               <<06578>>00680000
<<  some auxiliary jmat definitions  >>                        <<06578>>00685000
                                                               <<06578>>00690000
define                                                         <<06578>>00695000
   <<  job/session  types  >>                                  <<06578>>00700000
   sesstype   =    1#,  <<  a session  >>                      <<06578>>00705000
   jobtype    =    2#,  <<  a job      >>                      <<06578>>00710000
   jobhipri   =    15#, <<  high priority  >>                  <<06578>>00715000
                                                               <<06578>>00720000
   <<  job/session  states  >>                                 <<06578>>00725000
   jobintro   =    1#,                                         <<06578>>00730000
   jobwait    =    %40#,                                       <<06578>>00735000
   jobinit    =    %60#,                                       <<06578>>00740000
   jobsched    =    %70#,                                      << 8198>>00745000
   jobexec    =    2#,                                         <<06578>>00750000
   jobdone    =    3#,                                         <<06578>>00755000
   jobsusp    =    4#,                                         <<06578>>00760000
   joberr     =    %50#;                                       <<06578>>00765000
                                                               <<06578>>00770000
$page "***   UCOP DECLARATIONS   ***"                                   00775000
integer     req1    = q+1    ,                                          00780000
            req2    = q+2    ;                                          00785000
integer array reqlist(*) = db+0;                                        00790000
double array reqentry(*) = db+0;                                        00795000
integer     reqmax  = db+0   ,                                          00800000
            reqfree = db+1   ,                                          00805000
            reqnext = db+2   ;                                          00810000
                                                                        00815000
<< allocate parms >>                                                    00820000
integer array     devinfo (0:11);                              <<06572>>00825000
byte array        nullforms (0:1) := "..";                              00830000
integer pointer   xddsubp;          <<sub entry pntr>>                  00835000
integer           xddsubx;          <<for old allocate>>                00840000
integer           ucoppin;          <<allocate "OWNER">>                00845000
                                                               << 8198>>00850000
equate                                                         << 8198>>00855000
   ucopwait  = -24;    << %30 (decimal 24) is the wait     >>  << 8198>>00860000
                       << mask for junk and timer waits.   >>  << 8198>>00865000
                       << the negative value indicates     >>  << 8198>>00870000
                       << that the wakeup waiting switch   >>  << 8198>>00875000
                       << is to be used.                   >>  << 8198>>00880000
                                                                        00885000
                                                                        00890000
equate nonewses       = 80,  << can't initiate new sess... >>  <<ljc>>  00895000
       cantgetlist    = 81,  << allocation of sdtlist fail >>  <<ljc>>  00900000
       cantgetin      = 82;  << allocation of stdin fail   >>  <<ljc>>  00905000
                                                               << 8198>>00910000
equate                                                         << 8198>>00915000
   sysset       = 1,                                           << 8198>>00920000
   schedcomperr = 83;                                          << 8198>>00925000
                                                               << 8198>>00930000
<< the following equates are for the message numbers, to >>    << 8998>>00935000
<< inform the operator of the failure to allocate resources.>> << 8998>>00940000
<< for session, the ldev number is given.  for jobs,  >>       << 8998>>00945000
<< since the job will be put in wait state, we will let >>     << 8998>>00950000
<< them know the job number.     >>                            << 8998>>00955000
equate cantgetstack = 102,    << for sessions >>               << 8998>>00960000
       cantgetjit   = 103,                                     << 8998>>00965000
       cantgetjdt   = 104,                                     << 8998>>00970000
       cantgetpcb   = 105,                                     << 8998>>00975000
       cantgetjpcnt = 106,                                     << 8998>>00980000
       cantgetfiledst=107,                                     << 8998>>00985000
       cantgetjin   = 108,                                     << 8998>>00990000
       cantgetjlist = 109;                                     << 8998>>00995000
equate jcantgetstack = 110,    << for jobs >>                  << 8998>>01000000
       jcantgetjit   = 111,                                    << 8998>>01005000
       jcantgetjdt   = 112,                                    << 8998>>01010000
       jcantgetpcb   = 113,                                    << 8998>>01015000
       jcantgetjpcnt = 114,                                    << 8998>>01020000
       jcantgetfiledst=115,                                    << 8998>>01025000
       jcantgetjin   = 116,                                    << 8998>>01030000
       jcantgetjlist = 117;                                    << 8998>>01035000
logical waitflags;                                                      01040000
      << ucop local wait information:                                   01045000
         15 job waiting for device (will set jobsynch before wait),     01050000
         0  error printing(s) waiting (checked before wait).    >>      01055000
integer    comintlb     ,                                               01060000
           comintdp     ;                                               01065000
<< the following declarations are for the handling of the  >>  << 8198>>01070000
<< timer request list (trl) entry used for the scheduling  >>  << 8198>>01075000
<< of jobs.                                                >>  << 8198>>01080000
   integer                                                     << 8198>>01085000
      ucoppcbinx,         << holds the pcb index of this   >>  << 8198>>01090000
                          << process for the timereq call. >>  << 8198>>01095000
      trlx,               << index of the trl entry.       >>  << 8198>>01100000
      trl'jmatinx,        << jmat index of the first       >>  << 8198>>01105000
                          << scheduled job associated with >>  << 8198>>01110000
                          << the trl entry (trlx).         >>  << 8198>>01115000
      trl'jsno;           << the job number of the first   >>  << 8198>>01120000
                          << scheduled job.                >>  << 8198>>01125000
                                                               << 8198>>01130000
   equate                                                      << 8198>>01135000
      ucoplpin  = 2,      << for the call to sysproc.      >>  << 8198>>01140000
      notrl     = -1,     << null value for trlx and       >>  << 8198>>01145000
                          << trl'jsno.                     >>  << 8198>>01150000
      watchdog  = %12;    << timereq for a watchdog timer  >>  << 8198>>01155000
                          << request which will wake the   >>  << 8198>>01160000
                          << specified process at the      >>  << 8198>>01165000
                          << specified time.               >>  << 8198>>01170000
                                                               << 8198>>01175000
                                                               << 8198>>01180000
                                                                        01185000
switch swex := null, jmp, procout;                                      01190000
                                                                        01195000
                                                                        01200000
intrinsic debug;                                               <<06577>>01205000
                                                               <<06573>>01210000
logical procedure getsir(a);                                            01215000
   value   a;                                                           01220000
   logical a;                                                           01225000
   option external;                                                     01230000
                                                               << 8153>>01235000
double procedure findprocessport(pin);                         << 8153>>01240000
value pin;                                                     << 8153>>01245000
integer pin;                                                   << 8153>>01250000
option external;                                               << 8153>>01255000
                                                               << 8153>>01260000
procedure send'db(portid,subqueue,message);                    << 8153>>01265000
value portid,subqueue,message;                                 << 8153>>01270000
double portid;                                                 << 8153>>01275000
integer subqueue;                                              << 8153>>01280000
integer pointer message;                                       << 8153>>01285000
option external;                                               << 8153>>01290000
                                                               << 8153>>01295000
                                                                        01300000
procedure relsir(a,b);                                                  01305000
   value   a,b;                                                         01310000
   logical a,b;                                                         01315000
   option external;                                                     01320000
                                                               << 8198>>01325000
procedure aborttimereq( trlx );                                << 8198>>01330000
   value   trlx;                                               << 8198>>01335000
   integer trlx;                                               << 8198>>01340000
option external;                                               << 8198>>01345000
                                                               << 8198>>01350000
integer procedure timereq( code, req, time );                  << 8198>>01355000
   value   code, req, time;                                    << 8198>>01360000
   double  time;                                               << 8198>>01365000
   integer code, req;                                          << 8198>>01370000
option external;                                               << 8198>>01375000
                                                               << 8198>>01380000
procedure schedulejob( jmatp );                                << 8198>>01385000
   value   jmatp;                                              << 8198>>01390000
   integer pointer   jmatp;                                    << 8198>>01395000
option external;                                               << 8198>>01400000
                                                               << 8198>>01405000
integer procedure comptime( t1, t2, diff, err );               << 8198>>01410000
   integer array   t1, t2;                                     << 8198>>01415000
   double          diff;                                       << 8198>>01420000
   integer         err;                                        << 8198>>01425000
option variable, external;                                     << 8198>>01430000
                                                                        01435000
procedure reldataseg(a);                                                01440000
   value   a;                                                           01445000
   logical a;                                                           01450000
   option external;                                                     01455000
                                                                        01460000
procedure returnentry(a,b);                                             01465000
   value   a,b;                                                         01470000
   logical a,b;                                                         01475000
   option external;                                                     01480000
                                                                        01485000
integer procedure getdataseg(memsize,vdsize);                           01490000
   value   memsize,vdsize;                                              01495000
   integer memsize,vdsize;                                              01500000
   option external;                                                     01505000
                                                                        01510000
integer procedure getstack(memsize,vdsize);                             01515000
   value   memsize,vdsize;                                              01520000
   integer memsize,vdsize;                                              01525000
   option external;                                                     01530000
                                                                        01535000
logical procedure getentry(ix);                                         01540000
   value   ix;                                                          01545000
   logical ix;                                                          01550000
   option external;                                                     01555000
                                                                        01560000
logical procedure exchangedb(a);                                        01565000
   value   a;                                                           01570000
   logical a;                                                           01575000
   option external;                                                     01580000
                                                                        01585000
procedure awake(pcbpt,n,w);                                             01590000
   value   pcbpt,n,w;                                                   01595000
   integer pcbpt,n,w;                                                   01600000
   option external;                                                     01605000
                                                                        01610000
procedure writedseg(d);                                                 01615000
   value   d;                                                           01620000
   integer d;                                                           01625000
   option external;                                                     01630000
                                                               << 8153>>01635000
integer procedure get'dcs'failno(where,errnum);                << 8153>>01640000
value where,errnum;                                            << 8153>>01645000
integer where,errnum;                                         << kj  >> 01650000
option external;                                               << 8153>>01655000
                                                                        01660000
procedure procreate (pin, plabel, deltap, stackdst, globsize,  <<01200>>01665000
                     dlsize, locsize, pri, string, stringlnth, <<01200>>01670000
                     parm, flags, maxstack, stdin, stdlist);   <<01200>>01675000
  value plabel, deltap, stackdst, globsize, dlsize, locsize,   <<01200>>01680000
        pri, string, stringlnth, parm, flags, maxstack;        <<01200>>01685000
  integer plabel, deltap, stackdst, globsize, dlsize, locsize, <<01200>>01690000
          pri, string, stringlnth, parm, pin, maxstack;        <<01200>>01695000
  logical flags;                                               <<01200>>01700000
  logical array stdin, stdlist;                                <<01200>>01705000
  option external;                                             <<01200>>01710000
                                                                        01715000
procedure wait(wf,jp);                                                  01720000
   value   wf,jp;                                                       01725000
   integer wf,jp;                                                       01730000
   option external;                                                     01735000
                                                                        01740000
procedure burryproc(pcbpt);                                             01745000
   value   pcbpt;                                                       01750000
   integer pcbpt;                                                       01755000
   option external;                                                     01760000
                                                                        01765000
procedure buryproc(pcbpt);                                              01770000
   value pcbpt;                                                         01775000
   integer pcbpt;                                                       01780000
   option external;                                                     01785000
                                                                        01790000
integer procedure allocate                                              01795000
   (index, old, outpri, id, jmpin, formsmsg, jnum, copies,              01800000
         devinfo, xddsubp, access);                                     01805000
      value index, old, outpri, jmpin, jnum, copies;                    01810000
      integer index, outpri, jmpin, jnum, copies, access;               01815000
      logical old;                                                      01820000
      array id, devinfo;                                                01825000
      byte array formsmsg;                                              01830000
      integer pointer xddsubp;                                          01835000
      option external;                                                  01840000
                                                                        01845000
procedure deallocate (device);                                          01850000
   value device;                                                        01855000
   double device;                                              <<06577>>01860000
   option external;                                                     01865000
                                                                        01870000
double procedure attachio (dev, qm, dst, buf, fn, cnt, p1, p2, fl);     01875000
   value dev, qm, dst, buf, fn, cnt, p1, p2, fl;                        01880000
   integer dev, qm, dst, buf, fn, cnt, p1, p2, fl;                      01885000
   option external;                                                     01890000
                                                                        01895000
integer procedure genmsg(setno,msgno,mask,a,b,c,d,e,           <<0u.eb>>01900000
      dest,reply,buff,dst,iotype);                             <<0u.eb>>01905000
   value setno,msgno,mask,a,b,c,d,e,dest,reply,buff,           <<0u.eb>>01910000
      dst,iotype;                                              <<0u.eb>>01915000
   logical setno,msgno,mask,a,b,c,d,e,dest,reply,buff,         <<0u.eb>>01920000
      dst,iotype;                                              <<0u.eb>>01925000
   option variable,external;                                   <<0u.eb>>01930000
                                                                        01935000
procedure abortprocio (pin);                                            01940000
   value pin;                                                           01945000
   integer pin;                                                         01950000
   option external;                                                     01955000
                                                                        01960000
logical procedure cilogtable(c,j,l,a);                         <<00.04>>01965000
   value   c,j;                                                <<00.04>>01970000
   integer c,j,l;                                              <<00.04>>01975000
   integer array a;                                            <<00.04>>01980000
   option external;                                            <<00.04>>01985000
                                                               <<00.04>>01990000
procedure delink'jmat (jmatinx);                               <<06578>>01995000
   value jmatinx;                                              <<06578>>02000000
   integer jmatinx;                                            <<06578>>02005000
   option external;                                                     02010000
                                                                        02015000
procedure deallocate'jmat (ep);                                <<06578>>02020000
   value ep;                                                            02025000
   integer pointer ep;                                                  02030000
   option external;                                                     02035000
                                                                        02040000
integer procedure sysproc(lpin);                                        02045000
   value   lpin;                                                        02050000
   integer lpin;                                                        02055000
   option external;                                                     02060000
                                                                        02065000
procedure fcreatecb (a,b,c,d,e);                                        02070000
   value a,b,c,d,e;                                                     02075000
   integer c,d,e;                                              <<07270>>02080000
   double b;                                                   <<07270>>02085000
   integer pointer a;                                                   02090000
   option external;                                                     02095000
                                                               <<01549>>02100000
procedure fcpostimeout(portmap);                               <<01549>>02105000
   value portmap;                                              <<01549>>02110000
   integer portmap;                                            <<01549>>02115000
   option external;                                            <<01549>>02120000
procedure put'jobnum'in'pxfixed(jnum,jtype);                   <<06573>>02125000
value jnum,jtype;  integer jnum,jtype;                         <<06573>>02130000
<< this procedure is called in split stack mode   >>           <<06573>>02135000
<< from launchjob( db pointing at jmat ).  it will>>           <<06573>>02140000
<< put the job/session number and type into ucops >>           <<06573>>02145000
<< pxfixed for procreate which will take it out   >>           <<06573>>02150000
<< and place it in the process-job crossreference >>           <<06573>>02155000
<< table which is used by showq.                  >>           <<06573>>02160000
begin                                                          <<06573>>02165000
integer pxfixedloc;                                            <<06573>>02170000
array qarray(*)=q+0;                                           <<06573>>02175000
pxfixed;                                                       <<06573>>02180000
pxfxjobnum := jnum;                                            <<06573>>02185000
pxfxjobtype := jtype;                                          <<06573>>02190000
end; << put'jobnum'in'pxfixed >>                               <<06573>>02195000
                                                               <<06573>>02200000
$page "***   JOB SELECTION/LAUNCH ROUTINES   ***"                       02205000
integer procedure launchjob (jmatp);                                    02210000
   value jmatp;                                                         02215000
   integer pointer jmatp;                                               02220000
   option privileged, uncallable, internal;                             02225000
<< determines whether job <jmatp> can be launched, examining            02230000
   availability of job-local, job-type relevant, and                    02235000
   system resources.  yf every condition satisfied, and all             02240000
   resources acquired, launchjob updates the jmat entry                 02245000
   and "LAUNCHES" job (procreate/awake).    >>                          02250000
<< * fix information                                       >>  <<ljc>>  02255000
<<                                                         >>  <<ljc>>  02260000
<<   informs the console if the allocation for $stdlist or >>  <<ljc>>  02265000
<<   $stdin fails during a logon attempt                   >>  <<ljc>>  02270000
<<   the ldev is now printed for an overload message       >>  <<ljc>>  02275000
<<   the ldev will be the input device the launch failed   >>  <<ljc>>  02280000
<<                                                         >>  <<ljc>>  02285000
<< ********************************************************* >><<06578>>02290000
<<        launchjob is called in split stack with db at      >><<06578>>02295000
<<        the jmat.                                          >><<06578>>02300000
<< ********************************************************* >><<06578>>02305000
<< * fix information                                    >>     <<06534>>02310000
<<                                                      >>     <<06534>>02315000
<<   fix pertains to the two new routines to handle the >>     <<06534>>02320000
<<   new mpev jpcnt table.  the biggest difference in   >>     <<06534>>02325000
<<   table, is a bit map for the entries.  the routines >>     <<06534>>02330000
<<   have further information and documentation.        >>     <<06534>>02335000
<<                                                      >>     <<06534>>02340000
begin                                                                   02345000
<< used for building pxglobal >>                               <<06573>>02350000
   array qarray(0:pxg'size-1)=q;                               <<06573>>02355000
   integer pcbglobloc := 0; << index wont change in this case>><<06573>>02360000
$include incljit                                               <<06818>>02365000
   integer           failnum   = launchjob;   <<return #>>              02370000
   equate            nofail   = 0,     <<successful>>                   02375000
                     << job-specific failures: >>                       02380000
                     deferredfail   = 8,                                02385000
                     jlistfail   = 9,                                   02390000
                     jinfail   = 10,                                    02395000
                     << job-generic failure: >>                         02400000
                     limitfail   = 16,                                  02405000
                     << system resource failures: >>                    02410000
                     sys2failgroup  = 1,                       <<ljc>>  02415000
                     sysfailgroup   = 3,                                02420000
                     stackfail   = 24,                                  02425000
                     jitfail   = 25,                                    02430000
                     jdtfail   = 26,                                    02435000
                     pcbfail   = 27,                                    02440000
                     jpcntfail   = 28,                                  02445000
                     filefail    = 29;                                  02450000
<< request parameters >>                                                02455000
   equate            initstacksize   = cis'globstksize         <<04600>>02460000
                                      +pcbxsize +locsize,      <<04600>>02465000
                     maxstacksize   = maxsize,                          02470000
                     maxjitsize   = 0,                                  02475000
                     initjdtsize = 34,                                  02480000
                     maxjdtsize   = 50*128-4; <<50 sectors-4 >><<06819>>02485000
                     << 50 is an arbitrary number to bring >>  <<06819>>02490000
                     << maxjdtsize up to about 6 k.  the   >>  <<06819>>02495000
                     << -4 is for the region trailer area. >>  <<06819>>02500000
                                                               <<06819>>02505000
   equate            stackflag   = 0,  <<for getdataseg>>               02510000
                     bitsperword = 16, << num bits/word >>     <<06534>>02515000
                     pcbcode   = 3,    <<for getentry>>        <<02.eb>>02520000
                     expcode = 7;  << for initjsmp >>          <<04556>>02525000
   define nwdsbitmap = (jpcntmaxentries+bitsperword-1)/        <<07268>>02530000
                       bitsperword#;                           <<07268>>02535000
logical interactive;                                           <<01549>>02540000
   integer           jin,              <<alloc'd devs>>                 02545000
                     jlist,                                             02550000
                     stackdst,         <<data seg #s>>                  02555000
                     jit'dst,                                  <<06818>>02560000
                     jdtdst,                                            02565000
                     mainpin,          <<pcb index>>                    02570000
                     filedst,                                           02575000
                     pri;              <<execution pri (#)>>            02580000
   integer jnum,jtype;                                         << 8998>>02585000
<< info passed to ci  in jit >>                                <<02.eb>>02590000
   equate            cinumparms   = 4;                         <<02.eb>>02595000
   array             ciparms (0:cinumparms-1)   = q;                    02600000
   integer pointer   jinxddep   = ciparms;    <<jin xdd pntr>>          02605000
   integer           jindevtype   = ciparms +1;    <<jin devtype>>      02610000
   integer pointer   jlistxddep   = ciparms +2;    <<jlist xdd p>>      02615000
   integer           jlistalloc   = ciparms +3;    <<alloc return>>     02620000
   integer pointer   dum;                                      <<07270>>02625000
<< misc locals >>                                                       02630000
   integer           access,           <<alloc access>>        <<06578>>02635000
                     wordset, << temp jpcntnextavail for releas<<06534>>02640000
                     bit, << bit entry set for jpct >>         <<06534>>02645000
                     bitcount,  << bits looked at in jpcount >><<07269>>02650000
                     jpcntindex, << ref to bitmap below >>     <<06534>>02655000
                     savesir;          <<jpcnt sir return>>             02660000
   logical        nomess;                                      <<ljc>>  02665000
   logical           old,              <<allocate old flag>>            02670000
                     shift,  << "COUNTER" for bit shift >>     <<06534>>02675000
                     << following variable indicates alloc order:       02680000
                        (15:1) = first,  (14:1) = second;               02685000
                        values:  true => jin,  false => jlist.  >>      02690000
                     allocorder  := 1;  <<assume (jin then jlist)>>     02695000
                                                               <<06577>>02700000
<< dflagdev is a double word structure.  the high order word >><<06577>>02705000
<< contains a flag mask and the low order word contains a    >><<06577>>02710000
<< logical device.  used in calls to external procecure      >><<06577>>02715000
<< deallocate (see subroutine dealloc in launchjob and       >><<06577>>02720000
<< procedure getjob).                                        >><<06577>>02725000
double dflagdev;                                               <<06577>>02730000
logical dflag =dflagdev;                                       <<06577>>02735000
logical ddev =dflagdev+1;                                      <<06577>>02740000
                                                               <<06577>>02745000
                                                               <<06578>>02750000
<< ........................................................ >> <<06578>>02755000
<<   **** declarations made for the jmat - mpev fixes ****  >> <<06578>>02760000
<<                                                          >> <<06578>>02765000
<<      jmatarr  --  the array used to reference a jmat     >> <<06578>>02770000
<<      jmatinx  --  the index for jmatarr                  >> <<06578>>02775000
<<                   pointer to delinkentry by reference.   >> <<06578>>02780000
<<      i        --  a loop index used in alloc (subroutine)>> <<06578>>02785000
<<                                                          >> <<06578>>02790000
<< ........................................................ >> <<06578>>02795000
   integer array    jmatarr(*) = db+0;                         <<06578>>02800000
   integer          jmatinx;                                   <<06578>>02805000
   integer i;                                                  <<06578>>02810000
                                                               <<06578>>02815000
   equate spooledclass = -3; <<allocate return>>               <<00640>>02820000
   logical nostdin   := 0,        << for procreate call >>     <<01200>>02825000
           nostdlist := 0;                                     <<01200>>02830000
   equate  nostring   = 0,                                     <<01200>>02835000
           nostlen    = 0;                                     <<01200>>02840000
   logical pcbpt;                                              <<06574>>02845000
<< >>                                                                   02850000
logical subroutine alloc (oldparm);                                     02855000
   value oldparm;                                                       02860000
   logical oldparm;    <<true => jin; false => jlist>>                  02865000
<< allocates jlist or jin; setting <dev>. >>                            02870000
begin                                                                   02875000
   old := oldparm;    <<won't be able to access s-rel.>>                02880000
<<  push the user, acct, and job names onto the stack >>       <<06578>>02885000
i := jmatusernameoff;                                          <<06578>>02890000
do begin                                                       <<06578>>02895000
  tos := jmatarr(jmatinx+i);                                   <<06578>>02900000
  i := i + 1;                                                  <<06578>>02905000
end                                                            <<06578>>02910000
until i >= jmatgrplogonoff;                                    <<06578>>02915000
                                                               <<06578>>02920000
                                                               <<06578>>02925000
   tos := "$STD";                                                       02930000
   tos := if old then "IN  " else "LIST";                               02935000
<< stack jmat entry parms for allocate (1st 8) >>                       02940000
   tos := 0;    <<return parm>>                                         02945000
   << stack dev & old/new flag; set access >>                           02950000
   if old then                                                          02955000
      begin                                                             02960000
      tos := jmatjindev;                                       <<06578>>02965000
      tos := true;                                                      02970000
      access := 0;                                                      02975000
      end                                                               02980000
   else                                                                 02985000
      begin                                                             02990000
      tos := jmatjlistdev;                                     <<06578>>02995000
      if logical(jmatcbit) then tos := -tos;                   <<06578>>03000000
      tos := false;                                                     03005000
      access := 1;                                                      03010000
      end;                                                              03015000
   tos := jmatoutpri;                                          <<06578>>03020000
   tos := 0;    <<for @names (stack) >>                                 03025000
   tos := mainpin;   <<owner pin>>                                      03030000
   tos := 0;    <<for @nullforms>>                                      03035000
   tos := jmatarr(jmatinx+jmatjsnooff);  << number and type >> <<06578>>03040000
   tos := jmatnumcopies;                                       <<06578>>03045000
<< complete allocate setup from stack >>                                03050000
   exchangedb (0);                                                      03055000
   @ps4 := @arrs24;                                                     03060000
   @ps2 := @nullforms;                                                  03065000
   tos := allocate (*, *, *, *, *, *, *, *,                             03070000
         devinfo, xddsubp, access);                                     03075000
   assemble (stax, subs 16);                                            03080000
   if xreg = spooledclass then xreg := 0;                      <<00640>>03085000
   if xreg <= 0 then                                                    03090000
      begin    <<successful alloc>>                                     03095000
          << note: devinfo is returned by the call to >>       <<06572>>03100000
          <<       allocate.  it returns the following>>       <<06572>>03105000
          <<       mpe v format:                      >>       <<06572>>03110000
          << devinfo (0)   - ldev or vdev allocated   >>       <<06572>>03115000
          <<         (1)-(4) lptd entry               >>       <<06572>>03120000
          <<         (5)-(11) ldt entry               >>       <<06572>>03125000
          <<                                          >>       <<06572>>03130000
          << ************ c a u t i o n ************* >>       <<06572>>03135000
          << this is the change for   mpe v !!!!!!!   >>       <<06572>>03140000
          <<                                          >>       <<06572>>03145000
          <<******************************************>>       <<06572>>03150000
      if old then                                                       03155000
         begin    << set jin and ci parms >>                            03160000
         jin := devinfo;                                                03165000
         @jinxddep := @xddsubp;                                         03170000
         jindevtype := devinfo (5 +ld'devtype);                <<06572>>03175000
         end                                                            03180000
      else                                                              03185000
         begin    << set jlist & ci parms >>                            03190000
         jlistalloc := xreg;                                            03195000
         jlist := devinfo;                                              03200000
         @jlistxddep := @xddsubp;                                       03205000
         end;                                                           03210000
      alloc := true;                                                    03215000
      end                                                               03220000
   else                                                                 03225000
      alloc := false;                                                   03230000
   exchangedb (jmatdst);                                                03235000
   end;    << alloc >>                                                  03240000
   << >>                                                                03245000
subroutine dealloc (dev);                                               03250000
   value dev;                                                           03255000
   integer dev;                                                         03260000
<< deallocate dev >>                                                    03265000
begin                                                                   03270000
   exchangedb (0);                                                      03275000
   dflag:=%1400;  << high order word of dflagdev >>            <<06577>>03280000
   ddev:=dev;     << low order word of dflagdev >>             <<06577>>03285000
   deallocate(dflagdev);                                       <<06577>>03290000
   exchangedb (jmatdst);                                                03295000
   end;    << dealloc >>                                                03300000
   << >>                                                                03305000
logical subroutine getfiledst;                                          03310000
<< allocates file nobuf dst; sets filedst >>                            03315000
begin                                                                   03320000
   getfiledst := true;                                                  03325000
   filedst := 0;                                                        03330000
   if jmatjstype <> sesstype then                              <<06578>>03335000
      begin                                                             03340000
      exchangedb(0);                                                    03345000
      fcreatecb(dum,0d,-69,0,0);                               <<07270>>03350000
      ddel;del;                                                <<07270>>03355000
      if < then getfiledst := false;                                    03360000
      filedst := exchangedb(jmatdst);                                   03365000
      end;                                                              03370000
   end;                                                                 03375000
   << >>                                                                03380000
subroutine reljpcnt;                                                    03385000
<< release jpcnt entry <jpcntp>. >>                                     03390000
<< reset bit to 0 showing unused entry                      >> <<06534>>03395000
<< called when other system resourses couldn't be allocated >> <<06534>>03400000
<< and the jpcnt entry must be released.  jpcntindex is     >> <<06534>>03405000
<< gotten form wordset.(5:7) and the entry to be free is bit>> <<06534>>03410000
begin                                                                   03415000
   exchangedb (jpcntdst);                                               03420000
   savesir := getsir (jpcntsir);                                        03425000
   jpcntindex:=wordset.(5:7);<< remember? got it in getjpcnt >><<06534>>03430000
   tos:=jpcntbitmap;                                           <<06534>>03435000
   xreg:=bit;                                                  <<06534>>03440000
   assemble(tsbc 0,x);             << set entry to 1 as free >><<06534>>03445000
   jpcntbitmap:=tos;               << update the table >>      <<06534>>03450000
   jpcntfreentries:=jpcntfreentries+1;<< up # free entries >>  <<06534>>03455000
   relsir (jpcntsir, savesir);                                          03460000
   exchangedb (jmatdst);                                                03465000
   end;    << reljpcnt >>                                               03470000
                                                                        03475000
                                                                        03480000
   << >>                                                                03485000
logical subroutine getjpcnt;                                   <<06534>>03490000
<< written for mpev.  uses a simular algorithm that the >>     <<06534>>03495000
<< directory uses for its bit map.  the search for a    >>     <<06534>>03500000
<< bit will use a jpcntnextavail word from the dst to start  >><<06534>>03505000
<< allocates the jpcnt entry for the session/job.  the       >><<06534>>03510000
<< variables wordset and bit, after getting a value here,    >><<06534>>03515000
<< will be used in this logical procedure and in the         >><<06534>>03520000
<< subroutine reljpcnt.                                      >><<06534>>03525000
<< the first entry allocated is zero (0).  wordset is the    >><<06534>>03530000
<< calculated jpcnt entry; and if all of the other resourses >><<06534>>03535000
<< that are needed for a successful launch are allocated,    >><<06534>>03540000
<< then wordset is stored in pxg'jpcntinx (8th word of user  >><<06534>>03545000
<< stack) in the launchjob main body below.                  >><<06534>>03550000
begin                                                          <<06534>>03555000
  getjpcnt := false;                                           <<07269>>03560000
  exchangedb(jpcntdst);                                        <<06534>>03565000
  savesir:=getsir(jpcntsir);                                   <<06534>>03570000
  if jpcntfreentries = 0                                       <<06534>>03575000
     then getjpcnt:=false                                      <<06534>>03580000
     else                                                      <<06534>>03585000
     begin                                                     <<06534>>03590000
     shift:=true;                                              <<06534>>03595000
     wordset:=0;                                               <<06534>>03600000
     bit:=0;                                                   <<06534>>03605000
     bitcount := 0;                                            <<07269>>03610000
     while (shift) and (bitcount < jpcntmaxentries)  do        <<07269>>03615000
       begin                                                   <<06534>>03620000
       jpcntindex:=jpcntnextavail;                             <<06534>>03625000
       if ((jpcntbitmap&lsl(bit)) < 0)                         <<06534>>03630000
          then begin                                           <<06534>>03635000
               tos:=jpcntbitmap;                               <<06534>>03640000
               << set the bit to 0 showing used entry >>       <<06534>>03645000
               xreg:=bit;                                      <<06534>>03650000
               assemble(trbc 0,x);                             <<06534>>03655000
               jpcntbitmap:=tos;                               <<06534>>03660000
               jpcntfreentries:=jpcntfreentries-1;             <<06534>>03665000
               wordset.(5:7):=jpcntnextavail;                  <<06534>>03670000
               wordset.(12:4):=bit;                            <<06534>>03675000
               shift:=false;                                   <<06534>>03680000
               getjpcnt:=true;                                 <<06534>>03685000
               end                                             <<07269>>03690000
          else                                                 <<07269>>03695000
               if bit=15  or  (jpcntnextavail*bitsperword+bit+1<<07269>>03700000
                              =jpcntmaxentries)                <<07269>>03705000
               then begin                                      <<07269>>03710000
                  if jpcntnextavail =(nwdsbitmap -1)           <<07269>>03715000
                        then jpcntnextavail:=0                 <<07269>>03720000
                        else jpcntnextavail:=jpcntnextavail+1; <<07269>>03725000
                  bit := 0;                                    <<07269>>03730000
               end                                             <<07269>>03735000
               else bit := bit + 1;                            <<07269>>03740000
               bitcount := bitcount + 1;                       <<07269>>03745000
       end; << while >>                                        <<06534>>03750000
    end; << else begin >>                                      <<06534>>03755000
  relsir(jpcntsir,savesir);                                    <<06534>>03760000
  exchangedb(jmatdst);                                         <<06534>>03765000
end; << procedure getjpcnt >>                                  <<06534>>03770000
                                                                        03775000
                                                                        03780000
<< ....................................................... >>  <<06578>>03785000
<<                                                         >>  <<06578>>03790000
<<    ************ main body of launchjob **************   >>  <<06578>>03795000
<<                                                         >>  <<06578>>03800000
<< ....................................................... >>  <<06578>>03805000
                                                               <<06577>>03810000
<< debug; >>                                                   <<06577>>03815000
                                                               <<06577>>03820000
i := -1;                                                       <<06573>>03825000
while (i := i + 1) <= pxg'size-1                               <<06573>>03830000
  do qarray(i) := 0;                                           <<06573>>03835000
                                                               <<06578>>03840000
<< jmatinx  is the jmat entry index of the job to be launched>><<06578>>03845000
jmatinx := @jmatp;                                             <<06578>>03850000
   failnum := limitfail;                                                03855000
   if (jmatinpri = jobhipri  land  not(logical(jmatlgbits)))   <<06578>>03860000
   or (jmatjstype = jobtype  land jmatjnum < jmatjlimit)       <<06578>>03865000
   or (jmatjstype = sesstype land jmatsnum < jmatslimit)       <<06578>>03870000
   then                                                        <<06578>>03875000
      begin    << we are under limits >>                       <<06578>>03880000
      if jmatjstype = jobtype                                  <<06578>>03885000
      then jmatjnum := jmatjnum + 1 << increment job count >>  <<06578>>03890000
      else jmatsnum := jmatsnum + 1;<< increment sess count >> <<06578>>03895000
      failnum := deferredfail;                                          03900000
      if jmatinpri > jmatjobfence then                         <<06578>>03905000
         begin    <<satisfied fence>>                                   03910000
         failnum := pcbfail;                                            03915000
         if ( mainpin := getentry (pcbcode) ) <> 0 then                 03920000
            begin    <<got pcb>>                                        03925000
            failnum := stackfail;                                       03930000
            if (stackdst := getstack(initstacksize,maxstacksize))       03935000
                  <> 0 then                                             03940000
               begin    <<got stack>>                                   03945000
               failnum := jitfail;                                      03950000
               if (jit'dst:=getdataseg(jit'entry'size,         <<06818>>03955000
                           maxjitsize)) <> 0 then              <<06818>>03960000
                  begin    <<got jit>>                                  03965000
                  failnum := jdtfail;                                   03970000
                  if (jdtdst := getdataseg (initjdtsize, maxjdtsize))   03975000
                        <> 0 then                                       03980000
                     begin    <<got jdt>>                               03985000
                     failnum := filefail;                               03990000
                     if getfiledst then                                 03995000
                      begin  <<got file nobuf dst>>                     04000000
                      failnum := jpcntfail;                             04005000
                      if getjpcnt then                                  04010000
                        begin    <<got jpcnt entry>>                    04015000
                        if logical(jmatcbit)                   <<06578>>04020000
                         or jmatjindev <> jmatjlistdev then    <<06578>>04025000
                           begin   <<in <> list: alloc list, then in>>  04030000
                           allocorder := 2;  <<list then in signal>>    04035000
                           failnum := jlistfail;  <<in case fails>>     04040000
                           end                                          04045000
                     << else                                            04050000
                           jin= jlist: alloc in, then list.             04055000
                           allocorder := 1; by initialization;          04060000
                           failnum not set,                             04065000
                              'cause alloc (jin) won't fail. >>;        04070000
                        if alloc (allocorder) then                      04075000
                           begin    <<got job list, or in  dev>>        04080000
                           failnum:=(if allocorder then        <<sb.00>>04085000
                                     jlistfail else jinfail);  <<sb.00>>04090000
                           if alloc (allocorder &lsr(1)) then           04095000
                           begin                               <<06578>>04100000
                                                               <<06578>>04105000
<< ........................................................ >> <<06578>>04110000
<<    we are here if we got everything we needed. now we    >> <<06578>>04115000
<<    set up and launch the job.                            >> <<06578>>04120000
<< ........................................................ >> <<06578>>04125000
                                                               <<06578>>04130000
                              << setup for job launch >>                04135000
                              failnum := nofail;                        04140000
                              delink'jmat (@jmatp);            <<06578>>04145000
                              << update jmat >>                         04150000
                              jmatjobstate := jobinit;         <<06578>>04155000
                              jmatorigjin := jmatjindev;       <<06578>>04160000
                              jmatjindev := jin;               <<06578>>04165000
                              jmatorigjlist := jmatjlistdev;   <<06578>>04170000
                              jmatjlistdev := jlist;           <<06578>>04175000
                              jmatmainpin := mainpin;          <<06578>>04180000
                              << procreate c.i. >>                      04185000
                              pri := jmatxpri;                 <<06578>>04190000
                              <<setup ci pxglob (3:6)>>                 04195000
                              put'jobnum'in'pxfixed(           <<06573>>04200000
                           jmatjsno, jmatjstype);              <<06578>>04205000
                              pxg'inputldev := jin;            <<06573>>04210000
                              pxg'jmatinx := jmatinx/          <<06578>>04215000
                                    jmatentrysize;             <<06578>>04220000
                              pxg'outputldev := jlist;         <<06573>>04225000
                              << wordset set in getjpcnt >>    <<06534>>04230000
                              pxg'jpcntinx := wordset;         <<06534>>04235000
                              pxg'jdtdst := jdtdst;            <<06573>>04240000
                              pxg'jitdst:=jit'dst;             <<06818>>04245000
                              pxg'restart := jmatrestart;      <<06578>>04250000
                              pxg'jobtype := jmatjstype;       <<06578>>04255000
                           pxg'duplicative := jmatduplicative; <<06578>>04260000
                           pxg'interactive := jmatinteractive; <<06578>>04265000
                              exchangedb (0);                           04270000
                              if pxg'interactive = 1           <<06573>>04275000
                                 then interactive := true      <<06573>>04280000
                                 else interactive := false;    <<06573>>04285000
                              procreate (                               04290000
                                  mainpin, comintlb, comintdp,          04295000
                                  stackdst,                    <<04600>>04300000
                                  cis'globstksize, dlsize,     <<04600>>04305000
                                  locsize-128, pri, nostring,  <<01200>>04310000
                                  nostlen, expcode, 0,         <<04556>>04315000
                                  maxsize, nostdin, nostdlist);<<01200>>04320000
                              << initialize pcbx >>                     04325000
                              << move pxglob (3:6) in >>                04330000
                              tos := stackdst;  <<setup move>>          04335000
                              tos := pxg'jobinfo'offset;       <<06573>>04340000
                              tos :=@qarray+pxg'jobinfo'offset;<<06573>>04345000
                              tos := pxg'jobinfo'len;          <<06573>>04350000
                              assemble (mtds 4);                        04355000
                              << put comm. info into jit >>    <<02.eb>>04360000
                              tos:=jit'dst;                    <<06818>>04365000
                              tos := 0; << offset in jit>>     <<02.eb>>04370000
                              tos := @ciparms;<<source>>       <<02.eb>>04375000
                              tos := cinumparms;<<count>>      <<02.eb>>04380000
                              assemble(mtds 4);                <<02.eb>>04385000
                              << find pxfile >>                         04390000
                              << move file nobuf dst >>                 04395000
                              tos := stackdst;                          04400000
                              tos := 0;                                 04405000
                              tos := @s0;                               04410000
                              tos := stackdst;                          04415000
                              tos := pxg'size;                 <<06573>>04420000
                              tos := 1;                                 04425000
                              assemble(mfds 4);                         04430000
                              tos := tos+pxg'size+10;          <<07270>>04435000
                              tos := @filedst;                          04440000
                              tos := 1;                                 04445000
                              assemble(mtds 4);                         04450000
                              exchangedb (jmatdst);                     04455000
                              << awake c.i. >>                          04460000
                              pcbpt := mainpin * pcbsize;      <<06574>>04465000
                              spcbcrit := 1;                   <<06574>>04470000
if interactive then                                            <<01549>>04475000
                              queueinginfo.interactiveflag :=1;<<06574>>04480000
                              awake(pcbpt,1,0);                <<06574>>04485000
                              return;    <<to ucop loop>>               04490000
                              end;    <<successful launch>>             04495000
      << unwind acquisitions by "UNNESTING" >>                          04500000
                           <<either jin or jlist failed>>      <<sb.00>>04505000
                           if failnum=jinfail then             <<sb.00>>04510000
                                dealloc(jlist)                 <<sb.00>>04515000
                           else                                <<sb.00>>04520000
                                dealloc(jin);                  <<sb.00>>04525000
                           end;                                <<sb.00>>04530000
                         reljpcnt;                                      04535000
                         end;                                           04540000
                        if filedst <> 0 then                            04545000
                           reldataseg(filedst);                         04550000
                        end;                                            04555000
                     reldataseg (jdtdst);                               04560000
                     end;                                               04565000
                  reldataseg(jit'dst);                         <<06818>>04570000
                  end;                                                  04575000
               reldataseg (stackdst);                                   04580000
               end;                                                     04585000
            returnentry (pcbcode, mainpin);                             04590000
            end;                                                        04595000
         end;                                                           04600000
      if jmatjstype = jobtype                                  <<06578>>04605000
      then jmatjnum := jmatjnum - 1 << decrement job count >>  <<06578>>04610000
      else jmatsnum := jmatsnum - 1;<< decrement sess count >> <<06578>>04615000
      end;                                                              04620000
   writedseg(jmatdst);                                                  04625000
   << failnum (type return) contains the failure reason >>              04630000
   << inform operator, if system resource failure >>                    04635000
   jin := jmatjindev;                                          <<06578>>04640000
  jtype := jmatjstype;                                         << 8998>>04645000
  jnum  := jmatjsno;                                           << 8998>>04650000
   if failnum.(10:3) = sysfailgroup then                                04655000
      begin    <<tell op of job resource depletion>>                    04660000
      exchangedb (0);                                                   04665000
      if jtype = sesstype then                                 << 8998>>04670000
       case failnum.(13:3) of                                  << 8998>>04675000
         begin                                                 << 8998>>04680000
         genmsg(1,cantgetstack,%10000,jin,,,,,0);              << 8998>>04685000
         genmsg(1,cantgetjit,%10000,jin,,,,,0);                << 8998>>04690000
         genmsg(1,cantgetjdt,%10000,jin,,,,,0);                << 8998>>04695000
         genmsg(1,cantgetpcb,%10000,jin,,,,,0);                << 8998>>04700000
         genmsg(1,cantgetjpcnt,%10000,jin,,,,,0);              << 8998>>04705000
         genmsg(1,cantgetfiledst,%10000,jin,,,,,0)             << 8998>>04710000
         end                                                   << 8998>>04715000
      else                                                     << 8998>>04720000
       case failnum.(13:3) of                                  << 8998>>04725000
         begin                                                 << 8998>>04730000
         genmsg(1,jcantgetstack,%10000,jnum,,,,,0);            << 8998>>04735000
         genmsg(1,jcantgetjit,%10000,jnum,,,,,0);              << 8998>>04740000
         genmsg(1,jcantgetjdt,%10000,jnum,,,,,0);              << 8998>>04745000
         genmsg(1,jcantgetpcb,%10000,jnum,,,,,0);              << 8998>>04750000
         genmsg(1,jcantgetjpcnt,%10000,jnum,,,,,0);            << 8998>>04755000
         genmsg(1,jcantgetfiledst,%10000,jnum,,,,,0)           << 8998>>04760000
         end;                                                  << 8998>>04765000
      exchangedb (jmatdst);                                             04770000
      end                                                      <<ljc>>  04775000
      else if failnum.(10:3) = sys2failgroup                   <<ljc>>  04780000
               << possible allocation problems >>              <<ljc>>  04785000
              then begin                                       <<ljc>>  04790000
                   nomess:=false;                              <<ljc>>  04795000
                   exchangedb(0);                              <<ljc>>  04800000
                   case failnum.(13:3) of                      <<ljc>>  04805000
                      begin                                    <<ljc>>  04810000
                      nomess:=true; << deferred fail nomsg >>  <<ljc>>  04815000
         <<1>> if jtype = sesstype then                        << 8998>>04820000
                genmsg(1,cantgetjlist,%10000,jin,,,,,0)        << 8998>>04825000
               else                                            << 8998>>04830000
                genmsg(1,jcantgetjlist,%10000,jnum,,,,,0);     << 8998>>04835000
         <<2>> if jtype = sesstype then                        << 8998>>04840000
                genmsg(1,cantgetjin,%10000,jin,,,,,0)          << 8998>>04845000
               else                                            << 8998>>04850000
                genmsg(1,jcantgetjin,%10000,jnum,,,,,0);       << 8998>>04855000
           end;   <<case failnum >>                            << 8998>>04860000
                   exchangedb(jmatdst);                        <<ljc>>  04865000
                   end;                                        <<ljc>>  04870000
   end;    <<launchjob>>                                                04875000
$page "CHECKSCHED:  Handles the Scheduled Jobs Queue."         << 8198>>04880000
procedure checksched;                                          << 8198>>04885000
begin                                                          << 8198>>04890000
                                                               << 8198>>04895000
<<*********************************************************>>  << 8198>>04900000
<<                                                         >>  << 8198>>04905000
<< this procedure manages the scheduled jobs queue.  it    >>  << 8198>>04910000
<< has several responsibilities:                           >>  << 8198>>04915000
<<                                                         >>  << 8198>>04920000
<<    o it checks the scheduled jobs scheduled             >>  << 8198>>04925000
<<      times against the current time and places          >>  << 8198>>04930000
<<      appropriate jobs into the wait queue.              >>  << 8198>>04935000
<<                                                         >>  << 8198>>04940000
<<    o it handles the timer request list request          >>  << 8198>>04945000
<<      that is set for the next job's scheduled           >>  << 8198>>04950000
<<      start time or 24 days, whichever comes             >>  << 8198>>04955000
<<      first.  note that there is no trl entry            >>  << 8198>>04960000
<<      if the scheduled jobs queue is empty.              >>  << 8198>>04965000
<<      also note that 24 days is the maximum number       >>  << 8198>>04970000
<<      of days expressable in milliseconds stored         >>  << 8198>>04975000
<<      in a double word integer.                          >>  << 8198>>04980000
<<                                                         >>  << 8198>>04985000
<<    o it handles the case that a newly introduced        >>  << 8198>>04990000
<<      scheduled job is scheduled earlier than the        >>  << 8198>>04995000
<<      job associated with the current trl entry.         >>  << 8198>>05000000
<<                                                         >>  << 8198>>05005000
<< the timer request list must be handled carefully.  ucop >>  << 8198>>05010000
<< will get a trl entry for the first job in the scheduled >>  << 8198>>05015000
<< jobs queue only.  since each entry in the trl must be   >>  << 8198>>05020000
<< aborted explicitly, this procedure will abort the       >>  << 8198>>05025000
<< current trl entry (if present) when it is entered and   >>  << 8198>>05030000
<< will create a trl entry for the first job in the        >>  << 8198>>05035000
<< scheduled jobs queue before completion.  note that the  >>  << 8198>>05040000
<< deletion of the current trl entry is always safe:  it   >>  << 8198>>05045000
<< is either popped, or it is associated with a job that   >>  << 8198>>05050000
<< may not yet need to be placed in the wait queue.        >>  << 8198>>05055000
<<                                                         >>  << 8198>>05060000
<< it should be noted that ucop will wait on events other  >>  << 8198>>05065000
<< than a timer wait.  it is not possible to determine     >>  << 8198>>05070000
<< which event awakened a process once it is awake.  thus, >>  << 8198>>05075000
<< this procedure is called at the beginning of getjob     >>  << 8198>>05080000
<< which is part of the ucop loop that launches jobs.      >>  << 8198>>05085000
<<                                                         >>  << 8198>>05090000
<< this procedure assumes that the jmat sir is being held  >>  << 8198>>05095000
<< by the caller and that db is still pointing at ucop's   >>  << 8198>>05100000
<< stack.  holding the jmat sir will prevent any other     >>  << 8198>>05105000
<< process from trying to introduce a job while we are     >>  << 8198>>05110000
<< playing with the various job queues.                    >>  << 8198>>05115000
<<                                                         >>  << 8198>>05120000
<< note that this procedure uses movefromdseg to access    >>  << 8198>>05125000
<< the jmat.  comptime cannot be called in split stack     >>  << 8198>>05130000
<< mode.  further, some of the variables used by this      >>  << 8198>>05135000
<< procedure (notably the trl variables) are global to     >>  << 8198>>05140000
<< ucop's outer block and are thus db-relative--these      >>  << 8198>>05145000
<< variables cannot, therefore, be referenced in split     >>  << 8198>>05150000
<< stack mode.                                             >>  << 8198>>05155000
<<                                                         >>  << 8198>>05160000
<<*********************************************************>>  << 8198>>05165000
                                                               << 8198>>05170000
                                                               << 8198>>05175000
<< the following declarations are used for comparing the   >>  << 8198>>05180000
<< scheduled jobs' times against the current time.         >>  << 8198>>05185000
   integer array                                               << 8198>>05190000
      nowtime(0:2),        << holds current time.          >>  << 8198>>05195000
      time(0:2);           << holds target's time.         >>  << 8198>>05200000
                                                               << 8198>>05205000
   logical                                                     << 8198>>05210000
      nowcal;              << year and day specifications. >>  << 8198>>05215000
                                                               << 8198>>05220000
   double                                                      << 8198>>05225000
      temp'd,                 << temporary storage.        >>  << 8198>>05230000
      trldelay,               << trl request time units.   >>  << 8198>>05235000
      nowclock;               << time specifications.      >>  << 8198>>05240000
                                                               << 8198>>05245000
   integer                                                     << 8198>>05250000
      trl'jmatinx'l,          << local trl variables used  >>  << 8198>>05255000
      trl'jsno'l,             << for split stack scan.     >>  << 8198>>05260000
      temp'0  = temp'd,       << temporary storage.        >>  << 8198>>05265000
      temp'1  = temp'd+1;                                      << 8198>>05270000
                                                               << 8198>>05275000
   intrinsic                                                   << 8198>>05280000
      calendar, clock;                                         << 8198>>05285000
                                                               << 8198>>05290000
   define                                                      << 8198>>05295000
      days'24 = 2073600000d#;   << trl units in 24 days.   >>  << 8198>>05300000
                                                               << 8198>>05305000
                                                               << 8198>>05310000
<< the following declarations are used in comparing two    >>  << 8198>>05315000
<< times (in internal jmat format).                        >>  << 8198>>05320000
   integer                                                     << 8198>>05325000
      comperror := 0,  << holds the error value returned   >>  << 8198>>05330000
                       << by comptime.                     >>  << 8198>>05335000
      compreturn;      << return value from comptime.      >>  << 8198>>05340000
                                                               << 8198>>05345000
   equate              << possible compreturn values.      >>  << 8198>>05350000
      lessthan     = -1,                                       << 8198>>05355000
      equals       = 0,                                        << 8198>>05360000
      greaterthan  = 1,                                        << 8198>>05365000
      very'great   = 2,                                        << 8198>>05370000
      errincomp    = 10;                                       << 8198>>05375000
                                                               << 8198>>05380000
   logical                                                     << 8198>>05385000
      notdone,               << looping flag.              >>  << 8198>>05390000
      errflag    := false;   << flags comptime error.      >>  << 8198>>05395000
                                                               << 8198>>05400000
   double                                                      << 8198>>05405000
      diff;                  << holds trl time unit delay. >>  << 8198>>05410000
                                                               << 8198>>05415000
                                                               << 8198>>05420000
<< the following define is used to handle the occurrence   >>  << 8198>>05425000
<< of an error detected by comptime.                       >>  << 8198>>05430000
   define                                                      << 8198>>05435000
      printcomperror                                           << 8198>>05440000
         =  begin                                              << 8198>>05445000
               genmsg( sysset, schedcomperr,                   << 8198>>05450000
                       %11000, comperror, jmatjsno,,,, 0 );    << 8198>>05455000
               errflag := false;                               << 8198>>05460000
               comperror := 0;                                 << 8198>>05465000
            end  #;                                            << 8198>>05470000
                                                               << 8198>>05475000
<< the following definitions are used for the referencing  >>  << 8198>>05480000
<< of the jmat.                                            >>  << 8198>>05485000
   integer array    jmatarr(0:jmatentrysize-1);                << 8198>>05490000
   integer          jmatinx := 0, << references jmatarr.   >>  << 8198>>05495000
                    currinx,      << current entry's jmat  >>  << 8198>>05500000
                                  << index.                >>  << 8198>>05505000
                    link;         << local scheduling link.>>  << 8198>>05510000
   integer pointer  jmatp;                                     << 8198>>05515000
   equate           jobchainend  = 0;                          << 8198>>05520000
                                                               << 8198>>05525000
$page                                                          << 8198>>05530000
<< movefromdseg:  standard mfds subroutine.                >>  << 8198>>05535000
   subroutine movefromdseg( target, dstn, offset, count );     << 8198>>05540000
      value   target, dstn, offset, count;                     << 8198>>05545000
      logical target, dstn, offset, count;                     << 8198>>05550000
   begin                                                       << 8198>>05555000
                                                               << 8198>>05560000
      x := tos;         << save subroutine return address. >>  << 8198>>05565000
      assemble( mfds 0 );                                      << 8198>>05570000
      tos := x;         << restore return address.         >>  << 8198>>05575000
                                                               << 8198>>05580000
   end;                                                        << 8198>>05585000
                                                               << 8198>>05590000
                                                               << 8198>>05595000
<< movetodseg:  standard mtds subroutine.                  >>  << 8198>>05600000
   subroutine movetodseg( dstn, offset, source, count );       << 8198>>05605000
      value   dstn, offset, source, count;                     << 8198>>05610000
      logical dstn, offset, source, count;                     << 8198>>05615000
   begin                                                       << 8198>>05620000
                                                               << 8198>>05625000
      x := tos;         << save subroutine return address. >>  << 8198>>05630000
      assemble( mtds 0 );                                      << 8198>>05635000
      tos := x;         << restore return address.         >>  << 8198>>05640000
                                                               << 8198>>05645000
   end;                                                        << 8198>>05650000
                                                               << 8198>>05655000
                                                               << 8198>>05660000
<< cango:  examines the current jmat entry to determine if >>  << 8198>>05665000
<< it is time for it to be placed into the wait state.     >>  << 8198>>05670000
   logical subroutine cango;                                   << 8198>>05675000
   begin                                                       << 8198>>05680000
                                                               << 8198>>05685000
   << this subroutine examines the current jmat entry in   >>  << 8198>>05690000
   << the jmatarr array to determine if it is time for the >>  << 8198>>05695000
   << associated job to be placed into the wait state.     >>  << 8198>>05700000
                                                               << 8198>>05705000
      time(0) := jmatcalendar;                                 << 8198>>05710000
      move time(1) := jmattime, (2);                           << 8198>>05715000
      compreturn := comptime( time, nowtime , , comperror );   << 8198>>05720000
      if compreturn = errincomp then                           << 8198>>05725000
      begin                                                    << 8198>>05730000
         errflag := true;                                      << 8198>>05735000
         cango := false;                                       << 8198>>05740000
         return;                                               << 8198>>05745000
      end;                                                     << 8198>>05750000
      if compreturn = lessthan  or  compreturn = equals        << 8198>>05755000
         then cango := true                                    << 8198>>05760000
         else cango := false;                                  << 8198>>05765000
                                                               << 8198>>05770000
      return;                                                  << 8198>>05775000
                                                               << 8198>>05780000
   end;                                                        << 8198>>05785000
$page                                                          << 8198>>05790000
<< start of main code for checksched.                      >>  << 8198>>05795000
                                                               << 8198>>05800000
<< first, initialize the values for the current time.      >>  << 8198>>05805000
   nowcal   := calendar;                                       << 8198>>05810000
   temp'd   := clock;                                          << 8198>>05815000
   nowtime    := nowcal;                                       << 8198>>05820000
   nowtime(1) := temp'0;                                       << 8198>>05825000
   nowtime(2) := temp'1;                                       << 8198>>05830000
                                                               << 8198>>05835000
<< check the scheduled jobs queue for jobs that are ready  >>  << 8198>>05840000
<< to go.  if found, these are placed into the wait queue  >>  << 8198>>05845000
<< by the call to schedulejob, and the scheduled jobs      >>  << 8198>>05850000
<< queue is updated.  when done, the scheduled job to be   >>  << 8198>>05855000
<< run will be the new jmatschedhead.                      >>  << 8198>>05860000
                                                               << 8198>>05865000
<< look at the first job in the scheduled jobs queue.      >>  << 8198>>05870000
   movefromdseg( @jmatarr, jmatdst, 0, jmatentrysize );        << 8198>>05875000
   link := jmatschedhead;                                      << 8198>>05880000
   if link = jobchainend                                       << 8198>>05885000
      then return;          << no scheduled jobs.          >>  << 8198>>05890000
                                                               << 8198>>05895000
   movefromdseg( @jmatarr, jmatdst, link, jmatentrysize );     << 8198>>05900000
   currinx := link;                                            << 8198>>05905000
   link := jmatschedlink;                                      << 8198>>05910000
                                                               << 8198>>05915000
   notdone := true;                                            << 8198>>05920000
   while notdone do                                            << 8198>>05925000
   begin                                                       << 8198>>05930000
                                                               << 8198>>05935000
   << the current job can be placed into the wait state.   >>  << 8198>>05940000
   << do so, and maintain the scheduled jobs queue.        >>  << 8198>>05945000
      if cango then                                            << 8198>>05950000
      begin                                                    << 8198>>05955000
         @jmatp := currinx;                                    << 8198>>05960000
         movefromdseg( @jmatarr, jmatdst, 0,                   << 8198>>05965000
                       jmatentrysize         );                << 8198>>05970000
         jmatschedhead := link;                                << 8198>>05975000
         movetodseg( jmatdst, 0, @jmatarr,                     << 8198>>05980000
                     jmatentrysize           );                << 8198>>05985000
         schedulejob( jmatp );                                 << 8198>>05990000
                                                               << 8198>>05995000
      << get next jmat entry if it exists.                 >>  << 8198>>06000000
         if link = jobchainend                                 << 8198>>06005000
            then notdone := false                              << 8198>>06010000
         else                                                  << 8198>>06015000
         begin                                                 << 8198>>06020000
            movefromdseg( @jmatarr, jmatdst, link,             << 8198>>06025000
                          jmatentrysize            );          << 8198>>06030000
            currinx := link;                                   << 8198>>06035000
            link := jmatschedlink;                             << 8198>>06040000
         end;                                                  << 8198>>06045000
      end    << current job cango case. >>                     << 8198>>06050000
                                                               << 8198>>06055000
      else if errflag                                          << 8198>>06060000
         then printcomperror                                   << 8198>>06065000
                                                               << 8198>>06070000
      else notdone := false;                                   << 8198>>06075000
                                                               << 8198>>06080000
   end;                                                        << 8198>>06085000
                                                               << 8198>>06090000
                                                               << 8198>>06095000
<< jmatschedhead in the jmat header now points to          >>  << 8198>>06100000
<< the first job in the scheduled jobs queue.  delete the  >>  << 8198>>06105000
<< current trl entry if it exists--it is no longer needed. >>  << 8198>>06110000
<< a new entry for the first job in the scheduled jobs     >>  << 8198>>06115000
<< queue will be obtained.                                 >>  << 8198>>06120000
                                                               << 8198>>06125000
   if trlx <> notrl                                            << 8198>>06130000
      then aborttimereq( trlx );                               << 8198>>06135000
                                                               << 8198>>06140000
                                                               << 8198>>06145000
<< if necessary, create a new timer request for the first  >>  << 8198>>06150000
<< job in the scheduled jobs queue.                        >>  << 8198>>06155000
   movefromdseg( @jmatarr, jmatdst, 0, jmatentrysize );        << 8198>>06160000
   currinx := jmatschedhead;                                   << 8198>>06165000
   if currinx = jobchainend then                               << 8198>>06170000
   begin                                                       << 8198>>06175000
                                                               << 8198>>06180000
   << the scheduled jobs queue is empty.  no trl request.  >>  << 8198>>06185000
      trl'jmatinx := notrl;  << signifies no trl request.  >>  << 8198>>06190000
      trl'jsno := notrl;                                       << 8198>>06195000
      trlx := notrl;                                           << 8198>>06200000
                                                               << 8198>>06205000
   end                                                         << 8198>>06210000
   else                                                        << 8198>>06215000
   begin                                                       << 8198>>06220000
                                                               << 8198>>06225000
   << the scheduled jobs queue is not empty.  generate a   >>  << 8198>>06230000
   << timer request for it.                                >>  << 8198>>06235000
      jmatinx := 0;                                            << 8198>>06240000
      movefromdseg( @jmatarr, jmatdst, currinx,                << 8198>>06245000
                    jmatentrysize               );             << 8198>>06250000
      time(0) := jmatcalendar;                                 << 8198>>06255000
      move time(1) := jmattime, (2);                           << 8198>>06260000
      compreturn := comptime( time, nowtime,                   << 8198>>06265000
                              diff, comperror );               << 8198>>06270000
      if compreturn = errincomp                                << 8198>>06275000
         then printcomperror                                   << 8198>>06280000
      else                                                     << 8198>>06285000
      begin                                                    << 8198>>06290000
                                                               << 8198>>06295000
         if compreturn = very'great                            << 8198>>06300000
            then diff := days'24;                              << 8198>>06305000
         trlx := timereq( watchdog, ucoppcbinx, diff );        << 8198>>06310000
         trl'jmatinx := currinx;                               << 8198>>06315000
         if compreturn = very'great                            << 8198>>06320000
            then trl'jsno := notrl                             << 8198>>06325000
            else trl'jsno := jmatjsno;                         << 8198>>06330000
                                                               << 8198>>06335000
      end;                                                     << 8198>>06340000
                                                               << 8198>>06345000
   end;                                                        << 8198>>06350000
                                                               << 8198>>06355000
end;  << checksched >>                                         << 8198>>06360000
                                                               << 8198>>06365000
                                                               << 8198>>06370000
$page "GETJOB:  Checks to see if a Jobs are Ready."            << 8198>>06375000
logical procedure getjob;                                               06380000
<< scans jmat scheduling queue attempting to: 1). launch a              06385000
   qualifying session;  2). print a pending job error                   06390000
   message;  or 3). launch a qualifying batch job.                      06395000
   removes every session encountered which cannot be launched           06400000
   immediately.  returns (true) as soon as a job is launched.           06405000
   sets <waitflags> as appropriate (i.e. error message                  06410000
   waiting for the error buffer; and/or entry waiting for a             06415000
   device).  see, also, launchjob.    >>                                06420000
                                                               <<ljc>>  06425000
<< * fix information                                       >>  <<ljc>>  06430000
<<                                                         >>  <<ljc>>  06435000
<<   Two things: 1.  Puts the message "CAN'T INITIATE NEW  >>  <<LJC>>  06440000
<<   SESSIONS NOW" in CATALOG.PUB.SYS under $SET 1, $MSG80 >>  <<LJC>>  06445000
<<   2. prints a message to the user if the allocation for >>  <<ljc>>  06450000
<<   $stdlist/$stdin during a logon attempt, will up the   >>  <<ljc>>  06455000
<<   device, print the message and the down the device     >>  <<ljc>>  06460000
<<                                                         >>  <<ljc>>  06465000
<<  * fix information                                       >> <<06578>>06470000
<<                                                          >> <<06578>>06475000
<<      these are the mpe-v jmat changes.                   >> <<06578>>06480000
<<      note -- we keep a list of all the devices which     >> <<06578>>06485000
<<      have failed upon allocation in order to prevent     >> <<06578>>06490000
<<      duplication of error messages.  this list is kept on>> <<06578>>06495000
<<      tos.  each entry is now two words long (before the  >> <<06578>>06500000
<<      advent of 16 bit ldevs it was only one word) with   >> <<06578>>06505000
<<      the following format:                               >> <<06578>>06510000
<<              word 0:    the failed ldev                  >> <<06578>>06515000
<<              word 1:    0  =  input device               >> <<06578>>06520000
<<                         1  =  list device                >> <<06578>>06525000
<<                         2  =  list device is an index    >> <<06578>>06530000
<<                                                          >> <<06578>>06535000
<<      numcantalloc is the number of failed ldevs.         >> <<06578>>06540000
<<                                                          >> <<06578>>06545000
begin                                                                   06550000
                                                               <<06578>>06555000
<< ........................................................ >> <<06578>>06560000
<<    **** declarations for the jmat - mpev  fixes ****     >> <<06578>>06565000
<<                                                          >> <<06578>>06570000
<<  jmatarr    - is used by the jmat include file to        >> <<06578>>06575000
<<               reference the jmat.                        >> <<06578>>06580000
<<  jmatinx    - is the index into the jmatarr array        >> <<06578>>06585000
<<  nextentry  - saves the index to the next jmat entry     >> <<06578>>06590000
<<               in the scheduling list.                    >> <<06578>>06595000
<<  jmatp      - is used as a parameter to launchjob who    >> <<06578>>06600000
<<               expects a pointer to the jmat of the job   >> <<06578>>06605000
<<               to be launched.                            >> <<06578>>06610000
<< ........................................................ >> <<06578>>06615000
                                                               <<06578>>06620000
integer array jmatarr(*) = db + 0;<< using exchg db >>         <<06578>>06625000
integer       jmatinx;  << this is the index into the jmatarr>><<06578>>06630000
integer       nextentry;                                       <<06578>>06635000
integer pointer jmatp;                                         <<06578>>06640000
                                                               << 8153>>06645000
integer array                                                  << 8153>>06650000
    arr(0:2);  << used to send messages to creator. >>         << 8153>>06655000
                                                               <<06578>>06660000
<< local ucop wait flags >>                                             06665000
   logical           lwaitflags;                                        06670000
   define            waitdev   = lwaitflags.(15:1) #,                   06675000
                     waiterrbuf   = lwaitflags.(0:1) #;                 06680000
<< misc. vars >>                                                        06685000
   logical           stopflg := false; << stop scan flag >>    <<06574>>06690000
   integer           cilogx;                                   <<00.04>>06695000
   integer           action,           <<launchjob's action>>           06700000
                     sirreturn;        <<jmat sir return>>              06705000
   integer                                                     << 8153>>06710000
      creator'pin; << used to find creators port id. >>        << 8153>>06715000
                                                               << 8153>>06720000
   double                                                      << 8153>>06725000
      port'id;  << creators port id. >>                        << 8153>>06730000
                                                               << 8153>>06735000
   integer                                                     << 8153>>06740000
      sub'queue; << subqueue we are sending message to. >>     << 8153>>06745000
                                                               << 8153>>06750000
   equate            launchok   = 0,   <<launchjob returns>>            06755000
                     specificfail   = 1,                                06760000
                     jobchainend    = 0,<< end of jmat list >> <<06578>>06765000
                     jinfail   = 10,                                    06770000
                     jlistfail   = 9;                                   06775000
   double array      darrs0 (*)  = s-0;<<to access ldev list >><<06578>>06780000
   integer array     arrs0  (*)  = s-0;                                 06785000
   integer           numcantalloc  := 0; << list count >>      <<06578>>06790000
   double            targin,                                   <<06578>>06795000
                     targlist;  << hold new list failure >>    <<06578>>06800000
   equate            termtype  = 16;   << term dev type >>              06805000
   integer           listdevice;                               <<01029>>06810000
                                                               <<06577>>06815000
<< dflagdev is a double word structure.  the high order word >><<06577>>06820000
<< contains a flag mask and the low order word contains a    >><<06577>>06825000
<< logical device.  used in calls to external procecure      >><<06577>>06830000
<< deallocate (see subroutine dealloc in launchjob and       >><<06577>>06835000
<< procedure getjob).                                        >><<06577>>06840000
double dflagdev;                                               <<06577>>06845000
logical dflag =dflagdev;                                       <<06577>>06850000
logical ddev =dflagdev+1;                                      <<06577>>06855000
                                                               <<06577>>06860000
   integer                                                     <<06572>>06865000
      ldt'index := 0;                                          <<06572>>06870000
   logical array ldt(*) = db + 0;                              <<06572>>06875000
   << >>                                                                06880000
   getjob := false;                                                     06885000
   lwaitflags := 4;                                                     06890000
   sirreturn := getsir (jmatsir);                                       06895000
                                                               << 8198>>06900000
<< place appropriate scheduled jobs into wait queue.       >>  << 8198>>06905000
   checksched;                                                 << 8198>>06910000
   exchangedb( jmatdst );                                      << 8198>>06915000
                                                               << 8198>>06920000
   disable;                                                    <<01549>>06925000
   tos:=absys'miscword; tos.jobsync:=0; absolute(xreg):=tos;   <<01549>>06930000
   enable;                                                     <<01549>>06935000
   jmatinx := jmatheadptr; << start at head of queue >>        <<06578>>06940000
   @jmatp  := jmatinx; << remember, some people prefer ptrs >> <<06578>>06945000
   while (jmatinx <> jobchainend) and (not (stopflg)) do       <<06578>>06950000
      begin                                                             06955000
      nextentry := jmatschedlink;  << remember next entry >>   <<06578>>06960000
      if numcantalloc > 0 then                                          06965000
         begin  <<check 2 c if this jin/jlist failed b4>>               06970000
         tos         :=  jmatjlistdev;                         <<06578>>06975000
         tos         :=  if logical(jmatcbit) then 2  else 1;  <<06578>>06980000
         targlist    :=  tos;                                  <<06578>>06985000
                                                               <<06578>>06990000
         tos         :=  jmatjindev;                           <<06578>>06995000
         tos         :=  0;                                    <<06578>>07000000
         targin      :=  tos;                                  <<06578>>07005000
                                                               <<06578>>07010000
         xreg := -numcantalloc +1;                                      07015000
         do if darrs0 (xreg) = targlist  or                    <<06578>>07020000
               darrs0 (xreg) = targin    then goto next        <<06578>>07025000
         until (xreg := xreg +1) > 0;                                   07030000
         << jin or jlist hasn't previously failed >>                    07035000
         end;                                                           07040000
      if (action := launchjob (jmatp)) = launchok then                  07045000
         stopflg := (getjob := true)                           <<06574>>07050000
      else                                                              07055000
         begin    <<couldn't launch>>                                   07060000
         if jmatjstype = sesstype then                         <<06578>>07065000
            begin    <<couldn't launch session: remove>>                07070000
            ldt'index := jmatjindev * size'of'ldt'entry;       <<06578>>07075000
            exchangedb (ldt'dst);                              <<06572>>07080000
            << c if necessary 2 setup terminal device >>                07085000
            tos := (ldt'device'type = termtype);               <<06572>>07090000
            exchangedb (jmatdst);                                       07095000
            if (jmatproglogon=1) and (jmatwaittillon = 1) then << 8153>>07100000
                                                               << 8153>>07105000
            << session was programmatically created and the >> << 8153>>07110000
            << creator process is waiting to find out if the>> << 8153>>07115000
            << session made it.  we will let him know via   >> << 8153>>07120000
            << ipc.                                         >> << 8153>>07125000
            begin                                              << 8153>>07130000
              creator'pin := jmatcreator;                      << 8153>>07135000
              exchangedb(0);  << no split stack now >>         << 8153>>07140000
              port'id := findprocessport(creator'pin);         << 8153>>07145000
              sub'queue := 3; << must match the subqueue    >> << 8153>>07150000
                              << the creator is waiting on. >> << 8153>>07155000
              arr(1) := 3;  << msg length. >>                  << 8153>>07160000
              arr(2) := get'dcs'failno(2,action);              << 8153>>07165000
              send'db(port'id,sub'queue,arr);                  << 8153>>07170000
              exchangedb(jmatdst);                             << 8153>>07175000
              jmatwaittillon := 0;                             << 8153>>07180000
            end;                                               << 8153>>07185000
                                                               << 8153>>07190000
            if tos then                                                 07195000
               attachio (jmatjindev, 0, 0, 0, 21, 0,           <<06578>>07200000
                         1, 0, %13);                           <<06578>>07205000
            if logical(jmatcbit)                               <<06578>>07210000
            or (jmatjindev <> jmatjlistdev) then               <<06578>>07215000
               begin  << tell op 'cause can't tell user >>              07220000
               exchangedb (0);                                          07225000
               << message >>                                            07230000
               exchangedb (jmatdst);                                    07235000
               end                                                      07240000
            else if jmatproglogon = 0 then                              07245000
               begin    <<tell user>>                                   07250000
               listdevice := jmatjlistdev;                     <<06578>>07255000
               exchangedb (0);                                          07260000
               if((action=jlistfail)lor(action=jinfail))       <<ljc>>  07265000
                 then                                          <<ljc>>  07270000
                  if listdevice <> absolute(consolecell)       <<06817>>07275000
                     then                                      <<ljc>>  07280000
                     begin                                     <<ljc>>  07285000
                       attachio(listdevice,0,0,0,24,0,0,0,0);  <<ljc>>  07290000
                       if action=jlistfail                     <<ljc>>  07295000
                          then genmsg(1,cantgetlist,,,,,,,     <<ljc>>  07300000
                                      listdevice)                       07305000
                          else if action=jinfail               <<ljc>>  07310000
                                  then genmsg(1,cantgetin,     <<ljc>>  07315000
                                             ,,,,,,listdevice);<<ljc>>  07320000
                       attachio(listdevice,0,0,0,4,0,0,0,0);   <<ljc>>  07325000
                     end << if not console >>                  <<ljc>>  07330000
                     else  <<  for looks no new msg->cons >>   <<ljc>>  07335000
                  else genmsg(1,nonewses,,,,,,,listdevice);    <<ljc>>  07340000
               exchangedb (jmatdst);                                    07345000
               end;                                                     07350000
            << remove jmat entry >>                                     07355000
            delink'jmat (@jmatp);                              <<06578>>07360000
            dflag:=%3400; << high order word of dflagdev >>    <<07325>>07365000
            ddev:=jmatjindev; << low order word of dflagdev >> <<06577>>07370000
            cilogx := jmatftbits;                              <<06578>>07375000
            deallocate'jmat(jmatp);                            <<06578>>07380000
            exchangedb (0);                                             07385000
            deallocate(dflagdev);                              <<06577>>07390000
            if cilogx <> 0 then                                <<00.04>>07395000
                  cilogtable(2,@jmatp,cilogx,arrs0);           <<00.04>>07400000
            exchangedb (jmatdst);                              <<00.04>>07405000
            end                                                         07410000
         else                                                           07415000
            begin    <<couldn't launch job>>                            07420000
            if action = jlistfail then                                  07425000
               begin    << add jlist to cant alloc list >>              07430000
               tos := jmatjlistdev;                            <<06578>>07435000
               if logical(jmatcbit)                            <<06578>>07440000
               then tos := 2                                   <<06578>>07445000
               else tos := 1;                                  <<06578>>07450000
               numcantalloc := numcantalloc +1;                         07455000
               waitdev := true;                                         07460000
               end                                                      07465000
            else                                                        07470000
               if action = jinfail then                                 07475000
                  begin    << add jin to cant alloc list >>             07480000
                  tos := jmatjindev;                           <<06578>>07485000
                  tos := 0;                                    <<06578>>07490000
                  numcantalloc := numcantalloc +1;                      07495000
                  waitdev := true;                                      07500000
                  end                                                   07505000
               else                                                     07510000
                  << all other launch failures would cause              07515000
                     any subsequent job to fail also >>                 07520000
                  stopflg := true;                             <<06574>>07525000
            end;                                                        07530000
         end;    << launch failure handling >>                          07535000
next:                                                                   07540000
      jmatinx := nextentry;                                    <<06578>>07545000
      @jmatp  := jmatinx;                                      <<06578>>07550000
      end;                                                              07555000
   relsir (jmatsir, sirreturn);                                         07560000
   exchangedb (0);                                                      07565000
   waitflags := lwaitflags;                                             07570000
   end;    << getjob >>                                                 07575000
$page "***   OUTER BLOCK   ***"                                         07580000
      <<initialisation phase:set up ucop request list>>                 07585000
                                                                        07590000
      assemble(adds 17);                                                07595000
      exchangedb(urldst);          <<set db to url>>                    07600000
      reqfree := 2;                 <<init list pointers>>              07605000
      reqnext := 2;                                                     07610000
      exchangedb(0);                                                    07615000
      <<command interpreter labels>>                                    07620000
      comintlb := absys'ciextl.(8:8) lor %100000;                       07625000
      comintdp:= absys'ciintl;                                          07630000
      ucoppcbinx := sysproc( ucoplpin );                       << 8198>>07635000
      trlx := notrl;                                           << 8198>>07640000
      trl'jmatinx := notrl;                                    << 8198>>07645000
      trl'jsno := notrl;                                       << 8198>>07650000
      pcbpt := curprc;                                         <<06574>>07655000
      spcbptype' := 3;  << process type >>                     <<06574>>07660000
      awake(sysproc(0),2,%20);                 <<awake progenitor>>     07665000
                                                                        07670000
                                                                        07675000
start:                                                                  07680000
      exchangedb(urldst);          <<set db to url>>                    07685000
u4:   disable;                                                          07690000
      if reqnext = reqfree then                                         07695000
      begin                            <<no more requests>>             07700000
u1:      enable;                                                        07705000
u1':     exchangedb (0);                                                07710000
u3:      if getjob then goto u1                                         07715000
         else                                                           07720000
            begin                      << no ready job found >>         07725000
            << wait iff:                                                07730000
               - ucop request queue empty,  and                         07735000
               - no "STOP" requested,  and                              07740000
               - no job(s) just made ready,  and                        07745000
               - no (dev just made avail and job(s) waiting),  and      07750000
            << setup xreg values needed after disable >>                07755000
            tos := miscword;  <<job synch word>>               <<01549>>07760000
            push (q);                                                   07765000
            tos := -tos +@waitflags;                                    07770000
            tos := absys+ucopsw;  <<ucop stop word>>                    07775000
            exchangedb (urldst);                                        07780000
            disable;                      << go >>                      07785000
            if reqnext <> reqfree then                                  07790000
               begin                   <<ucop req. q not empty>>        07795000
               assemble (ddel, del);                                    07800000
               goto u2;                                                 07805000
               end;                                                     07810000
            xreg := tos;                                                07815000
            if absolute(xreg) < 0 then                                  07820000
               begin                   <<stop requested>>               07825000
               enable;                                                  07830000
               abortprocio (0);        <<stop any error printing>>      07835000
               awake (sysproc(0), 2, 0);  <<awake progen, signal stop>> 07840000
               wait (0, 0);                                             07845000
               end;                                                     07850000
            xreg := tos;                                                07855000
            tos := arrq0(xreg);        <<local wait indicators>>        07860000
            assemble (stbx, dup);                                       07865000
            tos := absolute (xreg);    <<job synch word>>               07870000
            assemble (and, del);                                        07875000
            if <> then                                                  07880000
               begin                   <<job just made ready,  or>>     07885000
               enable;                 <<device freed and job(s) wait>> 07890000
               ddel;                                                    07895000
               goto u1';                                                07900000
               end;                                                     07905000
            <<shift job sync bits one to the left to signal>>  <<01549>>07910000
            <<if jobs are waiting.>>                           <<01549>>07915000
            disable;                                           <<01549>>07920000
            tos:=absolute(xreg); assemble(xch);                <<01549>>07925000
            tos:=(tos&lsl(1)).jobsync;  <<also clears ports>>  <<01549>>07930000
            absolute(xreg):=tos;                               <<01549>>07935000
            enable;                                            <<01549>>07940000
            tos:=tos.portimer;  <<port timeout?>>              <<01549>>07945000
            if <> then                                         <<01549>>07950000
               fcpostimeout(*)                                 <<01549>>07955000
            else                                               <<01549>>07960000
               del;                                            <<01549>>07965000
            wait( ucopwait, 0 );                               << 8198>>07970000
            del;                                                        07975000
            goto u4;                                                    07980000
            end;                                                        07985000
      end else                                                          07990000
      begin                                                             07995000
                                                                        08000000
      <<the request list is not empty>>                                 08005000
u2:      tos := reqentry(reqnext);  <<double request>>                  08010000
         reqnext := if reqnext=reqmax+1 then 2 else reqnext+1; <<06159>>08015000
         enable;                                                        08020000
         exchangedb(0);                                                 08025000
         req2:=tos;                                                     08030000
         req1:=tos;                                                     08035000
         goto swex(req1.(12:4));                                        08040000
      end;                                                              08045000
                                                                        08050000
                                                                        08055000
null:                                                                   08060000
      goto start;                                                       08065000
                                                                        08070000
jmp:                                                                    08075000
                                                                        08080000
procout:                                                                08085000
      burryproc(req2 * pcbsize);                               <<06534>>08090000
      pcbpt := curprc;                                         <<06574>>08095000
      if spcbsoninfo = 0 then                                  <<06574>>08100000
         << removing last son >>                                        08105000
         << try awakening progen in case this is logoff (wait for son)>>08110000
         awake (sysproc(0), 2, 0);                                      08115000
      goto start;                                                       08120000
                                                               <<01549>>08125000
                                                                        08130000
                                                                        08135000
end.    << ucop >>                                             << 8198>>08140000
