<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$control map,code,uslinit                                               00010000
<< pcreate -- module 63 >>                                     <<01001>>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
                                                                        00055000
$set x0=on                                                     <<01245>>00060000
$control map, code, segment=pcreate, main=pcreate              <<01245>>00065000
                                                               <<01245>>00070000
<< compile options                                             <<01245>>00075000
   x0 =  on - list description & data structure diagrams       <<01245>>00080000
      = off - omit description & data structure diagrams       <<01245>>00085000
>>                                                             <<01245>>00090000
                                                               <<01245>>00095000
                                                               <<01245>>00100000
begin                                                          <<01245>>00105000
                                                               <<01245>>00110000
  << process creation module - pcreate - mpe module #63 >>     <<01245>>00115000
                                                               <<01245>>00120000
$if x0=off                                                     <<01245>>00125000
$if                                                            <<01245>>00130000
                                                               <<01245>>00135000
$page "MODULE DESCRIPTION AND GLOBAL DATA STRUCTURE DIAGRAMS"  <<01245>>00140000
$include inclst                                                <<mpeiv>>00145000
<< the following code was added to support privileged mode >>  <<04664>>00150000
<< bounds checking. when the pcbx is set up, word %36.(0:2)>>  <<04664>>00155000
<< is set to 3 indicating that db,p,q, and s  will be      >>  <<04664>>00160000
<< bounds tested.                                          >>  <<04664>>00165000
                                                               <<04664>>00170000
define   cpunum   = assemble(pcn)#;      << get cpu number >>  <<04664>>00175000
                                                               <<04664>>00180000
equate   series64 = 4,                                         <<04664>>00185000
         pmbc'init= 3;                                         <<04664>>00190000
                                                               <<04664>>00195000
<<    >>                                                       <<01245>>00200000
$include inclpcb5                                              <<06645>>00205000
array qarray(*) = q+0;                                         <<*7760>>00210000
$include inclpxdl                                              <<*7760>>00215000
$include inclpxgt                                              <<*7760>>00220000
$include inclpxft                                              <<*7760>>00225000
$page                                                          <<01245>>00230000
integer s0 = s-0,   s2 = s-2,   x = x;                         <<01265>>00235000
<<logical mapping information>>                                <<06099>>00240000
define logicalmapping=absolute(%1220)#, <<flag whether>>       <<06099>>00245000
                                        <<firmware present>>   <<06099>>00250000
       mapflag=(1:1)#, <<mapping flag in stack marker>>        <<06099>>00255000
       pcb'mapflag=(12:1)#; <<mapping flag for pcst>>          <<06099>>00260000
                                                               <<01245>>00265000
logical status = q-1;                                          <<01245>>00270000
                                                               <<01245>>00275000
define conditioncode   = status.(6:2)#;                        <<01245>>00280000
                                                               <<01245>>00285000
equate ccg             = 0,                                    <<01245>>00290000
       ccl             = 1,                                    <<01245>>00295000
       cce             = 2,                                    <<06624>>00300000
       sysbase         = %1000;                                <<06624>>00305000
                                                               <<01245>>00310000
define disable         = assemble (sed 0)#,                    <<01245>>00315000
       enable          = assemble (sed 1)#,                    <<01245>>00320000
       pdisable        = assemble (psdb)#,                     <<01245>>00325000
       penable         = assemble (pseb)#,                     <<01245>>00330000
       disaproc        = assemble (psdb)#,                     <<01245>>00335000
       enaproc         = assemble (pseb)#,                     <<01245>>00340000
       enablebreak     = 15#,                                  <<01265>>00345000
       disablebreak    = 14#,                                  <<01265>>00350000
       force'stkovflow = assemble (adds 100; subs 100)#;       <<01245>>00355000
                                                               <<01245>>00360000
equate  dstb            = 2,                                   <<06645>>00365000
  pcbb           = syspcbindex,                                <<06645>>00370000
       ptop'comm'dst   = 10;               << p to p c table >><<01245>>00375000
                                                               <<01245>>00380000
equate fatherwait      = 1,                                    <<01245>>00385000
       sonwait         = 2,                                    <<01245>>00390000
       junkwait        = %20,                                  <<01265>>00395000
       junk'sonwait    = junkwait + sonwait,                   <<01427>>00400000
       mourningwait=%4000;                                     <<mpeiv>>00405000
                                                               <<01245>>00410000
equate pxglob          = pxg'size,                             <<07257>>00415000
       pxfix           = fixedsize,                            <<07257>>00420000
       pxfile          = 200,                                  <<01245>>00425000
       pcbxsize        = pxglob + pxfix + pxfile + 4;          <<07257>>00430000
                                                               <<01245>>00435000
equate pjxref          = 50,                                   <<01245>>00440000
       pcbix           = 3,                                    <<mpeiv>>00445000
       dispq           = 1,                                    <<mpeiv>>00450000
       endofclass      = 0;                                    <<mpeiv>>00455000
                                                               <<01245>>00460000
define qtype           = (1:4)#,                               <<01245>>00465000
       eq              = (1:1)#,                               <<01245>>00470000
       lq              = (2:1)#,                               <<01245>>00475000
       cq              = (3:1)#,                               <<01245>>00480000
       dq              = (4:1)#;                               <<mpeiv>>00485000
                                                               <<01245>>00490000
                                                               <<01245>>00495000
  << *** load errors relevent to process creation *** >>       <<01245>>00500000
                                                               <<01245>>00505000
equate lerr20          = 20,      << illegal library search >> <<01245>>00510000
       lerr21          = 21,      << unknown entry point >>    <<01245>>00515000
       lerr22          = 22,      << trace subsys not found >> <<01245>>00520000
       lerr23          = 23,      << stack size too small >>   <<01245>>00525000
       lerr25          = 25,      << data seg > max data seg >><<01245>>00530000
       lerr31          = 31,      << invalid program file >>   <<01245>>00535000
       lerr34          = 34,      << prog is > 1 extent >>     <<01245>>00540000
       lerr35          = 35,      << data seg > 32k >>         <<01245>>00545000
       lerr36          = 36,      << data seg > sys max >>     <<01245>>00550000
       lerr39          = 39,      << illegal capability >>     <<01245>>00555000
       lerr45          = 45,      << invalid entry point >>    <<01245>>00560000
       lerr53          = 53,      << can't open prog file >>   <<01245>>00565000
       lerr63          = 63,      << i/o error on prog file >> <<01245>>00570000
       lerr66          = 66,      << no dst available >>       <<01245>>00575000
       lerr73          = 73,      << out of virt mem space >>  <<01245>>00580000
       lerr76          = 76,      << illegal dl >>             <<01245>>00585000
       lerr77          = 77,      << illegal maxdata >>        <<01245>>00590000
       lerr93          = 93;      << can't mount home vset >>  <<01245>>00595000
                                                               <<01245>>00600000
  << *** file system errors relevent to process creation *** >><<01265>>00605000
                                                               <<01265>>00610000
equate fserr50         = 50,      << non-existent account >>   <<01265>>00615000
       fserr51         = 51,      << non-existent group >>     <<01265>>00620000
       fserr52         = 52,      << non-existent perm file >> <<01265>>00625000
       fserr53         = 53;      << non-existent temp file >> <<01265>>00630000
                                                               <<01265>>00635000
logical pointer                                                <<01245>>00640000
  pcb            = syspcbindex;                                <<06645>>00645000
equate icsix=7;                                                <<mpeiv>>00650000
integer pointer ics=icsix;                                     <<mpeiv>>00655000
equate                                                         <<06615>>00660000
   slldst = 23;                                                <<06615>>00665000
                                                               <<mpeiv>>00670000
integer pcbsysbaseinx=db+pcbix;                                <<06624>>00675000
$include inclsll                                               <<mpeiv>>00680000
$include inclics                                               <<mpeiv>>00685000
$include inclmeas                                              <<01740>>00690000
$include inclmift                                              <<04503>>00695000
$page "EXTERNAL PROCEDURE DECLARATIONS"                        <<01245>>00700000
$include incljit                                               <<06884>>00705000
intrinsic debug, fopen, ascii, proctime, fcontrol, kill,       <<01710>>00710000
          ffileinfo, fclose, getjcw, setjcw;                   <<02002>>00715000
intrinsic ffileinfo;                                           <<01740>>00720000
                                                               <<01245>>00725000
procedure awake (pcbptr, wakeevent, waitevent);                <<01245>>00730000
  value pcbptr, wakeevent, waitevent;                          <<01245>>00735000
  integer pcbptr, waitevent;                                   <<01245>>00740000
  logical wakeevent;                                           <<01245>>00745000
  option external;                                             <<01245>>00750000
                                                               <<01245>>00755000
procedure wait (waittype, subpri);                             <<01245>>00760000
  value waittype, subpri;                                      <<01245>>00765000
  integer waittype;   logical subpri;                          <<01245>>00770000
  option external;                                             <<01245>>00775000
                                                               <<01245>>00780000
procedure burryproc (pcbptr);                                  <<01245>>00785000
  value pcbptr;                                                <<01245>>00790000
  integer pcbptr;                                              <<01245>>00795000
  option external;                                             <<01245>>00800000
                                                               <<01245>>00805000
procedure delay (millisecs);                                   <<01245>>00810000
  value millisecs;                                             <<01245>>00815000
  double millisecs;                                            <<01245>>00820000
  option external;                                             <<01245>>00825000
                                                               <<01245>>00830000
procedure set'psif (pcbptr, pseudoint);                        <<01245>>00835000
  value pcbptr, pseudoint;                                     <<01245>>00840000
  integer pcbptr;                                              <<01245>>00845000
  logical pseudoint;                                           <<01245>>00850000
  option external;                                             <<01245>>00855000
                                                               <<01245>>00860000
logical procedure setcritical;                                 <<01245>>00865000
  option external;                                             <<01245>>00870000
                                                               <<01245>>00875000
procedure resetcritical (critstate);                           <<01245>>00880000
  value critstate;                                             <<01245>>00885000
  logical critstate;                                           <<01245>>00890000
  option external;                                             <<01245>>00895000
                                                               <<01245>>00900000
integer procedure getsir (sirnum);                             <<01245>>00905000
  value sirnum;   integer sirnum;                              <<01245>>00910000
  option external;                                             <<01245>>00915000
                                                               <<01245>>00920000
procedure relsir (sirnum, sirstate);                           <<01245>>00925000
  value sirnum, sirstate;                                      <<01245>>00930000
  integer sirnum, sirstate;                                    <<01245>>00935000
  option external;                                             <<01245>>00940000
                                                               <<01245>>00945000
integer procedure getentry (entrytype);                        <<01245>>00950000
  value entrytype;                                             <<01245>>00955000
  integer entrytype;                                           <<01245>>00960000
  option external;                                             <<01245>>00965000
                                                               <<01245>>00970000
procedure returnentry (entrytype, entrynum);                   <<01245>>00975000
  value entrytype, entrynum;                                   <<01245>>00980000
  integer entrytype, entrynum;                                 <<01245>>00985000
  option external;                                             <<01245>>00990000
                                                               <<01245>>00995000
integer procedure getsystabentry(tabledst,primary,wait');      <<06615>>01000000
value tabledst,primary,wait';                                  <<06615>>01005000
integer tabledst;                                              <<06615>>01010000
logical primary,wait';                                         <<06615>>01015000
  option external;                                             <<mpeiv>>01020000
                                                               <<mpeiv>>01025000
integer procedure exchangedb (dstnum);                         <<01245>>01030000
  value dstnum;                                                <<01245>>01035000
  integer dstnum;                                              <<01245>>01040000
  option external;                                             <<01245>>01045000
                                                               <<01245>>01050000
logical procedure setsysdb;                                    <<01245>>01055000
  option external;                                             <<01245>>01060000
                                                               <<01245>>01065000
procedure resetdb (dstnum);                                    <<01245>>01070000
  value dstnum;                                                <<01245>>01075000
  integer dstnum;                                              <<01245>>01080000
  option external;                                             <<01245>>01085000
                                                               <<01245>>01090000
procedure queueproc (procsysdbinx, queue, location);           <<mpeiv>>01095000
  value procsysdbinx, queue, location;                         <<mpeiv>>01100000
  integer procsysdbinx, queue, location;                       <<mpeiv>>01105000
  option external;                                             <<mpeiv>>01110000
                                                               <<01245>>01115000
integer procedure convextlabeltodeltap (extlabel);             <<mpeiv>>01120000
  value extlabel;                                              <<mpeiv>>01125000
  integer extlabel;                                            <<mpeiv>>01130000
  option external;                                             <<mpeiv>>01135000
                                                               <<01245>>01140000
                                                               <<01245>>01145000
procedure load (progfname, entryname, cstindex,deltap,stackdst,<<01245>>01150000
                pin, loadflags, pcbxsize, dlsize, stacksize,   <<01245>>01155000
                maxdata,globalsize,strng,strlen,capability,    <<06099>>01160000
                mapflag');                                     <<06099>>01165000
  value pin, loadflags, pcbxsize, strlen;                      <<01245>>01170000
  byte array progfname, entryname, strng;                      <<01245>>01175000
  integer cstindex, deltap, stackdst, pin, pcbxsize, dlsize,   <<01245>>01180000
          stacksize, maxdata, globalsize, strlen;              <<01245>>01185000
  integer mapflag';                                            <<06099>>01190000
  logical loadflags, capability;                               <<01245>>01195000
  option external;                                             <<01245>>01200000
                                                               <<01245>>01205000
procedure unload (pin);                                        <<01245>>01210000
  value pin;   integer pin;                                    <<01245>>01215000
  option external;                                             <<01245>>01220000
                                                               <<01245>>01225000
procedure parse'file'eq (fequation, errnum, dummy);            <<01245>>01230000
  byte array fequation;                                        <<01245>>01235000
  integer errnum, dummy;                                       <<01245>>01240000
  option external;                                             <<01245>>01245000
                                                               <<01245>>01250000
integer procedure addjtentry (fdes, gp, acct, tbl, size, ntry);<<01245>>01255000
  value tbl, size;                                             <<01245>>01260000
  byte array fdes, gp, acct;                                   <<01245>>01265000
  integer tbl, size;                                           <<01245>>01270000
  integer array ntry;                                          <<01245>>01275000
  option external;                                             <<01245>>01280000
                                                               <<01245>>01285000
integer procedure xretjtentry (fdes, group, accnt, size, ntry);<<01427>>01290000
  byte array fdes, group, accnt;                               <<01427>>01295000
  integer size;                                                <<01427>>01300000
  integer array ntry;                                          <<01427>>01305000
  option external;                                             <<01427>>01310000
                                                               <<01427>>01315000
integer procedure xremjtentry (fdes, group, accnt, tablenum);  <<01245>>01320000
  value tablenum;                                              <<01245>>01325000
  byte array fdes, group, accnt;                               <<01245>>01330000
  integer tablenum;                                            <<01245>>01335000
  option external;                                             <<01245>>01340000
                                                               <<01245>>01345000
logical procedure fnformat (string, fname, group, accnt, lw);  <<01427>>01350000
  value string;                                                <<01427>>01355000
  byte pointer string;                                         <<01427>>01360000
  logical array fname, group, accnt, lw;                       <<01427>>01365000
  option external;                                             <<01427>>01370000
                                                               <<01427>>01375000
integer procedure calendar;                                    <<01245>>01380000
  option external;                                             <<01245>>01385000
                                                               <<01245>>01390000
double procedure clock;                                        <<01245>>01395000
  option external;                                             <<01245>>01400000
                                                               <<01245>>01405000
double procedure timer;                                        <<01740>>01410000
  option external;                                             <<01740>>01415000
procedure erroron;                                             <<01245>>01420000
                                                               <<01740>>01425000
  option external;                                             <<01245>>01430000
                                                               <<01245>>01435000
double procedure chek (intrinsic, flags, parms, cap, ovmask);  <<01245>>01440000
  value intrinsic, flags, parms, cap, ovmask;                  <<01245>>01445000
  logical intrinsic, flags, ovmask;                            <<01245>>01450000
  double parms, cap;                                           <<01245>>01455000
  option variable, external;                                   <<01245>>01460000
                                                               <<01245>>01465000
double procedure chek'noabort (intrinsic, flags, parms, cap,   <<01245>>01470000
                               ovmask);                        <<01245>>01475000
  value intrinsic, flags, parms, cap, ovmask;                  <<01245>>01480000
  logical intrinsic, flags, ovmask;                            <<01245>>01485000
  double parms, cap;                                           <<01245>>01490000
  option variable, external;                                   <<01245>>01495000
                                                               <<01245>>01500000
logical procedure errorget (level);                            <<01245>>01505000
  value level;   integer level;                                <<01245>>01510000
  option external;                                             <<01245>>01515000
                                                               <<01245>>01520000
procedure errorput (errword, level);                           <<01427>>01525000
  value errword, level;                                        <<01427>>01530000
  integer errword, level;                                      <<01427>>01535000
  option external;                                             <<01427>>01540000
                                                               <<01427>>01545000
procedure errorexit (intrinexit, error, abortparm);            <<01245>>01550000
  value intrinexit, error, abortparm;                          <<01245>>01555000
  logical intrinexit, error, abortparm;                        <<01245>>01560000
  option external;                                             <<01245>>01565000
                                                               <<01245>>01570000
procedure suddendeath (sysfailnum);                            <<01245>>01575000
  value sysfailnum;                                            <<01245>>01580000
  integer sysfailnum;                                          <<01245>>01585000
  option external;                                             <<01245>>01590000
                                                               <<01245>>01595000
procedure help;                                                <<01245>>01600000
  option external;                                             <<01245>>01605000
                                                               <<mpeiv>>01610000
procedure crash' (why);                                        <<mpeiv>>01615000
  value why;                                                   <<mpeiv>>01620000
  integer why;                                                 <<mpeiv>>01625000
  option external;                                             <<mpeiv>>01630000
                                                               <<mpeiv>>01635000
integer procedure checkpriority (prclass, pcbpt);              <<01245>>01640000
  value prclass, pcbpt;                                        <<01245>>01645000
  logical prclass;                                             <<01245>>01650000
  integer pcbpt;                                               <<01245>>01655000
  option forward;                                              <<01245>>01660000
logical procedure label'is'sl'seg (plabel,pcbpt);              <<06099>>01665000
   value plabel,pcbpt;                                         <<06099>>01670000
   integer plabel,pcbpt;                                       <<06099>>01675000
   option external;                                            <<06099>>01680000
                                                               <<06099>>01685000
procedure addtolocality(sllheadinx,objid,flags);               <<06658>>01690000
   value sllheadinx,objid,flags;                               <<06658>>01695000
   integer sllheadinx,flags;                                   <<06658>>01700000
   double objid;                                               <<06658>>01705000
   option external;                                            <<06099>>01710000
$page "PROCEDURE SUBQUEUE"                                     <<01245>>01715000
double procedure subqueue(n,criteria);                                  01720000
value n,criteria; integer n,criteria;                                   01725000
option privileged,uncallable;                                           01730000
comment: returns double word characteristics of sub queue               01735000
choice based on criteria= n th element:                                 01740000
         n=1  priority number                                           01745000
         n=4  sub queue name                                            01750000
         returns cce if ok, ccl if not found in pcbtable.               01755000
      ;                                                                 01760000
                                                                        01765000
begin                                                                   01770000
      integer pcbpt;                                           <<06645>>01775000
      double array subqtable(*)=pb :=                                   01780000
      comment name, 0,                                     <<*disp*00*>>01785000
              scheduling type:                             <<*disp*00*>>01790000
                  4 - linear                               <<*disp*00*>>01795000
                  2 - cq                                   <<*disp*00*>>01800000
                  1 - dq                                   <<*disp*00*>>01805000
                  9 - eq                                   <<*disp*00*>>01810000
              priority;                                    <<*disp*00*>>01815000
           [8/%101,8/0,5/4,3/0,8/030]d,   << as >>         <<*disp*00*>>01820000
           [8/%102,8/0,5/4,3/0,8/100]d,   << bs >>         <<*disp*00*>>01825000
           [8/%103,8/0,5/2,3/0,8/150]d,   << cs >>         <<*disp*00*>>01830000
           [8/%104,8/0,5/1,3/0,8/200]d,   << ds >>         <<*disp*00*>>01835000
           [8/%105,8/0,5/9,3/0,8/250]d;   << es >>         <<*disp*00*>>01840000
      integer cx,shiftcnt;                                              01845000
      integer cc;                                                       01850000
      logical ls0=s-0;                                                  01855000
      pcbpt := curprc;                                         <<06645>>01860000
                                                                        01865000
      if n=1 then                                                       01870000
        begin << caller determines priority >>                          01875000
         tos := queueinginfo;                                  <<06645>>01880000
         if ls0.lschedflag then                                <<mpeiv>>01885000
          begin                                                         01890000
         tos := queueinginfo.prifield;                         <<06645>>01895000
          if tos < 100 then ls0:=30 else ls0:=100;                      01900000
          end                                                           01905000
        else                                                            01910000
            if ls0.eschedflag then  ls0:=250                   <<mpeiv>>01915000
         else                                                           01920000
            if ls0.dschedflag then ls0:=200                    <<mpeiv>>01925000
          else ls0:=150;                                                01930000
        criteria := tos;                                                01935000
        end << n = 1 >>;                                                01940000
      cx:=-1;                                                           01945000
      shiftcnt:=8*(n-1);                                                01950000
      while (cx:=cx+1)<5 do                                             01955000
      begin                                                             01960000
         tos:=subqtable(cx)&dlsr(shiftcnt);                             01965000
         if (tos land %377)= logical(criteria) then                     01970000
         begin                                                          01975000
            subqueue:=subqtable(cx);                                    01980000
            cc:=cce;                                                    01985000
            goto fin;                                                   01990000
         end;                                                           01995000
      end;                                                              02000000
      cc:=ccl;                                                          02005000
fin:  status.(6:2):=cc;                                                 02010000
end;  <<subqueue>>                                                      02015000
$page "PROCEDURE GETPRIORITY"                                  <<01245>>02020000
procedure getpriority(pin,priorityclass,rank);                          02025000
value pin,priorityclass,rank;                                           02030000
logical priorityclass;                                                  02035000
integer pin,rank;                                                       02040000
option  privileged,variable;                                            02045000
                                                                        02050000
                                                                        02055000
comment: gets a new priority for the process specified by pin.          02060000
         pin must be a caller's son or caller itself(if 0).             02065000
         db  needs not be pointing at stack.                            02070000
                                                                        02075000
         returns cc                                                     02080000
            cce      if request granted                                 02085000
            ccg      process is not alive                               02090000
            ccl      illegal pin                                        02095000
                                                                        02100000
         error code :   120                                             02105000
         error sub code:same as checpriority procedure                  02110000
                                                                        02115000
         ;                                                              02120000
                                                                        02125000
                                                                        02130000
begin                                                                   02135000
                                                                        02140000
      integer cc,pcbpt,err;                                             02145000
logical chkprivalue;                                           <<mpeiv>>02150000
      integer pointer  pcb = 3;                                         02155000
      logical vmask = q-4;                                              02160000
                                                                        02165000
      err:=120&lsl(6)+4;                                                02170000
      erroron;                                                          02175000
      chek(err,1&lsl(15)+3,,double(1),1);                               02180000
                                                                        02185000
      tos := curprc;                                           <<06645>>02190000
      assemble(dup);                                                    02195000
      pcbpt:=tos;                                                       02200000
      if pin<>0 then                   <<for son>>                      02205000
      begin                            <<check validity>>               02210000
         pcbpt:=pin*pcbsize;                                            02215000
      tos := fatherinfo;                                       <<06645>>02220000
         if tos<>tos or                <<not a son>>                    02225000
not (1<=pin<=pcb(0)) then                                      <<mpeiv>>02230000
         begin                                                          02235000
            cc:=ccl;                                                    02240000
            goto fin;                                                   02245000
         end                                                            02250000
      end else del;                                                     02255000
      if not procstate.aliveflag then                          <<06645>>02260000
      begin cc:=ccg; goto fin; end;        <<not alive>>                02265000
                                                                        02270000
      tos:=checkpriority(priorityclass,pcbpt);                          02275000
chkprivalue:=tos;                                              <<mpeiv>>02280000
                                                                        02285000
      if < then                                                         02290000
      begin                            <<violation>>                    02295000
         tos:=err;                     <<error code>>                   02300000
         assemble(xch);                                                 02305000
         tos := 0;                                                      02310000
         errorexit(*,*,*);             << pri violation >>              02315000
      end;                                                              02320000
<<update queueing info in process' pcb>>                       <<mpeiv>>02325000
disable;                                                       <<mpeiv>>02330000
x:=pcbpt+queueinginfowordnum;                                  <<mpeiv>>02335000
pcb(x).qtype := 0;                                             <<01761>>02340000
if chkprivalue.lq then                                         <<mpeiv>>02345000
   begin                                                       <<mpeiv>>02350000
   pcb(x).lschedflag:=1;                                       <<mpeiv>>02355000
   pcb(x).prifield:=chkprivalue.(8:8)                          <<mpeiv>>02360000
   +(if vmask then rank else 0);                               <<mpeiv>>02365000
   end                                                         <<mpeiv>>02370000
else                                                           <<mpeiv>>02375000
   if chkprivalue.eq then                                      <<mpeiv>>02380000
      begin                                                    <<mpeiv>>02385000
      tos:=ics(-ics'eschedbasecell);                           <<mpeiv>>02390000
      pcb(pcbpt+queueinginfowordnum).eschedflag:=1;            <<mpeiv>>02395000
      pcb(x).prifield:=tos;                                    <<mpeiv>>02400000
      end                                                      <<mpeiv>>02405000
   else                                                        <<mpeiv>>02410000
      if chkprivalue.dq then                                   <<mpeiv>>02415000
         begin                                                 <<mpeiv>>02420000
         tos:=ics(-ics'dschedbasecell);                        <<mpeiv>>02425000
         pcb(pcbpt+queueinginfowordnum).dschedflag:=1;         <<mpeiv>>02430000
         pcb(x).prifield:=tos;                                 <<mpeiv>>02435000
         end                                                   <<mpeiv>>02440000
      else                                                     <<mpeiv>>02445000
         begin                                                 <<mpeiv>>02450000
         tos:=ics(-ics'cschedbasecell);                        <<mpeiv>>02455000
         pcb(pcbpt+queueinginfowordnum).cschedflag:=1;         <<mpeiv>>02460000
         pcb(x).prifield:=tos;                                 <<mpeiv>>02465000
         end;                                                  <<mpeiv>>02470000
if logical(pcb(pcbpt+queueinginfowordnum)).dispqflag then      <<mpeiv>>02475000
   begin                                                       <<mpeiv>>02480000
   tos:=%1000d;                                                <<mpeiv>>02485000
   assemble(xchd);                                             <<mpeiv>>02490000
   queueproc(pcbpt,dispq,endofclass);                          <<06645>>02495000
   assemble(xchd);                                             <<mpeiv>>02500000
   end;                                                        <<mpeiv>>02505000
enable;                                                        <<mpeiv>>02510000
      cc := cce;                                                        02515000
fin:  status.(6:2) := cc;                                               02520000
      errorexit(err,0,0);                                               02525000
                                                                        02530000
end;   << getpriority >>                                                02535000
$page "PSEUDO MAIL FACILITY"                                   <<01245>>02540000
procedure init'pseudomail (sonpin);                            <<01245>>02545000
  value sonpin;                                                <<01245>>02550000
<<                                                                      02555000
   function                                                             02560000
     initializes the pseudo mail box - the entry in the process to      02565000
     process communication table that describes the normal mail box     02570000
     between a son process and its father process.  this is a very      02575000
     special use of the mail mechanism and is intended to be used       02580000
     only in the creation of a new process.  note that the mechanism    02585000
     will be replaced by the general kernel-level ipc of mpe iv.        02590000
>>                                                                      02595000
<< inputs >>                                                   <<01245>>02600000
     integer                                                   <<01245>>02605000
       sonpin;                   << pin of communicating son >><<01245>>02610000
                                                               <<01245>>02615000
<< outputs                                                              02620000
     none.  but sets the entry in the process to process                02625000
     table to -1 for the initial value.                                 02630000
>>                                                                      02635000
option privileged, uncallable;                                 <<01427>>02640000
                                                               <<01245>>02645000
  begin                                                        <<01245>>02650000
    integer                                                    <<01245>>02655000
      mail'count,                                              <<01245>>02660000
      mail'value;                                              <<01245>>02665000
                                                               <<01245>>02670000
    mail'count := 0;   mail'value := -1;                       <<01245>>02675000
                                                               <<01245>>02680000
    tos := ptop'comm'dst;                                      <<01245>>02685000
    tos := sonpin * 2;                                         <<01245>>02690000
    tos := @mail'count;                                        <<01245>>02695000
    tos := 2;                                                  <<01245>>02700000
    assemble (mtds 4);                                         <<01245>>02705000
  end << init'pseudomail >>;                                   <<01245>>02710000
$page                                                          <<01245>>02715000
procedure send'pseudomail (message);                           <<01245>>02720000
  value message;                                               <<01245>>02725000
<<                                                                      02730000
   function                                                             02735000
     sends a pseudo mail message to the father process through the      02740000
     process-to-process communication table.                            02745000
>>                                                                      02750000
<< inputs >>                                                   <<01245>>02755000
     integer                                                   <<01245>>02760000
       message;                        << message to be sent >><<01245>>02765000
                                                               <<01245>>02770000
<< outputs                                                              02775000
     none.  but places 2 words (length & message) in the p-to-p         02780000
     communication table.                                               02785000
>>                                                                      02790000
option privileged, uncallable;                                 <<01427>>02795000
                                                               <<01245>>02800000
  begin                                                        <<01245>>02805000
    integer                                                    <<01245>>02810000
      mypin,                                                   <<01245>>02815000
      mail'count,                                              <<01245>>02820000
      mail'value;                                              <<01245>>02825000
                                                               <<01245>>02830000
      mypin := (curprc)/pcbsize;                               <<06645>>02835000
      mail'count := 1;   mail'value := message;                <<01245>>02840000
                                                               <<01245>>02845000
      tos := ptop'comm'dst;                                    <<01245>>02850000
      tos := mypin * 2;                                        <<01245>>02855000
      tos := @mail'count;                                      <<01245>>02860000
      tos := 2;                                                <<01245>>02865000
      assemble (mtds 4);                                       <<01245>>02870000
  end << send'pseudomail >>;                                   <<01245>>02875000
$page                                                          <<01245>>02880000
procedure recv'pseudomail (sonpin, message);                   <<01245>>02885000
  value sonpin;                                                <<01245>>02890000
<<                                                                      02895000
   function                                                             02900000
     receives a pseudo mail message from the specified son process      02905000
     through the process-to-process communication table.                02910000
>>                                                                      02915000
<< inputs >>                                                   <<01245>>02920000
     integer                                                   <<01245>>02925000
       sonpin;                         << pin of sending son >><<01245>>02930000
                                                               <<01245>>02935000
<< outputs >>                                                  <<01245>>02940000
     integer                                                   <<01245>>02945000
       message;                        << message received >>  <<01245>>02950000
                                                               <<01245>>02955000
option privileged, uncallable;                                 <<01427>>02960000
                                                               <<01427>>02965000
  begin                                                        <<01245>>02970000
    integer                                                    <<01245>>02975000
      mail'count,                                              <<01245>>02980000
      mail'value;                                              <<01245>>02985000
                                                               <<01245>>02990000
    tos := @mail'count;                                        <<01245>>02995000
    tos := ptop'comm'dst;                                      <<01245>>03000000
    tos := sonpin * 2;                                         <<01245>>03005000
    tos := 2;                                                  <<01245>>03010000
    assemble (mfds 4);                                         <<01245>>03015000
    message := mail'value;                                     <<01245>>03020000
  end << recv'pseudomail >>;                                   <<01245>>03025000
$page                                                          <<01245>>03030000
procedure free'pseudomail (sonpin);                            <<01245>>03035000
  value sonpin;                                                <<01245>>03040000
<<                                                                      03045000
   function                                                             03050000
     cleans up the entry in the process-to-process communication        03055000
     table used for the pseudo mail between a father and son process    03060000
     during creation.                                                   03065000
>>                                                                      03070000
<< inputs >>                                                   <<01245>>03075000
     integer                                                   <<01245>>03080000
       sonpin;                         << pin of created son >><<01245>>03085000
                                                               <<01245>>03090000
<< outputs                                                              03095000
     none.  but sets the appropriate entry in the process-to-process    03100000
     communication table to 0 for possible later use as a true mail     03105000
     box.                                                               03110000
>>                                                                      03115000
option privileged, uncallable;                                 <<01427>>03120000
                                                               <<01245>>03125000
  begin                                                        <<01245>>03130000
    integer                                                    <<01245>>03135000
      mail'count,                                              <<01245>>03140000
      mail'value;                                              <<01245>>03145000
                                                               <<01245>>03150000
    mail'count := 0;   mail'value := 0;                        <<01245>>03155000
                                                               <<01245>>03160000
    tos := ptop'comm'dst;                                      <<01245>>03165000
    tos := sonpin * 2;                                         <<01245>>03170000
    tos := @mail'count;                                        <<01245>>03175000
    tos := 2;                                                  <<01245>>03180000
    assemble (mtds 4);                                         <<01245>>03185000
  end << free'pseudomail >>;                                   <<01245>>03190000
$page "PROCEDURE INITIATE"                                     <<01245>>03195000
procedure initiate;                                            <<01245>>03200000
<<                                                                      03205000
   function                                                             03210000
     opens the standard input and output files ($stdin and              03215000
     $stdlist) for a new process being created on the system.           03220000
     initiate is the 1st code a process executes in its life and        03225000
     therefore runs on the stack of the new process.                    03230000
>>                                                                      03235000
<< inputs                                                               03240000
     none.  note that initiate assumes the fopen parameters and the     03245000
     byte arrays containing file name, device, and forms message (if    03250000
     necessary) have been placed on the stack by the creating           03255000
     process.                                                           03260000
>>                                                                      03265000
<< outputs                                                              03270000
     none.  but sends a message via pseudo-mail to the father           03275000
     indicating the success or failure of the standard file opens.      03280000
     the meaning of the message is                                      03285000
                                                                        03290000
                -2 - $stdlist open caused abort                         03295000
                -1 - $stdin open caused abort                           03300000
                 0 - $stdin and $stdlist opened successfully            03305000
                 1 - $stdin open failed                                 03310000
                 2 - $stdlist open failed                               03315000
>>                                                                      03320000
option privileged, uncallable;                                 <<01245>>03325000
                                                               <<01245>>03330000
  begin                                                        <<01245>>03335000
    integer                                                    <<01245>>03340000
      pcbptr          = q+1,           << pcb ptr for caller >><<01245>>03345000
      fatherpcbptr    = q+2,           << pcb ptr for father >><<01245>>03350000
      errormsg        = q+3;           << message to creator >><<01245>>03355000
                                                               <<01245>>03360000
    erroron;                                                   <<01870>>03365000
    errormsg := -1;     << assume $stdin open will abort >>    <<01427>>03370000
    send'pseudomail (errormsg);                                <<01427>>03375000
    pcbptr := curprc;                                          <<06645>>03380000
    fatherpcbptr := pcb(pcbptr+                                <<mpeiv>>03385000
             fatherinfowordnum);                               <<06645>>03390000
    assemble (pcal fopen);                  << $stdin >>       <<01245>>03395000
    del;     << fopen return value >>                          <<01245>>03400000
                                                               <<01245>>03405000
    if < then errormsg := 1                                    <<01245>>03410000
    else                                                       <<01245>>03415000
      begin                                                    <<01245>>03420000
        errormsg := -2;     << assume $stdlist open aborts >>  <<01427>>03425000
        send'pseudomail (errormsg);                            <<01427>>03430000
        assemble (pcal fopen);              << $stdlist >>     <<01245>>03435000
        del;     << fopen return value >>                      <<01245>>03440000
        if < then errormsg := 2                                <<01427>>03445000
          else errormsg := 0;                                  <<01427>>03450000
      end;                                                     <<01245>>03455000
                                                               <<01245>>03460000
    << tell creating process what happened and then wait >>    <<01245>>03465000
                                                               <<01245>>03470000
    send'pseudomail (errormsg);                                <<01245>>03475000
    << note that wait will penable >>                          <<01265>>03480000
    pdisable;                                                  <<01265>>03485000
    awake (fatherpcbptr, junkwait, 0);                         <<01265>>03490000
    resetcritical (0);                                         <<01870>>03495000
    wait (fatherwait, 0);                                      <<01265>>03500000
    errorexit (0,0,0);                                         <<01870>>03505000
  end << initiate >>;                                          <<01245>>03510000
$page "LOGICAL PROCEDURE GETJOBN"                              <<06631>>03515000
logical procedure getjobn;                                     <<06631>>03520000
   option privileged,uncallable;                               <<*7860>>03525000
<<gets the job number out of the pxfixed table word 19.(2:14)>><<06631>>03530000
  begin                                                        <<06631>>03535000
    logical pxfixedloc;                                        <<06631>>03540000
                                                               <<06631>>03545000
    pxfixed;  <<calculate the location of pxfixed table>>      <<06631>>03550000
   getjobn := pxfxjobnum lor (pxfxjobtype & lsl(14));          <<07257>>03555000
  end;                                                         <<06631>>03560000
$page "LOGICAL PROCEDURE GETJITDST"                            <<06631>>03565000
logical procedure getjitdst;                                   <<06631>>03570000
   option privileged,uncallable;                               <<*7860>>03575000
<<gets the jitdst from the pxglobal table.>>                   <<06631>>03580000
begin                                                          <<06631>>03585000
  logical pcbglobloc;                                          <<06631>>03590000
                                                               <<06631>>03595000
  pxglobal;                                                    <<06631>>03600000
  getjitdst:=pxg'jitdst;                                       <<06631>>03605000
end;                                                           <<06631>>03610000
                                                               <<06631>>03615000
$page "PROCEDURE PROCREATE"                                    <<01245>>03620000
procedure procreate (pin, plabel, deltap, stackdstx, globsize, <<01245>>03625000
                     dlsize, locsize, priority, string,strlnth,<<01245>>03630000
                     param, flags, maxstack, stdin, stdlist);  <<01245>>03635000
  value plabel, deltap, stackdstx, globsize, dlsize, locsize,  <<01245>>03640000
        priority, string, strlnth, param, flags, maxstack;     <<01245>>03645000
  integer plabel, deltap, stackdstx, globsize, dlsize, locsize,<<01245>>03650000
          priority, string, strlnth, param, pin, maxstack;     <<01245>>03655000
  logical flags;                                               <<01245>>03660000
  logical array stdin, stdlist;                                <<01245>>03665000
  option uncallable, privileged;                               <<01245>>03670000
                                                               <<01245>>03675000
comment: sets up a process given one instruction and a data segment.    03680000
                                                               <<01245>>03685000
         returns:                                              <<01245>>03690000
            cce:  ok                                           <<01245>>03695000
            ccg  (null)                                        <<01245>>03700000
            ccl  failure:no pcb available                      <<01245>>03705000
                                                               <<01245>>03710000
         db has to be pointing to stack                        <<01245>>03715000
                                                               <<01245>>03720000
         flags word is coded as follows:                       <<01245>>03725000
            0:7     abort dump                                 <<01245>>03730000
            4:1     father activation                          <<01245>>03735000
            7:9     capability word                            <<01245>>03740000
            13:1    initial debug call                         <<01245>>03745000
            10:1    0= r/w access to prog. file                <<01245>>03750000
plabel is coded as follows:                                    <<06099>>03755000
  0:1   priv mode bit for status reg                           <<06099>>03760000
  1:7   0                                                      <<06099>>03765000
  8:8   starting seg number                                    <<06099>>03770000
                                                               <<06099>>03775000
deltap is coded as follows:                                    <<06099>>03780000
  0:1   0                                                      <<06099>>03785000
  1:1   if no logical mapping firmware then 0                  <<06099>>03790000
        if logical mapping firmware present                    <<06099>>03795000
          then 0 if seg is logically mapped                    <<06099>>03800000
          else 1 if seg is physically mapped                   <<06099>>03805000
  2:14  deltap                                                 <<06099>>03810000
      ;                                                        <<01245>>03815000
                                                               <<01245>>03820000
                                                               <<01245>>03825000
                                                               <<01245>>03830000
begin                                                          <<01245>>03835000
      equate termil=%1156,termel=%1155;                        <<01245>>03840000
      equate   pxsize=pxglob+pxfix+pxfile+4;                   <<06631>>03845000
      equate psir=5;                                           <<01245>>03850000
      equate pcbglobloc = 0,                                   <<06631>>03855000
             pxfixedloc = pxg'size,                            <<07257>>03860000
             pxfileloc  = pxfixedloc + fixedsize;              <<07257>>03865000
                                                               <<01245>>03870000
      integer pri, qrelpin;                                <<*d<<01245>>03875000
      integer pcbpt;                                           <<06645>>03880000
      integer xdsblkindx; <<to scan xds entries in pcbx>>      <<06631>>03885000
      integer proc,v,sir,cx,t,k;                               <<01245>>03890000
      integer                                                  <<06615>>03895000
         sllheadinx,     << index to sll header entry >>       <<06624>>03900000
         sllinx;         << index to sll regular entry >>      <<06624>>03905000
double savedb;                                                 <<mpeiv>>03910000
      integer jit,db;                                          <<06884>>03915000
      integer array jitarr(*)=db+0;                            <<06884>>03920000
      integer virt,cpcbdst;                                    <<06631>>03925000
      equate vmpagesizeix = %3;                                <<mpeiv>>03930000
      integer pointer vdsmtab = %26;                           <<mpeiv>>03935000
      define vmpagesize = vdsmtab(vmpagesizeix)#;              <<mpeiv>>03940000
      define pxglob'ptr = qarray(pxsize-1)#,                   <<06631>>03945000
             pxfix'ptr  = qarray(pxsize-2)#,                   <<06631>>03950000
             pxfile'ptr = qarray(pxsize-3)#;                   <<06631>>03955000
      define pxfilesize = qarray(pxglob+pxfix)#;               <<06631>>03960000
                                                               <<mpeiv>>03965000
                                                               <<mpeiv>>03970000
      integer pointer pcbtable = 3;                            <<01245>>03975000
      integer pointer  dst = 2;                                <<01245>>03980000
      integer pointer  cstblk = %51;                           <<01245>>03985000
      integer array stack(*)=db+0;                             <<01245>>03990000
      logical array qarray(*) = db+0;                          <<06631>>03995000
      integer array pty(0:4)=pb:=0,0,2,1;   <<process type>>   <<01245>>04000000
      integer array pcbx(*)=q+0;                               <<01245>>04005000
      logical jn,returndst;                                    <<06631>>04010000
      integer base, dbbase, sin, slist, stcount;               <<01245>>04015000
                                                               <<01245>>04020000
      define                                                   <<01245>>04025000
        name            = (3:1)#,                              <<01245>>04030000
        device          = (7:1)#,                              <<01245>>04035000
        formmsg         = (8:1)#;   << flags in fopen ovmask >><<01245>>04040000
                                                               <<01245>>04045000
                                                               <<01740>>04050000
      << declarations for process instrumentation >>           <<01740>>04055000
      integer mypcbptr, measprocentsize, sircond;              <<01740>>04060000
                                                               <<01740>>04065000
      logical measprocentptr;                                  <<01740>>04070000
                                                               <<01740>>04075000
      logical array process'name(0:11);                        <<01740>>04080000
                                                               <<01740>>04085000
      define ucop'call = pcb(mypcbptr+                         <<01740>>04090000
                          procstatewordnum).ptypefield = 6#;   <<01740>>04095000
                                                               <<01245>>04100000
      integer lsttdst;  << dst # of cst mapping table >>       <<06658>>04105000
      logical tempdb;                                          <<06099>>04110000
                                                               <<06658>>04115000
      define                                                   <<06658>>04120000
         stackobj  = double(stackdstx)#,                       <<06658>>04125000
         lsttobj   = double(lsttdst)#;                         <<06658>>04130000
                                                               <<06658>>04135000
                                                               <<06099>>04140000
$include inclpxdl                                              <<*7760>>04145000
subroutine mds(tdst,tdisp,sdst,sdisp,count);                   <<06631>>04150000
  value tdst,tdisp,sdst,sdisp,count;                           <<06631>>04155000
  integer tdst,tdisp,sdst,sdisp,count;                         <<06631>>04160000
                                                               <<06631>>04165000
  begin                                                        <<06631>>04170000
    x:=tos;                                                    <<06631>>04175000
    assemble(mds 0);                                           <<06631>>04180000
    tos:=x;                                                    <<06631>>04185000
  end;                                                         <<06631>>04190000
                                                               <<06631>>04195000
   integer subroutine wordaddress' (byteaddress);              <<01245>>04200000
     value byteaddress;                                        <<01245>>04205000
     logical byteaddress;                                      <<01245>>04210000
     begin                                                     <<01245>>04215000
       tos := wordaddress' := byteaddress & lsr(1);            <<01245>>04220000
       push (z);                                               <<01245>>04225000
       if <<wordaddress'>> tos > tos <<z>> then                <<01245>>04230000
         wordaddress'.(0:1) := 1;                              <<01245>>04235000
     end;                                                      <<01245>>04240000
                                                               <<01245>>04245000
      sin := stdin;   slist := stdlist;                        <<01245>>04250000
                                                               <<01245>>04255000
      tos:=setcritical;                                        <<01245>>04260000
      tos:=pin;                                                <<01245>>04265000
      if = then                        <<not yet a pcb>>       <<01245>>04270000
      begin                                                    <<01245>>04275000
         tos := getentry(pcbb);                                <<06645>>04280000
         assemble(test);                                       <<01245>>04285000
         if = then                     <<no pcb available>>    <<01245>>04290000
         begin                                                 <<01245>>04295000
            pin:=tos;                  <<pin returned equal to 0>>      04300000
            tos:=ccl;                                          <<01245>>04305000
            goto fin;                                          <<01245>>04310000
         end;                                                  <<01245>>04315000
         assemble(dup);                                        <<01245>>04320000
         pin:=tos;assemble(xch,del);                           <<01245>>04325000
      end;                                                     <<01245>>04330000
      qrelpin := pin;                                      <<*d<<01245>>04335000
      proc:=tos*pcbsize;                                       <<01245>>04340000
                                                               <<01245>>04345000
      jn := stdin;                                             <<01245>>04350000
                                                               <<01245>>04355000
      stcount := 0;                                            <<01245>>04360000
      if strlnth > 0 then                                      <<01245>>04365000
        begin  << a string was specified >>                    <<01245>>04370000
          if logical(strlnth) then                             <<01245>>04375000
            stcount := strlnth&lsr(1) + 1                      <<01245>>04380000
          else                                                 <<01245>>04385000
            begin  << even length >>                           <<01245>>04390000
              if logical(string) then                          <<01245>>04395000
                stcount := strlnth&lsr(1) + 2                  <<01245>>04400000
              else                                             <<01245>>04405000
                stcount := strlnth&lsr(1);                     <<01245>>04410000
            end;                                               <<01245>>04415000
        end;                                                   <<01245>>04420000
                                                               <<01245>>04425000
      << pcbx formatting >>                                    <<01245>>04430000
cpcbdst := integer(pcb(curprc+stkinfowordnum).stkdstfield);    <<06645>>04435000
      xdsblkindx:=firstxdsblkindx;                             <<06631>>04440000
      exchangedb(stackdstx);   <<db to new stack>>             <<06631>>04445000
      virt :=  dst(stackdstx&lsl(2)+1).vmalloc * vmpagesize;   <<mpeiv>>04450000
      pcbpt := curprc;                                         <<06645>>04455000
      v := 0;                                                  <<06645>>04460000
      stack := 0;                                              <<01245>>04465000
      move  stack(1) := stack,(pxsize-1);                      <<06631>>04470000
      pxg'relative'dl:=pxsize;                                 <<06631>>04475000
      pxg'relative'db:=pxsize + dlsize;                        <<06631>>04480000
      pxglob'ptr:=pxsize;                                      <<06631>>04485000
      pxfix'ptr:=pxsize - pxg'size;                            <<06631>>04490000
      pxfile'ptr:= pxfile + 4;                                 <<06631>>04495000
      pxfilesize:=pxfile ;                                     <<06631>>04500000
      pxfxsize:= fixedsize;                                    <<06631>>04505000
      pxfxzreg:= globsize + locsize; <<rel z >>                <<06631>>04510000
      pxfxqreg:= globsize + stcount + 2;       << q init - db ><<06631>>04515000
      pxfxdlreg:=dlsize;               << db - dl >>           <<06631>>04520000
      pxfxcap:= flags land %713;             << cap >>         <<06631>>04525000
      pxfxxdscnt:= 4;         <<xtra data segment count>>      <<06631>>04530000
      pxfxrw:= flags.(10:1);           <<read/write flag>>     <<06631>>04535000
      pxfxinitcst := plabel;                                   <<06631>>04540000
      if logicalmapping then                                   <<06099>>04545000
         pxfxcstexpbit := deltap.mapflag;                      <<07257>>04550000
      pxfxmaxstk:=maxstack;                                    <<06631>>04555000
      pxfxvirspace:=virt;                                      <<06631>>04560000
      <<  current max stack size  z-dl  >>                     <<01245>>04565000
      pxfxcurmxstk:=globsize+locsize+dlsize;                   <<06631>>04570000
      <<  total virtual storage in sectors  >>                 <<01245>>04575000
      pxfxvsused:=(virt+127)&lsr(7);                           <<06631>>04580000
      cpunum;    << get cpu number >>                          <<04664>>04585000
      if tos= series64 then pxfxpmbc:= pmbc'init;              <<06631>>04590000
                                                               <<04664>>04595000
                                                               <<01245>>04600000
      <<marker to terminate>>                                  <<01245>>04605000
      tos:=v;                                                  <<01245>>04610000
      x := stack(0) + dlsize + globsize + stcount;             <<01245>>04615000
      << base pts to deltaq of stkmarker following initiate >> <<01245>>04620000
      base := x + 10;                                          <<01245>>04625000
                                                               <<01245>>04630000
      stack(x) := strlnth;                                     <<01245>>04635000
      if strlnth > 0 then                                      <<01245>>04640000
        stack(x:=x+1) := globsize&lsl(1) + string.(15:1)       <<01245>>04645000
      else                                                     <<01245>>04650000
        stack(x:=x+1) := 0;                                    <<01245>>04655000
      stack(x:=x+1) := param;                                  <<01245>>04660000
                                                               <<01245>>04665000
      stack(x+1):=0;                   <<x>>                   <<01245>>04670000
      v:=x+1;                                                  <<01245>>04675000
      stack(v):=absolute(termil);                              <<01245>>04680000
      if logicalmapping  then                                  <<06099>>04685000
         begin                <<mapping firmware present>>     <<06099>>04690000
         <<insert mapping flag into marker>>                   <<06099>>04695000
         stack(v).mapflag:=absolute(termel).(0:1);             <<06099>>04700000
         end;                                                  <<06099>>04705000
      tos:=absolute(termel);       <<ext label of terminate>>  <<01245>>04710000
      tos:=tos land %377;              <<extract cst>>         <<01245>>04715000
      tos:=tos lor %140000;            <<interrpt and priv mode>>       04720000
      stack(v:=v+1):=tos;              <<store in status word>><<01245>>04725000
      stack(x:=x+1):=4;                <<delta q>>             <<01245>>04730000
      stack(x:=x+1):=0;                <<x>>                   <<01245>>04735000
      stack(x:=x+1):=deltap;                                   <<01245>>04740000
      stack(x:=x+1):=%60000+plabel;    <<priv mode in cst.(0:1)>>       04745000
      stack(x:=x+1):=4;                <<delta q>>             <<01245>>04750000
      if  flags.(13:1) land not (flags.(10:1))  then           <<01245>>04755000
         begin  << build a marker to debug >>                  <<01245>>04760000
         v:=x;                                                 <<06099>>04765000
         plabel := @debug;                                     <<06099>>04770000
         deltap := convextlabeltodeltap(plabel);               <<06099>>04775000
         if logicalmapping then                                <<06099>>04780000
            deltap.mapflag := plabel.(0:1);                    <<06099>>04785000
         stack(v+1):=0;   << xreg >>                           <<06099>>04790000
         stack(x:=x+1) := deltap;                              <<06099>>04795000
         stack(x:=x+1) := %160000+plabel.(8:8);                <<06099>>04800000
         stack(x:=x+1):=4;                                     <<01245>>04805000
         base := base + 4;                                     <<01245>>04810000
         end;                                                  <<01245>>04815000
      tos := x;                                                <<01245>>04820000
      dbbase := base - (stack(0) + dlsize);                    <<01245>>04825000
      if procstate.ptypefield' > 1 or sin = 0                  <<06645>>04830000
        then x := tos                                          <<01245>>04835000
        else                                                   <<01245>>04840000
        begin   << set up for initiate >>                      <<01245>>04845000
         exchangedb (0);                                       <<01254>>04850000
         jn := tos + 109; << tos = old x >>                    <<01245>>04855000
                                                               <<01245>>04860000
         << dbbase is # words from db to deltaq of marker >>   <<01245>>04865000
         tos := stackdstx;                                     <<01245>>04870000
         if stdlist.name = 1 then                              <<01245>>04875000
           begin                                               <<01245>>04880000
             tos := base + 4;                                  <<01245>>04885000
             tos := wordaddress' (stdlist(1));                 <<01245>>04890000
             tos := 18;                                        <<01245>>04895000
             assemble (mtds 3);                                <<01245>>04900000
             stdlist(1) := (dbbase+4)&lsl(1);                  <<01245>>04905000
           end;                                                <<01245>>04910000
         if stdlist.device = 1 then                            <<01245>>04915000
           begin                                               <<01245>>04920000
             tos := base + 22;                                 <<01245>>04925000
             tos := wordaddress' (stdlist(5));                 <<01245>>04930000
             tos := 9;                                         <<01245>>04935000
             assemble (mtds 3);                                <<01245>>04940000
             stdlist(5) := (dbbase+22)&lsl(1);                 <<01245>>04945000
           end;                                                <<01245>>04950000
         if stdlist.formmsg = 1 then                           <<01245>>04955000
           begin                                               <<01245>>04960000
             tos := base + 31;                                 <<01245>>04965000
             tos := wordaddress' (stdlist(6));                 <<01245>>04970000
             tos := 25;                                        <<01245>>04975000
             assemble (mtds 3);                                <<01245>>04980000
             stdlist(6) := (dbbase+31)&lsl(1);                 <<01245>>04985000
           end;                                                <<01245>>04990000
         if stdin.name = 1 then                                <<01245>>04995000
           begin                                               <<01245>>05000000
             tos := base + 56;                                 <<01245>>05005000
             tos := wordaddress' (stdin(1));                   <<01245>>05010000
             tos := 18;                                        <<01245>>05015000
             assemble (mtds 3);                                <<01245>>05020000
             stdin(1) := (dbbase+56)&lsl(1);                   <<01245>>05025000
           end;                                                <<01245>>05030000
         if stdin.device = 1 then                              <<01245>>05035000
           begin                                               <<01245>>05040000
             tos := base + 74;                                 <<01245>>05045000
             tos := wordaddress' (stdin(5));                   <<01245>>05050000
             tos := 9;                                         <<01245>>05055000
             assemble (mtds 3);                                <<01245>>05060000
             stdin(5) := (dbbase+74)&lsl(1);                   <<01245>>05065000
           end;                                                <<01245>>05070000
         if stdin.formmsg = 1 then                             <<01245>>05075000
           begin                                               <<01245>>05080000
             tos := base + 83;                                 <<01245>>05085000
             tos := wordaddress' (stdin(6));                   <<01245>>05090000
             tos := 25;                                        <<01245>>05095000
             assemble (mtds 3);                                <<01245>>05100000
             stdin(6) := (dbbase+83)&lsl(1);                   <<01245>>05105000
           end;                                                <<01245>>05110000
         del;     << stackdstx >>                              <<01245>>05115000
                                                               <<01245>>05120000
         tos := stackdstx;                                     <<01245>>05125000
         tos := jn;                                            <<01245>>05130000
         tos := @stdlist(1);                                   <<01245>>05135000
         tos := 14;                                            <<01245>>05140000
         assemble (mtds 3);   << keep dst # >>                 <<01245>>05145000
                                                               <<01245>>05150000
         tos := jn + 16;                                       <<01245>>05155000
         tos := @stdin(1);                                     <<01245>>05160000
         tos := 14;                                            <<01245>>05165000
         assemble (mtds 4);                                    <<01245>>05170000
                                                               <<01245>>05175000
         exchangedb (stackdstx);                               <<01245>>05180000
         stack(jn:=jn+14) := slist;   << ovmask >>             <<01245>>05185000
         stack(jn:=jn+16) := sin;     << ovmask >>             <<01245>>05190000
         tos := logical(absolute(%1122).(8:8)) lor %160000;    <<01245>>05195000
         tos := absolute(x:=x+1);                              <<01245>>05200000
         if logicalmapping then                                <<06099>>05205000
            tos.mapflag := absolute(%1122).(0:1);              <<06099>>05210000
         x := jn;                                              <<01245>>05215000
         stack(x:=x+1) := 0;                                   <<01245>>05220000
         stack(x:=x+1) := tos;  <<deltap for initiate>>        <<01245>>05225000
         stack(x:=x+1) := tos;  <<status for initiate>>        <<01245>>05230000
         stack(x:=x+1) := 143;                                 <<01245>>05235000
         end;                                                  <<01245>>05240000
      stack(x:=x+1):=0;                <<db>>                  <<01245>>05245000
      stack(x:=x+1) := 0;                                      <<01245>>05250000
      v:=tos;                                                  <<01245>>05255000
      tos:=x; tos:=pxg'relative'db; assemble(sub);             <<06631>>05260000
      pxfxsreg:=tos;             <<store s relative>>          <<06631>>05265000
      <<move global info>>                                     <<01245>>05270000
      mds(stackdstx,2,cpcbdst,2,pxg'size-2);                   <<06631>>05275000
      << abort dump flags set here >>                          <<01245>>05280000
      tos := flags&lsr(9) land %173;                           <<01245>>05285000
      assemble( dup );                                         <<01245>>05290000
      case  * tos.(14:2)  of                                   <<01245>>05295000
         begin                                                 <<01245>>05300000
         del;        << no change >>                           <<01245>>05305000
            begin                                              <<01245>>05310000
            tos := tos&lsr(3);                                 <<01245>>05315000
            tos.(10:1) := 1;                                   <<01245>>05320000
            pxg'stkdumpflags := tos;                           <<06631>>05325000
            end;                                               <<01245>>05330000
         del;                                                  <<01245>>05335000
            begin                                              <<01245>>05340000
            pxg'stkdumpflags := 0;                             <<06631>>05345000
            del;                                               <<01245>>05350000
            end;                                               <<01245>>05355000
         end;                                                  <<01245>>05360000
      <<copy job number>>                                      <<01245>>05365000
      pxfxjobnum := jn := getjobn; << get job # >>             <<07257>>05370000
      pxfxjobtype:=getjobn & lsr(14);                          <<07313>>05375000
      exchangedb(0);                                           <<07257>>05380000
      tos := pjxref;                                           <<07257>>05385000
      tos := qrelpin;                                          <<07257>>05390000
      tos := @jn;                                              <<07257>>05395000
      tos:=1;                                                  <<06631>>05400000
      assemble(mtds);                                          <<06631>>05405000
                                                               <<01245>>05410000
      <<set up process control block>>                         <<01245>>05415000
                                                               <<01245>>05420000
      pcbpt := proc;                                           <<06645>>05425000
      fatherinfo := curprc;                                    <<06645>>05430000
      pdisable;                                                <<01245>>05435000
      if lpcb(curprc+soninfowordnum) = 0 then                  <<06645>>05440000
         lpcb(curprc+soninfowordnum) := pcbpt                  <<06645>>05445000
      else                                                     <<06645>>05450000
         begin                                                 <<06645>>05455000
         pcbpt := lpcb(curprc+soninfowordnum);                 <<06645>>05460000
         while brotherinfo <> 0 do                             <<06645>>05465000
            pcbpt := brotherinfo;                              <<06645>>05470000
         brotherinfo := proc;                                  <<06645>>05475000
         pcbpt := proc;                                        <<06645>>05480000
         end;                                                  <<06645>>05485000
      penable;                                                 <<01245>>05490000
                                                               <<01245>>05495000
      <<process type>>                                         <<01245>>05500000
         v := curprc + procstatewordnum;                       <<06645>>05505000
         k := proc + procstatewordnum;                         <<06645>>05510000
      tos := pty(pcbtable(v).ptypefield');                     <<06645>>05515000
      t:=tos;                                                  <<01245>>05520000
      pcbtable(k).ptypefield' := t;                            <<06645>>05525000
      if t=0 then                 <<new process not a main>>   <<01245>>05530000
      pcbtable(k).sonofmainflag := pcbtable(v) & lsr(8);       <<07313>>05535000
      pri := priority.(8:8);                               <<*d<<01245>>05540000
      if  t > 0  then                                      <<*d<<01245>>05545000
         begin  << system process or main process >>       <<*d<<01245>>05550000
         tos := 1;                                         <<*d<<01245>>05555000
         if t <> 1 then                                    <<*d<<01245>>05560000
            begin  << system process >>                    <<*d<<01245>>05565000
            tos := tos&lsl(1);                             <<*d<<01245>>05570000
            if pri < 150 then tos := tos&lsl(1);           <<*d<<01245>>05575000
            end                                            <<*d<<01245>>05580000
         else                                              <<*d<<01245>>05585000
            begin                                          <<*d<<01245>>05590000
            if pri = 250 then tos := tos lor %10           <<*d<<01245>>05595000
            else                                           <<*d<<01245>>05600000
               begin                                       <<*d<<01245>>05605000
               if pri < 200 then tos := tos&lsl(1);        <<*d<<01245>>05610000
               if pri < 150 then tos := tos&lsl(1);        <<*d<<01245>>05615000
               end;                                        <<*d<<01245>>05620000
            end;                                           <<*d<<01245>>05625000
         priority.qtype := tos;                            <<*d<<01245>>05630000
   if priority.eq=1 then priority.(8:8):=                      <<mpeiv>>05635000
      ics(-ics'eschedbasecell)                                 <<mpeiv>>05640000
   else                                                        <<mpeiv>>05645000
      if priority.dq=1 then priority.(8:8):=                   <<mpeiv>>05650000
         ics(-ics'dschedbasecell)                              <<mpeiv>>05655000
      else                                                     <<mpeiv>>05660000
         if priority.cq = 1 then priority.(8:8) :=             <<04491>>05665000
            ics(-ics'cschedbasecell);                          <<04491>>05670000
         end;                                              <<*d<<01245>>05675000
                                                               <<01245>>05680000
      <<pcb miscellaneous>>                                    <<01245>>05685000
disaproc;                                                      <<mpeiv>>05690000
tos:=%1000d;                                                   <<mpeiv>>05695000
assemble(xchd);                                                <<mpeiv>>05700000
savedb:=tos;                                                   <<mpeiv>>05705000
pcbpt := proc;                                                 <<06645>>05710000
stkinfo.stkdstfield:=stackdstx;                                <<mpeiv>>05715000
tos:=0;                                                        <<mpeiv>>05720000
tos.sarflag:=1;                                                <<mpeiv>>05725000
resabortinfo:=tos;                                             <<mpeiv>>05730000
queueinginfo.prifield:=priority.(8:8);                         <<mpeiv>>05735000
tos:=priority;                                                 <<mpeiv>>05740000
assemble(tbc 1);                                               <<mpeiv>>05745000
if <> then queueinginfo.eschedflag:=1;                         <<mpeiv>>05750000
assemble(tbc 2);                                               <<mpeiv>>05755000
if <> then queueinginfo.lschedflag:=1;                         <<mpeiv>>05760000
assemble(tbc 3);                                               <<mpeiv>>05765000
if <> then queueinginfo.cschedflag:=1;                         <<mpeiv>>05770000
assemble(tbc 4);                                               <<mpeiv>>05775000
      << eq and dq can both get set from the code in the>>     <<01908>>05780000
      << process type area above.  to resolve this, a   >>     <<01908>>05785000
      << patch is made to the next line. it is temporary>>     <<01908>>05790000
      if <> and (queueinginfo.eschedflag=0) then               <<01908>>05795000
            queueinginfo.dschedflag := 1;                      <<01908>>05800000
assemble(tbc 5);                                               <<mpeiv>>05805000
if <> then queueinginfo.procresidentflag:=1;                   <<mpeiv>>05810000
assemble(del);                                                 <<mpeiv>>05815000
piinfo.psimfield := 7; << normal state >>                      <<06645>>05820000
procstate.aliveflag:=1;                                        <<mpeiv>>05825000
if flags.(4:1) then piinfo.facflag := 1;                       <<06645>>05830000
wakemask.fatherwaitflag:=1;                                    <<mpeiv>>05835000
wakemask.memorywaitflag:=1;                                    <<mpeiv>>05840000
enaproc; << because we can impede on getsystabentry >>         <<07313>>05845000
sllheadinx := getsystabentry(slldst,false,true); << s,w >>     <<06624>>05850000
if sllheadinx = 0 then                                         <<06624>>05855000
   suddendeath(602);                                           <<06615>>05860000
sllptr := logical(sllheadinx);  << pcb -> sll header entry >>  <<06658>>05865000
lsttdst:=mapdst;                                               <<06099>>05870000
sllinx := getsystabentry(slldst,false,true); << s,w >>         <<06624>>05875000
if sllinx = 0 then                                             <<06624>>05880000
   suddendeath(602);                                           <<06615>>05885000
disaproc; << can't impede now >>                               <<07313>>05890000
sll(firstinx) := logical(sllinx);                              <<06624>>05895000
sll(memreqinx) := logical(sllinx);                             <<06624>>05900000
sll(segcount) := 1;                                            <<06624>>05905000
tos := stackobj;                                               <<06658>>05910000
sll(sll'objnum) := tos;                                        <<06658>>05915000
sll(sll'objdesc) := tos;                                      <<<06658>>05920000
sll(sll'flags).sllstkentryflag := 1;                           <<06624>>05925000
tos:=savedb;                                                   <<mpeiv>>05930000
assemble(xchd);                                                <<mpeiv>>05935000
  if lsttdst <> 0 then                                         <<06099>>05940000
     begin     <<logical map created>>                         <<06099>>05945000
     tos := sllheadinx;                                        <<06658>>05950000
     tos := lsttobj;                                           <<06658>>05955000
     tempdb:=setsysdb;                                         <<06099>>05960000
     addtolocality( *, *, %400 );                              <<06099>>05965000
     resetdb(tempdb);                                          <<06099>>05970000
     end;                                                      <<06099>>05975000
enaproc;                                                       <<mpeiv>>05980000
      tos:=cce;                                                <<01245>>05985000
                                                               <<01245>>05990000
      if flags.(11:1) then                                     <<01245>>05995000
        begin  << nocb was specified >>                        <<01245>>06000000
          << set nocb bit in pxfile area of new stack >>       <<01245>>06005000
          tos := %100000;                                      <<01245>>06010000
          tos := stackdstx;                                    <<01245>>06015000
          tos := pxglob + pxfix + 2;                           <<06631>>06020000
          tos := @s2;                                          <<01245>>06025000
          tos := 1;                                            <<01245>>06030000
          assemble (mtds 4);                                   <<01245>>06035000
          del;   << nocb bit word >>                           <<01245>>06040000
        end;                                                   <<01245>>06045000
                                                               <<01245>>06050000
      <<accumulate # of creations>>                            <<01245>>06055000
      pcbpt := curprc;                                         <<06645>>06060000
      if not procstate.systemprocflag then                     <<06645>>06065000
      begin                            <<user process>>        <<01245>>06070000
         jit := getjitdst;                                     <<06884>>06075000
         db := exchangedb(jit);                                <<06884>>06080000
         jitnumcreations:=jitnumcreations+1; <<#creations+1>>  <<06884>>06085000
         if < then jitnumcreations := %77777; <<overflow>>     <<06884>>06090000
         exchangedb(db);                                       <<06884>>06095000
      end;                                                     <<01245>>06100000
                                                               <<01740>>06105000
      sircond := getsir (meassir);                             <<01740>>06110000
      if gclassenabledmask.class15 then                        <<01740>>06115000
        begin  << process instrumentation enabled >>           <<01740>>06120000
          if logicalmapping then plabel.(0:1):=deltap.mapflag; <<06099>>06125000
          if label'is'sl'seg(plabel,0) then                    <<06099>>06130000
            begin  << procreate must make entry >>             <<01740>>06135000
              << note that for normal program files          >><<01740>>06140000
              << (i.e. plabel >= %301), createprocess makes  >><<01740>>06145000
              << the entry.                                  >><<01740>>06150000
                                                               <<01740>>06155000
              << get pointer to appropriate entry >>           <<01740>>06160000
              tos := measprocxdsbank;                          <<01740>>06165000
              tos := measprocxdsbase;                          <<01740>>06170000
              assemble (lsea);          << get entry size >>   <<01740>>06175000
              measprocentsize := tos;   << remember size >>    <<01740>>06180000
              tos := pin * measprocentsize;   << offset >>     <<01740>>06185000
              assemble (ladd);     << absolute ptr to entry >> <<01740>>06190000
              measprocentptr := s0;   << remember entry ptr >> <<01740>>06195000
                                                               <<01740>>06200000
              << initialize entry with zeroes >>               <<01740>>06205000
              k := 0;                                          <<01740>>06210000
              while (k := k + 1) <= measprocentsize do         <<01740>>06215000
                begin                                          <<01740>>06220000
                  tos := 0;                                    <<01740>>06225000
                  assemble (ssea);     << clear the word >>    <<01740>>06230000
                  tos := tos + 1;      << ptr to next word >>  <<01740>>06235000
                end;                                           <<01740>>06240000
                                                               <<01740>>06245000
              << fill in create time >>                        <<01740>>06250000
              s0 := measprocentptr + logical(cp'createtime);   <<01740>>06255000
              tos := timer;        << double word time stamp >><<01740>>06260000
              assemble (sdea);     << place time in entry >>   <<01740>>06265000
                                                               <<01740>>06270000
              << fill in job/session number >>                 <<01740>>06275000
              s0 := measprocentptr + logical(cp'jobsessionnum);<<01740>>06280000
              tos := jn;           << job/session num >>       <<01740>>06285000
              assemble (ssea);     << place j/s num in entry >><<01740>>06290000
                                                               <<01740>>06295000
              << fill in queue descriptor word >>              <<01740>>06300000
              s0 := measprocentptr+logical(cp'procquestopword);<<01740>>06305000
              tos := 0;                                        <<01740>>06310000
              s0.(0:4) := pcb(pin*pcbsize+                     <<01740>>06315000
                                queueinginfowordnum).qtype;    <<01740>>06320000
              assemble (ssea);     << place q word in entry >> <<01740>>06325000
                                                               <<01740>>06330000
              ddel;          << xds bank & address >>          <<01740>>06335000
                                                               <<01740>>06340000
              << fill in process name >>                       <<01740>>06345000
              process'name := "  ";                            <<01740>>06350000
              move process'name(1) := process'name, (11);      <<01740>>06355000
              mypcbptr := curprc;                              <<06645>>06360000
              if ucop'call then                                <<01740>>06365000
                move process'name := "CI"                      <<01740>>06370000
              else                                             <<01740>>06375000
                move process'name := "SP";                     <<01740>>06380000
              tos := measprocxdsnum;                           <<01740>>06385000
              tos := measprocentptr - measprocxdsbase;         <<01740>>06390000
              tos := tos + logical(cp'progname);               <<01740>>06395000
              tos := @process'name;                            <<01740>>06400000
              tos := 12;                                       <<01740>>06405000
              assemble (mtds);     << place name in entry >>   <<01740>>06410000
            end << procreate makes entry >>;                   <<01740>>06415000
        end << process instrumentation >>;                     <<01740>>06420000
      relsir (meassir, sircond);                               <<01740>>06425000
                                                               <<01245>>06430000
fin:                                                           <<01245>>06435000
      status.(6:2):=tos;                                       <<01245>>06440000
      resetcritical(*);                                        <<01245>>06445000
                                                               <<01245>>06450000
                                                               <<01245>>06455000
end;  << p r o c r e a t e  >>                                 <<01245>>06460000
$page "PROCEDURE CHECKPRIORITY"                                <<01254>>06465000
integer procedure checkpriority(prclass,pcbpt);                         06470000
value prclass,pcbpt;                                                    06475000
logical prclass; integer pcbpt;                                         06480000
option privileged,uncallable;                                           06485000
                                                                        06490000
comment: checks the validity of the priority class specified            06495000
         for the specified process.                                     06500000
         prclass.(8:8)="S","M" or "A".                                  06505000
         prclass.(0:8)="SUB QUEUE NAME" or priority number.             06510000
         returns                                                        06515000
            cc=cce if no violation:checkpriority=2th word of sq mapp ent06520000
            cc=ccl if violation:checkpriority=error number              06525000
      error number                                                      06530000
      20    sub queue name not existant                                 06535000
      25    portion of master q requested without capability            06540000
      26    absolute priority requested without capability              06545000
      27    illegal queue specification                                 06550000
      32    priority exceeding maximum for account                      06555000
                                                                        06560000
      ;                                                                 06565000
                                                                        06570000
begin                                                                   06575000
      define as = (2:1)#,                                      <<04550>>06580000
             bs = (2:1)#,                                      <<04550>>06585000
             cs = (3:1)#,                                      <<04550>>06590000
             ds = (4:1)#,                                      <<04550>>06595000
             es = (1:1)#;                                      <<04550>>06600000
      equate accessx=5;                                                 06605000
                                                                        06610000
      integer pcbglobloc;                                      <<06631>>06615000
      logical pxfixedloc;                                      <<06631>>06620000
      integer jit;                                                      06625000
      integer array jitarr(*)=db+0;                            <<06884>>06630000
      integer is2=s-2,is3=s-3,is4=s-4;                                  06635000
      integer sqn,chk=q-6,err:=-1;                                      06640000
      logical cap;                                                      06645000
                                                                        06650000
                                                                        06655000
                                                                        06660000
      subroutine acctpri;                                               06665000
                                                                        06670000
      comment: cheks the priority number against maximum allowed        06675000
               for the account.                                         06680000
               in s-1 is the priority number                            06685000
               in s is the condition code returned from checkpriority   06690000
               updates the maximum priority for job.                    06695000
               ;                                                        06700000
                                                                        06705000
      begin                                                             06710000
         pxglobal;                                             <<06631>>06715000
         tos:=exchangedb(pxg'jitdst);                          <<06734>>06720000
         << check priority for types "S" and "M" only >>       <<00165>>06725000
         if (prclass land %377) <> "A" then                    <<00165>>06730000
            begin                                              <<00165>>06735000
            tos:=jitmaxpri;  <<max priority>>                  <<06884>>06740000
            tos:=is4.(8:8);            << priority requested >><<00165>>06745000
            assemble(lcmp);            << max pri > request >> <<00165>>06750000
            if > then                  << fail >>              <<00165>>06755000
               begin                                           <<00165>>06760000
               is2:=ccl;                                       <<00165>>06765000
               is3:=32;                                        <<00165>>06770000
               end;                                            <<00165>>06775000
            end;                                               <<00165>>06780000
         if is2=cce then               <<ok>>                           06785000
         begin                                                          06790000
            tos:=jithipri;  <<current number>>                 <<06884>>06795000
            tos := if logical(is4).cs then                     <<04550>>06800000
                      ics(-ics'cschedbasecell)                 <<04550>>06805000
                   else                                        <<04550>>06810000
                   if logical(is4).ds then                     <<04550>>06815000
                      ics(-ics'dschedbasecell)                 <<04550>>06820000
                   else                                        <<04550>>06825000
                   if logical(is4).es then                     <<04550>>06830000
                      ics(-ics'eschedbasecell)                 <<04550>>06835000
                   else                                        <<04550>>06840000
                      is4.(8:8);                               <<04550>>06845000
            if tos > tos then jithipri :=                      <<06884>>06850000
               if logical(is3).cs then                         <<04550>>06855000
                  ics(-ics'cschedbasecell)                     <<04550>>06860000
               else                                            <<04550>>06865000
               if logical(is3).ds then                         <<04550>>06870000
                  ics(-ics'dschedbasecell)                     <<04550>>06875000
               else                                            <<04550>>06880000
               if logical(is3).es then                         <<04550>>06885000
                  ics(-ics'eschedbasecell)                     <<04550>>06890000
               else                                            <<04550>>06895000
                  is3;                                         <<04550>>06900000
         end;                                                           06905000
         assemble(zero,xch);exchangedb(*);                              06910000
      end;  << a c c t p r i  >>                                        06915000
                                                                        06920000
                                                                        06925000
      pxfixed;                                                 <<06631>>06930000
      cap:=pxfxcap;                    <<general resource cap>><<06631>>06935000
      sqn:=prclass&lsr(8);             <<extract sub q name>>           06940000
      if (prclass land %377)="S" then                                   06945000
      begin                                                             06950000
         tos:=subqueue(4,sqn);         <<double word entry back>>       06955000
         if < then                     <<sq name not found>>            06960000
         begin                                                          06965000
            tos:=20;                   <<error # 20>>                   06970000
            tos:=ccl;                                                   06975000
            goto fin;                                                   06980000
         end;                                                           06985000
         tos:= cce;                                                     06990000
         acctpri;                <<check max pri >>                     06995000
         goto fin;                                                      07000000
      end;                             <<end of "S" examination>>       07005000
                                                                        07010000
      if (prclass land %377)="M" then                                   07015000
      begin                                                             07020000
         if cap&lsr(6) then            <<test for priv in capability>>  07025000
         begin                                                          07030000
            tos:=subqueue(4,sqn);                                       07035000
            if < then                                                   07040000
            begin                                                       07045000
               tos:=24;                <<error #>>                      07050000
               tos:=ccl;                                                07055000
               goto fin;                                                07060000
            end;                                                        07065000
            << set linear q bit & schedule after start of q >> <<01140>>07070000
            tos := (tos lor %20000) + 1;                       <<01140>>07075000
            tos:=cce;                                                   07080000
            acctpri;                                                    07085000
            goto fin;                                                   07090000
         end else                                                       07095000
         begin                                                          07100000
            tos:=25;                   <<error #>>                      07105000
            tos:=ccl;                                                   07110000
            goto fin;                                                   07115000
         end;                                                           07120000
      end;                                                              07125000
                                                                        07130000
      if (prclass land %377)="A" then                                   07135000
      begin                                                             07140000
         if cap&lsr(6) then                                             07145000
         begin                                                          07150000
            tos:=prclass&lsr(8)+%20000;<<priority #>>                   07155000
            tos:=cce;                                                   07160000
            acctpri;   << update max pri. no priority check >> <<00165>>07165000
            goto fin;                                                   07170000
         end else                                                       07175000
         begin                                                          07180000
            tos:=26;                   <<error number>>                 07185000
            tos:=ccl;                                                   07190000
            goto fin;                                                   07195000
         end;                                                           07200000
      end;                                                              07205000
      tos:=27;                         <<error #>>                      07210000
      tos:=ccl;                                                         07215000
fin:  status.(6:2):=tos;                                                07220000
      chk:=tos;                        <<result>>                       07225000
                                                                        07230000
end;  << c h e c k p r i o r i t y  >>                                  07235000
$page "PROCEDURE INHERIT'STDX"                                 <<01710>>07240000
procedure inherit'stdx (error, stdx, stdx'num, stdxname,       <<01710>>07245000
                        stdxdev);                              <<01710>>07250000
  value stdx'num;                                              <<01710>>07255000
<<                                                                      07260000
   function                                                             07265000
     builds the array of fopen parameters and sets up the byte arrays   07270000
     for file name and device for the default $stdin or $stdlist for    07275000
     a process being created by createprocess.  the default $stdin      07280000
     and $stdlist of a process are the $stdin and $stdlist of the       07285000
     creating process.  thus, new processes inherit the standard file   07290000
     settings of their fathers if no explicit specification is made     07295000
     for $stdin or $stdlist.                                            07300000
>>                                                                      07305000
<< inputs >>                                                   <<01710>>07310000
     integer                                                            07315000
       stdx'num;                << 1 = $stdin;  2 = $stdlist >><<01710>>07320000
                                                               <<01710>>07325000
<< outputs >>                                                  <<01710>>07330000
     integer                                                   <<01710>>07335000
       error;                   << err rtrn - ffileinfo fail >><<01710>>07340000
                                                               <<01710>>07345000
     logical array                                             <<01710>>07350000
       stdx;                    << fopen parameters for stdx >><<01710>>07355000
                                                               <<01710>>07360000
     byte array                                                <<01710>>07365000
       stdxname,                << stdx file name >>           <<01710>>07370000
       stdxdev;                 << stdx device >>              <<01710>>07375000
                                                               <<01710>>07380000
option privileged, uncallable;                                 <<01710>>07385000
                                                               <<01710>>07390000
  begin                                                        <<01710>>07395000
    integer                                                    <<01710>>07400000
      stdx'ldev,               << ldev from ffileinfo >>       <<01710>>07405000
      stdx'devtype,            << ldev type from ffileinfo >>  <<01710>>07410000
      stdx'hdaddr;             << hard addr from ffileinfo >>  <<01710>>07415000
                                                               <<01710>>07420000
    << *** fopen parameters in stdx array *** >>               <<01710>>07425000
                                                               <<01710>>07430000
    equate                                                     <<01710>>07435000
      name            = 1,     << formal file designator >>    <<01710>>07440000
      fopts           = 2,     << foptions >>                  <<01710>>07445000
      aopts           = 3,     << aoptions >>                  <<01710>>07450000
      dev             = 5;     << logical device >>            <<01710>>07455000
                                                               <<01710>>07460000
    define                                                     <<01710>>07465000
      type            = (8:8)#,    << device type field >>     <<01710>>07470000
      ovname          = (3:1)#,    << name option var bit >>   <<01710>>07475000
      ovdev           = (7:1)#;    << device option var bit >> <<01710>>07480000
                                                               <<01710>>07485000
    equate                                                     <<01710>>07490000
      fixedheaddisc   = 1;         << fixed head disc code >>  <<01710>>07495000
                                                               <<01710>>07500000
                                                               <<01710>>07505000
    << inherit'stdx >>                                         <<01710>>07510000
                                                               <<01710>>07515000
    stdxname := " ";                                           <<01710>>07520000
    move stdxname(1) := stdxname, (35);                        <<01710>>07525000
    stdxdev := " ";                                            <<01710>>07530000
    move stdxdev(1) := stdxdev, (17);                          <<01710>>07535000
    << set option variable mask for name, fopts, and aopts >>  <<01710>>07540000
    stdx := %16000;                                            <<01710>>07545000
                                                               <<01710>>07550000
    ffileinfo (stdx'num, 1, stdxname, 2, stdx(fopts),          <<01710>>07555000
               3, stdx(aopts), 5, stdx'devtype,                <<01710>>07560000
               6, stdx'ldev);                                  <<01710>>07565000
    ffileinfo(stdx'num, 47, stdx'hdaddr);    <<9-bit drts>>    <<03066>>07570000
                                                               <<01710>>07575000
    if < then << should only be true for sys processes >>      <<01710>>07580000
      error := -1                                              <<01710>>07585000
    else                                                       <<01710>>07590000
      begin  << got the file info ok >>                        <<01710>>07595000
        stdx(name) := @stdxname;                               <<01710>>07600000
                                                               <<01710>>07605000
        if stdx'devtype.type > fixedheaddisc then              <<01796>>07610000
          begin  << non-disc device >>                         <<01710>>07615000
            x := ascii (stdx'ldev, -10, stdxdev(2));           <<01710>>07620000
            case x-1 of                                        <<01710>>07625000
              begin  << add ldev leading 0s as needed >>       <<01710>>07630000
                << 1 >>   move stdxdev := "00";                <<01710>>07635000
                << 2 >>   stdxdev := "0";                      <<01710>>07640000
                << 3 >>   ;                                    <<01710>>07645000
              end;                                             <<01710>>07650000
            stdx(dev) := @stdxdev;                             <<01710>>07655000
            stdx.ovdev := 1;                                   <<01710>>07660000
            << if device is spooled, don't specify name     >> <<01710>>07665000
            << since fopen will open the virtual device.    >> <<01710>>07670000
            if stdx'hdaddr = 0 then stdx.ovname := 0;          <<03066>>07675000
          end;                                                 <<01710>>07680000
      end << got file info >>;                                 <<01710>>07685000
  end << inherit'stdx >>;                                      <<01710>>07690000
$page "PROCEDURE BUILD'STDX"                                   <<01245>>07695000
procedure build'stdx (error, stdx, stdx'num, stdx'strng,       <<01245>>07700000
                      strng'lnth, parsetab'lnth, stdxname,     <<01245>>07705000
                      stdxdev, stdxforms, formaldes);          <<01245>>07710000
  value stdx'num, strng'lnth, parsetab'lnth;                   <<01245>>07715000
<<                                                                      07720000
   function                                                             07725000
     builds the array of fopen parameters and sets up the byte arrays   07730000
     for file name , device, and forms message (if necessary) for the   07735000
     specified $stdin or $stdlist from the partial file equation        07740000
     specified by the caller of createprocess.  a special entry point   07745000
     to the :file command executor of the ci is used to parse the       07750000
     partial file equation.  it returns a file equation table entry     07755000
     which is then used to construct the fopen parameters.              07760000
>>                                                                      07765000
<< inputs >>                                                   <<01245>>07770000
     byte array                                                <<01245>>07775000
       stdx'strng;              << stdx string from user >>    <<01245>>07780000
                                                               <<01245>>07785000
     integer                                                   <<01245>>07790000
       stdx'num,                << 1 = $stdin;  2 = $stdlist >><<01245>>07795000
       strng'lnth,              << length of stdx string >>    <<01245>>07800000
       parsetab'lnth;           << length of parse table >>    <<01245>>07805000
                                                               <<01245>>07810000
<< outputs >>                                                  <<01245>>07815000
     integer                                                   <<01245>>07820000
       error;                   << err rtrn from file parse >> <<01245>>07825000
                                                               <<01245>>07830000
     logical array                                             <<01245>>07835000
       stdx;                    << fopen parameters for stdx >><<01245>>07840000
                                                               <<01245>>07845000
     byte array                                                <<01245>>07850000
       stdxname,                << stdx file name, if any >>   <<01245>>07855000
       stdxdev,                 << stdx device, if any >>      <<01245>>07860000
       stdxforms,               << stdx forms msg, if any >>   <<01245>>07865000
       formaldes;               << formal des, if needed >>    <<01245>>07870000
                                                               <<01245>>07875000
option privileged, uncallable;                                 <<01427>>07880000
                                                               <<01427>>07885000
  begin                                                        <<01245>>07890000
    integer                                                    <<01245>>07895000
      rqstd'access,             << access requested by user >> <<01245>>07900000
      dummy,                    << dummy parm for parse call >><<01245>>07905000
      mypin,                    << pin of calling process >>   <<01245>>07910000
      ptime,                    << process execution time >>   <<01245>>07915000
      deslnth;                  << length of formal desig >>   <<01245>>07920000
                                                               <<01245>>07925000
    logical                                                    <<01245>>07930000
      blank           := "  ";  << blank for addjtentry >>     <<01245>>07935000
                                                               <<01245>>07940000
    byte pointer                                               <<01245>>07945000
      bptr            := @blank,<< for addjtentry >>           <<01245>>07950000
      fname,                    << temp var for file name >>   <<01245>>07955000
      device,                   << temp var for device >>      <<01245>>07960000
      formsmessage;             << temp var for forms msg >>   <<01245>>07965000
                                                               <<01245>>07970000
    logical array                                              <<01245>>07975000
      parsetab(0:parsetab'lnth);<< file eq table from parser >><<01245>>07980000
                                                               <<01245>>07985000
    byte array                                                 <<01245>>07990000
      file'equation(*) = parsetab;    << input to parser - file eq >>   07995000
                                                               <<01245>>08000000
    equate                                                     <<01245>>08005000
      cr               = %15;   << carriage return char >>     <<01245>>08010000
                                                               <<01245>>08015000
    << *** variables for handling back references *** >>       <<01427>>08020000
                                                               <<01427>>08025000
    equate                                                     <<01427>>08030000
      breftab'len     = 96;     << back ref table size >>      <<01427>>08035000
                                                               <<01427>>08040000
    logical array                                              <<01427>>08045000
      breftab(0:breftab'len-1), << back reference table >>     <<01427>>08050000
      brefnames(0:15),          << names in bref fdesig >>     <<01427>>08055000
      bref'fname(*)   = brefnames,                             <<01427>>08060000
      bref'gname(*)   = brefnames(4),                          <<01427>>08065000
      bref'aname(*)   = brefnames(8),                          <<01427>>08070000
      bref'lwname(*)  = brefnames(12);                         <<01427>>08075000
                                                               <<01427>>08080000
    logical                                                    <<01710>>08085000
      backref         := false; << true if name is backref >>  <<01710>>08090000
                                                               <<01710>>08095000
    integer                                                    <<01427>>08100000
      br'index,                 << index into bref tab ntry >> <<01427>>08105000
      br'varsize;               << variable size part >>       <<01427>>08110000
                                                               <<01427>>08115000
    << *** fopen parameters in stdx array *** >>               <<01245>>08120000
                                                               <<01245>>08125000
    equate                                                     <<01245>>08130000
      name            =  1,     << formal file designator >>   <<01245>>08135000
      fopts           =  2,     << foptions >>                 <<01245>>08140000
      aopts           =  3,     << aoptions >>                 <<01245>>08145000
      recsize         =  4,     << record size >>              <<01245>>08150000
      dev             =  5,     << logical device >>           <<01245>>08155000
      formsmsg        =  6,     << forms message or tape lbl >><<01245>>08160000
      userlabels      =  7,     << # of user defined labels >> <<01245>>08165000
      blkfactor       =  8,     << blocking factor >>          <<01245>>08170000
      numbuffs        =  9,     << # buffers, copies, outpri >><<01245>>08175000
      filesize1       = 10,     << # records in file >>        <<01245>>08180000
      filesize2       = 11,     << 2nd word of double size >>  <<01245>>08185000
      numxtents       = 12,     << # disc extents for file >>  <<01245>>08190000
      initalloc       = 13,     << initial extent allocation >><<01245>>08195000
      fcode           = 14;     << file code >>                <<01245>>08200000
                                                               <<01245>>08205000
    << *** access types possible for aoptions of fopen *** >>  <<01245>>08210000
                                                               <<01245>>08215000
    equate                                                     <<01245>>08220000
      read'only       = 0,                                     <<01245>>08225000
      write'only      = 1,                                     <<01245>>08230000
      write'save      = 2,                                     <<01245>>08235000
      append          = 3,                                     <<01245>>08240000
      read'write      = 4,                                     <<01245>>08245000
      update          = 5,                                     <<01245>>08250000
      execute         = 6;                                     <<01245>>08255000
                                                               <<01245>>08260000
    define                                                     <<01245>>08265000
      access          = (12:4)#;   << access of aoptions >>    <<01427>>08270000
                                                               <<01427>>08275000
    << *** miscellaneous foptions & aoptions fields *** >>     <<01427>>08280000
                                                               <<01427>>08285000
    equate                                                     <<01427>>08290000
      share           = 3,         << share access mode >>     <<01710>>08295000
      old'domain      = 1;         << permanent file domain >> <<01427>>08300000
                                                               <<01427>>08305000
    define                                                     <<01427>>08310000
      accessmode      = (8:2)#,    << access mode of aopts >>  <<01710>>08315000
      multi           = (6:1)#,    << multi-acc bit of aopts >><<01710>>08320000
      domain          = (14:2)#,   << domain of foptions >>    <<01427>>08325000
      nofleq          = (5:1)#;    << no file equations bit >> <<01427>>08330000
                                                               <<01245>>08335000
    << *** description of option variable mask for fopen *** >><<01245>>08340000
                                                               <<01245>>08345000
    define                                                     <<01245>>08350000
      ovname          = (3:1)#,                                <<01245>>08355000
      ovfopts         = (4:1)#,                                <<01245>>08360000
      ovaopts         = (5:1)#,                                <<01245>>08365000
      ovrecsize       = (6:1)#,                                <<01245>>08370000
      ovdev           = (7:1)#,                                <<01245>>08375000
      ovformsmsg      = (8:1)#,                                <<01245>>08380000
      ovulabels       = (9:1)#,                                <<01245>>08385000
      ovblkfactor     = (10:1)#,                               <<01245>>08390000
      ovnumbuffs      = (11:1)#,                               <<01245>>08395000
      ovfilesize      = (12:1)#,                               <<01245>>08400000
      ovnumxtents     = (13:1)#,                               <<01245>>08405000
      ovinitalloc     = (14:1)#,                               <<01245>>08410000
      ovfcode         = (15:1)#;                               <<01245>>08415000
                                                               <<01245>>08420000
    << *** description of parse table from file eqtn parser *** >>      08425000
                                                               <<01245>>08430000
    equate                                                     <<01245>>08435000
      feqtablnth       = 78;    << max size of entry >>        <<01245>>08440000
                                                               <<01245>>08445000
    define                                                     <<01245>>08450000
      parse'mask1     = parsetab(0)#,                          <<01245>>08455000
      parse'mask2     = parsetab(1)#,                          <<01245>>08460000
      parse'namelen   = parsetab(2).(0:8)#,                    <<01245>>08465000
      parse'devlen    = parsetab(2).(8:8)#,                    <<01245>>08470000
      parse'name      = @parsetab(3) & lsl(1)#,                <<01245>>08475000
      varsize         = (parse'namelen + parse'devlen + 1)/2#, <<01245>>08480000
      parse'dev       = logical(parse'name) + parse'namelen#,  <<01245>>08485000
      parse'fopts     = parsetab(3+varsize)#,                  <<01245>>08490000
      parse'aopts     = parsetab(4+varsize)#,                  <<01245>>08495000
      parse'numbuffs  = parsetab(5+varsize).(0:8)#,            <<01245>>08500000
      parse'initalloc = parsetab(5+varsize).(8:5)#,            <<01245>>08505000
      parse'recsize   = parsetab(6+varsize)#,                  <<01245>>08510000
      parse'numxtents = parsetab(7+varsize).(0:5)#,            <<01245>>08515000
      parse'blkfactor = parsetab(7+varsize).(8:8)#,            <<01245>>08520000
      parse'fsize1    = parsetab(8+varsize)#,                  <<01245>>08525000
      parse'fsize2    = parsetab(9+varsize)#,                  <<01245>>08530000
      parse'fcode     = parsetab(10+varsize)#,                 <<01245>>08535000
      parse'outpri    = parsetab(11+varsize).(0:4)#,           <<01245>>08540000
      parse'ncopies   = parsetab(11+varsize).(4:7)#,           <<01245>>08545000
      parse'ulabels   = parsetab(12+varsize).(5:11)#,          <<01245>>08550000
      parse'formslen  = parsetab(13+varsize)#,                 <<01245>>08555000
      parse'formsmsg  = @parsetab(14+varsize) & lsl(1)#;       <<01245>>08560000
                                                               <<01245>>08565000
    << *** description of parse table mask words *** >>        <<01245>>08570000
                                                               <<01245>>08575000
    define                                                     <<01245>>08580000
      name'flag       = parse'mask1.(15:1)#,                   <<01245>>08585000
      backref'flag    = parse'mask2.(6:1)#,                    <<01245>>08590000
      foptions'flags  = parse'mask1.(8:6)#,                    <<01245>>08595000
      domain'flag     = parse'mask1.(13:1)#,                   <<01427>>08600000
      aoptions'flags1 = parse'mask1.(4:4)#,                    <<01245>>08605000
      aoptions'flags2 = parse'mask2.(7:3)#,                    <<01245>>08610000
      access'flag     = parse'mask1.(7:1)#,                    <<01427>>08615000
      accessmode'flag = parse'mask1.(5:1)#,                    <<01710>>08620000
      multi'flag      = parse'mask2.(9:1)#,                    <<01710>>08625000
      recsize'flag    = parse'mask1.(1:1)#,                    <<01245>>08630000
      dev'flag        = parse'mask1.(14:1)#,                   <<01245>>08635000
      formmsg'flags   = parse'mask2.(0:3)#,                    <<01245>>08640000
      ulabels'flag    = parse'mask2.(3:1)#,                    <<01245>>08645000
      blkfact'flag    = parse'mask1.(0:1)#,                    <<01245>>08650000
      numbuffs'flag   = parse'mask1.(3:1)#,                    <<01245>>08655000
      ncopies'flag    = parse'mask2.(11:1)#,                   <<01245>>08660000
      outpri'flag     = parse'mask2.(10:1)#,                   <<01245>>08665000
      filesize'flag   = parse'mask2.(13:1)#,                   <<01245>>08670000
      nxtents'flag    = parse'mask2.(14:1)#,                   <<01245>>08675000
      initalloc'flag  = parse'mask2.(15:1)#,                   <<01245>>08680000
      fcode'flag      = parse'mask2.(12:1)#,                   <<01245>>08685000
      dispositn'flag  = parse'mask1.(2:1)#;                    <<01427>>08690000
                                                               <<01245>>08695000
                                                               <<01245>>08700000
    << build'stdx >>                                           <<01245>>08705000
                                                               <<01245>>08710000
    << add dummy formal designator to file eq for parser >>    <<01245>>08715000
    move file'equation := "STDX=";                             <<01245>>08720000
    move file'equation(5) := stdx'strng, (strng'lnth);         <<01245>>08725000
    parse'file'eq (file'equation, error, dummy);               <<01245>>08730000
                                                               <<01245>>08735000
    if error = 0 then                                          <<01245>>08740000
      begin  << parse succeeded - fill stdx >>                 <<01245>>08745000
        stdx := 0;     << clear option variable mask >>        <<01245>>08750000
                                                               <<01245>>08755000
        << clear foptions and aoptions if necessary >>         <<01427>>08760000
        if foptions'flags = 0 then parse'fopts := 0;           <<01427>>08765000
        if aoptions'flags1 = 0 and aoptions'flags2 = 0 then    <<01427>>08770000
          parse'aopts := 0;                                    <<01427>>08775000
                                                               <<01427>>08780000
        << there is always an actual name to handle >>         <<01427>>08785000
        @fname := parse'name;                                  <<01427>>08790000
        if backref'flag then                                   <<01427>>08795000
          begin  << name is a *backref >>                      <<01427>>08800000
            backref := true;                                   <<01710>>08805000
            stdxname := "*";                                   <<mpeiv>>08810000
            move stdxname(1) := fname, (parse'namelen);        <<mpeiv>>08815000
            stdxname(parse'namelen+1) := cr;                   <<mpeiv>>08820000
            << break full name into name, group, acct, lword >><<01427>>08825000
            breftab := "  ";                                   <<01427>>08830000
            move breftab(1) := breftab, (breftab'len-1);       <<01427>>08835000
            fnformat (stdxname(1), bref'fname, bref'gname,     <<mpeiv>>08840000
                      bref'aname, bref'lwname);                <<01427>>08845000
            << find entry in file eq table for back ref name >><<01427>>08850000
            if xretjtentry (bref'fname, bref'gname, bref'aname,<<01427>>08855000
                            dummy, breftab) <> 0 then          <<01427>>08860000
              error := -1                                      <<01427>>08865000
            else                                               <<01427>>08870000
              begin  << entry for backref found >>             <<01427>>08875000
                << get index into entry for mask1 and mask2 >> <<01710>>08880000
                br'index := breftab.(8:8) + 1;                 <<01710>>08885000
                << set mask1 and mask2 from backref >>         <<01710>>08890000
                parse'mask1 := breftab(br'index);              <<01710>>08895000
                parse'mask2 := breftab(br'index+1);            <<01710>>08900000
                << get index into entry for fopts and aopts >> <<01710>>08905000
                br'index := br'index.(8:8) + 2;                <<01710>>08910000
                br'varsize := (breftab(br'index).(0:8) +       <<01427>>08915000
                                breftab(br'index).(8:8) + 1)/2;<<01427>>08920000
                br'index := br'index + br'varsize;             <<01427>>08925000
                << set foptions and aoptions from backref >>   <<01427>>08930000
                parse'fopts := breftab(br'index+1);            <<01427>>08935000
                parse'aopts := breftab(br'index+2);            <<01427>>08940000
              end;                                             <<01427>>08945000
          end << name is *backref >>                           <<01427>>08950000
        else                                                   <<01427>>08955000
          begin  << name is not a *backref >>                  <<01427>>08960000
            move stdxname := fname, (parse'namelen);           <<01427>>08965000
            stdxname(parse'namelen) := cr;                     <<01427>>08970000
          end;                                                 <<01427>>08975000
        stdx(name) := @stdxname;                               <<01427>>08980000
        stdx.ovname := 1;                                      <<01427>>08985000
                                                               <<01245>>08990000
        << check and set foptions >>                           <<01427>>08995000
        if not domain'flag then                                <<01427>>09000000
          begin  << force 'old' domain >>                      <<01427>>09005000
            parse'fopts.domain := old'domain;                  <<01427>>09010000
            domain'flag := 1;                                  <<01427>>09015000
          end;                                                 <<01427>>09020000
        << set 'disallow file equations' flag for norm name >> <<01427>>09025000
        << where disposition was not specified              >> <<01710>>09030000
        if not backref and not dispositn'flag then             <<01710>>09035000
          parse'fopts.nofleq := 1;                             <<01710>>09040000
        stdx(fopts) := parse'fopts;                            <<01427>>09045000
        stdx.ovfopts := 1;                                     <<01427>>09050000
                                                               <<01245>>09055000
        << check and set aoptions;  return error if needed >>  <<01427>>09060000
        if not access'flag then                                <<01427>>09065000
          begin  << no access specified >>                     <<01427>>09070000
            << force minimum access for $stdx >>               <<01427>>09075000
            if stdx'num = 1 then                               <<01427>>09080000
              parse'aopts.access := read'only    << $stdin >>  <<01427>>09085000
            else                                               <<01427>>09090000
              parse'aopts.access := write'only;  << $stdlist >><<01427>>09095000
          end                                                  <<01427>>09100000
        else                                                   <<01427>>09105000
          begin  << access was specified >>                    <<01427>>09110000
            << check for proper minimum access >>              <<01427>>09115000
            rqstd'access := parse'aopts.access;                <<01427>>09120000
            if stdx'num = 1 then                               <<01427>>09125000
              begin  << $stdin >>                              <<01427>>09130000
                if (write'only <= rqstd'access <= append)      <<01427>>09135000
                   or rqstd'access = execute then              <<01427>>09140000
                  error := -1;                                 <<01427>>09145000
              end                                              <<01427>>09150000
            else                                               <<01427>>09155000
              begin  << $stdlist >>                            <<01427>>09160000
                if rqstd'access = read'only                    <<01427>>09165000
                   or rqstd'access = execute then              <<01427>>09170000
                  error := -1;                                 <<01427>>09175000
              end;                                             <<01427>>09180000
          end << access specified >>;                          <<01427>>09185000
        if not accessmode'flag then                            <<01710>>09190000
          begin                                                <<01710>>09195000
            << force share as default access >>                <<01710>>09200000
            parse'aopts.accessmode := share;                   <<01710>>09205000
          end;                                                 <<01710>>09210000
        if not multi'flag then                                 <<01710>>09215000
          begin                                                <<01710>>09220000
            << force multi-access as default >>                <<01710>>09225000
            parse'aopts.multi := 1;                            <<01710>>09230000
          end;                                                 <<01710>>09235000
        stdx(aopts) := parse'aopts;                            <<01245>>09240000
        stdx.ovaopts := 1;                                     <<01245>>09245000
                                                               <<01245>>09250000
        << for *backref use only name, fopts, and aopts >>     <<01427>>09255000
        if backref or error <> 0 then return;                  <<01710>>09260000
                                                               <<01427>>09265000
        << set remaining options if needed for normal name >>  <<01427>>09270000
        if recsize'flag then                                   <<01245>>09275000
          begin                                                <<01245>>09280000
            stdx(recsize) := parse'recsize;                    <<01245>>09285000
            stdx.ovrecsize := 1;                               <<01245>>09290000
          end;                                                 <<01245>>09295000
                                                               <<01245>>09300000
        if dev'flag then                                       <<01245>>09305000
          begin                                                <<01245>>09310000
            @device := parse'dev;                              <<01245>>09315000
            move stdxdev := device, (parse'devlen);            <<01245>>09320000
            stdxdev(parse'devlen) := cr;                       <<01245>>09325000
            stdx(dev) := @stdxdev;                             <<01245>>09330000
            stdx.ovdev := 1;                                   <<01245>>09335000
          end;                                                 <<01245>>09340000
                                                               <<01245>>09345000
        if formmsg'flags <> 0 then                             <<01245>>09350000
          begin                                                <<01245>>09355000
            @formsmessage := parse'formsmsg;                   <<01245>>09360000
            move stdxforms := formsmessage, (parse'formslen);  <<01245>>09365000
            stdxforms(parse'formslen) := cr;                   <<01245>>09370000
            stdx(formsmsg) := @stdxforms;                      <<01245>>09375000
            stdx.ovformsmsg := 1;                              <<01245>>09380000
          end;                                                 <<01245>>09385000
                                                               <<01245>>09390000
        if ulabels'flag then                                   <<01245>>09395000
          begin                                                <<01245>>09400000
            stdx(userlabels) := parse'ulabels;                 <<01245>>09405000
            stdx.ovulabels := 1;                               <<01245>>09410000
          end;                                                 <<01245>>09415000
                                                               <<01245>>09420000
        if blkfact'flag then                                   <<01245>>09425000
          begin                                                <<01245>>09430000
            stdx(blkfactor) := parse'blkfactor;                <<01245>>09435000
            stdx.ovblkfactor := 1;                             <<01245>>09440000
          end;                                                 <<01245>>09445000
                                                               <<01245>>09450000
        if numbuffs'flag or ncopies'flag or outpri'flag then   <<01245>>09455000
          begin                                                <<01245>>09460000
            stdx(numbuffs).(0:4) := parse'outpri;              <<01245>>09465000
            stdx(numbuffs).(4:7) := parse'ncopies;             <<01245>>09470000
            stdx(numbuffs).(11:5) := parse'numbuffs;           <<01245>>09475000
            stdx.ovnumbuffs := 1;                              <<01245>>09480000
          end;                                                 <<01245>>09485000
                                                               <<01245>>09490000
        if filesize'flag then                                  <<01245>>09495000
          begin                                                <<01245>>09500000
            stdx(filesize1) := parse'fsize1;                   <<01245>>09505000
            stdx(filesize2) := parse'fsize2;                   <<01245>>09510000
            stdx.ovfilesize := 1;                              <<01245>>09515000
          end;                                                 <<01245>>09520000
                                                               <<01245>>09525000
        if nxtents'flag then                                   <<01245>>09530000
          begin                                                <<01245>>09535000
            stdx(numxtents) := parse'numxtents + 1;            <<01245>>09540000
            stdx.ovnumxtents := 1;                             <<01245>>09545000
          end;                                                 <<01245>>09550000
                                                               <<01245>>09555000
        if initalloc'flag then                                 <<01245>>09560000
          begin                                                <<01245>>09565000
            stdx(initalloc) := parse'initalloc + 1;            <<01245>>09570000
            stdx.ovinitalloc := 1;                             <<01245>>09575000
          end;                                                 <<01245>>09580000
                                                               <<01245>>09585000
        if fcode'flag then                                     <<01245>>09590000
          begin                                                <<01245>>09595000
            stdx(fcode) := parse'fcode;                        <<01245>>09600000
            stdx.ovfcode := 1;                                 <<01245>>09605000
          end;                                                 <<01245>>09610000
                                                               <<01245>>09615000
        if dispositn'flag then                                 <<01427>>09620000
          begin                                                <<01245>>09625000
            << place a temporary entry in the file equation >> <<01245>>09630000
            << table so that the disposition is noted by    >> <<01427>>09635000
            << fopen.  entry will be removed from table     >> <<01427>>09640000
            << after new process starts up.                 >> <<01427>>09645000
                                                               <<01245>>09650000
            << build a unique formal designator for file >>    <<01245>>09655000
            move formaldes := "         ";                     <<01245>>09660000
            formaldes := if stdx'num = 1 then "I" else "L";    <<01245>>09665000
          mypin := (curprc)/pcbsize;                           <<06645>>09670000
            deslnth := 1 + ascii (mypin, 10, formaldes(1));    <<01245>>09675000
            ptime := integer(proctime);   << unique time >>    <<01245>>09680000
            << use only last 4 digits of ptime >>              <<01245>>09685000
            ptime := ptime.(3:13);                             <<01245>>09690000
            deslnth := deslnth +                               <<01245>>09695000
                         ascii (ptime, 10, formaldes(deslnth));<<01245>>09700000
                                                               <<01245>>09705000
            << change file name that fopen will use to the  >> <<01245>>09710000
            << unique formal file designator just built     >> <<01245>>09715000
            move stdxname := formaldes, (deslnth);             <<01245>>09720000
            stdxname(deslnth) := cr;                           <<01245>>09725000
                                                               <<01245>>09730000
            << add temporary entry to file eqtn table >>       <<01245>>09735000
            if addjtentry (formaldes, bptr, bptr, -3,          <<01245>>09740000
                           feqtablnth, parsetab) <> 0 then     <<01245>>09745000
              begin  << couldn't add entry - report failure >> <<01245>>09750000
                error := -1;                                   <<01245>>09755000
                move formaldes := "         ";                 <<01245>>09760000
              end;                                             <<01245>>09765000
          end;                                                 <<01245>>09770000
      end << parse succeeded >>;                               <<01245>>09775000
  end << build'stdx >>;                                        <<01245>>09780000
$page "PROCEDURE CREATEPROCESS"                                <<01245>>09785000
procedure createprocess (error, pin, progname, optionnums,     <<01245>>09790000
                         options);                             <<01245>>09795000
<<                                                                      09800000
   function                                                             09805000
     creates a new process on the system given a program file name      09810000
     and a set of options to be used in the creation.  this             09815000
     intrinsic is fully extensible by adding option numbers for new     09820000
     options being defined and the appropriate code to process the      09825000
     new options.                                                       09830000
>>                                                                      09835000
<< inputs >>                                                   <<01245>>09840000
     byte array                                                <<01245>>09845000
       progname;                    << program file name >>    <<01245>>09850000
                                                               <<01245>>09855000
     integer array                                             <<01245>>09860000
       optionnums;                  << option numbers to use >><<01245>>09865000
                                                               <<01245>>09870000
     logical array                                             <<01245>>09875000
       options;                     << corresponding options >><<01245>>09880000
                                                               <<01245>>09885000
<< outputs >>                                                  <<01245>>09890000
     integer                                                   <<01245>>09895000
       error,                       << error return >>         <<01245>>09900000
       pin;                         << pin of new process >>   <<01245>>09905000
                                                               <<01245>>09910000
<< algorithm                                                            09915000
     determine options specified;                                       09920000
     set up values for options;                                         09925000
     get a pcb;                                                         09930000
     load program & format stack global area;                           09935000
     procreate - format pcb, pcbx, and start-up markers;                09940000
     startprocess - activate to open $stdin/$stdlist;                   09945000
     finalize any other options;                                        09950000
>>                                                                      09955000
option variable, privileged;                                   <<01245>>09960000
                                                               <<01245>>09965000
  begin                                                        <<01245>>09970000
                                                               <<01245>>09975000
    << final variables used for calls to load and procreate >> <<01245>>09980000
                                                               <<01245>>09985000
    byte pointer                                               <<01245>>09990000
      entryname,                   << entry point name >>      <<01245>>09995000
      string;                      << string for new process >><<01245>>10000000
                                                               <<01245>>10005000
    logical                                                    <<01245>>10010000
      loadflags,                   << load option flags >>     <<01245>>10015000
      susp;                        << suspend flg - autoact >> <<01245>>10020000
                                                               <<01245>>10025000
    integer                                                    <<01245>>10030000
      parm,                        << passed integer @ q-4 >>  <<01245>>10035000
      stacksize,                   << init q to z >>           <<01245>>10040000
      dlsize,                      << dl to db >>              <<01245>>10045000
      maxdata,                     << max dl to z allowed >>   <<01245>>10050000
      stringlength;                << length of passed strng >><<01245>>10055000
    integer mapflag';                                          <<06099>>10060000
                                                               <<01245>>10065000
    logical array                                              <<01245>>10070000
      stdin(0:14),                 << fopen parms for $stdin >><<01245>>10075000
      stdlist(0:14);               << parms for $stdlist >>    <<01245>>10080000
                                                               <<01245>>10085000
    define                                                     <<01245>>10090000
      activatefather = loadflags.(15:1)#,                      <<01245>>10095000
      nocb           = loadflags.(9:1)#;                       <<01245>>10100000
                                                               <<01245>>10105000
    << *** variables used to determine options specified *** >><<01245>>10110000
                                                               <<01245>>10115000
    integer                                                    <<01245>>10120000
      entryname'indx  := -1,       << index to entry point >>  <<01245>>10125000
      parm'indx       := -1,       << index to parm >>         <<01245>>10130000
      loadflags'indx  := -1,       << index to load flags >>   <<01245>>10135000
      stacksize'indx  := -1,                                   <<01245>>10140000
      dlsize'indx     := -1,                                   <<01245>>10145000
      maxdata'indx    := -1,                                   <<01245>>10150000
      priority'indx   := -1,                                   <<01245>>10155000
      stdin'indx      := -1,                                   <<01245>>10160000
      stdlist'indx    := -1,                                   <<01245>>10165000
      autoact'indx    := -1,                                   <<01245>>10170000
      string'indx     := -1,                                   <<01245>>10175000
      strnglnth'indx  := -1,                                   <<01245>>10180000
      i;                           << loop index >>            <<01245>>10185000
                                                               <<01245>>10190000
    logical                                                    <<01245>>10195000
      endoflist,                   << true if end of optns >>  <<01245>>10200000
      ovmask          = q-4;       << option variable mask >>  <<01245>>10205000
                                                               <<01245>>10210000
    equate                                                     <<01245>>10215000
      maxopts         = 12;        << # of defined options >>  <<01245>>10220000
                                                               <<01245>>10225000
    define                                                     <<01245>>10230000
      nums'but'noopts = (ovmask.(14:2) = %(2)10)#,             <<01245>>10235000
      opts'but'nonums = (ovmask.(14:2) = %(2)01)#,             <<01245>>10240000
      have'options    = (ovmask.(14:2) = %(2)11)#;             <<01245>>10245000
                                                               <<01245>>10250000
    << *** miscellaneous variables for createprocess *** >>    <<01245>>10255000
                                                               <<01245>>10260000
    integer                                                    <<01245>>10265000
      mypcbptr,                    << pcb ptr of caller >>     <<01245>>10270000
      sonpcbptr,                   << pcb ptr of new process >><<01245>>10275000
      sonpin,                      << pin of any son >>        <<mpeiv>>10280000
      mail'status,                 << for result of start-up >><<01245>>10285000
      startup'status,              << for result of start-up >><<01245>>10290000
      startcstnum,                 << 1st cst # of new prcss >><<01245>>10295000
      startdeltap,                 << initial delta p >>       <<01245>>10300000
      stackdst        := 0,        << dst # of new stack >>    <<01245>>10305000
      globalsize,                  << size of db global area >><<01245>>10310000
      file'err,                    << file err in load >>      <<01265>>10315000
      loading'err,                 << error return from load >><<01245>>10320000
      chek'err,                    << error rtrn from chek' >> <<01245>>10325000
      createflags,                 << flags for procreate >>   <<01245>>10330000
      stdx'lnth,                   << stdin/list strng lnth >> <<01245>>10335000
      stdxparse'lnth;              << parse table length >>    <<01245>>10340000
                                                               <<01245>>10345000
    double                                                     <<01245>>10350000
      subq'info;                   << scheduling info >>       <<01245>>10355000
                                                               <<01245>>10360000
    logical                                                    <<01245>>10365000
      dummy,                       << for fcontrol >>          <<01265>>10370000
      critstate,                   << from setcritical >>      <<01245>>10375000
      progcapability,              << prog file capabilities >><<01245>>10380000
      blank           := "  ",     << default entry point >>   <<01245>>10385000
      priority        = subq'info + 1,   << init priority >>   <<01250>>10390000
      final'priority;              << final pri of new prcss >><<01245>>10395000
                                                               <<01245>>10400000
    << *** values for error return from createprocess *** >>   <<01245>>10405000
                                                               <<01245>>10410000
    equate                                                     <<01245>>10415000
      no'error        =   0,       << normal return >>         <<01245>>10420000
      lacks'ph        =   1,       << caller lacks ph cap >>   <<01245>>10425000
      reqdparm'omittd =   2,       << required parm omitted >> <<01245>>10430000
      reqdparm'badadr =   3,       << bad address for parm >>  <<01245>>10435000
      out'of'resos    =   4,       << resource not available >><<01245>>10440000
      invalid'option  =   5,       << option not defined >>    <<01245>>10445000
      unknown'prog    =   6,       << non-existent program >>  <<01245>>10450000
      bad'progfile    =   7,       << invalid program file >>  <<01245>>10455000
      bad'entryname   =   8,       << invalid entry point >>   <<01245>>10460000
      dflt'stacksize  =  -9,       << default stacksize used >><<01245>>10465000
      dflt'dlsize     = -10,       << default dlsize used >>   <<01245>>10470000
      dflt'maxdata    = -11,       << default maxdata used >>  <<01245>>10475000
      dl'rounded      = -12,       << dlsize rounded up >>     <<01245>>10480000
      maxdata'decrsed = -13,       << maxdata decreased >>     <<01245>>10485000
      maxdata'incrsed = -14,       << maxdata increased >>     <<01245>>10490000
      stack'toobig    =  15,       << stack > config max >>    <<01245>>10495000
      hard'load'err   =  16,       << 'hard' loader error >>   <<01245>>10500000
      bad'priority    =  17,       << priority invalid >>      <<01245>>10505000
      invalid'stdin   =  18,       << $stdin invalid >>        <<01245>>10510000
      invalid'stdlist =  19,       << $stdlist invalid >>      <<01245>>10515000
      invalid'string  =  20;       << string spec invalid >>   <<01245>>10520000
                                                               <<01245>>10525000
    << *** definitions for setting $stdin and $stdlist *** >>  <<01245>>10530000
                                                               <<01245>>10535000
    byte array                                                 <<01245>>10540000
      stdin'name(0:35),         << stdin file name >>          <<01245>>10545000
      stdin'dev(0:17),          << stdin device >>             <<01245>>10550000
      stdin'forms(0:78),        << stdin forms message >>      <<01245>>10555000
      stdin'formal(0:8),        << stdin formal desig >>       <<01245>>10560000
      stdlist'name(0:35),       << stdlist file name >>        <<01245>>10565000
      stdlist'dev(0:17),        << stdlist device >>           <<01245>>10570000
      stdlist'forms(0:78),      << stdlist forms message >>    <<01245>>10575000
      stdlist'formal(0:8);      << stdlist formal desig >>     <<01245>>10580000
                                                               <<01245>>10585000
    byte pointer                                               <<01245>>10590000
      stdin'strng,              << local ptr to stdin >>       <<01245>>10595000
      stdlist'strng,            << local ptr to stdlist >>     <<01245>>10600000
      blnkptr         := @blank;<< for xremjtentry >>          <<01245>>10605000
                                                               <<01245>>10610000
    equate                                                     <<01245>>10615000
      linearqueues = %102,                                     <<01245>>10620000
      csubq        = %103,                                     <<01245>>10625000
      dsubq        = %104,                                     <<01245>>10630000
      esubq        = %105;                                     <<01245>>10635000
                                                               <<01245>>10640000
    equate                                                     <<01245>>10645000
      minparsetab'len = 78,     << minimum parse tble size >>  <<01245>>10650000
      termchar        = %16,    << line feed to stop scan >>   <<01245>>10655000
      scanchar        = %15,    << crg return - terminator >>  <<01245>>10660000
      scantest        = [8/termchar, 8/scanchar];              <<01245>>10665000
                                                               <<01245>>10670000
    << *** definitions for error detection by chek'noabort *** >>       10675000
                                                               <<01245>>10680000
    double                                                     <<01254>>10685000
      bounds;                   << stack bounds from chek >>   <<01254>>10690000
                                                               <<01254>>10695000
    integer                                                    <<01254>>10700000
      lower'bound     = bounds,                                <<01254>>10705000
      upper'bound     = bounds + 1;                            <<01254>>10710000
                                                               <<01254>>10715000
    equate                                                     <<01245>>10720000
      intrinsic'num   = 101,                                   <<01245>>10725000
      num'parms       = 5,                                     <<01245>>10730000
      num'parmwords   = num'parms + 1,                         <<01245>>10735000
      errorreturn     = [10/intrinsic'num, 6/num'parmwords],   <<01245>>10740000
      dbatstack       = 0,                                     <<01245>>10745000
      checkflags      = [1/dbatstack, 7/0, 2/0, 1/0, 5/num'parms],      10750000
      parmscheck      = [6/0, 2/2, 2/2, 2/3, 2/2, 2/2],        <<01245>>10755000
      phcap           = 1,                                     <<01245>>10760000
      ovmask'reqd     = %(2)00011,                             <<01245>>10765000
                                                               <<01245>>10770000
      chek'illcap     = 2,                                     <<01245>>10775000
      chek'omittdparm = 3;                                     <<01245>>10780000
                                                               <<01740>>10785000
    << *** definitions for process instrumentation use *** >>  <<01740>>10790000
                                                               <<01740>>10795000
    integer                                                    <<01740>>10800000
      sircond,                   << from getsir for meassir >> <<01740>>10805000
      progfnum,                  << program file number >>     <<01740>>10810000
      pcbglobloc,                                              <<06631>>10815000
      pxfixedloc,                                              <<06631>>10820000
      measprocentsize;           << size of meas entry >>      <<01740>>10825000
                                                               <<01740>>10830000
    logical                                                    <<01740>>10835000
      measprocentptr;            << pointer to meas entry >>   <<01740>>10840000
                                                               <<01740>>10845000
    logical array                                              <<01740>>10850000
      proc'name(0:11);           << formatted process name >>  <<01740>>10855000
                                                               <<01740>>10860000
    byte array                                                 <<01740>>10865000
      proc'name'b(*)  = proc'name,                             <<01740>>10870000
      filename(0:27);            << file name from ffileinfo >><<01740>>10875000
                                                               <<01740>>10880000
                                                               <<01740>>10885000
    << *** definitions for various callers of createprocess ***<<01740>>10890000
                                                               <<01245>>10895000
    define                                                     <<01265>>10900000
      ci'call         = pcb(mypcbptr+                          <<mpeiv>>10905000
                         procstatewordnum.ptypefield) = main#, <<01710>>10910000
      sysprocess'call = (pcb(mypcbptr+                         <<mpeiv>>10915000
                          procstatewordnum).ptypefield > 3)#;  <<mpeiv>>10920000
                                                               <<01427>>10925000
$include inclcis                                               <<04601>>10930000
$page "PROCEDURE CREATEPROCESS"                                <<04601>>10935000
                                                               <<01710>>10940000
    logical                                                    <<01710>>10945000
      old'jcw;                     << jcw before creating >>   <<01710>>10950000
                                                               <<01710>>10955000
    equate                                                     <<01710>>10960000
      stkovflow'jcw   = %140024;   << jcw for stack overflow >><<01710>>10965000
$page                                                          <<01245>>10970000
  << *** subroutines used by createprocess *** >>              <<01245>>10975000
                                                               <<01245>>10980000
    integer subroutine wordaddress' (byteaddress);             <<01254>>10985000
      value byteaddress;                                       <<01254>>10990000
    <<                                                                  10995000
       function                                                         11000000
         returns the word address corresponding to the byte address     11005000
         input parameter.                                               11010000
    >>                                                                  11015000
    << inputs >>                                                        11020000
         logical                                               <<01254>>11025000
           byteaddress;             << contains byte address >><<01254>>11030000
                                                               <<01254>>11035000
    << outputs                                                          11040000
         returns the word address equivalent as function return.        11045000
    >>                                                                  11050000
      begin                                                    <<01254>>11055000
        tos := wordaddress' := byteaddress & lsr(1);           <<01254>>11060000
        push (z);                                              <<01254>>11065000
        if <<woraddress'>> tos > tos <<z>> then                <<01254>>11070000
          wordaddress'.(0:1) := 1;                             <<01254>>11075000
      end << wordaddress >>;                                   <<01254>>11080000
$page                                                          <<01254>>11085000
    logical subroutine boundscheck (address, byteadr);         <<01254>>11090000
      value address, byteadr;                                  <<01254>>11095000
    <<                                                                  11100000
       function                                                         11105000
         checks that the given address is within the bounds of the      11110000
         caller's stack.                                                11115000
    >>                                                                  11120000
    << inputs >>                                                        11125000
    integer                                                    <<01254>>11130000
      address;                  << address to check >>         <<01254>>11135000
                                                               <<01254>>11140000
    logical                                                    <<01254>>11145000
      byteadr;                  << true if address is byte >>  <<01254>>11150000
                                                               <<01254>>11155000
    << outputs                                                          11160000
        returns true if address is within bounds of stack.              11165000
    >>                                                                  11170000
      begin                                                    <<01254>>11175000
        if byteadr then address := wordaddress' (address);     <<01254>>11180000
        if lower'bound <= address <= upper'bound then          <<01254>>11185000
          boundscheck := true                                  <<01254>>11190000
        else                                                   <<01254>>11195000
          boundscheck := false;                                <<01254>>11200000
      end << boundscheck >>;                                   <<01254>>11205000
$page                                                          <<01254>>11210000
    subroutine recover;                                        <<01245>>11215000
    <<                                                                  11220000
       function                                                         11225000
         performs error recovery for all 'hard' errors encountered      11230000
         in createprocess (i.e. where a positive error number is        11235000
         returned).  any resources acquired so far are returned to      11240000
         the system before returning directly to the user (via the      11245000
         call to errorexit).                                            11250000
    >>                                                                  11255000
    << inputs                                                           11260000
         none.  but assumes that parameter error has alreay been        11265000
         set.                                                           11270000
    >>                                                                  11275000
                                                                        11280000
    << outputs                                                          11285000
         none.                                                          11290000
    >>                                                                  11295000
      begin                                                    <<01245>>11300000
        if stdin'formal <> "  " then                           <<01245>>11305000
          xremjtentry (stdin'formal, blnkptr, blnkptr, 3);     <<01245>>11310000
        if stdlist'formal <> "  " then                         <<01245>>11315000
          xremjtentry (stdlist'formal, blnkptr, blnkptr, 3);   <<01245>>11320000
                                                               <<01245>>11325000
        if stackdst <> 0 then                                  <<01245>>11330000
          begin                                                <<01245>>11335000
            << since load was successful, there is a process >><<01245>>11340000
                                                               <<01245>>11345000
            pdisable;                                          <<01245>>11350000
            set'psif (sonpcbptr, softkill);                    <<01245>>11355000
            << awake & wait will penable >>                    <<01245>>11360000
            awake (sonpcbptr, fatherwait, mourningwait);       <<01245>>11365000
            << the new process is now all but gone >>          <<01245>>11370000
            burryproc (sonpcbptr);                             <<01245>>11375000
            resetcritical (critstate);                         <<01245>>11380000
          end                                                  <<01245>>11385000
        else if pin <> 0 then                                  <<01245>>11390000
          begin                                                <<01245>>11395000
            << need only return the pcb >>                     <<01245>>11400000
                                                               <<01245>>11405000
              returnentry(pcbb,pin);                           <<06645>>11410000
            resetcritical (critstate);                         <<01245>>11415000
          end;                                                 <<01245>>11420000
                                                               <<01245>>11425000
        pin := 0;                                              <<01245>>11430000
        conditioncode := ccl;                                  <<01245>>11435000
        errorexit (errorreturn, 0, 0);                         <<01245>>11440000
      end << recover >>;                                       <<01245>>11445000
$page                                                          <<01245>>11450000
    subroutine figure'options;                                 <<01245>>11455000
    <<                                                                  11460000
       function                                                         11465000
         determines which options the caller has selected to be used    11470000
         in creating the new process.                                   11475000
    >>                                                                  11480000
    << inputs                                                           11485000
         none.  but the arrays optionnums and options are scanned to    11490000
         determine the desired options.                                 11495000
    >>                                                                  11500000
    << outputs                                                          11505000
         none.  but the option index variables (e.g. stdin'indx) are    11510000
         set to indicate where in the options array the various         11515000
         options are to be found.                                       11520000
         the option index variables (e.g. stdin'indx) are set to        11525000
         indicate where in the options array the various options        11530000
         are to be found.                                               11535000
    >>                                                                  11540000
      begin                                                    <<01245>>11545000
                                                               <<01245>>11550000
        i := 0;   endoflist := false;                          <<01245>>11555000
        while i <= maxopts and not endoflist do                <<01245>>11560000
          begin                                                <<01245>>11565000
            if not (0 <= optionnums(i) <= maxopts)             <<01245>>11570000
              then endoflist := true                           <<01245>>11575000
            else                                               <<01245>>11580000
              case *optionnums(i) of                           <<01245>>11585000
                begin                                          <<01245>>11590000
                  endoflist := true;                           <<01245>>11595000
                                                               <<01245>>11600000
                  if entryname'indx <> -1 then endoflist := true        11605000
                    else entryname'indx := i;                  <<01245>>11610000
                                                               <<01245>>11615000
                  if parm'indx <> -1 then endoflist := true    <<01245>>11620000
                    else parm'indx := i;                       <<01245>>11625000
                                                               <<01245>>11630000
                  if loadflags'indx <> -1 then endoflist := true        11635000
                    else loadflags'indx := i;                  <<01245>>11640000
                                                               <<01245>>11645000
                  if stacksize'indx <> -1 then endoflist := true        11650000
                    else stacksize'indx := i;                  <<01245>>11655000
                                                               <<01245>>11660000
                  if dlsize'indx <> -1 then endoflist := true  <<01245>>11665000
                    else dlsize'indx := i;                     <<01245>>11670000
                                                               <<01245>>11675000
                  if maxdata'indx <> -1 then endoflist := true <<01245>>11680000
                    else maxdata'indx := i;                    <<01245>>11685000
                                                               <<01245>>11690000
                  if priority'indx <> -1 then endoflist := true<<01245>>11695000
                    else priority'indx := i;                   <<01245>>11700000
                                                               <<01245>>11705000
                  if stdin'indx <> -1 then endoflist := true   <<01245>>11710000
                    else stdin'indx := i;                      <<01245>>11715000
                                                               <<01245>>11720000
                  if stdlist'indx <> -1 then endoflist := true <<01245>>11725000
                    else stdlist'indx := i;                    <<01245>>11730000
                                                               <<01245>>11735000
                  if autoact'indx <> -1 then endoflist := true <<01245>>11740000
                    else autoact'indx := i;                    <<01245>>11745000
                                                               <<01245>>11750000
                  if string'indx <> -1 then endoflist := true  <<01245>>11755000
                    else string'indx := i;                     <<01245>>11760000
                                                               <<01245>>11765000
                  if strnglnth'indx <> -1 then endoflist := true        11770000
                    else strnglnth'indx := i;                  <<01245>>11775000
                end << case >>;                                <<01245>>11780000
                                                               <<01245>>11785000
            i := i + 1;                                        <<01245>>11790000
          end << while >>;                                     <<01245>>11795000
                                                               <<01245>>11800000
        if optionnums(i-1) <> 0 then error := invalid'option;  <<01245>>11805000
      end << figure'options >>;                                <<01245>>11810000
$page                                                          <<01245>>11815000
    subroutine set'loadoptns;                                  <<01245>>11820000
    <<                                                                  11825000
       function                                                         11830000
         sets the values (default or user specified) for all variables  11835000
         involved in loading the program for the new process.           11840000
    >>                                                                  11845000
    << inputs                                                           11850000
         none.                                                          11855000
    >>                                                                  11860000
    << outputs                                                          11865000
         none.                                                          11870000
    >>                                                                  11875000
      begin                                                    <<01245>>11880000
        if loadflags'indx = -1 then loadflags := 0             <<01245>>11885000
          else loadflags := options(loadflags'indx);           <<01245>>11890000
                                                               <<01245>>11895000
        if stacksize'indx = -1 then stacksize := -1            <<01245>>11900000
          else stacksize := options(stacksize'indx);           <<01245>>11905000
                                                               <<01245>>11910000
        if dlsize'indx = -1 then dlsize := -1                  <<01245>>11915000
          else dlsize := options(dlsize'indx);                 <<01245>>11920000
                                                               <<01245>>11925000
        if maxdata'indx = -1 then maxdata := -1                <<01245>>11930000
          else maxdata := options(maxdata'indx);               <<01245>>11935000
                                                               <<01254>>11940000
        if entryname'indx = -1 then @entryname := @blank&lsl(1)<<01254>>11945000
        else                                                   <<01254>>11950000
          begin  << entry name specified >>                    <<01254>>11955000
            @entryname := options(entryname'indx);             <<01254>>11960000
            if not boundscheck (@entryname, true) then         <<01254>>11965000
              error := bad'entryname;                          <<01254>>11970000
          end;                                                 <<01254>>11975000
      end << set'loadoptns >>;                                 <<01245>>11980000
                                                               <<01245>>11985000
                                                               <<01245>>11990000
                                                               <<01245>>11995000
    subroutine set'parmoptn;                                   <<01245>>12000000
    <<                                                                  12005000
       function                                                         12010000
         sets the value (default or user specified) for parameter to    12015000
         be passed to the new process.                                  12020000
    >>                                                                  12025000
    << inputs                                                           12030000
         none.                                                          12035000
    >>                                                                  12040000
    << outputs                                                          12045000
         none.                                                          12050000
    >>                                                                  12055000
      begin                                                    <<01245>>12060000
        if parm'indx =-1 then parm := 0                        <<01245>>12065000
          else parm := options(parm'indx);                     <<01245>>12070000
      end << set'parmoptn >>;                                  <<01245>>12075000
                                                               <<01245>>12080000
                                                               <<01245>>12085000
                                                               <<01245>>12090000
    subroutine set'autoactoptn;                                <<01245>>12095000
    <<                                                                  12100000
       function                                                         12105000
         sets the value for the susp parameter for the automatic        12110000
         activation option.  susp, if non-zero, indicates that the      12115000
         calling process is to be suspended when the new process is     12120000
         activated upon creation completion.  the value indicates       12125000
         the anticipated source of re-activation.                       12130000
    >>                                                                  12135000
    << inputs                                                           12140000
         none.                                                          12145000
    >>                                                                  12150000
    << outputs                                                          12155000
         none.                                                          12160000
    >>                                                                  12165000
      begin                                                    <<01245>>12170000
        if autoact'indx = -1 then susp := 0                    <<01245>>12175000
          else susp := options(autoact'indx).(14:2);           <<01245>>12180000
      end << set'autoactoptn >>;                               <<01245>>12185000
$page                                                          <<01245>>12190000
    subroutine set'prioptn;                                    <<01245>>12195000
    <<                                                                  12200000
       function                                                         12205000
         sets the value (default or user specified) for the priority    12210000
         of the new process.                                            12215000
    >>                                                                  12220000
    << inputs                                                           12225000
         none.                                                          12230000
    >>                                                                  12235000
    << outputs                                                          12240000
         none.                                                          12245000
    >>                                                                  12250000
      begin                                                    <<01245>>12255000
        << initially give new process same priority as creating >>      12260000
        << process so as to avoid having to wait creating       >>      12265000
        << process for a possibly lower priority son.           >>      12270000
              mypcbptr := curprc;                              <<06645>>12275000
        tos := pcb(mypcbptr+queueinginfowordnum);              <<mpeiv>>12280000
                                                               <<01245>>12285000
        << note that setting subq'info also sets priority >>   <<01245>>12290000
        if logical(s0.eschedflag)                              <<mpeiv>>12295000
          then subq'info := subqueue (4, esubq)                <<01245>>12300000
        else if logical(s0.dschedflag)                         <<mpeiv>>12305000
          then subq'info := subqueue (4, dsubq)                <<01245>>12310000
        else if logical(s0.cschedflag)                         <<mpeiv>>12315000
          then subq'info := subqueue (4, csubq)                <<01245>>12320000
        else                                                   <<01245>>12325000
          begin                                                <<01245>>12330000
            subq'info := subqueue (4, linearqueues);           <<01245>>12335000
            priority.prifield :=                               <<mpeiv>>12340000
                 pcb(mypcbptr+queueinginfowordnum).prifield;   <<mpeiv>>12345000
          end;                                                 <<01245>>12350000
        del;   << my priority >>                               <<01245>>12355000
                                                               <<01245>>12360000
        if priority'indx = -1 then                             <<01245>>12365000
          final'priority := priority                           <<01245>>12370000
        else                                                   <<01245>>12375000
          begin  << priority specified by caller>>             <<01245>>12380000
            final'priority:=checkpriority (options(priority'indx), 0);  12385000
            if < then error := bad'priority;                   <<01245>>12390000
          end;                                                 <<01245>>12395000
                                                               <<mpeiv>>12400000
         tos := final'priority;                                <<mpeiv>>12405000
         if logical(s0.eq) then                                <<mpeiv>>12410000
           final'priority.qtype := %(2)0001                    <<mpeiv>>12415000
         else if logical(s0.dq) then                           <<mpeiv>>12420000
           final'priority.qtype := %(2)0010                    <<mpeiv>>12425000
         else if logical(s0.cq) then                           <<mpeiv>>12430000
           final'priority.qtype := %(2)0100                    <<mpeiv>>12435000
         else                                                  <<mpeiv>>12440000
           final'priority.qtype := %(2)1000;                   <<mpeiv>>12445000
         del;   << priority word >>                            <<mpeiv>>12450000
      end << set'priorityoptn >>;                              <<01245>>12455000
$page                                                          <<01245>>12460000
    subroutine set'stdxoptns;                                  <<01245>>12465000
    <<                                                                  12470000
       function                                                         12475000
         sets the values (default or user specified) for $stdin and     12480000
         $stdlist for the new process.  the arrays specifying           12485000
         each file are simply the 14 words of fopen parameters          12490000
         plus the option variable mask.                                 12495000
    >>                                                                  12500000
    << inputs                                                           12505000
         none.                                                          12510000
    >>                                                                  12515000
    << outputs                                                          12520000
         none.                                                          12525000
    >>                                                                  12530000
      begin                                                    <<01245>>12535000
        @stdin'strng := options(stdin'indx);                   <<01254>>12540000
        @stdlist'strng := options(stdlist'indx);               <<01254>>12545000
                                                               <<01245>>12550000
        if stdin'indx = -1 then                                <<01245>>12555000
          inherit'stdx (error, stdin, 1, stdin'name,           <<01710>>12560000
                        stdin'dev)                             <<01710>>12565000
        else if not boundscheck (@stdin'strng, true) then      <<01254>>12570000
          error := invalid'stdin                               <<01254>>12575000
        else                                                   <<01245>>12580000
          begin  << set specified $stdin values >>             <<01245>>12585000
            << determine length of string >>                   <<01245>>12590000
            tos := termchar;     << scan no farther than tos >><<01245>>12595000
            scan stdin'strng until scantest, 1;                <<01245>>12600000
            if carry then                                      <<01245>>12605000
              begin  << didn't find cr >>                      <<01245>>12610000
                ddel;   << stopper & ptr >>                    <<01245>>12615000
                error := invalid'stdin;                        <<01245>>12620000
              end                                              <<01245>>12625000
            else                                               <<01245>>12630000
              begin  << found terminating cr >>                <<01245>>12635000
                stdx'lnth := @stdin'strng - tos + 1;           <<01245>>12640000
                del;   << stopper >>                           <<01245>>12645000
                if (stdx'lnth + 1)/2 > minparsetab'len then    <<01245>>12650000
                  stdxparse'lnth := (stdx'lnth + 1)/2          <<01245>>12655000
                else                                           <<01245>>12660000
                  stdxparse'lnth := minparsetab'len;           <<01245>>12665000
                build'stdx (error, stdin, 1, stdin'strng,      <<01245>>12670000
                            stdx'lnth, stdxparse'lnth,         <<01245>>12675000
                            stdin'name, stdin'dev,             <<01245>>12680000
                            stdin'forms, stdin'formal);        <<01245>>12685000
              end;                                             <<01245>>12690000
          end << non-default stdin >>;                         <<01245>>12695000
        if error <> no'error then                              <<01796>>12700000
          begin                                                <<01796>>12705000
            if sysprocess'call then                            <<01796>>12710000
              error := no'error                                <<01796>>12715000
            else                                               <<01796>>12720000
              error := invalid'stdin;                          <<01796>>12725000
          end;                                                 <<01796>>12730000
                                                               <<01245>>12735000
        if error = no'error then                               <<01245>>12740000
          begin                                                <<01245>>12745000
            if stdlist'indx = -1 then                          <<01245>>12750000
              inherit'stdx (error, stdlist, 2, stdlist'name,   <<01710>>12755000
                            stdlist'dev)                       <<01710>>12760000
            else if not boundscheck (@stdlist'strng, true) then<<01254>>12765000
              error := invalid'stdlist                         <<01254>>12770000
            else                                               <<01245>>12775000
              begin  << set specified $stdlist values >>       <<01245>>12780000
                << determine length of string >>               <<01245>>12785000
                tos := termchar; << scan no farther than tos >><<01245>>12790000
                scan stdlist'strng until scantest, 1;          <<01245>>12795000
                if carry then                                  <<01245>>12800000
                  begin  << didn't find cr >>                  <<01245>>12805000
                    ddel;   << stopper & ptr >>                <<01245>>12810000
                    error := invalid'stdlist;                  <<01245>>12815000
                  end                                          <<01245>>12820000
                else                                           <<01245>>12825000
                  begin  << found terminating cr >>            <<01245>>12830000
                    stdx'lnth := @stdlist'strng - tos + 1;     <<01245>>12835000
                    del;   << stopper >>                       <<01245>>12840000
                    if (stdx'lnth + 1)/2 > minparsetab'len then<<01245>>12845000
                      stdxparse'lnth := (stdx'lnth + 1)/2      <<01245>>12850000
                    else                                       <<01245>>12855000
                      stdxparse'lnth := minparsetab'len;       <<01245>>12860000
                    build'stdx (error, stdlist, 2,             <<01245>>12865000
                                stdlist'strng, stdx'lnth,      <<01245>>12870000
                                stdxparse'lnth, stdlist'name,  <<01245>>12875000
                                stdlist'dev, stdlist'forms,    <<01245>>12880000
                                stdlist'formal);               <<01245>>12885000
                  end;                                         <<01245>>12890000
              end << non-default stdlist >>;                   <<01245>>12895000
            if error <> no'error then                          <<01796>>12900000
              begin                                            <<01796>>12905000
                if sysprocess'call then                        <<01796>>12910000
                  error := no'error                            <<01796>>12915000
                else                                           <<01796>>12920000
                  error := invalid'stdlist;                    <<01796>>12925000
              end;                                             <<01796>>12930000
          end;                                                 <<01245>>12935000
      end << set'stdxoptns >>;                                 <<01245>>12940000
$page                                                          <<01245>>12945000
    subroutine set'stringoptn;                                 <<01245>>12950000
    <<                                                                  12955000
       function                                                         12960000
         sets the value (default or user specified) for the string      12965000
         to be passed to the new process.                               12970000
    >>                                                                  12975000
    << inputs                                                           12980000
         none.                                                          12985000
    >>                                                                  12990000
    << outputs                                                          12995000
         none.                                                          13000000
    >>                                                                  13005000
      begin                                                    <<01245>>13010000
        if string'indx = -1 and strnglnth'indx <> -1           <<01245>>13015000
          or strnglnth'indx = -1 and string'indx <> -1         <<01245>>13020000
            then error := invalid'string                       <<01245>>13025000
                                                               <<01245>>13030000
        else if string'indx = -1 then                          <<01245>>13035000
          begin  << assign defaults >>                         <<01245>>13040000
            @string := 0;                                      <<01245>>13045000
            stringlength := 0;                                 <<01245>>13050000
          end                                                  <<01245>>13055000
                                                               <<01245>>13060000
        else                                                   <<01245>>13065000
          begin  << assign specified values, if ok >>          <<01245>>13070000
            if integer(options(strnglnth'indx)) < 0 or                  13075000
               integer(options(strnglnth'indx))                <<01254>>13080000
                               > upper'bound - lower'bound     <<01254>>13085000
              then error := invalid'string                     <<01245>>13090000
            else                                               <<01245>>13095000
              begin                                            <<01245>>13100000
                @string := options(string'indx);               <<01245>>13105000
                stringlength := options(strnglnth'indx);       <<01245>>13110000
              if not boundscheck (@string, true) then          <<01254>>13115000
                error := invalid'string;                       <<01254>>13120000
              end;                                             <<01245>>13125000
          end;                                                 <<01245>>13130000
      end << set'stringoptns >>;                               <<01245>>13135000
$page                                                          <<01245>>13140000
    subroutine setup'options;                                  <<01245>>13145000
    <<                                                                  13150000
       function                                                         13155000
         calls all other subroutines to set the initial values          13160000
         (default or user specified) for the various options            13165000
         possible in createprocess.                                     13170000
    >>                                                                  13175000
    << inputs                                                           13180000
         none.                                                          13185000
    >>                                                                  13190000
    << outputs                                                          13195000
         none.                                                          13200000
    >>                                                                  13205000
      begin                                                    <<01245>>13210000
        << options which will not result in errors >>          <<01245>>13215000
        set'parmoptn;                                          <<01245>>13220000
                                                               <<01245>>13225000
        set'autoactoptn;                                       <<01245>>13230000
                                                               <<01245>>13235000
        << options which may be specified incorrectly >>       <<01245>>13240000
        set'prioptn;                                           <<01245>>13245000
                                                               <<01254>>13250000
        if error = no'error then set'loadoptns;                <<01254>>13255000
                                                               <<01245>>13260000
        if error = no'error then set'stdxoptns;                <<01245>>13265000
                                                               <<01245>>13270000
        if error = no'error then set'stringoptn;               <<01245>>13275000
      end << setup'options >>;                                 <<01245>>13280000
$page                                                          <<01245>>13285000
    logical subroutine son'still'there;                        <<01427>>13290000
    <<                                                                  13295000
       function                                                         13300000
         determines whether the process undergoing creation             13305000
         still exists or is gone (i.e. was aborted).                    13310000
    >>                                                                  13315000
    << inputs                                                           13320000
         none.                                                          13325000
    >>                                                                  13330000
    << outputs                                                          13335000
         returns true if the new son still exists in the                13340000
         creating process's structure.                                  13345000
    >>                                                                  13350000
      begin                                                    <<01427>>13355000
        pdisable;     << startprocess will penable again >>    <<01427>>13360000
                                                               <<01427>>13365000
        sonpin :=                                              <<mpeiv>>13370000
          pcb(mypcbptr+soninfowordnum)/pcbsize;                <<06645>>13375000
                                                               <<01427>>13380000
        while sonpin <> 0 and sonpin <> pin do                 <<01427>>13385000
          sonpin := pcb(sonpin*pcbsize+                        <<mpeiv>>13390000
                          brotherinfowordnum)/pcbsize;         <<06645>>13395000
                                                               <<01427>>13400000
        son'still'there := if sonpin = pin then true           <<01427>>13405000
                             else false;                       <<01427>>13410000
      end << son'still'there >>;                               <<01427>>13415000
$page                                                          <<01427>>13420000
    subroutine startprocess;                                   <<01245>>13425000
    <<                                                                  13430000
       function                                                         13435000
         starts a process by forcing it to go through initiate          13440000
         which opens $stdin and $stdlist for the process.  the          13445000
         new process will send a message (via pseudo mail) to the       13450000
         creating process indicating the success or failure of the      13455000
         opens on the standard files.                                   13460000
    >>                                                                  13465000
    << inputs                                                           13470000
         none.                                                          13475000
    >>                                                                  13480000
    << outputs                                                          13485000
         none.                                                          13490000
    >>                                                                  13495000
      begin                                                    <<01245>>13500000
        init'pseudomail (pin);                                 <<01427>>13505000
                                                               <<01427>>13510000
        if ci'call and not cis'udcnobreakopt then              <<04601>>13515000
          fcontrol (1, disablebreak, dummy);                   <<01265>>13520000
                                                               <<01427>>13525000
        << save current jcw for possible use later >>          <<01710>>13530000
        old'jcw := getjcw;                                     <<01710>>13535000
                                                               <<01710>>13540000
       << set son critical; reset after initiate. >>           <<01870>>13545000
       pcb(sonpcbptr).critflag := 1;                           <<01870>>13550000
       << start up son... >>                                   <<01870>>13555000
        awake (sonpcbptr, fatherwait, junk'sonwait);           <<01427>>13560000
                                                               <<01245>>13565000
        recv'pseudomail (pin, startup'status);                 <<01245>>13570000
                                                               <<01245>>13575000
        while son'still'there and startup'status < 0 do        <<01427>>13580000
          begin  << a terminating son woke us instead >>       <<01427>>13585000
            << son'still'there pdisabled - wait will penable >><<01427>>13590000
            wait (-junk'sonwait, 0);                           <<01427>>13595000
            pdisable;                                          <<*7820>>13600000
            recv'pseudomail (pin, startup'status);             <<01245>>13605000
          end;                                                 <<01245>>13610000
                                                               <<01245>>13615000
        penable;                                               <<01427>>13620000
                                                               <<01427>>13625000
        if ci'call and not cis'udcnobreakopt then              <<04601>>13630000
          fcontrol (1, enablebreak, dummy);                    <<01265>>13635000
                                                               <<01427>>13640000
        free'pseudomail (pin);                                 <<01245>>13645000
                                                               <<01427>>13650000
        if \startup'status\ = 1 then                           <<01427>>13655000
          error := invalid'stdin                               <<01427>>13660000
        else if \startup'status\ = 2 then                      <<01427>>13665000
          error := invalid'stdlist;                            <<01427>>13670000
                                                               <<01427>>13675000
        if startup'status < 0 then                             <<01427>>13680000
          begin  << fopen caused new process to abort >>       <<01427>>13685000
            stackdst := 0;                                     <<01427>>13690000
            pin := 0;                                          <<01427>>13695000
            << aborted process has set jcw to fatal error. >>  <<01710>>13700000
            << reset it to prior value if the current jcw  >>  <<01710>>13705000
            << does, in fact, indicate stackoverflow.      >>  <<01710>>13710000
            << note that a window exists here where a the  >>  <<01710>>13715000
            << jcw can be reset over an error caused by a  >>  <<01710>>13720000
            << different process.                          >>  <<01710>>13725000
            if getjcw = stkovflow'jcw then                     <<01710>>13730000
              setjcw (old'jcw);                                <<01710>>13735000
            resetcritical (critstate);                         <<01427>>13740000
          end;                                                 <<01427>>13745000
      end << startprocess >>;                                  <<01245>>13750000
$page                                                          <<01740>>13755000
    subroutine record'create;                                  <<01740>>13760000
    comment                                                    <<01740>>13765000
       function                                                <<01740>>13770000
         records certain statistics at create-time in the      <<01740>>13775000
         entry for the new process in the data segment for     <<01740>>13780000
         global process level instrumentation.  note that      <<01740>>13785000
         this is done only if global process instrumentation   <<01740>>13790000
         is enabled.                                           <<01740>>13795000
                                                               <<01740>>13800000
       inputs                                                  <<01740>>13805000
         none.                                                 <<01740>>13810000
                                                               <<01740>>13815000
       outputs                                                 <<01740>>13820000
         none.  but the entry in the process instrumentation   <<01740>>13825000
         data segment corresponding to the new process (pin)   <<01740>>13830000
         is initialized and filled with several pieces of      <<01740>>13835000
         information.                                          <<01740>>13840000
    ;                                                          <<01740>>13845000
      begin                                                    <<01740>>13850000
        << get program file name in proper format >>           <<04503>>13855000
        proc'name := "  ";        << set name to blanks >>     <<04503>>13860000
        move proc'name(1) := proc'name, (11);                  <<04503>>13865000
        filename := " ";                                       <<04503>>13870000
        move filename(1) := filename, (27);                    <<04503>>13875000
        progfnum := fopen (progname, %2003, %767);             <<04503>>13880000
        if < then  << couldn't open program file >>            <<04503>>13885000
          move proc'name := "UNAVAIL"                          <<04503>>13890000
        else                                                   <<04503>>13895000
          begin  << opened program file ok >>                  <<04503>>13900000
            ffileinfo (progfnum, 1, filename);                 <<04503>>13905000
            << move prog file name into buffer >>              <<04503>>13910000
            move proc'name'b := filename while an, 0;          <<04503>>13915000
            delb;                 << remove destination ptr >> <<04503>>13920000
            tos := tos + 1;       << ignore '.' >>             <<04503>>13925000
            << move group name into buffer >>                  <<04503>>13930000
            move proc'name'b(8) := * while an, 0;              <<04503>>13935000
            delb;                 << remove destination ptr >> <<04503>>13940000
            tos := tos + 1;       << ignore '.' >>             <<04503>>13945000
            << move account name into buffer >>                <<04503>>13950000
            move proc'name'b(16) := * while an;                <<04503>>13955000
            fclose (progfnum,0,0);                             <<04503>>13960000
          end;                                                 <<04503>>13965000
                                                               <<04503>>13970000
          sircond := getsir ( meassir );                       <<04503>>13975000
      if gclassenabledmask.class15 then                        <<*7910>>13980000
      begin                                                    <<*7910>>13985000
        << get pointer to appropriate entry >>                 <<01740>>13990000
        tos := measprocxdsbank;                                <<01740>>13995000
        tos := measprocxdsbase;                                <<01740>>14000000
        assemble (lsea);          << get entry size >>         <<01740>>14005000
        measprocentsize := tos;   << remember entry size >>    <<01740>>14010000
        tos := pin * measprocentsize;   << offset to entry >>  <<01740>>14015000
        assemble (ladd);          << absolute ptr to entry >>  <<01740>>14020000
        measprocentptr := s0;     << remember entry pointer >> <<01740>>14025000
                                                               <<01740>>14030000
        << initialize entry with 0s >>                         <<01740>>14035000
        i := 0;                                                <<01740>>14040000
        while (i := i + 1) <= measprocentsize do               <<01740>>14045000
          begin                                                <<01740>>14050000
            tos := 0;                                          <<01740>>14055000
            assemble (ssea);      << clear the word >>         <<01740>>14060000
            tos := tos + 1;       << ptr to next word to 0 >>  <<01740>>14065000
          end;                                                 <<01740>>14070000
                                                               <<01740>>14075000
        << fill in create time >>                              <<01740>>14080000
        s0 := measprocentptr + logical(cp'createtime);         <<01740>>14085000
        tos := timer;             << double word time stamp >> <<01740>>14090000
        assemble (sdea);      << place create time in entry >> <<01740>>14095000
                                                               <<01740>>14100000
        << get ptr to job/session num in pcbx >>               <<01740>>14105000
        pxfixed;                                               <<06631>>14110000
                                                               <<01740>>14115000
        << fill in job/session number >>                       <<01740>>14120000
        s0 := measprocentptr + logical(cp'jobsessionnum);      <<01740>>14125000
        tos := pxfxjobnum;    << j/s num in pcbx >>            <<06631>>14130000
        assemble (ssea);          << place j/s num in entry >> <<01740>>14135000
                                                               <<01740>>14140000
        << fill in queue descriptor word >>                    <<01740>>14145000
        s0 := measprocentptr + logical(cp'procquestopword);    <<01740>>14150000
        tos := 0;                                              <<01740>>14155000
        s0.(0:4) := pcb(pin*pcbsize+queueinginfowordnum).qtype;<<01740>>14160000
        assemble (ssea);      << place queue word in entry >>  <<01740>>14165000
                                                               <<01740>>14170000
        ddel;                     << xds bank & address >>     <<01740>>14175000
        << fill in program file name >>                        <<01740>>14180000
        tos := measprocxdsnum;                                 <<01740>>14185000
        tos := measprocentptr - measprocxdsbase;   << offset >><<01740>>14190000
        tos := tos + logical(cp'progname);                     <<01740>>14195000
        tos := @proc'name;                                     <<01740>>14200000
        tos := 12;                                             <<01740>>14205000
        assemble (mtds);          << place name in entry >>    <<01740>>14210000
      end;                                                     <<*7910>>14215000
    relsir (meassir, sircond);                                 <<04503>>14220000
      end << record'create >>;                                 <<01740>>14225000
$page                                                          <<01245>>14230000
    << createprocess >>                                        <<01245>>14235000
    force'stkovflow;                                           <<01245>>14240000
    erroron;                                                   <<01245>>14245000
    bounds := chek'noabort (errorreturn, checkflags,           <<01254>>14250000
                            parmscheck d, phcap d,             <<01254>>14255000
                            ovmask'reqd);                      <<01254>>14260000
    if < then                                                  <<01245>>14265000
      begin  << an error from chek >>                          <<01245>>14270000
        chek'err := errorget (1).(8:8);                        <<01245>>14275000
        if chek'err = chek'illcap then                         <<01245>>14280000
          error := lacks'ph                                    <<01245>>14285000
        else if chek'err = chek'omittdparm then                <<01245>>14290000
          error := reqdparm'omittd                             <<01245>>14295000
        else                                                   <<01245>>14300000
          error := reqdparm'badadr;                            <<01245>>14305000
        conditioncode := ccl;                                  <<01245>>14310000
        errorexit (errorreturn, 0, 0);                         <<01245>>14315000
      end;                                                     <<01245>>14320000
                                                               <<01245>>14325000
    error := no'error;   pin := 0;   conditioncode := cce;     <<01245>>14330000
    move stdin'formal := "         ";                          <<01245>>14335000
    move stdlist'formal := "         ";                        <<01245>>14340000
                                                               <<01245>>14345000
    if nums'but'noopts or opts'but'nonums then                 <<01245>>14350000
      error := invalid'option                                  <<01245>>14355000
    else if have'options then                                  <<01245>>14360000
      figure'options;                                          <<01245>>14365000
                                                               <<01245>>14370000
    if error = invalid'option then recover                     <<01245>>14375000
      else setup'options;                                      <<01245>>14380000
                                                               <<01245>>14385000
    if error <> no'error then recover                          <<01245>>14390000
    else                                                       <<01245>>14395000
      begin  << get a pcb >>                                   <<01245>>14400000
        critstate := setcritical;                              <<01245>>14405000
          pin := getentry(pcbb);                               <<06645>>14410000
        sonpcbptr := pin * pcbsize;                            <<01268>>14415000
      end;                                                     <<01245>>14420000
                                                               <<01245>>14425000
    if pin = 0 then                                            <<01245>>14430000
      begin  << couldn't get a pcb right now >>                <<01245>>14435000
        error := out'of'resos;                                 <<01245>>14440000
        resetcritical (critstate);                             <<01254>>14445000
        recover;                                               <<01245>>14450000
      end                                                      <<01245>>14455000
    else                                                       <<01245>>14460000
      load (progname, entryname, startcstnum, startdeltap,     <<01245>>14465000
            stackdst, pin, loadflags, pcbxsize, dlsize,        <<01245>>14470000
            stacksize, maxdata, globalsize, string,            <<01245>>14475000
           stringlength,progcapability,mapflag');              <<06099>>14480000
                                                               <<01245>>14485000
    if < then                                                  <<01245>>14490000
      begin  << load failed >>                                 <<01245>>14495000
        loading'err := errorget (1);                           <<01245>>14500000
        if loading'err = lerr53 then                           <<01265>>14505000
          begin  << error opening prog file >>                 <<01265>>14510000
            file'err := errorget(2);                           <<01265>>14515000
            if fserr50 <= file'err <= fserr53 then             <<01265>>14520000
              error := unknown'prog                            <<01265>>14525000
            else                                               <<01265>>14530000
              error := hard'load'err;                          <<01265>>14535000
          end                                                  <<01265>>14540000
        else if loading'err = lerr34 or loading'err = lerr31   <<01245>>14545000
          then error := bad'progfile                           <<01245>>14550000
        else if loading'err = lerr21 or loading'err = lerr45   <<01245>>14555000
          then error := bad'entryname                          <<01245>>14560000
        else if loading'err = lerr35 or loading'err = lerr36   <<01245>>14565000
          then error := stack'toobig                           <<01245>>14570000
        else                                                   <<01245>>14575000
          error := hard'load'err;                              <<01245>>14580000
        recover;                                               <<01245>>14585000
      end                                                      <<01245>>14590000
    else                                                       <<01245>>14595000
      begin  << load succeeded >>                              <<01245>>14600000
                                                               <<01245>>14605000
        if > then                                              <<01245>>14610000
          begin                                                <<01245>>14615000
            << load returns the actual warning >>              <<01245>>14620000
            error := errorget (1);                             <<01245>>14625000
            conditioncode := ccg;                              <<01245>>14630000
          end;                                                 <<01245>>14635000
                                                               <<01245>>14640000
        createflags := (loadflags land %177004) lor            <<01245>>14645000
                         progcapability;                       <<01245>>14650000
        if nocb then createflags.(11:1) := 1;                  <<01245>>14655000
                                                               <<01245>>14660000
        << set 'father activate' flag so that creating      >> <<01427>>14665000
        << process will be awakened if new process aborts   >> <<01427>>14670000
        << during fopen of $stdin or $stdlist.              >> <<01427>>14675000
        if not sysprocess'call then createflags.(4:1) := 1;    <<01427>>14680000
                                                               <<01427>>14685000
        if logicalmapping then startdeltap.mapflag:=mapflag';  <<06099>>14690000
        procreate (pin, startcstnum, startdeltap, stackdst,    <<01245>>14695000
                   globalsize, dlsize, stacksize, priority,    <<01245>>14700000
                   @string, stringlength, parm, createflags,   <<01245>>14705000
                   maxdata, stdin, stdlist);                   <<01245>>14710000
                                                               <<01245>>14715000
        if not sysprocess'call then startprocess;              <<01268>>14720000
      end;                                                     <<01245>>14725000
                                                               <<01245>>14730000
    if error > no'error then recover                           <<01245>>14735000
    else                                                       <<01245>>14740000
      begin  << finalization - possibily a subroutine later >> <<01245>>14745000
        << remove temp file equation tab entries - if any >>   <<01245>>14750000
        if stdin'formal <> "  " then                           <<01245>>14755000
          xremjtentry (stdin'formal, blnkptr, blnkptr, 3);     <<01245>>14760000
        if stdlist'formal <> "  " then                         <<01245>>14765000
          xremjtentry (stdlist'formal, blnkptr, blnkptr, 3);   <<01245>>14770000
                                                               <<01245>>14775000
        << set final priority for new process >>               <<01245>>14780000
        pcb(sonpcbptr+queueinginfowordnum).qtype :=            <<mpeiv>>14785000
                    final'priority.qtype;                      <<mpeiv>>14790000
        pcb(sonpcbptr+queueinginfowordnum).prifield :=         <<mpeiv>>14795000
                    final'priority.prifield;                   <<mpeiv>>14800000
                                                               <<01245>>14805000
        << set 'father activate' bit in pcb to correct value >><<01427>>14810000
          pcb(sonpcbptr+piinfowordnum).facflag :=              <<06645>>14815000
          if activatefather then 1 else 0;                     <<mpeiv>>14820000
                                                               <<01740>>14825000
        << record creation if process instrumentation is set >><<01740>>14830000
        if gclassenabledmask.class15 then record'create;       <<01740>>14835000
                                                               <<01740>>14840000
        resetcritical (critstate);                             <<01245>>14845000
                                                               <<01245>>14850000
        if autoact'indx <> -1 then                             <<01245>>14855000
          awake (sonpcbptr, fatherwait, susp);                 <<01245>>14860000
      end;                                                     <<01245>>14865000
                                                               <<01245>>14870000
    << all done - return values & condition code already set >><<01245>>14875000
    errorexit (errorreturn, 0, 0);                             <<01245>>14880000
  end << createprocess >>;                                     <<01245>>14885000
$page "PROCEDURE CREATE"                                       <<01245>>14890000
procedure create(progname,entryname,pin,param,flags,stacksize, <<01245>>14895000
                  dlsize,maxdata,priorityclass,rank);          <<01245>>14900000
value param,flags,stacksize,dlsize,maxdata,priorityclass,rank; <<01245>>14905000
logical flags,priorityclass;                                   <<01245>>14910000
integer pin,param,stacksize,dlsize,maxdata,rank;               <<01245>>14915000
byte array progname,entryname;                                 <<01245>>14920000
option variable,privileged;                                    <<01245>>14925000
                                                               <<01245>>14930000
comment: establishes a new process on the system.              <<01245>>14935000
         loads proper program.                                 <<01245>>14940000
                                                               <<01245>>14945000
                                                               <<01245>>14950000
         error code: 100.                                      <<01245>>14955000
                                                               <<01245>>14960000
         error subcode:                                        <<01245>>14965000
            0     from chek                                    <<01245>>14970000
            5     no pcb available for the moment              <<01245>>14975000
            20    specified sub queue not existant             <<01245>>14980000
            24    not existant portion of m q requested        <<01245>>14985000
            25    portion of m q requested without capability  <<01245>>14990000
            26    absolute priority requested without capability        14995000
            27    illegal class specification                  <<01245>>15000000
            29    rank specified without oprator capability    <<01245>>15005000
            30    load error                                   <<01245>>15010000
            31    failure from procreate(no pcb avallable......)        15015000
                                                               <<01245>>15020000
      ;                                                        <<01245>>15025000
                                                               <<01245>>15030000
begin                                                          <<01245>>15035000
      integer                                                  <<01427>>15040000
        index,   <<to index thru pxfixed intrinsic err stack>> <<06631>>15045000
        error,                      << for call to errorexit >><<01427>>15050000
        err'level,                  << current error level >>  <<01427>>15055000
        pxfixedloc,                 << to index thru pxfixed>> <<06631>>15060000
        count,                      << # wrds of intrin area >><<01427>>15065000
        cc;                         << condition code return >><<01427>>15070000
                                                               <<01427>>15075000
      logical                                                  <<01427>>15080000
        exit'err        := 0,       << error to exit with >>   <<01427>>15085000
        fake'loaderr,               << error load once gave >> <<01427>>15090000
        ovmask           = q-4;     << option variable mask >> <<01427>>15095000
                                                               <<01427>>15100000
      integer array                                            <<01427>>15105000
        optionnums(0:12);           << option numbers to use >><<01427>>15110000
                                                               <<01427>>15115000
      logical array                                            <<01427>>15120000
        options(0:12);              << options to use >>       <<01427>>15125000
                                                               <<01427>>15130000
      equate                                                   <<01427>>15135000
        errcode          = 100;     << create intrinsic # >>   <<06631>>15140000
                                                               <<01427>>15145000
      << errors returned from createprocess >>                 <<01427>>15150000
      equate                                                   <<01427>>15155000
        out'of'resos     =   4,                                <<01427>>15160000
        unknown'prog     =   6,                                <<01427>>15165000
        bad'entryname    =   8,                                <<02303>>15170000
        dl'rounded       = -12,                                <<01427>>15175000
        maxdata'decrsed  = -13,                                <<01427>>15180000
        bad'priority     =  17,                                <<01427>>15185000
        invalid'stdin    =  18,                                <<01427>>15190000
        invalid'stdlist  =  19;                                <<01427>>15195000
                                                               <<01427>>15200000
                                                               <<01427>>15205000
                                                               <<01427>>15210000
      << create >>                                             <<01427>>15215000
      erroron;                                                 <<01245>>15220000
      status.(5:1):=0;                 <<reset carry bit>>     <<01245>>15225000
      chek(errcode&lsl(6)+11,10,double(%57),double(1),%577);   <<01245>>15230000
                                                               <<01245>>15235000
      << map create parameters into arrays for createprocess >><<01427>>15240000
      x := 0;                                                  <<01245>>15245000
      if ovmask&lsr(1) then                                    <<01245>>15250000
        begin  << priority specified >>                        <<01245>>15255000
          optionnums(x) := 7;                                  <<01245>>15260000
          options(x) := priorityclass;                         <<01245>>15265000
          x := x + 1;                                          <<01245>>15270000
        end;                                                   <<01245>>15275000
                                                               <<01245>>15280000
      if ovmask&lsr(2) then                                    <<01245>>15285000
        begin  << maxdata specified >>                         <<01245>>15290000
          optionnums(x) := 6;                                  <<01245>>15295000
          options(x) := maxdata;                               <<01245>>15300000
          x := x + 1;                                          <<01245>>15305000
        end;                                                   <<01245>>15310000
                                                               <<01245>>15315000
      if ovmask&lsr(3) then                                    <<01245>>15320000
        begin  << dlsize specified >>                          <<01245>>15325000
          optionnums(x) := 5;                                  <<01245>>15330000
          options(x) := dlsize;                                <<01245>>15335000
          x := x + 1;                                          <<01245>>15340000
        end;                                                   <<01245>>15345000
                                                               <<01245>>15350000
      if ovmask&lsr(4) then                                    <<01245>>15355000
        begin  << stacksize specified >>                       <<01245>>15360000
          optionnums(x) := 4;                                  <<01245>>15365000
          options(x) := stacksize;                             <<01245>>15370000
          x := x + 1;                                          <<01245>>15375000
        end;                                                   <<01245>>15380000
                                                               <<01245>>15385000
      if ovmask&lsr(5) then                                    <<01245>>15390000
        begin  << load flags specified >>                      <<01245>>15395000
          optionnums(x) := 3;                                  <<01245>>15400000
          options(x) := flags;                                 <<01245>>15405000
          x := x + 1;                                          <<01245>>15410000
        end;                                                   <<01245>>15415000
                                                               <<01245>>15420000
      if ovmask&lsr(6) then                                    <<01245>>15425000
        begin  << parm specified >>                            <<01245>>15430000
          optionnums(x) := 2;                                  <<01245>>15435000
          options(x) := param;                                 <<01245>>15440000
          x := x + 1;                                          <<01245>>15445000
        end;                                                   <<01245>>15450000
                                                               <<01245>>15455000
      if ovmask&lsr(8) then                                    <<01245>>15460000
        begin  << entry name specified >>                      <<01245>>15465000
          optionnums(x) := 1;                                  <<01245>>15470000
          options(x) := @entryname;                            <<01245>>15475000
          x := x + 1;                                          <<01245>>15480000
        end;                                                   <<01245>>15485000
                                                               <<01245>>15490000
      optionnums(x) := 0;   << end of option list >>           <<01245>>15495000
                                                               <<01245>>15500000
      createprocess (error, pin, progname, optionnums, options);        15505000
                                                               <<01245>>15510000
      << simulate old behavior of create (i.e. aborts) by    >><<01427>>15515000
      << setting error parameter for call to errorexit, if   >><<01427>>15520000
      << necessary.                                          >><<01427>>15525000
                                                               <<01427>>15530000
      if < then                                                <<01427>>15535000
        begin  << creation failed >>                           <<01427>>15540000
          cc := ccl;                                           <<01427>>15545000
          if error = out'of'resos or error = invalid'stdin or  <<01427>>15550000
             error = invalid'stdlist then                      <<01427>>15555000
            exit'err := 31                                     <<01427>>15560000
          else if error=unknown'prog or error=bad'entryname    <<02303>>15565000
            then exit'err := 0       << don't abort>>          <<02303>>15570000
          else if error = bad'priority then                    <<01427>>15575000
            exit'err := checkpriority (priorityclass, 0)       <<01427>>15580000
          else                                                 <<01427>>15585000
            exit'err := 30;   << all others are load errors >> <<01427>>15590000
        end                                                    <<01427>>15595000
      else if > then                                           <<01427>>15600000
        begin  << a load warning occurred >>                   <<01427>>15605000
          if error = dl'rounded or error = maxdata'decrsed then<<01427>>15610000
            begin                                              <<01427>>15615000
              cc := ccg;                                       <<01427>>15620000
              exit'err := 0;                                   <<01427>>15625000
            end                                                <<01427>>15630000
          else                                                 <<01427>>15635000
            begin  << create fails in these cases >>           <<01427>>15640000
              kill (pin);                                      <<01427>>15645000
              pin := 0;                                        <<01427>>15650000
              cc := ccl;                                       <<01427>>15655000
              case -error-9 of                                 <<01427>>15660000
                begin  << supply error load used to return >>  <<01427>>15665000
                  fake'loaderr := lerr23;   <<  9. bad stack >><<01427>>15670000
                  fake'loaderr := lerr76;   << 10. bad dl >>   <<01427>>15675000
                  fake'loaderr := lerr77;   << 11. bad mdata >><<01427>>15680000
                  ;                         << 12. dl round >> <<01427>>15685000
                  ;                         << 13. maxd down >><<01427>>15690000
                  fake'loaderr := lerr25;   << 14. stk > md >> <<01427>>15695000
                end;                                           <<01427>>15700000
              errorput (fake'loaderr, 2);                      <<01427>>15705000
              exit'err := 30;   << load errors >>              <<01427>>15710000
            end;                                               <<01427>>15715000
        end                                                    <<01427>>15720000
      else   << no problem >>                                  <<01427>>15725000
        cc := cce;                                             <<01427>>15730000
                                                               <<01245>>15735000
      if exit'err > 0 then                                     <<01427>>15740000
        begin  << must fix up intrinsic error area >>          <<01427>>15745000
          << get addressability into pxfixed area >>           <<01427>>15750000
        pxfixed;                                               <<06631>>15755000
                                                               <<01427>>15760000
          << move all lower level errors up so that it       >><<01427>>15765000
          << appears as though createprocess was not called. >><<01427>>15770000
          << this allows abort to print all the errors that  >><<01427>>15775000
          << occurred (e.g. create, load, filesystem).       >><<01427>>15780000
          err'level := pxfxerrlevel;                           <<06631>>15785000
          count := 6 - err'level - 1;                          <<01427>>15790000
          index:= err'level+1;                                 <<s7937>>15795000
          tos:=@pxfxintrerr;                                   <<06631>>15800000
          index:=err'level+2;                                  <<s7937>>15805000
          tos:=@pxfxintrerr;                                   <<06631>>15810000
          tos := count;                                        <<s7937>>15815000
          assemble (move);                                     <<s7937>>15820000
        end;                                                   <<01427>>15825000
                                                               <<01427>>15830000
      conditioncode := cc;                                     <<01245>>15835000
      tos := errcode&lsl(6)+11;                                <<01245>>15840000
      errorexit (*, exit'err, 0);                              <<01245>>15845000
   end << create >>;                                           <<01245>>15850000
                                                               <<01245>>15855000
$control segment=main                                          <<01245>>15860000
end.                                                           <<01268>>15865000
