$CONTROL MAP,CODE,USLINIT                                               00010000
<< PCREATE -- MODULE 63 >>                                     <<01001>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
                                                                        00028000
$SET X0=ON                                                     <<01245>>00030000
$CONTROL MAP, CODE, SEGMENT=PCREATE, MAIN=PCREATE              <<01245>>00032000
                                                               <<01245>>00034000
<< Compile Options                                             <<01245>>00036000
   x0 =  on - List Description & Data Structure Diagrams       <<01245>>00038000
      = off - Omit Description & Data Structure Diagrams       <<01245>>00040000
>>                                                             <<01245>>00042000
                                                               <<01245>>00044000
                                                               <<01245>>00046000
begin                                                          <<01245>>00048000
                                                               <<01245>>00050000
  << Process Creation Module - PCREATE - MPE Module #63 >>     <<01245>>00052000
                                                               <<01245>>00054000
$IF X0=OFF                                                     <<01245>>00056000
$IF                                                            <<01245>>00058000
                                                               <<01245>>00060000
$PAGE "MODULE DESCRIPTION AND GLOBAL DATA STRUCTURE DIAGRAMS"  <<01245>>00062000
$INCLUDE INCLST                                                <<MPEIV>>00064000
<< THE FOLLOWING CODE WAS ADDED TO SUPPORT PRIVILEGED MODE >>  <<04664>>00066000
<< BOUNDS CHECKING. WHEN THE PCBX IS SET UP, WORD %36.(0:2)>>  <<04664>>00068000
<< IS SET TO 3 INDICATING THAT DB,P,Q, AND S  WILL BE      >>  <<04664>>00070000
<< BOUNDS TESTED.                                          >>  <<04664>>00072000
                                                               <<04664>>00074000
DEFINE   CPUNUM   = ASSEMBLE(PCN)#;      << GET CPU NUMBER >>  <<04664>>00076000
                                                               <<04664>>00078000
EQUATE   SERIES64 = 4,                                         <<04664>>00080000
         PMBC'INIT= 3;                                         <<04664>>00082000
                                                               <<04664>>00084000
<<    >>                                                       <<01245>>00086000
$PAGE                                                          <<01245>>00088000
integer S0 = S-0,   S2 = S-2,   X = X;                         <<01265>>00090000
                                                               <<01245>>00092000
logical STATUS = Q-1;                                          <<01245>>00094000
                                                               <<01245>>00096000
define CONDITIONCODE   = STATUS.(6:2)#;                        <<01245>>00098000
                                                               <<01245>>00100000
equate CCG             = 0,                                    <<01245>>00102000
       CCL             = 1,                                    <<01245>>00104000
       CCE             = 2;                                    <<01245>>00106000
                                                               <<01245>>00108000
define DISABLE         = assemble (SED 0)#,                    <<01245>>00110000
       ENABLE          = assemble (SED 1)#,                    <<01245>>00112000
       PDISABLE        = assemble (PSDB)#,                     <<01245>>00114000
       PENABLE         = assemble (PSEB)#,                     <<01245>>00116000
       DISAPROC        = assemble (PSDB)#,                     <<01245>>00118000
       ENAPROC         = assemble (PSEB)#,                     <<01245>>00120000
       ENABLEBREAK     = 15#,                                  <<01265>>00122000
       DISABLEBREAK    = 14#,                                  <<01265>>00124000
       FORCE'STKOVFLOW = assemble (ADDS 100; SUBS 100)#;       <<01245>>00126000
                                                               <<01245>>00128000
equate CPCB            = 4,                << current PCB >>   <<01245>>00130000
       PCBB            = 3,                << PCB table base >><<01245>>00132000
       DSTB            = 2,                << DST table base >><<01245>>00134000
       PCBSIZE         = 16,               << PCB size >>      <<01245>>00136000
       PTOP'COMM'DST   = 10;               << P to P C table >><<01245>>00138000
                                                               <<01245>>00140000
equate FATHERWAIT      = 1,                                    <<01245>>00142000
       SONWAIT         = 2,                                    <<01245>>00144000
       JUNKWAIT        = %20,                                  <<01265>>00146000
       JUNK'SONWAIT    = JUNKWAIT + SONWAIT,                   <<01427>>00148000
       MOURNINGWAIT=%4000;                                     <<MPEIV>>00150000
                                                               <<01245>>00152000
equate PXGLOB          = 8,                                    <<01245>>00154000
       PXFIXED         = 80,                                   <<MPEIV>>00156000
       PXFILE          = 200,                                  <<01245>>00158000
       PCBXSIZE        = PXGLOB + PXFIXED + PXFILE + 4,        <<MPEIV>>00160000
       SPXGLOB         = 8,                                    <<01245>>00162000
       SPXFIXED        = 46,                                   <<01245>>00164000
       SPXFILE         = 11;                                   <<01245>>00166000
                                                               <<01245>>00168000
equate PJXREF          = 50,                                   <<01245>>00170000
       PCBIX           = 3,                                    <<MPEIV>>00172000
       SWAPTABIX       = %25,                                  <<MPEIV>>00174000
       DISPQ           = 1,                                    <<MPEIV>>00176000
       ENDOFCLASS      = 0;                                    <<MPEIV>>00178000
                                                               <<01245>>00180000
define QTYPE           = (1:4)#,                               <<01245>>00182000
       EQ              = (1:1)#,                               <<01245>>00184000
       LQ              = (2:1)#,                               <<01245>>00186000
       CQ              = (3:1)#,                               <<01245>>00188000
       DQ              = (4:1)#;                               <<MPEIV>>00190000
                                                               <<01245>>00192000
                                                               <<01245>>00194000
  << *** Load Errors Relevent to Process Creation *** >>       <<01245>>00196000
                                                               <<01245>>00198000
equate LERR20          = 20,      << illegal library search >> <<01245>>00200000
       LERR21          = 21,      << unknown entry point >>    <<01245>>00202000
       LERR22          = 22,      << trace subsys not found >> <<01245>>00204000
       LERR23          = 23,      << stack size too small >>   <<01245>>00206000
       LERR25          = 25,      << data seg > max data seg >><<01245>>00208000
       LERR31          = 31,      << invalid program file >>   <<01245>>00210000
       LERR34          = 34,      << prog is > 1 extent >>     <<01245>>00212000
       LERR35          = 35,      << data seg > 32K >>         <<01245>>00214000
       LERR36          = 36,      << data seg > sys max >>     <<01245>>00216000
       LERR39          = 39,      << illegal capability >>     <<01245>>00218000
       LERR45          = 45,      << invalid entry point >>    <<01245>>00220000
       LERR53          = 53,      << can't open prog file >>   <<01245>>00222000
       LERR63          = 63,      << i/o error on prog file >> <<01245>>00224000
       LERR66          = 66,      << no DST available >>       <<01245>>00226000
       LERR73          = 73,      << out of virt mem space >>  <<01245>>00228000
       LERR76          = 76,      << illegal DL >>             <<01245>>00230000
       LERR77          = 77,      << illegal maxdata >>        <<01245>>00232000
       LERR93          = 93;      << can't mount home vset >>  <<01245>>00234000
                                                               <<01245>>00236000
  << *** File System Errors Relevent to Process Creation *** >><<01265>>00238000
                                                               <<01265>>00240000
equate FSERR50         = 50,      << non-existent account >>   <<01265>>00242000
       FSERR51         = 51,      << non-existent group >>     <<01265>>00244000
       FSERR52         = 52,      << non-existent perm file >> <<01265>>00246000
       FSERR53         = 53;      << non-existent temp file >> <<01265>>00248000
                                                               <<01265>>00250000
logical pointer                                                <<01245>>00252000
  PCB             = PCBB;          << sysglob PCB table ptr >> <<01245>>00254000
EQUATE ICSIX=7;                                                <<MPEIV>>00256000
INTEGER POINTER ICS=ICSIX;                                     <<MPEIV>>00258000
                                                               <<MPEIV>>00260000
INTEGER PCBSYSBASEINX=DB+PCBIX,                                <<MPEIV>>00262000
        SWAPTABSYSBASEINX=DB+SWAPTABIX;                        <<MPEIV>>00264000
$INCLUDE INCLPCB                                               <<MPEIV>>00266000
$INCLUDE INCLSLL                                               <<MPEIV>>00268000
$INCLUDE INCLICS                                               <<MPEIV>>00270000
$INCLUDE INCLMEAS                                              <<01740>>00272000
$INCLUDE INCLMIFT                                              <<04503>>00274000
$PAGE "EXTERNAL PROCEDURE DECLARATIONS"                        <<01245>>00276000
intrinsic DEBUG, FOPEN, ASCII, PROCTIME, FCONTROL, KILL,       <<01710>>00278000
          FFILEINFO, FCLOSE, GETJCW, SETJCW;                   <<02002>>00280000
intrinsic FFILEINFO;                                           <<01740>>00282000
                                                               <<01245>>00284000
procedure AWAKE (PCBPTR, WAKEEVENT, WAITEVENT);                <<01245>>00286000
  value PCBPTR, WAKEEVENT, WAITEVENT;                          <<01245>>00288000
  integer PCBPTR, WAITEVENT;                                   <<01245>>00290000
  logical WAKEEVENT;                                           <<01245>>00292000
  option external;                                             <<01245>>00294000
                                                               <<01245>>00296000
procedure WAIT (WAITTYPE, SUBPRI);                             <<01245>>00298000
  value WAITTYPE, SUBPRI;                                      <<01245>>00300000
  integer WAITTYPE;   logical SUBPRI;                          <<01245>>00302000
  option external;                                             <<01245>>00304000
                                                               <<01245>>00306000
procedure BURRYPROC (PCBPTR);                                  <<01245>>00308000
  value PCBPTR;                                                <<01245>>00310000
  integer PCBPTR;                                              <<01245>>00312000
  option external;                                             <<01245>>00314000
                                                               <<01245>>00316000
procedure DELAY (MILLISECS);                                   <<01245>>00318000
  value MILLISECS;                                             <<01245>>00320000
  double MILLISECS;                                            <<01245>>00322000
  option external;                                             <<01245>>00324000
                                                               <<01245>>00326000
procedure SET'PSIF (PCBPTR, PSEUDOINT);                        <<01245>>00328000
  value PCBPTR, PSEUDOINT;                                     <<01245>>00330000
  integer PCBPTR;                                              <<01245>>00332000
  logical PSEUDOINT;                                           <<01245>>00334000
  option external;                                             <<01245>>00336000
                                                               <<01245>>00338000
logical procedure SETCRITICAL;                                 <<01245>>00340000
  option external;                                             <<01245>>00342000
                                                               <<01245>>00344000
procedure RESETCRITICAL (CRITSTATE);                           <<01245>>00346000
  value CRITSTATE;                                             <<01245>>00348000
  logical CRITSTATE;                                           <<01245>>00350000
  option external;                                             <<01245>>00352000
                                                               <<01245>>00354000
integer procedure GETSIR (SIRNUM);                             <<01245>>00356000
  value SIRNUM;   integer SIRNUM;                              <<01245>>00358000
  option external;                                             <<01245>>00360000
                                                               <<01245>>00362000
procedure RELSIR (SIRNUM, SIRSTATE);                           <<01245>>00364000
  value SIRNUM, SIRSTATE;                                      <<01245>>00366000
  integer SIRNUM, SIRSTATE;                                    <<01245>>00368000
  option external;                                             <<01245>>00370000
                                                               <<01245>>00372000
integer procedure GETENTRY (ENTRYTYPE);                        <<01245>>00374000
  value ENTRYTYPE;                                             <<01245>>00376000
  integer ENTRYTYPE;                                           <<01245>>00378000
  option external;                                             <<01245>>00380000
                                                               <<01245>>00382000
procedure RETURNENTRY (ENTRYTYPE, ENTRYNUM);                   <<01245>>00384000
  value ENTRYTYPE, ENTRYNUM;                                   <<01245>>00386000
  integer ENTRYTYPE, ENTRYNUM;                                 <<01245>>00388000
  option external;                                             <<01245>>00390000
                                                               <<01245>>00392000
integer procedure GETSYSTABENTRY (TABLESSYSBASEINX);           <<MPEIV>>00394000
  value TABLESSYSBASEINX;                                      <<MPEIV>>00396000
  integer TABLESSYSBASEINX;                                    <<MPEIV>>00398000
  option external;                                             <<MPEIV>>00400000
                                                               <<MPEIV>>00402000
integer procedure EXCHANGEDB (DSTNUM);                         <<01245>>00404000
  value DSTNUM;                                                <<01245>>00406000
  integer DSTNUM;                                              <<01245>>00408000
  option external;                                             <<01245>>00410000
                                                               <<01245>>00412000
logical procedure SETSYSDB;                                    <<01245>>00414000
  option external;                                             <<01245>>00416000
                                                               <<01245>>00418000
procedure RESETDB (DSTNUM);                                    <<01245>>00420000
  value DSTNUM;                                                <<01245>>00422000
  integer DSTNUM;                                              <<01245>>00424000
  option external;                                             <<01245>>00426000
                                                               <<01245>>00428000
procedure QUEUEPROC (PROCSYSDBINX, QUEUE, LOCATION);           <<MPEIV>>00430000
  value PROCSYSDBINX, QUEUE, LOCATION;                         <<MPEIV>>00432000
  integer PROCSYSDBINX, QUEUE, LOCATION;                       <<MPEIV>>00434000
  option external;                                             <<MPEIV>>00436000
                                                               <<01245>>00438000
integer procedure CONVEXTLABELTODELTAP (EXTLABEL);             <<MPEIV>>00440000
  value EXTLABEL;                                              <<MPEIV>>00442000
  integer EXTLABEL;                                            <<MPEIV>>00444000
  option external;                                             <<MPEIV>>00446000
                                                               <<01245>>00448000
procedure MMSTAT (EVENT, PARM1, PARM2, PARM3);                 <<01245>>00450000
  value EVENT, PARM1, PARM2, PARM3;                            <<01245>>00452000
  integer EVENT, PARM1, PARM2, PARM3;                          <<01245>>00454000
  option external;                                             <<01245>>00456000
                                                               <<01245>>00458000
procedure LOAD (PROGFNAME, ENTRYNAME, CSTINDEX,DELTAP,STACKDST,<<01245>>00460000
                PIN, LOADFLAGS, PCBXSIZE, DLSIZE, STACKSIZE,   <<01245>>00462000
                MAXDATA, GLOBALSIZE, STRNG, STRLEN,CAPABILITY);<<01245>>00464000
  value PIN, LOADFLAGS, PCBXSIZE, STRLEN;                      <<01245>>00466000
  byte array PROGFNAME, ENTRYNAME, STRNG;                      <<01245>>00468000
  integer CSTINDEX, DELTAP, STACKDST, PIN, PCBXSIZE, DLSIZE,   <<01245>>00470000
          STACKSIZE, MAXDATA, GLOBALSIZE, STRLEN;              <<01245>>00472000
  logical LOADFLAGS, CAPABILITY;                               <<01245>>00474000
  option external;                                             <<01245>>00476000
                                                               <<01245>>00478000
procedure UNLOAD (PIN);                                        <<01245>>00480000
  value PIN;   integer PIN;                                    <<01245>>00482000
  option external;                                             <<01245>>00484000
                                                               <<01245>>00486000
procedure PARSE'FILE'EQ (FEQUATION, ERRNUM, DUMMY);            <<01245>>00488000
  byte array FEQUATION;                                        <<01245>>00490000
  integer ERRNUM, DUMMY;                                       <<01245>>00492000
  option external;                                             <<01245>>00494000
                                                               <<01245>>00496000
integer procedure ADDJTENTRY (FDES, GP, ACCT, TBL, SIZE, NTRY);<<01245>>00498000
  value TBL, SIZE;                                             <<01245>>00500000
  byte array FDES, GP, ACCT;                                   <<01245>>00502000
  integer TBL, SIZE;                                           <<01245>>00504000
  integer array NTRY;                                          <<01245>>00506000
  option external;                                             <<01245>>00508000
                                                               <<01245>>00510000
integer procedure XRETJTENTRY (FDES, GROUP, ACCNT, SIZE, NTRY);<<01427>>00512000
  byte array FDES, GROUP, ACCNT;                               <<01427>>00514000
  integer SIZE;                                                <<01427>>00516000
  integer array NTRY;                                          <<01427>>00518000
  option external;                                             <<01427>>00520000
                                                               <<01427>>00522000
integer procedure XREMJTENTRY (FDES, GROUP, ACCNT, TABLENUM);  <<01245>>00524000
  value TABLENUM;                                              <<01245>>00526000
  byte array FDES, GROUP, ACCNT;                               <<01245>>00528000
  integer TABLENUM;                                            <<01245>>00530000
  option external;                                             <<01245>>00532000
                                                               <<01245>>00534000
logical procedure FNFORMAT (STRING, FNAME, GROUP, ACCNT, LW);  <<01427>>00536000
  value STRING;                                                <<01427>>00538000
  byte pointer STRING;                                         <<01427>>00540000
  logical array FNAME, GROUP, ACCNT, LW;                       <<01427>>00542000
  option external;                                             <<01427>>00544000
                                                               <<01427>>00546000
integer procedure CALENDAR;                                    <<01245>>00548000
  option external;                                             <<01245>>00550000
                                                               <<01245>>00552000
double procedure CLOCK;                                        <<01245>>00554000
  option external;                                             <<01245>>00556000
                                                               <<01245>>00558000
double procedure TIMER;                                        <<01740>>00560000
  option external;                                             <<01740>>00562000
procedure ERRORON;                                             <<01245>>00564000
                                                               <<01740>>00566000
  option external;                                             <<01245>>00568000
                                                               <<01245>>00570000
double procedure CHEK (INTRINSIC, FLAGS, PARMS, CAP, OVMASK);  <<01245>>00572000
  value INTRINSIC, FLAGS, PARMS, CAP, OVMASK;                  <<01245>>00574000
  logical INTRINSIC, FLAGS, OVMASK;                            <<01245>>00576000
  double PARMS, CAP;                                           <<01245>>00578000
  option variable, external;                                   <<01245>>00580000
                                                               <<01245>>00582000
double procedure CHEK'NOABORT (INTRINSIC, FLAGS, PARMS, CAP,   <<01245>>00584000
                               OVMASK);                        <<01245>>00586000
  value INTRINSIC, FLAGS, PARMS, CAP, OVMASK;                  <<01245>>00588000
  logical INTRINSIC, FLAGS, OVMASK;                            <<01245>>00590000
  double PARMS, CAP;                                           <<01245>>00592000
  option variable, external;                                   <<01245>>00594000
                                                               <<01245>>00596000
logical procedure ERRORGET (LEVEL);                            <<01245>>00598000
  value LEVEL;   integer LEVEL;                                <<01245>>00600000
  option external;                                             <<01245>>00602000
                                                               <<01245>>00604000
procedure ERRORPUT (ERRWORD, LEVEL);                           <<01427>>00606000
  value ERRWORD, LEVEL;                                        <<01427>>00608000
  integer ERRWORD, LEVEL;                                      <<01427>>00610000
  option external;                                             <<01427>>00612000
                                                               <<01427>>00614000
procedure ERROREXIT (INTRINEXIT, ERROR, ABORTPARM);            <<01245>>00616000
  value INTRINEXIT, ERROR, ABORTPARM;                          <<01245>>00618000
  logical INTRINEXIT, ERROR, ABORTPARM;                        <<01245>>00620000
  option external;                                             <<01245>>00622000
                                                               <<01245>>00624000
procedure SUDDENDEATH (SYSFAILNUM);                            <<01245>>00626000
  value SYSFAILNUM;                                            <<01245>>00628000
  integer SYSFAILNUM;                                          <<01245>>00630000
  option external;                                             <<01245>>00632000
                                                               <<01245>>00634000
procedure HELP;                                                <<01245>>00636000
  option external;                                             <<01245>>00638000
                                                               <<MPEIV>>00640000
procedure CRASH' (WHY);                                        <<MPEIV>>00642000
  value WHY;                                                   <<MPEIV>>00644000
  integer WHY;                                                 <<MPEIV>>00646000
  option external;                                             <<MPEIV>>00648000
                                                               <<MPEIV>>00650000
integer procedure CHECKPRIORITY (PRCLASS, PCBPT);              <<01245>>00652000
  value PRCLASS, PCBPT;                                        <<01245>>00654000
  logical PRCLASS;                                             <<01245>>00656000
  integer PCBPT;                                               <<01245>>00658000
  option forward;                                              <<01245>>00660000
$PAGE "PROCEDURE SUBQUEUE"                                     <<01245>>00662000
DOUBLE PROCEDURE SUBQUEUE(N,CRITERIA);                                  00664000
VALUE N,CRITERIA; INTEGER N,CRITERIA;                                   00666000
OPTION PRIVILEGED,UNCALLABLE;                                           00668000
COMMENT: RETURNS DOUBLE WORD CHARACTERISTICS OF SUB QUEUE               00670000
CHOICE BASED ON CRITERIA= N TH ELEMENT:                                 00672000
         N=1  PRIORITY NUMBER                                           00674000
         N=4  SUB QUEUE NAME                                            00676000
         RETURNS CCE IF OK, CCL IF NOT FOUND IN PCBTABLE.               00678000
      ;                                                                 00680000
                                                                        00682000
BEGIN                                                                   00684000
      DOUBLE ARRAY SUBQTABLE(*)=PB :=                                   00686000
      COMMENT NAME, 0,                                     <<*DISP*00*>>00688000
              SCHEDULING TYPE:                             <<*DISP*00*>>00690000
                  4 - LINEAR                               <<*DISP*00*>>00692000
                  2 - CQ                                   <<*DISP*00*>>00694000
                  1 - DQ                                   <<*DISP*00*>>00696000
                  9 - EQ                                   <<*DISP*00*>>00698000
              PRIORITY;                                    <<*DISP*00*>>00700000
           [8/%101,8/0,5/4,3/0,8/030]D,   << AS >>         <<*DISP*00*>>00702000
           [8/%102,8/0,5/4,3/0,8/100]D,   << BS >>         <<*DISP*00*>>00704000
           [8/%103,8/0,5/2,3/0,8/150]D,   << CS >>         <<*DISP*00*>>00706000
           [8/%104,8/0,5/1,3/0,8/200]D,   << DS >>         <<*DISP*00*>>00708000
           [8/%105,8/0,5/9,3/0,8/250]D;   << ES >>         <<*DISP*00*>>00710000
      INTEGER CX,SHIFTCNT;                                              00712000
      INTEGER CC;                                                       00714000
      LOGICAL LS0=S-0;                                                  00716000
                                                                        00718000
      IF N=1 THEN                                                       00720000
        BEGIN << CALLER DETERMINES PRIORITY >>                          00722000
         TOS:=ABSOLUTE(ABSOLUTE(CPCB)+QUEUEINGINFOWORDNUM);    <<MPEIV>>00724000
         IF LS0.LSCHEDFLAG THEN                                <<MPEIV>>00726000
          BEGIN                                                         00728000
            TOS:=ABSOLUTE(X).PRIFIELD;                         <<MPEIV>>00730000
          IF TOS < 100 THEN LS0:=30 ELSE LS0:=100;                      00732000
          END                                                           00734000
        ELSE                                                            00736000
            IF LS0.ESCHEDFLAG THEN  LS0:=250                   <<MPEIV>>00738000
         ELSE                                                           00740000
            IF LS0.DSCHEDFLAG THEN LS0:=200                    <<MPEIV>>00742000
          ELSE LS0:=150;                                                00744000
        CRITERIA := TOS;                                                00746000
        END << N = 1 >>;                                                00748000
      CX:=-1;                                                           00750000
      SHIFTCNT:=8*(N-1);                                                00752000
      WHILE (CX:=CX+1)<5 DO                                             00754000
      BEGIN                                                             00756000
         TOS:=SUBQTABLE(CX)&DLSR(SHIFTCNT);                             00758000
         IF (TOS LAND %377)= LOGICAL(CRITERIA) THEN                     00760000
         BEGIN                                                          00762000
            SUBQUEUE:=SUBQTABLE(CX);                                    00764000
            CC:=CCE;                                                    00766000
            GOTO FIN;                                                   00768000
         END;                                                           00770000
      END;                                                              00772000
      CC:=CCL;                                                          00774000
FIN:  STATUS.(6:2):=CC;                                                 00776000
END;  <<SUBQUEUE>>                                                      00778000
$PAGE "PROCEDURE GETPRIORITY"                                  <<01245>>00780000
PROCEDURE GETPRIORITY(PIN,PRIORITYCLASS,RANK);                          00782000
VALUE PIN,PRIORITYCLASS,RANK;                                           00784000
LOGICAL PRIORITYCLASS;                                                  00786000
INTEGER PIN,RANK;                                                       00788000
OPTION  PRIVILEGED,VARIABLE;                                            00790000
                                                                        00792000
                                                                        00794000
COMMENT: GETS A NEW PRIORITY FOR THE PROCESS SPECIFIED BY PIN.          00796000
         PIN MUST BE A CALLER'S SON OR CALLER ITSELF(IF 0).             00798000
         DB  NEEDS NOT BE POINTING AT STACK.                            00800000
                                                                        00802000
         RETURNS CC                                                     00804000
            CCE      IF REQUEST GRANTED                                 00806000
            CCG      PROCESS IS NOT ALIVE                               00808000
            CCL      ILLEGAL PIN                                        00810000
                                                                        00812000
         ERROR CODE :   120                                             00814000
         ERROR SUB CODE:SAME AS CHECPRIORITY PROCEDURE                  00816000
                                                                        00818000
         ;                                                              00820000
                                                                        00822000
                                                                        00824000
BEGIN                                                                   00826000
                                                                        00828000
      INTEGER CC,PCBPT,ERR;                                             00830000
LOGICAL CHKPRIVALUE;                                           <<MPEIV>>00832000
      INTEGER POINTER  PCB = 3;                                         00834000
      LOGICAL VMASK = Q-4;                                              00836000
                                                                        00838000
      ERR:=120&LSL(6)+4;                                                00840000
      ERRORON;                                                          00842000
      CHEK(ERR,1&LSL(15)+3,,DOUBLE(1),1);                               00844000
                                                                        00846000
      TOS:=ABSOLUTE(CPCB)-ABSOLUTE(PCBB);                               00848000
      ASSEMBLE(DUP);                                                    00850000
      PCBPT:=TOS;                                                       00852000
      IF PIN<>0 THEN                   <<FOR SON>>                      00854000
      BEGIN                            <<CHECK VALIDITY>>               00856000
         PCBPT:=PIN*PCBSIZE;                                            00858000
         TOS:=ABSOLUTE(ABSOLUTE(PCBB)+PCBPT+5)&LSR(8);                  00860000
         TOS:=TOS*PCBSIZE;                                              00862000
         IF TOS<>TOS OR                <<NOT A SON>>                    00864000
NOT (1<=PIN<=PCB(0)) THEN                                      <<MPEIV>>00866000
         BEGIN                                                          00868000
            CC:=CCL;                                                    00870000
            GOTO FIN;                                                   00872000
         END                                                            00874000
      END ELSE DEL;                                                     00876000
      IF PCB(PCBPT+9)>0 THEN                                            00878000
      BEGIN CC:=CCG; GOTO FIN; END;        <<NOT ALIVE>>                00880000
                                                                        00882000
      TOS:=CHECKPRIORITY(PRIORITYCLASS,PCBPT);                          00884000
CHKPRIVALUE:=TOS;                                              <<MPEIV>>00886000
                                                                        00888000
      IF < THEN                                                         00890000
      BEGIN                            <<VIOLATION>>                    00892000
         TOS:=ERR;                     <<ERROR CODE>>                   00894000
         ASSEMBLE(XCH);                                                 00896000
         TOS := 0;                                                      00898000
         ERROREXIT(*,*,*);             << PRI VIOLATION >>              00900000
      END;                                                              00902000
<<UPDATE QUEUEING INFO IN PROCESS' PCB>>                       <<MPEIV>>00904000
DISABLE;                                                       <<MPEIV>>00906000
X:=PCBPT+QUEUEINGINFOWORDNUM;                                  <<MPEIV>>00908000
PCB(X).QTYPE := 0;                                             <<01761>>00910000
IF CHKPRIVALUE.LQ THEN                                         <<MPEIV>>00912000
   BEGIN                                                       <<MPEIV>>00914000
   PCB(X).LSCHEDFLAG:=1;                                       <<MPEIV>>00916000
   PCB(X).PRIFIELD:=CHKPRIVALUE.(8:8)                          <<MPEIV>>00918000
   +(IF VMASK THEN RANK ELSE 0);                               <<MPEIV>>00920000
   END                                                         <<MPEIV>>00922000
ELSE                                                           <<MPEIV>>00924000
   IF CHKPRIVALUE.EQ THEN                                      <<MPEIV>>00926000
      BEGIN                                                    <<MPEIV>>00928000
      TOS:=ICS(-ICS'ESCHEDBASECELL);                           <<MPEIV>>00930000
      PCB(PCBPT+QUEUEINGINFOWORDNUM).ESCHEDFLAG:=1;            <<MPEIV>>00932000
      PCB(X).PRIFIELD:=TOS;                                    <<MPEIV>>00934000
      END                                                      <<MPEIV>>00936000
   ELSE                                                        <<MPEIV>>00938000
      IF CHKPRIVALUE.DQ THEN                                   <<MPEIV>>00940000
         BEGIN                                                 <<MPEIV>>00942000
         TOS:=ICS(-ICS'DSCHEDBASECELL);                        <<MPEIV>>00944000
         PCB(PCBPT+QUEUEINGINFOWORDNUM).DSCHEDFLAG:=1;         <<MPEIV>>00946000
         PCB(X).PRIFIELD:=TOS;                                 <<MPEIV>>00948000
         END                                                   <<MPEIV>>00950000
      ELSE                                                     <<MPEIV>>00952000
         BEGIN                                                 <<MPEIV>>00954000
         TOS:=ICS(-ICS'CSCHEDBASECELL);                        <<MPEIV>>00956000
         PCB(PCBPT+QUEUEINGINFOWORDNUM).CSCHEDFLAG:=1;         <<MPEIV>>00958000
         PCB(X).PRIFIELD:=TOS;                                 <<MPEIV>>00960000
         END;                                                  <<MPEIV>>00962000
IF LOGICAL(PCB(PCBPT+QUEUEINGINFOWORDNUM)).DISPQFLAG THEN      <<MPEIV>>00964000
   BEGIN                                                       <<MPEIV>>00966000
   TOS:=%1000D;                                                <<MPEIV>>00968000
   ASSEMBLE(XCHD);                                             <<MPEIV>>00970000
   QUEUEPROC(PCBPT+PCBSYSBASEINX,DISPQ,ENDOFCLASS);            <<MPEIV>>00972000
   ASSEMBLE(XCHD);                                             <<MPEIV>>00974000
   END;                                                        <<MPEIV>>00976000
ENABLE;                                                        <<MPEIV>>00978000
      CC := CCE;                                                        00980000
FIN:  STATUS.(6:2) := CC;                                               00982000
      ERROREXIT(ERR,0,0);                                               00984000
                                                                        00986000
END;   << GETPRIORITY >>                                                00988000
$PAGE "PSEUDO MAIL FACILITY"                                   <<01245>>00990000
procedure INIT'PSEUDOMAIL (SONPIN);                            <<01245>>00992000
  value SONPIN;                                                <<01245>>00994000
<<                                                                      00996000
   Function                                                             00998000
     Initializes the Pseudo Mail Box - the entry in the Process to      01000000
     Process Communication Table that describes the normal Mail Box     01002000
     between a son process and its father process.  This is a VERY      01004000
     special use of the MAIL mechanism and is intended to be used       01006000
     only in the creation of a new process.  Note that the mechanism    01008000
     will be replaced by the general Kernel-level IPC of MPE IV.        01010000
>>                                                                      01012000
<< Inputs >>                                                   <<01245>>01014000
     integer                                                   <<01245>>01016000
       SONPIN;                   << PIN of communicating son >><<01245>>01018000
                                                               <<01245>>01020000
<< Outputs                                                              01022000
     None.  But sets the entry in the Process to Process                01024000
     Table to -1 for the initial value.                                 01026000
>>                                                                      01028000
option privileged, uncallable;                                 <<01427>>01030000
                                                               <<01245>>01032000
  begin                                                        <<01245>>01034000
    integer                                                    <<01245>>01036000
      MAIL'COUNT,                                              <<01245>>01038000
      MAIL'VALUE;                                              <<01245>>01040000
                                                               <<01245>>01042000
    MAIL'COUNT := 0;   MAIL'VALUE := -1;                       <<01245>>01044000
                                                               <<01245>>01046000
    tos := PTOP'COMM'DST;                                      <<01245>>01048000
    tos := SONPIN * 2;                                         <<01245>>01050000
    tos := @MAIL'COUNT;                                        <<01245>>01052000
    tos := 2;                                                  <<01245>>01054000
    assemble (MTDS 4);                                         <<01245>>01056000
  end << INIT'PSEUDOMAIL >>;                                   <<01245>>01058000
$PAGE                                                          <<01245>>01060000
procedure SEND'PSEUDOMAIL (MESSAGE);                           <<01245>>01062000
  value MESSAGE;                                               <<01245>>01064000
<<                                                                      01066000
   Function                                                             01068000
     Sends a pseudo mail message to the father process through the      01070000
     Process-to-Process Communication Table.                            01072000
>>                                                                      01074000
<< Inputs >>                                                   <<01245>>01076000
     integer                                                   <<01245>>01078000
       MESSAGE;                        << message to be sent >><<01245>>01080000
                                                               <<01245>>01082000
<< Outputs                                                              01084000
     None.  But places 2 words (length & message) in the P-to-P         01086000
     Communication table.                                               01088000
>>                                                                      01090000
option privileged, uncallable;                                 <<01427>>01092000
                                                               <<01245>>01094000
  begin                                                        <<01245>>01096000
    integer                                                    <<01245>>01098000
      MYPIN,                                                   <<01245>>01100000
      MAIL'COUNT,                                              <<01245>>01102000
      MAIL'VALUE;                                              <<01245>>01104000
                                                               <<01245>>01106000
      MYPIN := (absolute(CPCB)-absolute(PCBB)) / PCBSIZE;      <<01245>>01108000
      MAIL'COUNT := 1;   MAIL'VALUE := MESSAGE;                <<01245>>01110000
                                                               <<01245>>01112000
      tos := PTOP'COMM'DST;                                    <<01245>>01114000
      tos := MYPIN * 2;                                        <<01245>>01116000
      tos := @MAIL'COUNT;                                      <<01245>>01118000
      tos := 2;                                                <<01245>>01120000
      assemble (MTDS 4);                                       <<01245>>01122000
  end << SEND'PSEUDOMAIL >>;                                   <<01245>>01124000
$PAGE                                                          <<01245>>01126000
procedure RECV'PSEUDOMAIL (SONPIN, MESSAGE);                   <<01245>>01128000
  value SONPIN;                                                <<01245>>01130000
<<                                                                      01132000
   Function                                                             01134000
     Receives a pseudo mail message from the specified son process      01136000
     through the Process-to-Process Communication Table.                01138000
>>                                                                      01140000
<< Inputs >>                                                   <<01245>>01142000
     integer                                                   <<01245>>01144000
       SONPIN;                         << PIN of sending son >><<01245>>01146000
                                                               <<01245>>01148000
<< Outputs >>                                                  <<01245>>01150000
     integer                                                   <<01245>>01152000
       MESSAGE;                        << message received >>  <<01245>>01154000
                                                               <<01245>>01156000
option privileged, uncallable;                                 <<01427>>01158000
                                                               <<01427>>01160000
  begin                                                        <<01245>>01162000
    integer                                                    <<01245>>01164000
      MAIL'COUNT,                                              <<01245>>01166000
      MAIL'VALUE;                                              <<01245>>01168000
                                                               <<01245>>01170000
    tos := @MAIL'COUNT;                                        <<01245>>01172000
    tos := PTOP'COMM'DST;                                      <<01245>>01174000
    tos := SONPIN * 2;                                         <<01245>>01176000
    tos := 2;                                                  <<01245>>01178000
    assemble (MFDS 4);                                         <<01245>>01180000
    MESSAGE := MAIL'VALUE;                                     <<01245>>01182000
  end << RECV'PSEUDOMAIL >>;                                   <<01245>>01184000
$PAGE                                                          <<01245>>01186000
procedure FREE'PSEUDOMAIL (SONPIN);                            <<01245>>01188000
  value SONPIN;                                                <<01245>>01190000
<<                                                                      01192000
   Function                                                             01194000
     Cleans up the entry in the Process-to-Process Communication        01196000
     Table used for the Pseudo Mail between a father and son process    01198000
     during creation.                                                   01200000
>>                                                                      01202000
<< Inputs >>                                                   <<01245>>01204000
     integer                                                   <<01245>>01206000
       SONPIN;                         << pin of created son >><<01245>>01208000
                                                               <<01245>>01210000
<< Outputs                                                              01212000
     None.  But sets the appropriate entry in the Process-to-Process    01214000
     Communication Table to 0 for possible later use as a true Mail     01216000
     Box.                                                               01218000
>>                                                                      01220000
option privileged, uncallable;                                 <<01427>>01222000
                                                               <<01245>>01224000
  begin                                                        <<01245>>01226000
    integer                                                    <<01245>>01228000
      MAIL'COUNT,                                              <<01245>>01230000
      MAIL'VALUE;                                              <<01245>>01232000
                                                               <<01245>>01234000
    MAIL'COUNT := 0;   MAIL'VALUE := 0;                        <<01245>>01236000
                                                               <<01245>>01238000
    tos := PTOP'COMM'DST;                                      <<01245>>01240000
    tos := SONPIN * 2;                                         <<01245>>01242000
    tos := @MAIL'COUNT;                                        <<01245>>01244000
    tos := 2;                                                  <<01245>>01246000
    assemble (MTDS 4);                                         <<01245>>01248000
  end << FREE'PSEUDOMAIL >>;                                   <<01245>>01250000
$PAGE "PROCEDURE INITIATE"                                     <<01245>>01252000
procedure INITIATE;                                            <<01245>>01254000
<<                                                                      01256000
   Function                                                             01258000
     Opens the Standard Input and Output files ($STDIN and              01260000
     $STDLIST) for a new process being created on the system.           01262000
     INITIATE is the 1st code a process executes in its life and        01264000
     therefore runs on the stack of the new process.                    01266000
>>                                                                      01268000
<< Inputs                                                               01270000
     None.  Note that INITIATE assumes the FOPEN parameters and the     01272000
     byte arrays containing file name, device, and forms message (if    01274000
     necessary) have been placed on the stack by the creating           01276000
     process.                                                           01278000
>>                                                                      01280000
<< Outputs                                                              01282000
     None.  But sends a message via PSEUDO-MAIL to the father           01284000
     indicating the success or failure of the standard file opens.      01286000
     The meaning of the message is                                      01288000
                                                                        01290000
                -2 - $STDLIST open caused ABORT                         01292000
                -1 - $STDIN open caused ABORT                           01294000
                 0 - $STDIN and $STDLIST opened successfully            01296000
                 1 - $STDIN open failed                                 01298000
                 2 - $STDLIST open failed                               01300000
>>                                                                      01302000
option privileged, uncallable;                                 <<01245>>01304000
                                                               <<01245>>01306000
  begin                                                        <<01245>>01308000
    integer                                                    <<01245>>01310000
      PCBPTR          = Q+1,           << PCB ptr for caller >><<01245>>01312000
      FATHERPCBPTR    = Q+2,           << PCB ptr for father >><<01245>>01314000
      ERRORMSG        = Q+3;           << message to creator >><<01245>>01316000
                                                               <<01245>>01318000
    ERRORON;                                                   <<01870>>01320000
    ERRORMSG := -1;     << assume $STDIN open will ABORT >>    <<01427>>01322000
    SEND'PSEUDOMAIL (ERRORMSG);                                <<01427>>01324000
    PCBPTR := absolute(CPCB) - absolute(PCBB);                 <<01245>>01326000
    FATHERPCBPTR := PCB(PCBPTR+                                <<MPEIV>>01328000
              FATHERSONINFOWORDNUM).FATHERPINFIELD * PCBSIZE;  <<MPEIV>>01330000
    assemble (PCAL FOPEN);                  << $STDIN >>       <<01245>>01332000
    del;     << Fopen return value >>                          <<01245>>01334000
                                                               <<01245>>01336000
    if < then ERRORMSG := 1                                    <<01245>>01338000
    else                                                       <<01245>>01340000
      begin                                                    <<01245>>01342000
        ERRORMSG := -2;     << assume $STDLIST open ABORTs >>  <<01427>>01344000
        SEND'PSEUDOMAIL (ERRORMSG);                            <<01427>>01346000
        assemble (PCAL FOPEN);              << $STDLIST >>     <<01245>>01348000
        del;     << Fopen return value >>                      <<01245>>01350000
        if < then ERRORMSG := 2                                <<01427>>01352000
          else ERRORMSG := 0;                                  <<01427>>01354000
      end;                                                     <<01245>>01356000
                                                               <<01245>>01358000
    << tell creating process what happened and then wait >>    <<01245>>01360000
                                                               <<01245>>01362000
    SEND'PSEUDOMAIL (ERRORMSG);                                <<01245>>01364000
    << note that WAIT will PENABLE >>                          <<01265>>01366000
    PDISABLE;                                                  <<01265>>01368000
    AWAKE (FATHERPCBPTR, JUNKWAIT, 0);                         <<01265>>01370000
    RESETCRITICAL (0);                                         <<01870>>01372000
    WAIT (FATHERWAIT, 0);                                      <<01265>>01374000
    ERROREXIT (0,0,0);                                         <<01870>>01376000
  end << INITIATE >>;                                          <<01245>>01378000
$PAGE "PROCEDURE PROCREATE"                                    <<01245>>01380000
procedure PROCREATE (PIN, PLABEL, DELTAP, STACKDSTX, GLOBSIZE, <<01245>>01382000
                     DLSIZE, LOCSIZE, PRIORITY, STRING,STRLNTH,<<01245>>01384000
                     PARAM, FLAGS, MAXSTACK, STDIN, STDLIST);  <<01245>>01386000
  value PLABEL, DELTAP, STACKDSTX, GLOBSIZE, DLSIZE, LOCSIZE,  <<01245>>01388000
        PRIORITY, STRING, STRLNTH, PARAM, FLAGS, MAXSTACK;     <<01245>>01390000
  integer PLABEL, DELTAP, STACKDSTX, GLOBSIZE, DLSIZE, LOCSIZE,<<01245>>01392000
          PRIORITY, STRING, STRLNTH, PARAM, PIN, MAXSTACK;     <<01245>>01394000
  logical FLAGS;                                               <<01245>>01396000
  logical array STDIN, STDLIST;                                <<01245>>01398000
  option uncallable, privileged;                               <<01245>>01400000
                                                               <<01245>>01402000
COMMENT: SETS UP A PROCESS GIVEN ONE INSTRUCTION AND A DATA SEGMENT.    01404000
                                                               <<01245>>01406000
         RETURNS:                                              <<01245>>01408000
            CCE:  OK                                           <<01245>>01410000
            CCG  (NULL)                                        <<01245>>01412000
            CCL  FAILURE:NO PCB AVAILABLE                      <<01245>>01414000
                                                               <<01245>>01416000
         DB HAS TO BE POINTING TO STACK                        <<01245>>01418000
                                                               <<01245>>01420000
         FLAGS WORD IS CODED AS FOLLOWS:                       <<01245>>01422000
            0:7     ABORT DUMP                                 <<01245>>01424000
            4:1     FATHER ACTIVATION                          <<01245>>01426000
            7:9     CAPABILITY WORD                            <<01245>>01428000
            13:1    INITIAL DEBUG CALL                         <<01245>>01430000
            10:1    0= R/W ACCESS TO PROG. FILE                <<01245>>01432000
      ;                                                        <<01245>>01434000
                                                               <<01245>>01436000
                                                               <<01245>>01438000
                                                               <<01245>>01440000
BEGIN                                                          <<01245>>01442000
      EQUATE JITX=6;                                           <<01245>>01444000
      EQUATE TERMIL=%1156,TERMEL=%1155;                        <<01245>>01446000
      EQUATE   PXSIZE=PXGLOB+PXFIXED+PXFILE+4,                 <<01245>>01448000
               SPXSIZE=SPXGLOB+SPXFIXED+SPXFILE+4;             <<01245>>01450000
      EQUATE PSIR=5;                                           <<01245>>01452000
      EQUATE JOBN=19;                                          <<01245>>01454000
                                                               <<01245>>01456000
      INTEGER PRI, QRELPIN;                                <<*D<<01245>>01458000
      INTEGER PROC,V,SIR,CX,T,K;                               <<01245>>01460000
DOUBLE SAVEDB;                                                 <<MPEIV>>01462000
      POINTER JIT1=DB+2,JIT2=DB+3;                             <<01245>>01464000
      INTEGER VIRT;                                            <<01245>>01466000
      EQUATE VMPAGESIZEIX = %3;                                <<MPEIV>>01468000
      INTEGER POINTER VDSMTAB = %26;                           <<MPEIV>>01470000
      DEFINE VMPAGESIZE = VDSMTAB(VMPAGESIZEIX)#;              <<MPEIV>>01472000
                                                               <<MPEIV>>01474000
                                                               <<MPEIV>>01476000
      INTEGER POINTER PCBTABLE = 3;                            <<01245>>01478000
      INTEGER POINTER  DST = 2;                                <<01245>>01480000
      INTEGER POINTER  CSTBLK = %51;                           <<01245>>01482000
      INTEGER ARRAY STACK(*)=DB+0;                             <<01245>>01484000
      INTEGER ARRAY PX(0:8)=PB:=PXGLOB,SPXGLOB,PXFIXED,SPXFIXED,        01486000
                        PXFILE,SPXFILE,PXSIZE,SPXSIZE;         <<01245>>01488000
      INTEGER ARRAY PTY(0:4)=PB:=0,0,2,1;   <<PROCESS TYPE>>   <<01245>>01490000
      INTEGER ARRAY PCBX(*)=Q+0;                               <<01245>>01492000
      LOGICAL JN;                                              <<01245>>01494000
      INTEGER BASE, DBBASE, SIN, SLIST, STCOUNT;               <<01245>>01496000
                                                               <<01245>>01498000
      DEFINE                                                   <<01245>>01500000
        NAME            = (3:1)#,                              <<01245>>01502000
        DEVICE          = (7:1)#,                              <<01245>>01504000
        FORMMSG         = (8:1)#;   << FLAGS IN FOPEN OVMASK >><<01245>>01506000
                                                               <<01245>>01508000
                                                               <<01740>>01510000
      << DECLARATIONS FOR PROCESS INSTRUMENTATION >>           <<01740>>01512000
      INTEGER MYPCBPTR, MEASPROCENTSIZE, SIRCOND;              <<01740>>01514000
                                                               <<01740>>01516000
      LOGICAL MEASPROCENTPTR;                                  <<01740>>01518000
                                                               <<01740>>01520000
      LOGICAL ARRAY PROCESS'NAME(0:11);                        <<01740>>01522000
                                                               <<01740>>01524000
      DEFINE UCOP'CALL = PCB(MYPCBPTR+                         <<01740>>01526000
                          PROCSTATEWORDNUM).PTYPEFIELD = 6#;   <<01740>>01528000
                                                               <<01245>>01530000
   INTEGER SUBROUTINE WORDADDRESS' (BYTEADDRESS);              <<01245>>01532000
     VALUE BYTEADDRESS;                                        <<01245>>01534000
     LOGICAL BYTEADDRESS;                                      <<01245>>01536000
     BEGIN                                                     <<01245>>01538000
       TOS := WORDADDRESS' := BYTEADDRESS & LSR(1);            <<01245>>01540000
       PUSH (Z);                                               <<01245>>01542000
       IF <<WORDADDRESS'>> TOS > TOS <<Z>> THEN                <<01245>>01544000
         WORDADDRESS'.(0:1) := 1;                              <<01245>>01546000
     END;                                                      <<01245>>01548000
                                                               <<01245>>01550000
      SIN := STDIN;   SLIST := STDLIST;                        <<01245>>01552000
                                                               <<01245>>01554000
      TOS:=SETCRITICAL;                                        <<01245>>01556000
      TOS:=PIN;                                                <<01245>>01558000
      IF = THEN                        <<NOT YET A PCB>>       <<01245>>01560000
      BEGIN                                                    <<01245>>01562000
         TOS:=GETENTRY(PCBB);                                  <<01245>>01564000
         ASSEMBLE(TEST);                                       <<01245>>01566000
         IF = THEN                     <<NO PCB AVAILABLE>>    <<01245>>01568000
         BEGIN                                                 <<01245>>01570000
            PIN:=TOS;                  <<PIN RETURNED EQUAL TO 0>>      01572000
            TOS:=CCL;                                          <<01245>>01574000
            GOTO FIN;                                          <<01245>>01576000
         END;                                                  <<01245>>01578000
         ASSEMBLE(DUP);                                        <<01245>>01580000
         PIN:=TOS;ASSEMBLE(XCH,DEL);                           <<01245>>01582000
      END;                                                     <<01245>>01584000
      QRELPIN := PIN;                                      <<*D<<01245>>01586000
      PROC:=TOS*PCBSIZE;                                       <<01245>>01588000
                                                               <<01245>>01590000
      JN := STDIN;                                             <<01245>>01592000
                                                               <<01245>>01594000
      STCOUNT := 0;                                            <<01245>>01596000
      if STRLNTH > 0 then                                      <<01245>>01598000
        begin  << a string was specified >>                    <<01245>>01600000
          if logical(STRLNTH) then                             <<01245>>01602000
            STCOUNT := STRLNTH&lsr(1) + 1                      <<01245>>01604000
          else                                                 <<01245>>01606000
            begin  << even length >>                           <<01245>>01608000
              if logical(STRING) then                          <<01245>>01610000
                STCOUNT := STRLNTH&lsr(1) + 2                  <<01245>>01612000
              else                                             <<01245>>01614000
                STCOUNT := STRLNTH&lsr(1);                     <<01245>>01616000
            end;                                               <<01245>>01618000
        end;                                                   <<01245>>01620000
                                                               <<01245>>01622000
      << PCBX FORMATTING >>                                    <<01245>>01624000
      TOS:=EXCHANGEDB(STACKDSTX);      <<DB TO NEW STACK>>     <<01245>>01626000
      VIRT :=  DST(STACKDSTX&LSL(2)+1).VMALLOC * VMPAGESIZE;   <<MPEIV>>01628000
      V:= IF ABSOLUTE(ABSOLUTE(CPCB)+9).(6:2)=2 THEN 0 ELSE 0; <<01245>>01630000
      STACK := 0;                                              <<01245>>01632000
      MOVE  STACK(1) := STACK,((IF LOGICAL(V) THEN SPXSIZE ELSE<<01245>>01634000
                               PXSIZE)-1);   << ZERO PCBX >>   <<01245>>01636000
      TOS:=PX(6+V);ASSEMBLE(DUP,DDUP,DDUP);                    <<01245>>01638000
      STACK(0):=TOS;                                           <<01245>>01640000
      STACK(1):=TOS+DLSIZE;                                    <<01245>>01642000
      ASSEMBLE(DECA,STAX);                                     <<01245>>01644000
      STACK(X):=TOS;                                           <<01245>>01646000
      TOS:=PX(V);                      <<PXGLOB>>              <<01245>>01648000
      ASSEMBLE(SUB,XCH);                                       <<01245>>01650000
      TOS:=TOS-2; ASSEMBLE(STAX);                              <<01245>>01652000
      STACK(X):=TOS;                                           <<01245>>01654000
      TOS := X-1;       << PXFILE PTR >>                       <<01245>>01656000
      TOS := PX(V+4)+4;                                        <<01245>>01658000
      ASSEMBLE( XCH,STAX );                                    <<01245>>01660000
      STACK(X) := TOS;                                         <<01245>>01662000
      IF LOGICAL(V) THEN STACK(X:=X-1):=-1;   <<SYSTEM PROCESS>>        01664000
      STACK(PX(V)+PX(2+V)):=PX(4+V);                           <<01245>>01666000
      STACK(PX(V)):=PX(2+V);                                   <<01245>>01668000
      X:=X+1;                          <<RESERVED FOR S VALUE>><<01245>>01670000
      STACK(X:=X+1):=GLOBSIZE+LOCSIZE; <<REL Z >>              <<01245>>01672000
      STACK(X:=X+1):=GLOBSIZE + STCOUNT + 2;   << Q init - DB >>        01674000
      STACK(X:=X+1):=DLSIZE;           << DB - DL >>           <<01245>>01676000
      STACK(X:=X+1):=FLAGS LAND %713;        << CAP >>         <<01245>>01678000
      X:=X+1;                                                  <<01245>>01680000
      STACK(X:=X+1):=4;                <<XTRA DATA SEGMENT COUNT>>      01682000
      TOS := FLAGS.(10:1)&LSL(8);                              <<01245>>01684000
      TOS.(8:8) := PLABEL;                                     <<01245>>01686000
      STACK(X:=X+5) := TOS;                                    <<01245>>01688000
      STACK(X:=X+1):=MAXSTACK;                                 <<01245>>01690000
      TOS:=VIRT; ASSEMBLE(DUP);        <<VIRTUAL MEME SIZE>>   <<01245>>01692000
      STACK(X:=X+7):=TOS;                                      <<01245>>01694000
      <<  CURRENT MAX STACK SIZE  Z-DL  >>                     <<01245>>01696000
      STACK(X:=X+3):=GLOBSIZE+LOCSIZE+DLSIZE;                  <<01245>>01698000
      <<  TOTAL VIRTUAL STORAGE IN SECTORS  >>                 <<01245>>01700000
      STACK(X:=X+4):=(TOS+127)&LSR(7);                         <<01245>>01702000
      CPUNUM;    << GET CPU NUMBER >>                          <<04664>>01704000
      IF TOS= SERIES64 THEN STACK(X:= X+3).(0:2):= PMBC'INIT;  <<04664>>01706000
                                                               <<04664>>01708000
                                                               <<01245>>01710000
      <<MARKER TO TERMINATE>>                                  <<01245>>01712000
      TOS:=V;                                                  <<01245>>01714000
      X := STACK(0) + DLSIZE + GLOBSIZE + STCOUNT;             <<01245>>01716000
      << BASE PTS TO DELTAQ OF STKMARKER FOLLOWING INITIATE >> <<01245>>01718000
      BASE := X + 10;                                          <<01245>>01720000
                                                               <<01245>>01722000
      STACK(X) := STRLNTH;                                     <<01245>>01724000
      IF STRLNTH > 0 THEN                                      <<01245>>01726000
        STACK(X:=X+1) := GLOBSIZE&LSL(1) + STRING.(15:1)       <<01245>>01728000
      ELSE                                                     <<01245>>01730000
        STACK(X:=X+1) := 0;                                    <<01245>>01732000
      STACK(X:=X+1) := PARAM;                                  <<01245>>01734000
                                                               <<01245>>01736000
      STACK(X+1):=0;                   <<X>>                   <<01245>>01738000
      V:=X+1;                                                  <<01245>>01740000
      STACK(V):=ABSOLUTE(TERMIL);                              <<01245>>01742000
      TOS:=ABSOLUTE(TERMEL);       <<EXT LABEL OF TERMINATE>>  <<01245>>01744000
      TOS:=TOS LAND %377;              <<EXTRACT CST>>         <<01245>>01746000
      TOS:=TOS LOR %140000;            <<INTERRPT AND PRIV MODE>>       01748000
      STACK(V:=V+1):=TOS;              <<STORE IN STATUS WORD>><<01245>>01750000
      STACK(X:=X+1):=4;                <<DELTA Q>>             <<01245>>01752000
      STACK(X:=X+1):=0;                <<X>>                   <<01245>>01754000
      STACK(X:=X+1):=DELTAP;                                   <<01245>>01756000
      STACK(X:=X+1):=%60000+PLABEL;    <<PRIV MODE IN CST.(0:1)>>       01758000
      STACK(X:=X+1):=4;                <<DELTA Q>>             <<01245>>01760000
      IF  FLAGS.(13:1) LAND NOT (FLAGS.(10:1))  THEN           <<01245>>01762000
         BEGIN  << BUILD A MARKER TO DEBUG >>                  <<01245>>01764000
         STACK(X:=X+1) := 0;          << XREG >>               <<01245>>01766000
         PLABEL := @DEBUG.(8:8);                               <<01245>>01768000
         STACK(X:=X+1):=DELTAP:=CONVEXTLABELTODELTAP(@DEBUG);  <<MPEIV>>01770000
         STACK(X:=X+1):=%160000+PLABEL;                        <<01245>>01772000
         STACK(X:=X+1):=4;                                     <<01245>>01774000
         BASE := BASE + 4;                                     <<01245>>01776000
         END;                                                  <<01245>>01778000
      TOS := X;                                                <<01245>>01780000
      DBBASE := BASE - (STACK(0) + DLSIZE);                    <<01245>>01782000
      IF ABSOLUTE(ABSOLUTE(CPCB)+9).(6:2) > 1 OR SIN = 0       <<01245>>01784000
        THEN X := TOS                                          <<01245>>01786000
        ELSE                                                   <<01245>>01788000
        BEGIN   << SET UP FOR INITIATE >>                      <<01245>>01790000
         EXCHANGEDB (0);                                       <<01254>>01792000
         JN := TOS + 109; << tos = old x >>                    <<01245>>01794000
                                                               <<01245>>01796000
         << DBBASE IS # WORDS FROM DB TO DELTAQ OF MARKER >>   <<01245>>01798000
         TOS := STACKDSTX;                                     <<01245>>01800000
         IF STDLIST.NAME = 1 THEN                              <<01245>>01802000
           BEGIN                                               <<01245>>01804000
             TOS := BASE + 4;                                  <<01245>>01806000
             TOS := WORDADDRESS' (STDLIST(1));                 <<01245>>01808000
             TOS := 18;                                        <<01245>>01810000
             ASSEMBLE (MTDS 3);                                <<01245>>01812000
             STDLIST(1) := (DBBASE+4)&LSL(1);                  <<01245>>01814000
           END;                                                <<01245>>01816000
         IF STDLIST.DEVICE = 1 THEN                            <<01245>>01818000
           BEGIN                                               <<01245>>01820000
             TOS := BASE + 22;                                 <<01245>>01822000
             TOS := WORDADDRESS' (STDLIST(5));                 <<01245>>01824000
             TOS := 9;                                         <<01245>>01826000
             ASSEMBLE (MTDS 3);                                <<01245>>01828000
             STDLIST(5) := (DBBASE+22)&LSL(1);                 <<01245>>01830000
           END;                                                <<01245>>01832000
         IF STDLIST.FORMMSG = 1 THEN                           <<01245>>01834000
           BEGIN                                               <<01245>>01836000
             TOS := BASE + 31;                                 <<01245>>01838000
             TOS := WORDADDRESS' (STDLIST(6));                 <<01245>>01840000
             TOS := 25;                                        <<01245>>01842000
             ASSEMBLE (MTDS 3);                                <<01245>>01844000
             STDLIST(6) := (DBBASE+31)&LSL(1);                 <<01245>>01846000
           END;                                                <<01245>>01848000
         IF STDIN.NAME = 1 THEN                                <<01245>>01850000
           BEGIN                                               <<01245>>01852000
             TOS := BASE + 56;                                 <<01245>>01854000
             TOS := WORDADDRESS' (STDIN(1));                   <<01245>>01856000
             TOS := 18;                                        <<01245>>01858000
             ASSEMBLE (MTDS 3);                                <<01245>>01860000
             STDIN(1) := (DBBASE+56)&LSL(1);                   <<01245>>01862000
           END;                                                <<01245>>01864000
         IF STDIN.DEVICE = 1 THEN                              <<01245>>01866000
           BEGIN                                               <<01245>>01868000
             TOS := BASE + 74;                                 <<01245>>01870000
             TOS := WORDADDRESS' (STDIN(5));                   <<01245>>01872000
             TOS := 9;                                         <<01245>>01874000
             ASSEMBLE (MTDS 3);                                <<01245>>01876000
             STDIN(5) := (DBBASE+74)&LSL(1);                   <<01245>>01878000
           END;                                                <<01245>>01880000
         IF STDIN.FORMMSG = 1 THEN                             <<01245>>01882000
           BEGIN                                               <<01245>>01884000
             TOS := BASE + 83;                                 <<01245>>01886000
             TOS := WORDADDRESS' (STDIN(6));                   <<01245>>01888000
             TOS := 25;                                        <<01245>>01890000
             ASSEMBLE (MTDS 3);                                <<01245>>01892000
             STDIN(6) := (DBBASE+83)&LSL(1);                   <<01245>>01894000
           END;                                                <<01245>>01896000
         DEL;     << STACKDSTX >>                              <<01245>>01898000
                                                               <<01245>>01900000
         TOS := STACKDSTX;                                     <<01245>>01902000
         TOS := JN;                                            <<01245>>01904000
         TOS := @STDLIST(1);                                   <<01245>>01906000
         TOS := 14;                                            <<01245>>01908000
         ASSEMBLE (MTDS 3);   << KEEP DST # >>                 <<01245>>01910000
                                                               <<01245>>01912000
         TOS := JN + 16;                                       <<01245>>01914000
         TOS := @STDIN(1);                                     <<01245>>01916000
         TOS := 14;                                            <<01245>>01918000
         ASSEMBLE (MTDS 4);                                    <<01245>>01920000
                                                               <<01245>>01922000
         EXCHANGEDB (STACKDSTX);                               <<01245>>01924000
         STACK(JN:=JN+14) := SLIST;   << OVMASK >>             <<01245>>01926000
         STACK(JN:=JN+16) := SIN;     << OVMASK >>             <<01245>>01928000
         TOS := LOGICAL(ABSOLUTE(%1122).(8:8)) LOR %160000;    <<01245>>01930000
         TOS := ABSOLUTE(X:=X+1);                              <<01245>>01932000
         X := JN;                                              <<01245>>01934000
         STACK(X:=X+1) := 0;                                   <<01245>>01936000
         STACK(X:=X+1) := TOS;  <<DELTAP FOR INITIATE>>        <<01245>>01938000
         STACK(X:=X+1) := TOS;  <<STATUS FOR INITIATE>>        <<01245>>01940000
         STACK(X:=X+1) := 143;                                 <<01245>>01942000
         END;                                                  <<01245>>01944000
      STACK(X:=X+1):=0;                <<DB>>                  <<01245>>01946000
      STACK(X:=X+1) := 0;                                      <<01245>>01948000
      V:=TOS;                                                  <<01245>>01950000
      TOS:=X; TOS:=STACK(1); ASSEMBLE(SUB);                    <<01245>>01952000
      STACK(PX(V)+1):=TOS;             <<STORE S RELATIVE>>    <<01245>>01954000
      <<MOVE GLOBAL INFO>>                                     <<01245>>01956000
      PUSH(Q,DL); ASSEMBLE(XCH,SUB);                           <<01245>>01958000
      ASSEMBLE(DUP); ASSEMBLE(STAX,DECX); TOS:=PCBX(X); ASSEMBLE(SUB);  01960000
      K:=TOS+2; T:=2;CX:=2;                                    <<01245>>01962000
      WHILE (CX:=CX+1)<=PX(V) DO                               <<01245>>01964000
      BEGIN STACK(T):=PCBX(K);T:=T+1;K:=K+1; END;              <<01245>>01966000
      << ABORT DUMP FLAGS SET HERE >>                          <<01245>>01968000
      TOS := FLAGS&LSR(9) LAND %173;                           <<01245>>01970000
      ASSEMBLE( DUP );                                         <<01245>>01972000
      CASE  * TOS.(14:2)  OF                                   <<01245>>01974000
         BEGIN                                                 <<01245>>01976000
         DEL;        << NO CHANGE >>                           <<01245>>01978000
            BEGIN                                              <<01245>>01980000
            TOS := TOS&LSR(3);                                 <<01245>>01982000
            TOS.(10:1) := 1;                                   <<01245>>01984000
            STACK(5).(0:6) := TOS;                             <<01245>>01986000
            END;                                               <<01245>>01988000
         DEL;                                                  <<01245>>01990000
            BEGIN                                              <<01245>>01992000
            STACK(5).(0:6) := 0;                               <<01245>>01994000
            DEL;                                               <<01245>>01996000
            END;                                               <<01245>>01998000
         END;                                                  <<01245>>02000000
      ASSEMBLE(ZERO,XCH);                                      <<01245>>02002000
      <<COPY JOB NUMBER>>                                      <<01245>>02004000
      PUSH(Q,DL);ASSEMBLE(XCH,SUB;DUP,STAX;DECX,DECX);         <<01245>>02006000
      TOS:=-PCBX(X);ASSEMBLE(ADD);X:=TOS+JOBN;TOS:=PCBX(X);    <<01245>>02008000
      ASSEMBLE( DUP,DUP );                                     <<01245>>02010000
      JN := TOS;                                               <<01245>>02012000
      STACK(PXGLOB+JOBN):=TOS;                                 <<01245>>02014000
      EXCHANGEDB(PJXREF);                                  <<*D<<01245>>02016000
      STACK(QRELPIN) := TOS; << JOB NUMBER, THIS PROCESS >><<*D<<01245>>02018000
      EXCHANGEDB(*);                                           <<01245>>02020000
                                                               <<01245>>02022000
      <<SET UP PROCESS CONTROL BLOCK>>                         <<01245>>02024000
                                                               <<01245>>02026000
      TOS:=ABSOLUTE(CPCB)-ABSOLUTE(PCBB);                      <<01245>>02028000
      ASSEMBLE(DUP,DUP);                                       <<01245>>02030000
      PDISABLE;                                                <<01245>>02032000
      V:=PROC/PCBSIZE;                                         <<01245>>02034000
      TOS:=TOS/PCBSIZE;                                        <<01245>>02036000
      TOS:=TOS&LSL(8);                                         <<01245>>02038000
      PCBTABLE(PROC+5):=TOS;           <<FATHER POINTER>>      <<01245>>02040000
      X:=TOS+5;                                                <<01245>>02042000
      TOS:= LOGICAL(PCBTABLE(X)) LAND %377;                    <<01245>>02044000
      IF = THEN                                                <<01245>>02046000
      BEGIN                                                    <<01245>>02048000
         PCBTABLE(X):=PCBTABLE(X)+V;                           <<01245>>02050000
         DEL;                                                  <<01245>>02052000
      END ELSE                                                 <<01245>>02054000
      BEGIN                                                    <<01245>>02056000
         CX:=TOS*PCBSIZE;                                      <<01245>>02058000
         WHILE (T:=PCBTABLE(CX+6)&LSR(8))<>0 DO CX:=T*PCBSIZE; <<01245>>02060000
         PCBTABLE(CX+6).(0:8):=V;      <<STORE BROTHER I D >>  <<01245>>02062000
      END;                                                     <<01245>>02064000
      PENABLE;                                                 <<01245>>02066000
                                                               <<01245>>02068000
      <<PROCESS TYPE>>                                         <<01245>>02070000
      V:=TOS+9;                                                <<01245>>02072000
      K:=PROC+9;                                               <<01245>>02074000
      TOS:=PTY(PCBTABLE(V).(6:2));                             <<01245>>02076000
      T:=TOS;                                                  <<01245>>02078000
      PCBTABLE(K).(6:2):=T;            <<FIRST TWO BIT OF PROCE<<01245>>02080000
      IF T=0 THEN                 <<NEW PROCESS NOT A MAIN>>   <<01245>>02082000
      PCBTABLE(K).(8:1):=PCBTABLE(V)&LSR(8);     <<SON OF MAIN BIT>>    02084000
      PRI := PRIORITY.(8:8);                               <<*D<<01245>>02086000
      IF  T > 0  THEN                                      <<*D<<01245>>02088000
         BEGIN  << SYSTEM PROCESS OR MAIN PROCESS >>       <<*D<<01245>>02090000
         TOS := 1;                                         <<*D<<01245>>02092000
         IF T <> 1 THEN                                    <<*D<<01245>>02094000
            BEGIN  << SYSTEM PROCESS >>                    <<*D<<01245>>02096000
            TOS := TOS&LSL(1);                             <<*D<<01245>>02098000
            IF PRI < 150 THEN TOS := TOS&LSL(1);           <<*D<<01245>>02100000
            END                                            <<*D<<01245>>02102000
         ELSE                                              <<*D<<01245>>02104000
            BEGIN                                          <<*D<<01245>>02106000
            IF PRI = 250 THEN TOS := TOS LOR %10           <<*D<<01245>>02108000
            ELSE                                           <<*D<<01245>>02110000
               BEGIN                                       <<*D<<01245>>02112000
               IF PRI < 200 THEN TOS := TOS&LSL(1);        <<*D<<01245>>02114000
               IF PRI < 150 THEN TOS := TOS&LSL(1);        <<*D<<01245>>02116000
               END;                                        <<*D<<01245>>02118000
            END;                                           <<*D<<01245>>02120000
         PRIORITY.QTYPE := TOS;                            <<*D<<01245>>02122000
   IF PRIORITY.EQ=1 THEN PRIORITY.(8:8):=                      <<MPEIV>>02124000
      ICS(-ICS'ESCHEDBASECELL)                                 <<MPEIV>>02126000
   ELSE                                                        <<MPEIV>>02128000
      IF PRIORITY.DQ=1 THEN PRIORITY.(8:8):=                   <<MPEIV>>02130000
         ICS(-ICS'DSCHEDBASECELL)                              <<MPEIV>>02132000
      ELSE                                                     <<MPEIV>>02134000
         IF PRIORITY.CQ = 1 THEN PRIORITY.(8:8) :=             <<04491>>02136000
            ICS(-ICS'CSCHEDBASECELL);                          <<04491>>02138000
         END;                                              <<*D<<01245>>02140000
                                                               <<01245>>02142000
      <<PCB MISCELLANEOUS>>                                    <<01245>>02144000
DISAPROC;                                                      <<MPEIV>>02146000
TOS:=%1000D;                                                   <<MPEIV>>02148000
ASSEMBLE(XCHD);                                                <<MPEIV>>02150000
SAVEDB:=TOS;                                                   <<MPEIV>>02152000
X:=PROC+PCBSYSBASEINX;                                         <<MPEIV>>02154000
STKINFO.STKDSTFIELD:=STACKDSTX;                                <<MPEIV>>02156000
TOS:=0;                                                        <<MPEIV>>02158000
TOS.SARFLAG:=1;                                                <<MPEIV>>02160000
RESABORTINFO:=TOS;                                             <<MPEIV>>02162000
QUEUEINGINFO.PRIFIELD:=PRIORITY.(8:8);                         <<MPEIV>>02164000
TOS:=PRIORITY;                                                 <<MPEIV>>02166000
ASSEMBLE(TBC 1);                                               <<MPEIV>>02168000
IF <> THEN QUEUEINGINFO.ESCHEDFLAG:=1;                         <<MPEIV>>02170000
ASSEMBLE(TBC 2);                                               <<MPEIV>>02172000
IF <> THEN QUEUEINGINFO.LSCHEDFLAG:=1;                         <<MPEIV>>02174000
ASSEMBLE(TBC 3);                                               <<MPEIV>>02176000
IF <> THEN QUEUEINGINFO.CSCHEDFLAG:=1;                         <<MPEIV>>02178000
ASSEMBLE(TBC 4);                                               <<MPEIV>>02180000
      << EQ and DQ can both get set from the code in the>>     <<01908>>02182000
      << PROCESS TYPE area above.  To resolve this, a   >>     <<01908>>02184000
      << patch is made to the next line. It is temporary>>     <<01908>>02186000
      IF <> AND (QUEUEINGINFO.ESCHEDFLAG=0) THEN               <<01908>>02188000
            QUEUEINGINFO.DSCHEDFLAG := 1;                      <<01908>>02190000
ASSEMBLE(TBC 5);                                               <<MPEIV>>02192000
IF <> THEN QUEUEINGINFO.PROCRESIDENTFLAG:=1;                   <<MPEIV>>02194000
ASSEMBLE(DEL);                                                 <<MPEIV>>02196000
PIINFONIMPPIN.PSIMFIELD:=7; <<NORMAL STATE>>                   <<MPEIV>>02198000
PROCSTATE.ALIVEFLAG:=1;                                        <<MPEIV>>02200000
IF FLAGS.(4:1) THEN PIINFONIMPPIN.FACFLAG:=1;                  <<MPEIV>>02202000
WAKEMASK.FATHERWAITFLAG:=1;                                    <<MPEIV>>02204000
WAKEMASK.MEMORYWAITFLAG:=1;                                    <<MPEIV>>02206000
TOS:=GETSYSTABENTRY(SWAPTABSYSBASEINX);                        <<MPEIV>>02208000
ASSEMBLE(TEST);                                                <<MPEIV>>02210000
IF = THEN SUDDENDEATH(602);                                    <<01635>>02212000
SLLPTR:=S0;                                                    <<MPEIV>>02214000
X:=TOS;                                                        <<MPEIV>>02216000
TOS:=GETSYSTABENTRY(SWAPTABSYSBASEINX);                        <<MPEIV>>02218000
ASSEMBLE(TEST);                                                <<MPEIV>>02220000
IF = THEN SUDDENDEATH(602);                                    <<01635>>02222000
SLLFIRSTINX:=S0;                                               <<MPEIV>>02224000
SLLMEMREQINX:=S0;                                              <<MPEIV>>02226000
SLLSEGCNT:=1;                                                  <<MPEIV>>02228000
X:=TOS;                                                        <<MPEIV>>02230000
SLLSEGIDENT:=STACKDSTX;                                        <<MPEIV>>02232000
SLLFLAGS.SLLSTKENTRYFLAG:=1;                                   <<MPEIV>>02234000
TOS:=SAVEDB;                                                   <<MPEIV>>02236000
ASSEMBLE(XCHD);                                                <<MPEIV>>02238000
ENAPROC;                                                       <<MPEIV>>02240000
      TOS:=CCE;                                                <<01245>>02242000
                                                               <<01245>>02244000
      IF FLAGS.(11:1) THEN                                     <<01245>>02246000
        BEGIN  << NOCB WAS SPECIFIED >>                        <<01245>>02248000
          << SET NOCB BIT IN PXFILE AREA OF NEW STACK >>       <<01245>>02250000
          TOS := %100000;                                      <<01245>>02252000
          TOS := STACKDSTX;                                    <<01245>>02254000
          TOS := PXGLOB + PXFIXED + 2;                         <<01245>>02256000
          TOS := @S2;                                          <<01245>>02258000
          TOS := 1;                                            <<01245>>02260000
          ASSEMBLE (MTDS 4);                                   <<01245>>02262000
          DEL;   << NOCB BIT WORD >>                           <<01245>>02264000
        END;                                                   <<01245>>02266000
                                                               <<01245>>02268000
      <<ACCUMULATE # OF CREATIONS>>                            <<01245>>02270000
      IF NOT(ABSOLUTE(ABSOLUTE(CPCB)+9).(6:1)) THEN            <<01245>>02272000
      BEGIN                            <<USER PROCESS>>        <<01245>>02274000
         PUSH(Q,DL);ASSEMBLE(XCH,SUB;DUP,STAX;DECX);           <<01245>>02276000
         TOS:=-PCBX(X);ASSEMBLE(ADD);X:=TOS+JITX;              <<01245>>02278000
         TOS:=0; TOS:=PCBX(X).(6:10); TOS:=EXCHANGEDB(*);      <<01245>>02280000
         TOS:=JIT2(1); TOS:=TOS+1;     <<# CREATIONS +1>>      <<01245>>02282000
         IF < THEN BEGIN DEL;TOS:=%77777;END;    <<OVERFLOW>>  <<01245>>02284000
         JIT2(X):=TOS;                 <<STORE BACK>>          <<01245>>02286000
         ASSEMBLE(ZERO,XCH); EXCHANGEDB(*);                    <<01245>>02288000
      END;                                                     <<01245>>02290000
                                                               <<01740>>02292000
      SIRCOND := GETSIR (MEASSIR);                             <<01740>>02294000
      IF GCLASSENABLEDMASK.CLASS15 THEN                        <<01740>>02296000
        BEGIN  << PROCESS INSTRUMENTATION ENABLED >>           <<01740>>02298000
          IF PLABEL.(8:8) < %301 THEN                          <<01740>>02300000
            BEGIN  << PROCREATE MUST MAKE ENTRY >>             <<01740>>02302000
              << NOTE THAT FOR NORMAL PROGRAM FILES          >><<01740>>02304000
              << (I.E. PLABEL >= %301), CREATEPROCESS MAKES  >><<01740>>02306000
              << THE ENTRY.                                  >><<01740>>02308000
                                                               <<01740>>02310000
              << GET POINTER TO APPROPRIATE ENTRY >>           <<01740>>02312000
              TOS := MEASPROCXDSBANK;                          <<01740>>02314000
              TOS := MEASPROCXDSBASE;                          <<01740>>02316000
              ASSEMBLE (LSEA);          << GET ENTRY SIZE >>   <<01740>>02318000
              MEASPROCENTSIZE := TOS;   << REMEMBER SIZE >>    <<01740>>02320000
              TOS := PIN * MEASPROCENTSIZE;   << OFFSET >>     <<01740>>02322000
              ASSEMBLE (LADD);     << ABSOLUTE PTR TO ENTRY >> <<01740>>02324000
              MEASPROCENTPTR := S0;   << REMEMBER ENTRY PTR >> <<01740>>02326000
                                                               <<01740>>02328000
              << INITIALIZE ENTRY WITH ZEROES >>               <<01740>>02330000
              K := 0;                                          <<01740>>02332000
              WHILE (K := K + 1) <= MEASPROCENTSIZE DO         <<01740>>02334000
                BEGIN                                          <<01740>>02336000
                  TOS := 0;                                    <<01740>>02338000
                  ASSEMBLE (SSEA);     << CLEAR THE WORD >>    <<01740>>02340000
                  TOS := TOS + 1;      << PTR TO NEXT WORD >>  <<01740>>02342000
                END;                                           <<01740>>02344000
                                                               <<01740>>02346000
              << FILL IN CREATE TIME >>                        <<01740>>02348000
              S0 := MEASPROCENTPTR + LOGICAL(CP'CREATETIME);   <<01740>>02350000
              TOS := TIMER;        << DOUBLE WORD TIME STAMP >><<01740>>02352000
              ASSEMBLE (SDEA);     << PLACE TIME IN ENTRY >>   <<01740>>02354000
                                                               <<01740>>02356000
              << FILL IN JOB/SESSION NUMBER >>                 <<01740>>02358000
              S0 := MEASPROCENTPTR + LOGICAL(CP'JOBSESSIONNUM);<<01740>>02360000
              TOS := JN;           << JOB/SESSION NUM >>       <<01740>>02362000
              ASSEMBLE (SSEA);     << PLACE J/S NUM IN ENTRY >><<01740>>02364000
                                                               <<01740>>02366000
              << FILL IN QUEUE DESCRIPTOR WORD >>              <<01740>>02368000
              S0 := MEASPROCENTPTR+LOGICAL(CP'PROCQUESTOPWORD);<<01740>>02370000
              TOS := 0;                                        <<01740>>02372000
              S0.(0:4) := PCB(PIN*PCBSIZE+                     <<01740>>02374000
                                QUEUEINGINFOWORDNUM).QTYPE;    <<01740>>02376000
              ASSEMBLE (SSEA);     << PLACE Q WORD IN ENTRY >> <<01740>>02378000
                                                               <<01740>>02380000
              DDEL;          << XDS BANK & ADDRESS >>          <<01740>>02382000
                                                               <<01740>>02384000
              << FILL IN PROCESS NAME >>                       <<01740>>02386000
              PROCESS'NAME := "  ";                            <<01740>>02388000
              MOVE PROCESS'NAME(1) := PROCESS'NAME, (11);      <<01740>>02390000
              MYPCBPTR := ABSOLUTE(CPCB) - ABSOLUTE(PCBB);     <<01740>>02392000
              IF UCOP'CALL THEN                                <<01740>>02394000
                MOVE PROCESS'NAME := "CI"                      <<01740>>02396000
              ELSE                                             <<01740>>02398000
                MOVE PROCESS'NAME := "SP";                     <<01740>>02400000
              TOS := MEASPROCXDSNUM;                           <<01740>>02402000
              TOS := MEASPROCENTPTR - MEASPROCXDSBASE;         <<01740>>02404000
              TOS := TOS + LOGICAL(CP'PROGNAME);               <<01740>>02406000
              TOS := @PROCESS'NAME;                            <<01740>>02408000
              TOS := 12;                                       <<01740>>02410000
              ASSEMBLE (MTDS);     << PLACE NAME IN ENTRY >>   <<01740>>02412000
            END << PROCREATE MAKES ENTRY >>;                   <<01740>>02414000
        END << PROCESS INSTRUMENTATION >>;                     <<01740>>02416000
      RELSIR (MEASSIR, SIRCOND);                               <<01740>>02418000
                                                               <<01245>>02420000
FIN:                                                           <<01245>>02422000
      STATUS.(6:2):=TOS;                                       <<01245>>02424000
      RESETCRITICAL(*);                                        <<01245>>02426000
                                                               <<01245>>02428000
                                                               <<01245>>02430000
END;  << P R O C R E A T E  >>                                 <<01245>>02432000
$PAGE "PROCEDURE CHECKPRIORITY"                                <<01254>>02434000
INTEGER PROCEDURE CHECKPRIORITY(PRCLASS,PCBPT);                         02436000
VALUE PRCLASS,PCBPT;                                                    02438000
LOGICAL PRCLASS; INTEGER PCBPT;                                         02440000
OPTION PRIVILEGED,UNCALLABLE;                                           02442000
                                                                        02444000
COMMENT: CHECKS THE VALIDITY OF THE PRIORITY CLASS SPECIFIED            02446000
         FOR THE SPECIFIED PROCESS.                                     02448000
         PRCLASS.(8:8)="S","M" OR "A".                                  02450000
         PRCLASS.(0:8)="SUB QUEUE NAME" OR PRIORITY NUMBER.             02452000
         RETURNS                                                        02454000
            CC=CCE IF NO VIOLATION:CHECKPRIORITY=2TH WORD OF SQ MAPP ENT02456000
            CC=CCL IF VIOLATION:CHECKPRIORITY=ERROR NUMBER              02458000
      ERROR NUMBER                                                      02460000
      20    SUB QUEUE NAME NOT EXISTANT                                 02462000
      25    PORTION OF MASTER Q REQUESTED WITHOUT CAPABILITY            02464000
      26    ABSOLUTE PRIORITY REQUESTED WITHOUT CAPABILITY              02466000
      27    ILLEGAL QUEUE SPECIFICATION                                 02468000
      32    PRIORITY EXCEEDING MAXIMUM FOR ACCOUNT                      02470000
                                                                        02472000
      ;                                                                 02474000
                                                                        02476000
BEGIN                                                                   02478000
      DEFINE AS = (2:1)#,                                      <<04550>>02480000
             BS = (2:1)#,                                      <<04550>>02482000
             CS = (3:1)#,                                      <<04550>>02484000
             DS = (4:1)#,                                      <<04550>>02486000
             ES = (1:1)#;                                      <<04550>>02488000
      EQUATE JITPX=6;                                                   02490000
      EQUATE ACCESSX=5;                                                 02492000
                                                                        02494000
      INTEGER JIT;                                                      02496000
      POINTER JIT2=DB+3;                                                02498000
      POINTER JITMISC=DB+2;                                             02500000
      INTEGER IS2=S-2,IS3=S-3,IS4=S-4;                                  02502000
      INTEGER ARRAY PCBX(*)=Q+0;                                        02504000
      INTEGER SQN,CHK=Q-6,ERR:=-1;                                      02506000
      LOGICAL CAP;                                                      02508000
                                                                        02510000
                                                                        02512000
                                                                        02514000
      SUBROUTINE ACCTPRI;                                               02516000
                                                                        02518000
      COMMENT: CHEKS THE PRIORITY NUMBER AGAINST MAXIMUM ALLOWED        02520000
               FOR THE ACCOUNT.                                         02522000
               IN S-1 IS THE PRIORITY NUMBER                            02524000
               IN S IS THE CONDITION CODE RETURNED FROM CHECKPRIORITY   02526000
               UPDATES THE MAXIMUM PRIORITY FOR JOB.                    02528000
               ;                                                        02530000
                                                                        02532000
      BEGIN                                                             02534000
         PUSH(Q,DL);                                                    02536000
         ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                               02538000
         TOS:=-PCBX(X);                                                 02540000
         ASSEMBLE(ADD); X:=TOS+JITPX;                                   02542000
         JIT:=PCBX(X).(6:10);          <<JOB INF TABLE>>                02544000
         TOS:=EXCHANGEDB(JIT);                                          02546000
         << CHECK PRIORITY FOR TYPES "S" AND "M" ONLY >>       <<00165>>02548000
         IF (PRCLASS LAND %377) <> "A" THEN                    <<00165>>02550000
            BEGIN                                              <<00165>>02552000
            TOS:=JITMISC(2).(0:8);     << MAX PRIORITY >>      <<00165>>02554000
            TOS:=IS4.(8:8);            << PRIORITY REQUESTED >><<00165>>02556000
            ASSEMBLE(LCMP);            << MAX PRI > REQUEST >> <<00165>>02558000
            IF > THEN                  << FAIL >>              <<00165>>02560000
               BEGIN                                           <<00165>>02562000
               IS2:=CCL;                                       <<00165>>02564000
               IS3:=32;                                        <<00165>>02566000
               END;                                            <<00165>>02568000
            END;                                               <<00165>>02570000
         IF IS2=CCE THEN               <<OK>>                           02572000
         BEGIN                                                          02574000
            TOS:=JIT2(4).(8:8);        <<CURRENT NUMBER>>               02576000
            TOS := IF LOGICAL(IS4).CS THEN                     <<04550>>02578000
                      ICS(-ICS'CSCHEDBASECELL)                 <<04550>>02580000
                   ELSE                                        <<04550>>02582000
                   IF LOGICAL(IS4).DS THEN                     <<04550>>02584000
                      ICS(-ICS'DSCHEDBASECELL)                 <<04550>>02586000
                   ELSE                                        <<04550>>02588000
                   IF LOGICAL(IS4).ES THEN                     <<04550>>02590000
                      ICS(-ICS'ESCHEDBASECELL)                 <<04550>>02592000
                   ELSE                                        <<04550>>02594000
                      IS4.(8:8);                               <<04550>>02596000
            IF TOS > TOS THEN JIT2(4).(8:8) :=                 <<04550>>02598000
               IF LOGICAL(IS3).CS THEN                         <<04550>>02600000
                  ICS(-ICS'CSCHEDBASECELL)                     <<04550>>02602000
               ELSE                                            <<04550>>02604000
               IF LOGICAL(IS3).DS THEN                         <<04550>>02606000
                  ICS(-ICS'DSCHEDBASECELL)                     <<04550>>02608000
               ELSE                                            <<04550>>02610000
               IF LOGICAL(IS3).ES THEN                         <<04550>>02612000
                  ICS(-ICS'ESCHEDBASECELL)                     <<04550>>02614000
               ELSE                                            <<04550>>02616000
                  IS3;                                         <<04550>>02618000
         END;                                                           02620000
         ASSEMBLE(ZERO,XCH);EXCHANGEDB(*);                              02622000
      END;  << A C C T P R I  >>                                        02624000
                                                                        02626000
                                                                        02628000
      PUSH(DL,Q);                                                       02630000
      ASSEMBLE(XCH,SUB);               <<DL-Q>>                         02632000
      ASSEMBLE(DUP,STAX);                                               02634000
      X:=X-1;X:=X-1;                                                    02636000
      TOS:=-PCBX(X);                                                    02638000
      ASSEMBLE(ADD);                                                    02640000
      TOS:=TOS+ACCESSX;                                                 02642000
      ASSEMBLE(STAX);                                                   02644000
      CAP:=PCBX(X);                    <<GENERAL RESOURCE CAP>>         02646000
      SQN:=PRCLASS&LSR(8);             <<EXTRACT SUB Q NAME>>           02648000
      IF (PRCLASS LAND %377)="S" THEN                                   02650000
      BEGIN                                                             02652000
         TOS:=SUBQUEUE(4,SQN);         <<DOUBLE WORD ENTRY BACK>>       02654000
         IF < THEN                     <<SQ NAME NOT FOUND>>            02656000
         BEGIN                                                          02658000
            TOS:=20;                   <<ERROR # 20>>                   02660000
            TOS:=CCL;                                                   02662000
            GOTO FIN;                                                   02664000
         END;                                                           02666000
         TOS:= CCE;                                                     02668000
         ACCTPRI;                <<CHECK MAX PRI >>                     02670000
         GOTO FIN;                                                      02672000
      END;                             <<END OF "S" EXAMINATION>>       02674000
                                                                        02676000
      IF (PRCLASS LAND %377)="M" THEN                                   02678000
      BEGIN                                                             02680000
         IF CAP&LSR(6) THEN            <<TEST FOR PRIV IN CAPABILITY>>  02682000
         BEGIN                                                          02684000
            TOS:=SUBQUEUE(4,SQN);                                       02686000
            IF < THEN                                                   02688000
            BEGIN                                                       02690000
               TOS:=24;                <<ERROR #>>                      02692000
               TOS:=CCL;                                                02694000
               GOTO FIN;                                                02696000
            END;                                                        02698000
            << SET LINEAR Q BIT & SCHEDULE AFTER START OF Q >> <<01140>>02700000
            TOS := (TOS LOR %20000) + 1;                       <<01140>>02702000
            TOS:=CCE;                                                   02704000
            ACCTPRI;                                                    02706000
            GOTO FIN;                                                   02708000
         END ELSE                                                       02710000
         BEGIN                                                          02712000
            TOS:=25;                   <<ERROR #>>                      02714000
            TOS:=CCL;                                                   02716000
            GOTO FIN;                                                   02718000
         END;                                                           02720000
      END;                                                              02722000
                                                                        02724000
      IF (PRCLASS LAND %377)="A" THEN                                   02726000
      BEGIN                                                             02728000
         IF CAP&LSR(6) THEN                                             02730000
         BEGIN                                                          02732000
            TOS:=PRCLASS&LSR(8)+%20000;<<PRIORITY #>>                   02734000
            TOS:=CCE;                                                   02736000
            ACCTPRI;   << UPDATE MAX PRI. NO PRIORITY CHECK >> <<00165>>02738000
            GOTO FIN;                                                   02740000
         END ELSE                                                       02742000
         BEGIN                                                          02744000
            TOS:=26;                   <<ERROR NUMBER>>                 02746000
            TOS:=CCL;                                                   02748000
            GOTO FIN;                                                   02750000
         END;                                                           02752000
      END;                                                              02754000
      TOS:=27;                         <<ERROR #>>                      02756000
      TOS:=CCL;                                                         02758000
FIN:  STATUS.(6:2):=TOS;                                                02760000
      CHK:=TOS;                        <<RESULT>>                       02762000
                                                                        02764000
END;  << C H E C K P R I O R I T Y  >>                                  02766000
$PAGE "PROCEDURE INHERIT'STDX"                                 <<01710>>02768000
procedure INHERIT'STDX (ERROR, STDX, STDX'NUM, STDXNAME,       <<01710>>02770000
                        STDXDEV);                              <<01710>>02772000
  value STDX'NUM;                                              <<01710>>02774000
<<                                                                      02776000
   Function                                                             02778000
     Builds the array of FOPEN parameters and sets up the byte arrays   02780000
     for file name and device for the default $STDIN or $STDLIST for    02782000
     a process being created by CREATEPROCESS.  The default $STDIN      02784000
     and $STDLIST of a process are the $STDIN and $STDLIST of the       02786000
     creating process.  Thus, new processes inherit the standard file   02788000
     settings of their fathers if no explicit specification is made     02790000
     for $STDIN or $STDLIST.                                            02792000
>>                                                                      02794000
<< Inputs >>                                                   <<01710>>02796000
     integer                                                            02798000
       STDX'NUM;                << 1 = $stdin;  2 = $stdlist >><<01710>>02800000
                                                               <<01710>>02802000
<< Outputs >>                                                  <<01710>>02804000
     integer                                                   <<01710>>02806000
       ERROR;                   << err rtrn - Ffileinfo fail >><<01710>>02808000
                                                               <<01710>>02810000
     logical array                                             <<01710>>02812000
       STDX;                    << FOPEN parameters for STDx >><<01710>>02814000
                                                               <<01710>>02816000
     byte array                                                <<01710>>02818000
       STDXNAME,                << STDx file name >>           <<01710>>02820000
       STDXDEV;                 << STDx device >>              <<01710>>02822000
                                                               <<01710>>02824000
option privileged, uncallable;                                 <<01710>>02826000
                                                               <<01710>>02828000
  begin                                                        <<01710>>02830000
    integer                                                    <<01710>>02832000
      STDX'LDEV,               << ldev from Ffileinfo >>       <<01710>>02834000
      STDX'DEVTYPE,            << ldev type from Ffileinfo >>  <<01710>>02836000
      STDX'HDADDR;             << hard addr from Ffileinfo >>  <<01710>>02838000
                                                               <<01710>>02840000
    << *** FOPEN parameters in STDx array *** >>               <<01710>>02842000
                                                               <<01710>>02844000
    equate                                                     <<01710>>02846000
      NAME            = 1,     << formal file designator >>    <<01710>>02848000
      FOPTS           = 2,     << foptions >>                  <<01710>>02850000
      AOPTS           = 3,     << aoptions >>                  <<01710>>02852000
      DEV             = 5;     << logical device >>            <<01710>>02854000
                                                               <<01710>>02856000
    define                                                     <<01710>>02858000
      TYPE            = (8:8)#,    << device type field >>     <<01710>>02860000
      OVNAME          = (3:1)#,    << name option var bit >>   <<01710>>02864000
      OVDEV           = (7:1)#;    << device option var bit >> <<01710>>02866000
                                                               <<01710>>02868000
    equate                                                     <<01710>>02870000
      FIXEDHEADDISC   = 1;         << fixed head disc code >>  <<01710>>02872000
                                                               <<01710>>02874000
                                                               <<01710>>02876000
    << INHERIT'STDX >>                                         <<01710>>02878000
                                                               <<01710>>02880000
    STDXNAME := " ";                                           <<01710>>02882000
    move STDXNAME(1) := STDXNAME, (35);                        <<01710>>02884000
    STDXDEV := " ";                                            <<01710>>02886000
    move STDXDEV(1) := STDXDEV, (17);                          <<01710>>02888000
    << set option variable mask for name, fopts, and aopts >>  <<01710>>02890000
    STDX := %16000;                                            <<01710>>02892000
                                                               <<01710>>02894000
    FFILEINFO (STDX'NUM, 1, STDXNAME, 2, STDX(FOPTS),          <<01710>>02896000
               3, STDX(AOPTS), 5, STDX'DEVTYPE,                <<01710>>02898000
               6, STDX'LDEV);                                  <<01710>>02900000
    FFILEINFO(STDX'NUM, 47, STDX'HDADDR);    <<9-bit DRTs>>    <<03066>>02902000
                                                               <<01710>>02904000
    if < then << should only be true for sys processes >>      <<01710>>02906000
      ERROR := -1                                              <<01710>>02908000
    else                                                       <<01710>>02910000
      begin  << got the file info ok >>                        <<01710>>02912000
        STDX(NAME) := @STDXNAME;                               <<01710>>02914000
                                                               <<01710>>02916000
        if STDX'DEVTYPE.TYPE > FIXEDHEADDISC then              <<01796>>02918000
          begin  << non-disc device >>                         <<01710>>02920000
            X := ASCII (STDX'LDEV, -10, STDXDEV(2));           <<01710>>02922000
            case X-1 of                                        <<01710>>02924000
              begin  << add ldev leading 0s as needed >>       <<01710>>02926000
                << 1 >>   move STDXDEV := "00";                <<01710>>02928000
                << 2 >>   STDXDEV := "0";                      <<01710>>02930000
                << 3 >>   ;                                    <<01710>>02932000
              end;                                             <<01710>>02934000
            STDX(DEV) := @STDXDEV;                             <<01710>>02936000
            STDX.OVDEV := 1;                                   <<01710>>02938000
            << if device is spooled, don't specify name     >> <<01710>>02940000
            << since FOPEN will open the virtual device.    >> <<01710>>02942000
            if STDX'HDADDR = 0 then STDX.OVNAME := 0;          <<03066>>02944000
          end;                                                 <<01710>>02946000
      end << got file info >>;                                 <<01710>>02948000
  end << INHERIT'STDX >>;                                      <<01710>>02950000
$PAGE "PROCEDURE BUILD'STDX"                                   <<01245>>02952000
procedure BUILD'STDX (ERROR, STDX, STDX'NUM, STDX'STRNG,       <<01245>>02954000
                      STRNG'LNTH, PARSETAB'LNTH, STDXNAME,     <<01245>>02956000
                      STDXDEV, STDXFORMS, FORMALDES);          <<01245>>02958000
  value STDX'NUM, STRNG'LNTH, PARSETAB'LNTH;                   <<01245>>02960000
<<                                                                      02962000
   Function                                                             02964000
     Builds the array of FOPEN parameters and sets up the byte arrays   02966000
     for file name , device, and forms message (if necessary) for the   02968000
     specified $STDIN or $STDLIST from the partial file equation        02970000
     specified by the caller of CREATEPROCESS.  A special entry point   02972000
     to the :FILE command executor of the CI is used to parse the       02974000
     partial file equation.  It returns a file equation table entry     02976000
     which is then used to construct the FOPEN parameters.              02978000
>>                                                                      02980000
<< Inputs >>                                                   <<01245>>02982000
     byte array                                                <<01245>>02984000
       STDX'STRNG;              << STDx string from user >>    <<01245>>02986000
                                                               <<01245>>02988000
     integer                                                   <<01245>>02990000
       STDX'NUM,                << 1 = $stdin;  2 = $stdlist >><<01245>>02992000
       STRNG'LNTH,              << length of STDx string >>    <<01245>>02994000
       PARSETAB'LNTH;           << length of parse table >>    <<01245>>02996000
                                                               <<01245>>02998000
<< Outputs >>                                                  <<01245>>03000000
     integer                                                   <<01245>>03002000
       ERROR;                   << err rtrn from file parse >> <<01245>>03004000
                                                               <<01245>>03006000
     logical array                                             <<01245>>03008000
       STDX;                    << FOPEN parameters for STDx >><<01245>>03010000
                                                               <<01245>>03012000
     byte array                                                <<01245>>03014000
       STDXNAME,                << STDx file name, if any >>   <<01245>>03016000
       STDXDEV,                 << STDx device, if any >>      <<01245>>03018000
       STDXFORMS,               << STDx forms msg, if any >>   <<01245>>03020000
       FORMALDES;               << formal des, if needed >>    <<01245>>03022000
                                                               <<01245>>03024000
option privileged, uncallable;                                 <<01427>>03026000
                                                               <<01427>>03028000
  begin                                                        <<01245>>03030000
    integer                                                    <<01245>>03032000
      RQSTD'ACCESS,             << access requested by user >> <<01245>>03034000
      DUMMY,                    << dummy parm for parse call >><<01245>>03036000
      MYPIN,                    << PIN of calling process >>   <<01245>>03038000
      PTIME,                    << process execution time >>   <<01245>>03040000
      DESLNTH;                  << length of formal desig >>   <<01245>>03042000
                                                               <<01245>>03044000
    logical                                                    <<01245>>03046000
      BLANK           := "  ";  << blank for ADDJTENTRY >>     <<01245>>03048000
                                                               <<01245>>03050000
    byte pointer                                               <<01245>>03052000
      BPTR            := @BLANK,<< for ADDJTENTRY >>           <<01245>>03054000
      FNAME,                    << temp var for file name >>   <<01245>>03056000
      DEVICE,                   << temp var for device >>      <<01245>>03058000
      FORMSMESSAGE;             << temp var for forms msg >>   <<01245>>03060000
                                                               <<01245>>03062000
    logical array                                              <<01245>>03064000
      PARSETAB(0:PARSETAB'LNTH);<< file eq table from parser >><<01245>>03066000
                                                               <<01245>>03068000
    byte array                                                 <<01245>>03070000
      FILE'EQUATION(*) = PARSETAB;    << input to parser - file eq >>   03072000
                                                               <<01245>>03074000
    equate                                                     <<01245>>03076000
      CR               = %15;   << carriage return char >>     <<01245>>03078000
                                                               <<01245>>03080000
    << *** Variables for handling back references *** >>       <<01427>>03082000
                                                               <<01427>>03084000
    equate                                                     <<01427>>03086000
      BREFTAB'LEN     = 96;     << back ref table size >>      <<01427>>03088000
                                                               <<01427>>03090000
    logical array                                              <<01427>>03092000
      BREFTAB(0:BREFTAB'LEN-1), << back reference table >>     <<01427>>03094000
      BREFNAMES(0:15),          << names in bref fdesig >>     <<01427>>03096000
      BREF'FNAME(*)   = BREFNAMES,                             <<01427>>03098000
      BREF'GNAME(*)   = BREFNAMES(4),                          <<01427>>03100000
      BREF'ANAME(*)   = BREFNAMES(8),                          <<01427>>03102000
      BREF'LWNAME(*)  = BREFNAMES(12);                         <<01427>>03104000
                                                               <<01427>>03106000
    logical                                                    <<01710>>03108000
      BACKREF         := false; << true if name is backref >>  <<01710>>03110000
                                                               <<01710>>03112000
    integer                                                    <<01427>>03114000
      BR'INDEX,                 << index into bref tab ntry >> <<01427>>03116000
      BR'VARSIZE;               << variable size part >>       <<01427>>03118000
                                                               <<01427>>03120000
    << *** FOPEN parameters in STDx array *** >>               <<01245>>03122000
                                                               <<01245>>03124000
    equate                                                     <<01245>>03126000
      NAME            =  1,     << formal file designator >>   <<01245>>03128000
      FOPTS           =  2,     << foptions >>                 <<01245>>03130000
      AOPTS           =  3,     << aoptions >>                 <<01245>>03132000
      RECSIZE         =  4,     << record size >>              <<01245>>03134000
      DEV             =  5,     << logical device >>           <<01245>>03136000
      FORMSMSG        =  6,     << forms message or tape lbl >><<01245>>03138000
      USERLABELS      =  7,     << # of user defined labels >> <<01245>>03140000
      BLKFACTOR       =  8,     << blocking factor >>          <<01245>>03142000
      NUMBUFFS        =  9,     << # buffers, copies, outpri >><<01245>>03144000
      FILESIZE1       = 10,     << # records in file >>        <<01245>>03146000
      FILESIZE2       = 11,     << 2nd word of double size >>  <<01245>>03148000
      NUMXTENTS       = 12,     << # disc extents for file >>  <<01245>>03150000
      INITALLOC       = 13,     << initial extent allocation >><<01245>>03152000
      FCODE           = 14;     << file code >>                <<01245>>03154000
                                                               <<01245>>03156000
    << *** Access Types possible for Aoptions of Fopen *** >>  <<01245>>03158000
                                                               <<01245>>03160000
    equate                                                     <<01245>>03162000
      READ'ONLY       = 0,                                     <<01245>>03164000
      WRITE'ONLY      = 1,                                     <<01245>>03166000
      WRITE'SAVE      = 2,                                     <<01245>>03168000
      APPEND          = 3,                                     <<01245>>03170000
      READ'WRITE      = 4,                                     <<01245>>03172000
      UPDATE          = 5,                                     <<01245>>03174000
      EXECUTE         = 6;                                     <<01245>>03176000
                                                               <<01245>>03178000
    define                                                     <<01245>>03180000
      ACCESS          = (12:4)#;   << access of aoptions >>    <<01427>>03182000
                                                               <<01427>>03184000
    << *** Miscellaneous foptions & aoptions fields *** >>     <<01427>>03186000
                                                               <<01427>>03188000
    equate                                                     <<01427>>03190000
      SHARE           = 3,         << share access mode >>     <<01710>>03192000
      OLD'DOMAIN      = 1;         << permanent file domain >> <<01427>>03194000
                                                               <<01427>>03196000
    define                                                     <<01427>>03198000
      ACCESSMODE      = (8:2)#,    << access mode of aopts >>  <<01710>>03200000
      MULTI           = (6:1)#,    << multi-acc bit of aopts >><<01710>>03202000
      DOMAIN          = (14:2)#,   << domain of foptions >>    <<01427>>03204000
      NOFLEQ          = (5:1)#;    << no file equations bit >> <<01427>>03206000
                                                               <<01245>>03208000
    << *** Description of Option Variable Mask for FOPEN *** >><<01245>>03210000
                                                               <<01245>>03212000
    define                                                     <<01245>>03214000
      OVNAME          = (3:1)#,                                <<01245>>03216000
      OVFOPTS         = (4:1)#,                                <<01245>>03218000
      OVAOPTS         = (5:1)#,                                <<01245>>03220000
      OVRECSIZE       = (6:1)#,                                <<01245>>03222000
      OVDEV           = (7:1)#,                                <<01245>>03224000
      OVFORMSMSG      = (8:1)#,                                <<01245>>03226000
      OVULABELS       = (9:1)#,                                <<01245>>03228000
      OVBLKFACTOR     = (10:1)#,                               <<01245>>03230000
      OVNUMBUFFS      = (11:1)#,                               <<01245>>03232000
      OVFILESIZE      = (12:1)#,                               <<01245>>03234000
      OVNUMXTENTS     = (13:1)#,                               <<01245>>03236000
      OVINITALLOC     = (14:1)#,                               <<01245>>03238000
      OVFCODE         = (15:1)#;                               <<01245>>03240000
                                                               <<01245>>03242000
    << *** Description of Parse Table from File Eqtn Parser *** >>      03244000
                                                               <<01245>>03246000
    equate                                                     <<01245>>03248000
      FEQTABLNTH       = 78;    << max size of entry >>        <<01245>>03250000
                                                               <<01245>>03252000
    define                                                     <<01245>>03254000
      PARSE'MASK1     = PARSETAB(0)#,                          <<01245>>03256000
      PARSE'MASK2     = PARSETAB(1)#,                          <<01245>>03258000
      PARSE'NAMELEN   = PARSETAB(2).(0:8)#,                    <<01245>>03260000
      PARSE'DEVLEN    = PARSETAB(2).(8:8)#,                    <<01245>>03262000
      PARSE'NAME      = @PARSETAB(3) & LSL(1)#,                <<01245>>03264000
      VARSIZE         = (PARSE'NAMELEN + PARSE'DEVLEN + 1)/2#, <<01245>>03266000
      PARSE'DEV       = logical(PARSE'NAME) + PARSE'NAMELEN#,  <<01245>>03268000
      PARSE'FOPTS     = PARSETAB(3+VARSIZE)#,                  <<01245>>03270000
      PARSE'AOPTS     = PARSETAB(4+VARSIZE)#,                  <<01245>>03272000
      PARSE'NUMBUFFS  = PARSETAB(5+VARSIZE).(0:8)#,            <<01245>>03274000
      PARSE'INITALLOC = PARSETAB(5+VARSIZE).(8:5)#,            <<01245>>03276000
      PARSE'RECSIZE   = PARSETAB(6+VARSIZE)#,                  <<01245>>03278000
      PARSE'NUMXTENTS = PARSETAB(7+VARSIZE).(0:5)#,            <<01245>>03280000
      PARSE'BLKFACTOR = PARSETAB(7+VARSIZE).(8:8)#,            <<01245>>03282000
      PARSE'FSIZE1    = PARSETAB(8+VARSIZE)#,                  <<01245>>03284000
      PARSE'FSIZE2    = PARSETAB(9+VARSIZE)#,                  <<01245>>03286000
      PARSE'FCODE     = PARSETAB(10+VARSIZE)#,                 <<01245>>03288000
      PARSE'OUTPRI    = PARSETAB(11+VARSIZE).(0:4)#,           <<01245>>03290000
      PARSE'NCOPIES   = PARSETAB(11+VARSIZE).(4:7)#,           <<01245>>03292000
      PARSE'ULABELS   = PARSETAB(12+VARSIZE).(5:11)#,          <<01245>>03294000
      PARSE'FORMSLEN  = PARSETAB(13+VARSIZE)#,                 <<01245>>03296000
      PARSE'FORMSMSG  = @PARSETAB(14+VARSIZE) & LSL(1)#;       <<01245>>03298000
                                                               <<01245>>03300000
    << *** Description of Parse Table Mask Words *** >>        <<01245>>03302000
                                                               <<01245>>03304000
    define                                                     <<01245>>03306000
      NAME'FLAG       = PARSE'MASK1.(15:1)#,                   <<01245>>03308000
      BACKREF'FLAG    = PARSE'MASK2.(6:1)#,                    <<01245>>03310000
      FOPTIONS'FLAGS  = PARSE'MASK1.(8:6)#,                    <<01245>>03312000
      DOMAIN'FLAG     = PARSE'MASK1.(13:1)#,                   <<01427>>03314000
      AOPTIONS'FLAGS1 = PARSE'MASK1.(4:4)#,                    <<01245>>03316000
      AOPTIONS'FLAGS2 = PARSE'MASK2.(7:3)#,                    <<01245>>03318000
      ACCESS'FLAG     = PARSE'MASK1.(7:1)#,                    <<01427>>03320000
      ACCESSMODE'FLAG = PARSE'MASK1.(5:1)#,                    <<01710>>03322000
      MULTI'FLAG      = PARSE'MASK2.(9:1)#,                    <<01710>>03324000
      RECSIZE'FLAG    = PARSE'MASK1.(1:1)#,                    <<01245>>03326000
      DEV'FLAG        = PARSE'MASK1.(14:1)#,                   <<01245>>03328000
      FORMMSG'FLAGS   = PARSE'MASK2.(0:3)#,                    <<01245>>03330000
      ULABELS'FLAG    = PARSE'MASK2.(3:1)#,                    <<01245>>03332000
      BLKFACT'FLAG    = PARSE'MASK1.(0:1)#,                    <<01245>>03334000
      NUMBUFFS'FLAG   = PARSE'MASK1.(3:1)#,                    <<01245>>03336000
      NCOPIES'FLAG    = PARSE'MASK2.(11:1)#,                   <<01245>>03338000
      OUTPRI'FLAG     = PARSE'MASK2.(10:1)#,                   <<01245>>03340000
      FILESIZE'FLAG   = PARSE'MASK2.(13:1)#,                   <<01245>>03342000
      NXTENTS'FLAG    = PARSE'MASK2.(14:1)#,                   <<01245>>03344000
      INITALLOC'FLAG  = PARSE'MASK2.(15:1)#,                   <<01245>>03346000
      FCODE'FLAG      = PARSE'MASK2.(12:1)#,                   <<01245>>03348000
      DISPOSITN'FLAG  = PARSE'MASK1.(2:1)#;                    <<01427>>03350000
                                                               <<01245>>03352000
                                                               <<01245>>03354000
    << BUILD'STDX >>                                           <<01245>>03356000
                                                               <<01245>>03358000
    << add dummy formal designator to file eq for parser >>    <<01245>>03360000
    move FILE'EQUATION := "STDX=";                             <<01245>>03362000
    move FILE'EQUATION(5) := STDX'STRNG, (STRNG'LNTH);         <<01245>>03364000
    PARSE'FILE'EQ (FILE'EQUATION, ERROR, DUMMY);               <<01245>>03366000
                                                               <<01245>>03368000
    if ERROR = 0 then                                          <<01245>>03370000
      begin  << parse succeeded - fill STDx >>                 <<01245>>03372000
        STDX := 0;     << clear option variable mask >>        <<01245>>03374000
                                                               <<01245>>03376000
        << clear foptions and aoptions if necessary >>         <<01427>>03378000
        if FOPTIONS'FLAGS = 0 then PARSE'FOPTS := 0;           <<01427>>03380000
        if AOPTIONS'FLAGS1 = 0 and AOPTIONS'FLAGS2 = 0 then    <<01427>>03382000
          PARSE'AOPTS := 0;                                    <<01427>>03384000
                                                               <<01427>>03386000
        << there is always an actual name to handle >>         <<01427>>03388000
        @FNAME := PARSE'NAME;                                  <<01427>>03390000
        if BACKREF'FLAG then                                   <<01427>>03392000
          begin  << name is a *BACKREF >>                      <<01427>>03394000
            BACKREF := true;                                   <<01710>>03396000
            STDXNAME := "*";                                   <<MPEIV>>03398000
            move STDXNAME(1) := FNAME, (PARSE'NAMELEN);        <<MPEIV>>03400000
            STDXNAME(PARSE'NAMELEN+1) := CR;                   <<MPEIV>>03402000
            << break full name into name, group, acct, lword >><<01427>>03404000
            BREFTAB := "  ";                                   <<01427>>03406000
            move BREFTAB(1) := BREFTAB, (BREFTAB'LEN-1);       <<01427>>03408000
            FNFORMAT (STDXNAME(1), BREF'FNAME, BREF'GNAME,     <<MPEIV>>03410000
                      BREF'ANAME, BREF'LWNAME);                <<01427>>03412000
            << find entry in file eq table for back ref name >><<01427>>03414000
            if XRETJTENTRY (BREF'FNAME, BREF'GNAME, BREF'ANAME,<<01427>>03416000
                            DUMMY, BREFTAB) <> 0 then          <<01427>>03418000
              ERROR := -1                                      <<01427>>03420000
            else                                               <<01427>>03422000
              begin  << entry for backref found >>             <<01427>>03424000
                << get index into entry for mask1 and mask2 >> <<01710>>03426000
                BR'INDEX := BREFTAB.(8:8) + 1;                 <<01710>>03428000
                << set mask1 and mask2 from backref >>         <<01710>>03430000
                PARSE'MASK1 := BREFTAB(BR'INDEX);              <<01710>>03432000
                PARSE'MASK2 := BREFTAB(BR'INDEX+1);            <<01710>>03434000
                << get index into entry for fopts and aopts >> <<01710>>03436000
                BR'INDEX := BR'INDEX.(8:8) + 2;                <<01710>>03438000
                BR'VARSIZE := (BREFTAB(BR'INDEX).(0:8) +       <<01427>>03440000
                                BREFTAB(BR'INDEX).(8:8) + 1)/2;<<01427>>03442000
                BR'INDEX := BR'INDEX + BR'VARSIZE;             <<01427>>03444000
                << set foptions and aoptions from backref >>   <<01427>>03446000
                PARSE'FOPTS := BREFTAB(BR'INDEX+1);            <<01427>>03448000
                PARSE'AOPTS := BREFTAB(BR'INDEX+2);            <<01427>>03450000
              end;                                             <<01427>>03452000
          end << name is *BACKREF >>                           <<01427>>03454000
        else                                                   <<01427>>03456000
          begin  << name is not a *BACKREF >>                  <<01427>>03458000
            move STDXNAME := FNAME, (PARSE'NAMELEN);           <<01427>>03460000
            STDXNAME(PARSE'NAMELEN) := CR;                     <<01427>>03462000
          end;                                                 <<01427>>03464000
        STDX(NAME) := @STDXNAME;                               <<01427>>03466000
        STDX.OVNAME := 1;                                      <<01427>>03468000
                                                               <<01245>>03470000
        << check and set foptions >>                           <<01427>>03472000
        if not DOMAIN'FLAG then                                <<01427>>03474000
          begin  << force 'OLD' domain >>                      <<01427>>03476000
            PARSE'FOPTS.DOMAIN := OLD'DOMAIN;                  <<01427>>03478000
            DOMAIN'FLAG := 1;                                  <<01427>>03480000
          end;                                                 <<01427>>03482000
        << set 'disallow file equations' flag for norm name >> <<01427>>03484000
        << where disposition was not specified              >> <<01710>>03486000
        if not BACKREF and not DISPOSITN'FLAG then             <<01710>>03488000
          PARSE'FOPTS.NOFLEQ := 1;                             <<01710>>03490000
        STDX(FOPTS) := PARSE'FOPTS;                            <<01427>>03492000
        STDX.OVFOPTS := 1;                                     <<01427>>03494000
                                                               <<01245>>03496000
        << check and set aoptions;  return error if needed >>  <<01427>>03498000
        if not ACCESS'FLAG then                                <<01427>>03500000
          begin  << no access specified >>                     <<01427>>03502000
            << force minimum access for $STDx >>               <<01427>>03504000
            if STDX'NUM = 1 then                               <<01427>>03506000
              PARSE'AOPTS.ACCESS := READ'ONLY    << $STDIN >>  <<01427>>03508000
            else                                               <<01427>>03510000
              PARSE'AOPTS.ACCESS := WRITE'ONLY;  << $STDLIST >><<01427>>03512000
          end                                                  <<01427>>03514000
        else                                                   <<01427>>03516000
          begin  << access was specified >>                    <<01427>>03518000
            << check for proper minimum access >>              <<01427>>03520000
            RQSTD'ACCESS := PARSE'AOPTS.ACCESS;                <<01427>>03522000
            if STDX'NUM = 1 then                               <<01427>>03524000
              begin  << $STDIN >>                              <<01427>>03526000
                if (WRITE'ONLY <= RQSTD'ACCESS <= APPEND)      <<01427>>03528000
                   or RQSTD'ACCESS = EXECUTE then              <<01427>>03530000
                  ERROR := -1;                                 <<01427>>03532000
              end                                              <<01427>>03534000
            else                                               <<01427>>03536000
              begin  << $STDLIST >>                            <<01427>>03538000
                if RQSTD'ACCESS = READ'ONLY                    <<01427>>03540000
                   or RQSTD'ACCESS = EXECUTE then              <<01427>>03542000
                  ERROR := -1;                                 <<01427>>03544000
              end;                                             <<01427>>03546000
          end << access specified >>;                          <<01427>>03548000
        if not ACCESSMODE'FLAG then                            <<01710>>03550000
          begin                                                <<01710>>03552000
            << force share as default access >>                <<01710>>03554000
            PARSE'AOPTS.ACCESSMODE := SHARE;                   <<01710>>03556000
          end;                                                 <<01710>>03558000
        if not MULTI'FLAG then                                 <<01710>>03560000
          begin                                                <<01710>>03562000
            << force multi-access as default >>                <<01710>>03564000
            PARSE'AOPTS.MULTI := 1;                            <<01710>>03566000
          end;                                                 <<01710>>03568000
        STDX(AOPTS) := PARSE'AOPTS;                            <<01245>>03570000
        STDX.OVAOPTS := 1;                                     <<01245>>03572000
                                                               <<01245>>03574000
        << for *BACKREF use only name, fopts, and aopts >>     <<01427>>03576000
        if BACKREF or ERROR <> 0 then return;                  <<01710>>03578000
                                                               <<01427>>03580000
        << set remaining options if needed for normal name >>  <<01427>>03582000
        if RECSIZE'FLAG then                                   <<01245>>03584000
          begin                                                <<01245>>03586000
            STDX(RECSIZE) := PARSE'RECSIZE;                    <<01245>>03588000
            STDX.OVRECSIZE := 1;                               <<01245>>03590000
          end;                                                 <<01245>>03592000
                                                               <<01245>>03594000
        if DEV'FLAG then                                       <<01245>>03596000
          begin                                                <<01245>>03598000
            @DEVICE := PARSE'DEV;                              <<01245>>03600000
            move STDXDEV := DEVICE, (PARSE'DEVLEN);            <<01245>>03602000
            STDXDEV(PARSE'DEVLEN) := CR;                       <<01245>>03604000
            STDX(DEV) := @STDXDEV;                             <<01245>>03606000
            STDX.OVDEV := 1;                                   <<01245>>03608000
          end;                                                 <<01245>>03610000
                                                               <<01245>>03612000
        if FORMMSG'FLAGS <> 0 then                             <<01245>>03614000
          begin                                                <<01245>>03616000
            @FORMSMESSAGE := PARSE'FORMSMSG;                   <<01245>>03618000
            move STDXFORMS := FORMSMESSAGE, (PARSE'FORMSLEN);  <<01245>>03620000
            STDXFORMS(PARSE'FORMSLEN) := CR;                   <<01245>>03622000
            STDX(FORMSMSG) := @STDXFORMS;                      <<01245>>03624000
            STDX.OVFORMSMSG := 1;                              <<01245>>03626000
          end;                                                 <<01245>>03628000
                                                               <<01245>>03630000
        if ULABELS'FLAG then                                   <<01245>>03632000
          begin                                                <<01245>>03634000
            STDX(USERLABELS) := PARSE'ULABELS;                 <<01245>>03636000
            STDX.OVULABELS := 1;                               <<01245>>03638000
          end;                                                 <<01245>>03640000
                                                               <<01245>>03642000
        if BLKFACT'FLAG then                                   <<01245>>03644000
          begin                                                <<01245>>03646000
            STDX(BLKFACTOR) := PARSE'BLKFACTOR;                <<01245>>03648000
            STDX.OVBLKFACTOR := 1;                             <<01245>>03650000
          end;                                                 <<01245>>03652000
                                                               <<01245>>03654000
        if NUMBUFFS'FLAG or NCOPIES'FLAG or OUTPRI'FLAG then   <<01245>>03656000
          begin                                                <<01245>>03658000
            STDX(NUMBUFFS).(0:4) := PARSE'OUTPRI;              <<01245>>03660000
            STDX(NUMBUFFS).(4:7) := PARSE'NCOPIES;             <<01245>>03662000
            STDX(NUMBUFFS).(11:5) := PARSE'NUMBUFFS;           <<01245>>03664000
            STDX.OVNUMBUFFS := 1;                              <<01245>>03666000
          end;                                                 <<01245>>03668000
                                                               <<01245>>03670000
        if FILESIZE'FLAG then                                  <<01245>>03672000
          begin                                                <<01245>>03674000
            STDX(FILESIZE1) := PARSE'FSIZE1;                   <<01245>>03676000
            STDX(FILESIZE2) := PARSE'FSIZE2;                   <<01245>>03678000
            STDX.OVFILESIZE := 1;                              <<01245>>03680000
          end;                                                 <<01245>>03682000
                                                               <<01245>>03684000
        if NXTENTS'FLAG then                                   <<01245>>03686000
          begin                                                <<01245>>03688000
            STDX(NUMXTENTS) := PARSE'NUMXTENTS + 1;            <<01245>>03690000
            STDX.OVNUMXTENTS := 1;                             <<01245>>03692000
          end;                                                 <<01245>>03694000
                                                               <<01245>>03696000
        if INITALLOC'FLAG then                                 <<01245>>03698000
          begin                                                <<01245>>03700000
            STDX(INITALLOC) := PARSE'INITALLOC + 1;            <<01245>>03702000
            STDX.OVINITALLOC := 1;                             <<01245>>03704000
          end;                                                 <<01245>>03706000
                                                               <<01245>>03708000
        if FCODE'FLAG then                                     <<01245>>03710000
          begin                                                <<01245>>03712000
            STDX(FCODE) := PARSE'FCODE;                        <<01245>>03714000
            STDX.OVFCODE := 1;                                 <<01245>>03716000
          end;                                                 <<01245>>03718000
                                                               <<01245>>03720000
        if DISPOSITN'FLAG then                                 <<01427>>03722000
          begin                                                <<01245>>03724000
            << Place a temporary entry in the file equation >> <<01245>>03726000
            << table so that the disposition is noted by    >> <<01427>>03728000
            << Fopen.  Entry will be removed from table     >> <<01427>>03730000
            << after new process starts up.                 >> <<01427>>03732000
                                                               <<01245>>03734000
            << build a unique formal designator for file >>    <<01245>>03736000
            move FORMALDES := "         ";                     <<01245>>03738000
            FORMALDES := if STDX'NUM = 1 then "I" else "L";    <<01245>>03740000
            MYPIN := (absolute(CPCB)-absolute(PCBB))/PCBSIZE;  <<01245>>03742000
            DESLNTH := 1 + ASCII (MYPIN, 10, FORMALDES(1));    <<01245>>03744000
            PTIME := integer(PROCTIME);   << unique time >>    <<01245>>03746000
            << use only last 4 digits of PTIME >>              <<01245>>03748000
            PTIME := PTIME.(3:13);                             <<01245>>03750000
            DESLNTH := DESLNTH +                               <<01245>>03752000
                         ASCII (PTIME, 10, FORMALDES(DESLNTH));<<01245>>03754000
                                                               <<01245>>03756000
            << change file name that Fopen will use to the  >> <<01245>>03758000
            << unique formal file designator just built     >> <<01245>>03760000
            move STDXNAME := FORMALDES, (DESLNTH);             <<01245>>03762000
            STDXNAME(DESLNTH) := CR;                           <<01245>>03764000
                                                               <<01245>>03766000
            << add temporary entry to file eqtn table >>       <<01245>>03768000
            if ADDJTENTRY (FORMALDES, BPTR, BPTR, -3,          <<01245>>03770000
                           FEQTABLNTH, PARSETAB) <> 0 then     <<01245>>03772000
              begin  << couldn't add entry - report failure >> <<01245>>03774000
                ERROR := -1;                                   <<01245>>03776000
                move FORMALDES := "         ";                 <<01245>>03778000
              end;                                             <<01245>>03780000
          end;                                                 <<01245>>03782000
      end << parse succeeded >>;                               <<01245>>03784000
  end << BUILD'STDX >>;                                        <<01245>>03786000
$PAGE "PROCEDURE CREATEPROCESS"                                <<01245>>03788000
procedure CREATEPROCESS (ERROR, PIN, PROGNAME, OPTIONNUMS,     <<01245>>03790000
                         OPTIONS);                             <<01245>>03792000
<<                                                                      03794000
   Function                                                             03796000
     Creates a new process on the system given a program file name      03798000
     and a set of options to be used in the creation.  This             03800000
     intrinsic is fully extensible by adding option numbers for new     03802000
     options being defined and the appropriate code to process the      03804000
     new options.                                                       03806000
>>                                                                      03808000
<< Inputs >>                                                   <<01245>>03810000
     byte array                                                <<01245>>03812000
       PROGNAME;                    << program file name >>    <<01245>>03814000
                                                               <<01245>>03816000
     integer array                                             <<01245>>03818000
       OPTIONNUMS;                  << option numbers to use >><<01245>>03820000
                                                               <<01245>>03822000
     logical array                                             <<01245>>03824000
       OPTIONS;                     << corresponding options >><<01245>>03826000
                                                               <<01245>>03828000
<< Outputs >>                                                  <<01245>>03830000
     integer                                                   <<01245>>03832000
       ERROR,                       << error return >>         <<01245>>03834000
       PIN;                         << PIN of new process >>   <<01245>>03836000
                                                               <<01245>>03838000
<< Algorithm                                                            03840000
     determine options specified;                                       03842000
     set up values for options;                                         03844000
     get a PCB;                                                         03846000
     Load program & format stack global area;                           03848000
     Procreate - format PCB, PCBX, and start-up markers;                03850000
     Startprocess - activate to open $STDIN/$STDLIST;                   03852000
     finalize any other options;                                        03854000
>>                                                                      03856000
option variable, privileged;                                   <<01245>>03858000
                                                               <<01245>>03860000
  begin                                                        <<01245>>03862000
                                                               <<01245>>03864000
    << final variables used for calls to Load and Procreate >> <<01245>>03866000
                                                               <<01245>>03868000
    byte pointer                                               <<01245>>03870000
      ENTRYNAME,                   << entry point name >>      <<01245>>03872000
      STRING;                      << string for new process >><<01245>>03874000
                                                               <<01245>>03876000
    logical                                                    <<01245>>03878000
      LOADFLAGS,                   << load option flags >>     <<01245>>03880000
      SUSP;                        << suspend flg - autoact >> <<01245>>03882000
                                                               <<01245>>03884000
    integer                                                    <<01245>>03886000
      PARM,                        << passed integer @ Q-4 >>  <<01245>>03888000
      STACKSIZE,                   << init Q to Z >>           <<01245>>03890000
      DLSIZE,                      << DL to DB >>              <<01245>>03892000
      MAXDATA,                     << max DL to Z allowed >>   <<01245>>03894000
      STRINGLENGTH;                << length of passed strng >><<01245>>03896000
                                                               <<01245>>03898000
    logical array                                              <<01245>>03900000
      STDIN(0:14),                 << fopen parms for $STDIN >><<01245>>03902000
      STDLIST(0:14);               << parms for $STDLIST >>    <<01245>>03904000
                                                               <<01245>>03906000
    define                                                     <<01245>>03908000
      ACTIVATEFATHER = LOADFLAGS.(15:1)#,                      <<01245>>03910000
      NOCB           = LOADFLAGS.(9:1)#;                       <<01245>>03912000
                                                               <<01245>>03914000
    << *** variables used to determine options specified *** >><<01245>>03916000
                                                               <<01245>>03918000
    integer                                                    <<01245>>03920000
      ENTRYNAME'INDX  := -1,       << index to entry point >>  <<01245>>03922000
      PARM'INDX       := -1,       << index to parm >>         <<01245>>03924000
      LOADFLAGS'INDX  := -1,       << index to load flags >>   <<01245>>03926000
      STACKSIZE'INDX  := -1,                                   <<01245>>03928000
      DLSIZE'INDX     := -1,                                   <<01245>>03930000
      MAXDATA'INDX    := -1,                                   <<01245>>03932000
      PRIORITY'INDX   := -1,                                   <<01245>>03934000
      STDIN'INDX      := -1,                                   <<01245>>03936000
      STDLIST'INDX    := -1,                                   <<01245>>03938000
      AUTOACT'INDX    := -1,                                   <<01245>>03940000
      STRING'INDX     := -1,                                   <<01245>>03942000
      STRNGLNTH'INDX  := -1,                                   <<01245>>03944000
      I;                           << loop index >>            <<01245>>03946000
                                                               <<01245>>03948000
    logical                                                    <<01245>>03950000
      ENDOFLIST,                   << true if end of optns >>  <<01245>>03952000
      OVMASK          = Q-4;       << option variable mask >>  <<01245>>03954000
                                                               <<01245>>03956000
    equate                                                     <<01245>>03958000
      MAXOPTS         = 12;        << # of defined options >>  <<01245>>03960000
                                                               <<01245>>03962000
    define                                                     <<01245>>03964000
      NUMS'BUT'NOOPTS = (OVMASK.(14:2) = %(2)10)#,             <<01245>>03966000
      OPTS'BUT'NONUMS = (OVMASK.(14:2) = %(2)01)#,             <<01245>>03968000
      HAVE'OPTIONS    = (OVMASK.(14:2) = %(2)11)#;             <<01245>>03970000
                                                               <<01245>>03972000
    << *** miscellaneous variables for CREATEPROCESS *** >>    <<01245>>03974000
                                                               <<01245>>03976000
    integer                                                    <<01245>>03978000
      MYPCBPTR,                    << PCB ptr of caller >>     <<01245>>03980000
      SONPCBPTR,                   << PCB ptr of new process >><<01245>>03982000
      SONPIN,                      << pin of any son >>        <<MPEIV>>03984000
      MAIL'STATUS,                 << for result of start-up >><<01245>>03986000
      STARTUP'STATUS,              << for result of start-up >><<01245>>03988000
      STARTCSTNUM,                 << 1st CST # of new prcss >><<01245>>03990000
      STARTDELTAP,                 << initial delta p >>       <<01245>>03992000
      STACKDST        := 0,        << DST # of new stack >>    <<01245>>03994000
      GLOBALSIZE,                  << size of DB global area >><<01245>>03996000
      FILE'ERR,                    << file err in Load >>      <<01265>>03998000
      LOADING'ERR,                 << error return from Load >><<01245>>04000000
      CHEK'ERR,                    << error rtrn from Chek' >> <<01245>>04002000
      CREATEFLAGS,                 << flags for Procreate >>   <<01245>>04004000
      STDX'LNTH,                   << stdin/list strng lnth >> <<01245>>04006000
      STDXPARSE'LNTH;              << parse table length >>    <<01245>>04008000
                                                               <<01245>>04010000
    double                                                     <<01245>>04012000
      SUBQ'INFO;                   << scheduling info >>       <<01245>>04014000
                                                               <<01245>>04016000
    logical                                                    <<01245>>04018000
      DUMMY,                       << for FCONTROL >>          <<01265>>04020000
      CRITSTATE,                   << from SETCRITICAL >>      <<01245>>04022000
      PROGCAPABILITY,              << prog file capabilities >><<01245>>04024000
      BLANK           := "  ",     << default entry point >>   <<01245>>04026000
      PRIORITY        = SUBQ'INFO + 1,   << init priority >>   <<01250>>04028000
      FINAL'PRIORITY;              << final pri of new prcss >><<01245>>04030000
                                                               <<01245>>04032000
    << *** values for ERROR return from CREATEPROCESS *** >>   <<01245>>04034000
                                                               <<01245>>04036000
    equate                                                     <<01245>>04038000
      NO'ERROR        =   0,       << normal return >>         <<01245>>04040000
      LACKS'PH        =   1,       << caller lacks PH cap >>   <<01245>>04042000
      REQDPARM'OMITTD =   2,       << required parm omitted >> <<01245>>04044000
      REQDPARM'BADADR =   3,       << bad address for parm >>  <<01245>>04046000
      OUT'OF'RESOS    =   4,       << resource not available >><<01245>>04048000
      INVALID'OPTION  =   5,       << option not defined >>    <<01245>>04050000
      UNKNOWN'PROG    =   6,       << non-existent program >>  <<01245>>04052000
      BAD'PROGFILE    =   7,       << invalid program file >>  <<01245>>04054000
      BAD'ENTRYNAME   =   8,       << invalid entry point >>   <<01245>>04056000
      DFLT'STACKSIZE  =  -9,       << default stacksize used >><<01245>>04058000
      DFLT'DLSIZE     = -10,       << default dlsize used >>   <<01245>>04060000
      DFLT'MAXDATA    = -11,       << default maxdata used >>  <<01245>>04062000
      DL'ROUNDED      = -12,       << dlsize rounded up >>     <<01245>>04064000
      MAXDATA'DECRSED = -13,       << maxdata decreased >>     <<01245>>04066000
      MAXDATA'INCRSED = -14,       << maxdata increased >>     <<01245>>04068000
      STACK'TOOBIG    =  15,       << stack > config max >>    <<01245>>04070000
      HARD'LOAD'ERR   =  16,       << 'hard' loader error >>   <<01245>>04072000
      BAD'PRIORITY    =  17,       << priority invalid >>      <<01245>>04074000
      INVALID'STDIN   =  18,       << $STDIN invalid >>        <<01245>>04076000
      INVALID'STDLIST =  19,       << $STDLIST invalid >>      <<01245>>04078000
      INVALID'STRING  =  20;       << string spec invalid >>   <<01245>>04080000
                                                               <<01245>>04082000
    << *** definitions for setting $STDIN and $STDLIST *** >>  <<01245>>04084000
                                                               <<01245>>04086000
    byte array                                                 <<01245>>04088000
      STDIN'NAME(0:35),         << stdin file name >>          <<01245>>04090000
      STDIN'DEV(0:17),          << stdin device >>             <<01245>>04092000
      STDIN'FORMS(0:78),        << stdin forms message >>      <<01245>>04094000
      STDIN'FORMAL(0:8),        << stdin formal desig >>       <<01245>>04096000
      STDLIST'NAME(0:35),       << stdlist file name >>        <<01245>>04098000
      STDLIST'DEV(0:17),        << stdlist device >>           <<01245>>04100000
      STDLIST'FORMS(0:78),      << stdlist forms message >>    <<01245>>04102000
      STDLIST'FORMAL(0:8);      << stdlist formal desig >>     <<01245>>04104000
                                                               <<01245>>04106000
    byte pointer                                               <<01245>>04108000
      STDIN'STRNG,              << local ptr to stdin >>       <<01245>>04110000
      STDLIST'STRNG,            << local ptr to stdlist >>     <<01245>>04112000
      BLNKPTR         := @BLANK;<< for XREMJTENTRY >>          <<01245>>04114000
                                                               <<01245>>04116000
    equate                                                     <<01245>>04118000
      LINEARQUEUES = %102,                                     <<01245>>04120000
      CSUBQ        = %103,                                     <<01245>>04122000
      DSUBQ        = %104,                                     <<01245>>04124000
      ESUBQ        = %105;                                     <<01245>>04126000
                                                               <<01245>>04128000
    equate                                                     <<01245>>04130000
      MINPARSETAB'LEN = 78,     << minimum parse tble size >>  <<01245>>04132000
      TERMCHAR        = %16,    << line feed to stop scan >>   <<01245>>04134000
      SCANCHAR        = %15,    << crg return - terminator >>  <<01245>>04136000
      SCANTEST        = [8/TERMCHAR, 8/SCANCHAR];              <<01245>>04138000
                                                               <<01245>>04140000
    << *** Definitions for Error Detection by CHEK'NOABORT *** >>       04142000
                                                               <<01245>>04144000
    double                                                     <<01254>>04146000
      BOUNDS;                   << stack bounds from Chek >>   <<01254>>04148000
                                                               <<01254>>04150000
    integer                                                    <<01254>>04152000
      LOWER'BOUND     = BOUNDS,                                <<01254>>04154000
      UPPER'BOUND     = BOUNDS + 1;                            <<01254>>04156000
                                                               <<01254>>04158000
    equate                                                     <<01245>>04160000
      INTRINSIC'NUM   = 101,                                   <<01245>>04162000
      NUM'PARMS       = 5,                                     <<01245>>04164000
      NUM'PARMWORDS   = NUM'PARMS + 1,                         <<01245>>04166000
      ERRORRETURN     = [10/INTRINSIC'NUM, 6/NUM'PARMWORDS],   <<01245>>04168000
      DBATSTACK       = 0,                                     <<01245>>04170000
      CHECKFLAGS      = [1/DBATSTACK, 7/0, 2/0, 1/0, 5/NUM'PARMS],      04172000
      PARMSCHECK      = [6/0, 2/2, 2/2, 2/3, 2/2, 2/2],        <<01245>>04174000
      PHCAP           = 1,                                     <<01245>>04176000
      OVMASK'REQD     = %(2)00011,                             <<01245>>04178000
                                                               <<01245>>04180000
      CHEK'ILLCAP     = 2,                                     <<01245>>04182000
      CHEK'OMITTDPARM = 3;                                     <<01245>>04184000
                                                               <<01740>>04186000
    << *** Definitions for Process Instrumentation Use *** >>  <<01740>>04188000
                                                               <<01740>>04190000
    integer                                                    <<01740>>04192000
      SIRCOND,                   << from GETSIR for MEASSIR >> <<01740>>04194000
      PROGFNUM,                  << program file number >>     <<01740>>04196000
      JSNUMPTR,                  << ptr to j/s num in PCBX >>  <<01740>>04198000
      MEASPROCENTSIZE;           << size of meas entry >>      <<01740>>04200000
                                                               <<01740>>04202000
    logical                                                    <<01740>>04204000
      MEASPROCENTPTR;            << pointer to meas entry >>   <<01740>>04206000
                                                               <<01740>>04208000
    logical array                                              <<01740>>04210000
      PCBX(*)         = Q+0,     << for accessing PCBX >>      <<01740>>04212000
      PROC'NAME(0:11);           << formatted process name >>  <<01740>>04214000
                                                               <<01740>>04216000
    byte array                                                 <<01740>>04218000
      PROC'NAME'B(*)  = PROC'NAME,                             <<01740>>04220000
      FILENAME(0:27);            << file name from Ffileinfo >><<01740>>04222000
                                                               <<01740>>04224000
    equate                                                     <<01740>>04226000
      PXFIX'JSNUM     = %23;     << pxfix offset to jsnum >>   <<01740>>04228000
                                                               <<01740>>04230000
    << *** Definitions for various callers of Createprocess ***<<01740>>04232000
                                                               <<01245>>04234000
    define                                                     <<01265>>04236000
      CI'CALL         = PCB(MYPCBPTR+                          <<MPEIV>>04238000
                         PROCSTATEWORDNUM.PTYPEFIELD) = MAIN#, <<01710>>04240000
      SYSPROCESS'CALL = (PCB(MYPCBPTR+                         <<MPEIV>>04242000
                          PROCSTATEWORDNUM).PTYPEFIELD > 3)#;  <<MPEIV>>04244000
                                                               <<01427>>04246000
$INCLUDE INCLCIS                                               <<04601>>04248000
$PAGE "PROCEDURE CREATEPROCESS"                                <<04601>>04250000
                                                               <<01710>>04254000
    logical                                                    <<01710>>04256000
      OLD'JCW;                     << JCW before creating >>   <<01710>>04258000
                                                               <<01710>>04260000
    equate                                                     <<01710>>04262000
      STKOVFLOW'JCW   = %140024;   << JCW for stack overflow >><<01710>>04264000
$PAGE                                                          <<01245>>04266000
  << *** Subroutines used by CREATEPROCESS *** >>              <<01245>>04268000
                                                               <<01245>>04270000
    integer subroutine WORDADDRESS' (BYTEADDRESS);             <<01254>>04272000
      value BYTEADDRESS;                                       <<01254>>04274000
    <<                                                                  04276000
       Function                                                         04278000
         Returns the word address corresponding to the byte address     04280000
         input parameter.                                               04282000
    >>                                                                  04284000
    << Inputs >>                                                        04286000
         logical                                               <<01254>>04288000
           BYTEADDRESS;             << contains byte address >><<01254>>04290000
                                                               <<01254>>04292000
    << Outputs                                                          04294000
         Returns the word address equivalent as function return.        04296000
    >>                                                                  04298000
      begin                                                    <<01254>>04300000
        tos := WORDADDRESS' := BYTEADDRESS & lsr(1);           <<01254>>04302000
        push (Z);                                              <<01254>>04304000
        if <<WORADDRESS'>> tos > tos <<Z>> then                <<01254>>04306000
          WORDADDRESS'.(0:1) := 1;                             <<01254>>04308000
      end << WORDADDRESS >>;                                   <<01254>>04310000
$PAGE                                                          <<01254>>04312000
    logical subroutine BOUNDSCHECK (ADDRESS, BYTEADR);         <<01254>>04314000
      value ADDRESS, BYTEADR;                                  <<01254>>04316000
    <<                                                                  04318000
       Function                                                         04320000
         Checks that the given address is within the bounds of the      04322000
         caller's stack.                                                04324000
    >>                                                                  04326000
    << Inputs >>                                                        04328000
    integer                                                    <<01254>>04330000
      ADDRESS;                  << address to check >>         <<01254>>04332000
                                                               <<01254>>04334000
    logical                                                    <<01254>>04336000
      BYTEADR;                  << true if ADDRESS is byte >>  <<01254>>04338000
                                                               <<01254>>04340000
    << Outputs                                                          04342000
        Returns true if address is within bounds of stack.              04344000
    >>                                                                  04346000
      begin                                                    <<01254>>04348000
        if BYTEADR then ADDRESS := WORDADDRESS' (ADDRESS);     <<01254>>04350000
        if LOWER'BOUND <= ADDRESS <= UPPER'BOUND then          <<01254>>04352000
          BOUNDSCHECK := true                                  <<01254>>04354000
        else                                                   <<01254>>04356000
          BOUNDSCHECK := false;                                <<01254>>04358000
      end << BOUNDSCHECK >>;                                   <<01254>>04360000
$PAGE                                                          <<01254>>04362000
    subroutine RECOVER;                                        <<01245>>04364000
    <<                                                                  04366000
       Function                                                         04368000
         Performs error recovery for all 'hard' errors encountered      04370000
         in CREATEPROCESS (i.e. where a positive error number is        04372000
         returned).  Any resources acquired so far are returned to      04374000
         the system before returning directly to the user (via the      04376000
         call to ERROREXIT).                                            04378000
    >>                                                                  04380000
    << Inputs                                                           04382000
         None.  But assumes that parameter ERROR has alreay been        04384000
         set.                                                           04386000
    >>                                                                  04388000
                                                                        04390000
    << Outputs                                                          04392000
         None.                                                          04394000
    >>                                                                  04396000
      begin                                                    <<01245>>04398000
        if STDIN'FORMAL <> "  " then                           <<01245>>04400000
          XREMJTENTRY (STDIN'FORMAL, BLNKPTR, BLNKPTR, 3);     <<01245>>04402000
        if STDLIST'FORMAL <> "  " then                         <<01245>>04404000
          XREMJTENTRY (STDLIST'FORMAL, BLNKPTR, BLNKPTR, 3);   <<01245>>04406000
                                                               <<01245>>04408000
        if STACKDST <> 0 then                                  <<01245>>04410000
          begin                                                <<01245>>04412000
            << since Load was successful, there is a process >><<01245>>04414000
                                                               <<01245>>04416000
            PDISABLE;                                          <<01245>>04418000
            SET'PSIF (SONPCBPTR, SOFTKILL);                    <<01245>>04420000
            << AWAKE & WAIT will PENABLE >>                    <<01245>>04422000
            AWAKE (SONPCBPTR, FATHERWAIT, MOURNINGWAIT);       <<01245>>04424000
            << the new process is now all but gone >>          <<01245>>04426000
            BURRYPROC (SONPCBPTR);                             <<01245>>04428000
            RESETCRITICAL (CRITSTATE);                         <<01245>>04430000
          end                                                  <<01245>>04432000
        else if PIN <> 0 then                                  <<01245>>04434000
          begin                                                <<01245>>04436000
            << need only return the PCB >>                     <<01245>>04438000
                                                               <<01245>>04440000
            RETURNENTRY (PCBB, PIN);                           <<01245>>04442000
            RESETCRITICAL (CRITSTATE);                         <<01245>>04444000
          end;                                                 <<01245>>04446000
                                                               <<01245>>04448000
        PIN := 0;                                              <<01245>>04450000
        CONDITIONCODE := CCL;                                  <<01245>>04452000
        ERROREXIT (ERRORRETURN, 0, 0);                         <<01245>>04454000
      end << RECOVER >>;                                       <<01245>>04456000
$PAGE                                                          <<01245>>04458000
    subroutine FIGURE'OPTIONS;                                 <<01245>>04460000
    <<                                                                  04462000
       Function                                                         04464000
         Determines which options the caller has selected to be used    04466000
         in creating the new process.                                   04468000
    >>                                                                  04470000
    << Inputs                                                           04472000
         None.  But the arrays OPTIONNUMS and OPTIONS are scanned to    04474000
         determine the desired options.                                 04476000
    >>                                                                  04478000
    << Outputs                                                          04480000
         None.  But the option index variables (e.g. STDIN'INDX) are    04482000
         set to indicate where in the OPTIONS array the various         04484000
         options are to be found.                                       04486000
         The option index variables (e.g. STDIN'INDX) are set to        04488000
         indicate where in the OPTIONS array the various options        04490000
         are to be found.                                               04492000
    >>                                                                  04494000
      begin                                                    <<01245>>04496000
                                                               <<01245>>04498000
        I := 0;   ENDOFLIST := false;                          <<01245>>04500000
        while i <= MAXOPTS and not ENDOFLIST do                <<01245>>04502000
          begin                                                <<01245>>04504000
            if not (0 <= OPTIONNUMS(I) <= MAXOPTS)             <<01245>>04506000
              then ENDOFLIST := true                           <<01245>>04508000
            else                                               <<01245>>04510000
              case *OPTIONNUMS(I) of                           <<01245>>04512000
                begin                                          <<01245>>04514000
                  ENDOFLIST := true;                           <<01245>>04516000
                                                               <<01245>>04518000
                  if ENTRYNAME'INDX <> -1 then ENDOFLIST := true        04520000
                    else ENTRYNAME'INDX := I;                  <<01245>>04522000
                                                               <<01245>>04524000
                  if PARM'INDX <> -1 then ENDOFLIST := true    <<01245>>04526000
                    else PARM'INDX := I;                       <<01245>>04528000
                                                               <<01245>>04530000
                  if LOADFLAGS'INDX <> -1 then ENDOFLIST := true        04532000
                    else LOADFLAGS'INDX := I;                  <<01245>>04534000
                                                               <<01245>>04536000
                  if STACKSIZE'INDX <> -1 then ENDOFLIST := true        04538000
                    else STACKSIZE'INDX := I;                  <<01245>>04540000
                                                               <<01245>>04542000
                  if DLSIZE'INDX <> -1 then ENDOFLIST := true  <<01245>>04544000
                    else DLSIZE'INDX := I;                     <<01245>>04546000
                                                               <<01245>>04548000
                  if MAXDATA'INDX <> -1 then ENDOFLIST := true <<01245>>04550000
                    else MAXDATA'INDX := I;                    <<01245>>04552000
                                                               <<01245>>04554000
                  if PRIORITY'INDX <> -1 then ENDOFLIST := true<<01245>>04556000
                    else PRIORITY'INDX := I;                   <<01245>>04558000
                                                               <<01245>>04560000
                  if STDIN'INDX <> -1 then ENDOFLIST := true   <<01245>>04562000
                    else STDIN'INDX := I;                      <<01245>>04564000
                                                               <<01245>>04566000
                  if STDLIST'INDX <> -1 then ENDOFLIST := true <<01245>>04568000
                    else STDLIST'INDX := I;                    <<01245>>04570000
                                                               <<01245>>04572000
                  if AUTOACT'INDX <> -1 then ENDOFLIST := true <<01245>>04574000
                    else AUTOACT'INDX := I;                    <<01245>>04576000
                                                               <<01245>>04578000
                  if STRING'INDX <> -1 then ENDOFLIST := true  <<01245>>04580000
                    else STRING'INDX := I;                     <<01245>>04582000
                                                               <<01245>>04584000
                  if STRNGLNTH'INDX <> -1 then ENDOFLIST := true        04586000
                    else STRNGLNTH'INDX := I;                  <<01245>>04588000
                end << case >>;                                <<01245>>04590000
                                                               <<01245>>04592000
            I := I + 1;                                        <<01245>>04594000
          end << while >>;                                     <<01245>>04596000
                                                               <<01245>>04598000
        if OPTIONNUMS(I-1) <> 0 then ERROR := INVALID'OPTION;  <<01245>>04600000
      end << FIGURE'OPTIONS >>;                                <<01245>>04602000
$PAGE                                                          <<01245>>04604000
    subroutine SET'LOADOPTNS;                                  <<01245>>04606000
    <<                                                                  04608000
       Function                                                         04610000
         Sets the values (default or user specified) for all variables  04612000
         involved in Loading the program for the new process.           04614000
    >>                                                                  04616000
    << Inputs                                                           04618000
         None.                                                          04620000
    >>                                                                  04622000
    << Outputs                                                          04624000
         None.                                                          04626000
    >>                                                                  04628000
      begin                                                    <<01245>>04630000
        if LOADFLAGS'INDX = -1 then LOADFLAGS := 0             <<01245>>04632000
          else LOADFLAGS := OPTIONS(LOADFLAGS'INDX);           <<01245>>04634000
                                                               <<01245>>04636000
        if STACKSIZE'INDX = -1 then STACKSIZE := -1            <<01245>>04638000
          else STACKSIZE := OPTIONS(STACKSIZE'INDX);           <<01245>>04640000
                                                               <<01245>>04642000
        if DLSIZE'INDX = -1 then DLSIZE := -1                  <<01245>>04644000
          else DLSIZE := OPTIONS(DLSIZE'INDX);                 <<01245>>04646000
                                                               <<01245>>04648000
        if MAXDATA'INDX = -1 then MAXDATA := -1                <<01245>>04650000
          else MAXDATA := OPTIONS(MAXDATA'INDX);               <<01245>>04652000
                                                               <<01254>>04654000
        if ENTRYNAME'INDX = -1 then @ENTRYNAME := @BLANK&lsl(1)<<01254>>04656000
        else                                                   <<01254>>04658000
          begin  << entry name specified >>                    <<01254>>04660000
            @ENTRYNAME := OPTIONS(ENTRYNAME'INDX);             <<01254>>04662000
            if not BOUNDSCHECK (@ENTRYNAME, true) then         <<01254>>04664000
              ERROR := BAD'ENTRYNAME;                          <<01254>>04666000
          end;                                                 <<01254>>04668000
      end << SET'LOADOPTNS >>;                                 <<01245>>04670000
                                                               <<01245>>04672000
                                                               <<01245>>04674000
                                                               <<01245>>04676000
    subroutine SET'PARMOPTN;                                   <<01245>>04678000
    <<                                                                  04680000
       Function                                                         04682000
         Sets the value (default or user specified) for parameter to    04684000
         be passed to the new process.                                  04686000
    >>                                                                  04688000
    << Inputs                                                           04690000
         None.                                                          04692000
    >>                                                                  04694000
    << Outputs                                                          04696000
         None.                                                          04698000
    >>                                                                  04700000
      begin                                                    <<01245>>04702000
        if PARM'INDX =-1 then PARM := 0                        <<01245>>04704000
          else PARM := OPTIONS(PARM'INDX);                     <<01245>>04706000
      end << SET'PARMOPTN >>;                                  <<01245>>04708000
                                                               <<01245>>04710000
                                                               <<01245>>04712000
                                                               <<01245>>04714000
    subroutine SET'AUTOACTOPTN;                                <<01245>>04716000
    <<                                                                  04718000
       Function                                                         04720000
         Sets the value for the SUSP parameter for the automatic        04722000
         activation option.  SUSP, if non-zero, indicates that the      04724000
         calling process is to be suspended when the new process is     04726000
         activated upon creation completion.  The value indicates       04728000
         the anticipated source of re-activation.                       04730000
    >>                                                                  04732000
    << Inputs                                                           04734000
         None.                                                          04736000
    >>                                                                  04738000
    << Outputs                                                          04740000
         None.                                                          04742000
    >>                                                                  04744000
      begin                                                    <<01245>>04746000
        if AUTOACT'INDX = -1 then SUSP := 0                    <<01245>>04748000
          else SUSP := OPTIONS(AUTOACT'INDX).(14:2);           <<01245>>04750000
      end << SET'AUTOACTOPTN >>;                               <<01245>>04752000
$PAGE                                                          <<01245>>04754000
    subroutine SET'PRIOPTN;                                    <<01245>>04756000
    <<                                                                  04758000
       Function                                                         04760000
         Sets the value (default or user specified) for the priority    04762000
         of the new process.                                            04764000
    >>                                                                  04766000
    << Inputs                                                           04768000
         None.                                                          04770000
    >>                                                                  04772000
    << Outputs                                                          04774000
         None.                                                          04776000
    >>                                                                  04778000
      begin                                                    <<01245>>04780000
        << initially give new process same priority as creating >>      04782000
        << process so as to avoid having to wait creating       >>      04784000
        << process for a possibly lower priority son.           >>      04786000
        MYPCBPTR := absolute(CPCB) - absolute(PCBB);           <<01245>>04788000
        tos := PCB(MYPCBPTR+QUEUEINGINFOWORDNUM);              <<MPEIV>>04790000
                                                               <<01245>>04792000
        << note that setting SUBQ'INFO also sets PRIORITY >>   <<01245>>04794000
        if logical(S0.ESCHEDFLAG)                              <<MPEIV>>04796000
          then SUBQ'INFO := SUBQUEUE (4, ESUBQ)                <<01245>>04798000
        else if logical(S0.DSCHEDFLAG)                         <<MPEIV>>04800000
          then SUBQ'INFO := SUBQUEUE (4, DSUBQ)                <<01245>>04802000
        else if logical(S0.CSCHEDFLAG)                         <<MPEIV>>04804000
          then SUBQ'INFO := SUBQUEUE (4, CSUBQ)                <<01245>>04806000
        else                                                   <<01245>>04808000
          begin                                                <<01245>>04810000
            SUBQ'INFO := SUBQUEUE (4, LINEARQUEUES);           <<01245>>04812000
            PRIORITY.PRIFIELD :=                               <<MPEIV>>04814000
                 PCB(MYPCBPTR+QUEUEINGINFOWORDNUM).PRIFIELD;   <<MPEIV>>04816000
          end;                                                 <<01245>>04818000
        del;   << my priority >>                               <<01245>>04820000
                                                               <<01245>>04822000
        if PRIORITY'INDX = -1 then                             <<01245>>04824000
          FINAL'PRIORITY := PRIORITY                           <<01245>>04826000
        else                                                   <<01245>>04828000
          begin  << priority specified by caller>>             <<01245>>04830000
            FINAL'PRIORITY:=CHECKPRIORITY (OPTIONS(PRIORITY'INDX), 0);  04832000
            if < then ERROR := BAD'PRIORITY;                   <<01245>>04834000
          end;                                                 <<01245>>04836000
                                                               <<MPEIV>>04838000
         tos := FINAL'PRIORITY;                                <<MPEIV>>04840000
         if logical(S0.EQ) then                                <<MPEIV>>04842000
           FINAL'PRIORITY.QTYPE := %(2)0001                    <<MPEIV>>04844000
         else if logical(S0.DQ) then                           <<MPEIV>>04846000
           FINAL'PRIORITY.QTYPE := %(2)0010                    <<MPEIV>>04848000
         else if logical(S0.CQ) then                           <<MPEIV>>04850000
           FINAL'PRIORITY.QTYPE := %(2)0100                    <<MPEIV>>04852000
         else                                                  <<MPEIV>>04854000
           FINAL'PRIORITY.QTYPE := %(2)1000;                   <<MPEIV>>04856000
         del;   << priority word >>                            <<MPEIV>>04858000
      end << SET'PRIORITYOPTN >>;                              <<01245>>04860000
$PAGE                                                          <<01245>>04862000
    subroutine SET'STDXOPTNS;                                  <<01245>>04864000
    <<                                                                  04866000
       Function                                                         04868000
         Sets the values (default or user specified) for $STDIN and     04870000
         $STDLIST for the new process.  The arrays specifying           04872000
         each file are simply the 14 words of FOPEN parameters          04874000
         plus the option variable mask.                                 04876000
    >>                                                                  04878000
    << Inputs                                                           04880000
         None.                                                          04882000
    >>                                                                  04884000
    << Outputs                                                          04886000
         None.                                                          04888000
    >>                                                                  04890000
      begin                                                    <<01245>>04892000
        @STDIN'STRNG := OPTIONS(STDIN'INDX);                   <<01254>>04894000
        @STDLIST'STRNG := OPTIONS(STDLIST'INDX);               <<01254>>04896000
                                                               <<01245>>04898000
        if STDIN'INDX = -1 then                                <<01245>>04900000
          INHERIT'STDX (ERROR, STDIN, 1, STDIN'NAME,           <<01710>>04902000
                        STDIN'DEV)                             <<01710>>04904000
        else if not BOUNDSCHECK (@STDIN'STRNG, true) then      <<01254>>04906000
          ERROR := INVALID'STDIN                               <<01254>>04908000
        else                                                   <<01245>>04910000
          begin  << set specified $stdin values >>             <<01245>>04912000
            << determine length of string >>                   <<01245>>04914000
            tos := TERMCHAR;     << scan no farther than tos >><<01245>>04916000
            scan STDIN'STRNG until SCANTEST, 1;                <<01245>>04918000
            if carry then                                      <<01245>>04920000
              begin  << didn't find CR >>                      <<01245>>04922000
                ddel;   << stopper & ptr >>                    <<01245>>04924000
                ERROR := INVALID'STDIN;                        <<01245>>04926000
              end                                              <<01245>>04928000
            else                                               <<01245>>04930000
              begin  << found terminating CR >>                <<01245>>04932000
                STDX'LNTH := @STDIN'STRNG - tos + 1;           <<01245>>04934000
                del;   << stopper >>                           <<01245>>04936000
                if (STDX'LNTH + 1)/2 > MINPARSETAB'LEN then    <<01245>>04938000
                  STDXPARSE'LNTH := (STDX'LNTH + 1)/2          <<01245>>04940000
                else                                           <<01245>>04942000
                  STDXPARSE'LNTH := MINPARSETAB'LEN;           <<01245>>04944000
                BUILD'STDX (ERROR, STDIN, 1, STDIN'STRNG,      <<01245>>04946000
                            STDX'LNTH, STDXPARSE'LNTH,         <<01245>>04948000
                            STDIN'NAME, STDIN'DEV,             <<01245>>04950000
                            STDIN'FORMS, STDIN'FORMAL);        <<01245>>04952000
              end;                                             <<01245>>04954000
          end << non-default stdin >>;                         <<01245>>04956000
        if ERROR <> NO'ERROR then                              <<01796>>04958000
          begin                                                <<01796>>04960000
            if SYSPROCESS'CALL then                            <<01796>>04962000
              ERROR := NO'ERROR                                <<01796>>04964000
            else                                               <<01796>>04966000
              ERROR := INVALID'STDIN;                          <<01796>>04968000
          end;                                                 <<01796>>04970000
                                                               <<01245>>04972000
        if ERROR = NO'ERROR then                               <<01245>>04974000
          begin                                                <<01245>>04976000
            if STDLIST'INDX = -1 then                          <<01245>>04978000
              INHERIT'STDX (ERROR, STDLIST, 2, STDLIST'NAME,   <<01710>>04980000
                            STDLIST'DEV)                       <<01710>>04982000
            else if not BOUNDSCHECK (@STDLIST'STRNG, true) then<<01254>>04984000
              ERROR := INVALID'STDLIST                         <<01254>>04986000
            else                                               <<01245>>04988000
              begin  << set specified $stdlist values >>       <<01245>>04990000
                << determine length of string >>               <<01245>>04992000
                tos := TERMCHAR; << scan no farther than tos >><<01245>>04994000
                scan STDLIST'STRNG until SCANTEST, 1;          <<01245>>04996000
                if carry then                                  <<01245>>04998000
                  begin  << didn't find CR >>                  <<01245>>05000000
                    ddel;   << stopper & ptr >>                <<01245>>05002000
                    ERROR := INVALID'STDLIST;                  <<01245>>05004000
                  end                                          <<01245>>05006000
                else                                           <<01245>>05008000
                  begin  << found terminating CR >>            <<01245>>05010000
                    STDX'LNTH := @STDLIST'STRNG - tos + 1;     <<01245>>05012000
                    del;   << stopper >>                       <<01245>>05014000
                    if (STDX'LNTH + 1)/2 > MINPARSETAB'LEN then<<01245>>05016000
                      STDXPARSE'LNTH := (STDX'LNTH + 1)/2      <<01245>>05018000
                    else                                       <<01245>>05020000
                      STDXPARSE'LNTH := MINPARSETAB'LEN;       <<01245>>05022000
                    BUILD'STDX (ERROR, STDLIST, 2,             <<01245>>05024000
                                STDLIST'STRNG, STDX'LNTH,      <<01245>>05026000
                                STDXPARSE'LNTH, STDLIST'NAME,  <<01245>>05028000
                                STDLIST'DEV, STDLIST'FORMS,    <<01245>>05030000
                                STDLIST'FORMAL);               <<01245>>05032000
                  end;                                         <<01245>>05034000
              end << non-default stdlist >>;                   <<01245>>05036000
            if ERROR <> NO'ERROR then                          <<01796>>05038000
              begin                                            <<01796>>05040000
                if SYSPROCESS'CALL then                        <<01796>>05042000
                  ERROR := NO'ERROR                            <<01796>>05044000
                else                                           <<01796>>05046000
                  ERROR := INVALID'STDLIST;                    <<01796>>05048000
              end;                                             <<01796>>05050000
          end;                                                 <<01245>>05052000
      end << SET'STDXOPTNS >>;                                 <<01245>>05054000
$PAGE                                                          <<01245>>05056000
    subroutine SET'STRINGOPTN;                                 <<01245>>05058000
    <<                                                                  05060000
       Function                                                         05062000
         Sets the value (default or user specified) for the string      05064000
         to be passed to the new process.                               05066000
    >>                                                                  05068000
    << Inputs                                                           05070000
         None.                                                          05072000
    >>                                                                  05074000
    << Outputs                                                          05076000
         None.                                                          05078000
    >>                                                                  05080000
      begin                                                    <<01245>>05082000
        if STRING'INDX = -1 and STRNGLNTH'INDX <> -1           <<01245>>05084000
          or STRNGLNTH'INDX = -1 and STRING'INDX <> -1         <<01245>>05086000
            then ERROR := INVALID'STRING                       <<01245>>05088000
                                                               <<01245>>05090000
        else if STRING'INDX = -1 then                          <<01245>>05092000
          begin  << assign defaults >>                         <<01245>>05094000
            @STRING := 0;                                      <<01245>>05096000
            STRINGLENGTH := 0;                                 <<01245>>05098000
          end                                                  <<01245>>05100000
                                                               <<01245>>05102000
        else                                                   <<01245>>05104000
          begin  << assign specified values, if ok >>          <<01245>>05106000
            if integer(OPTIONS(STRNGLNTH'INDX)) < 0 or                  05108000
               integer(OPTIONS(STRNGLNTH'INDX))                <<01254>>05110000
                               > UPPER'BOUND - LOWER'BOUND     <<01254>>05112000
              then ERROR := INVALID'STRING                     <<01245>>05114000
            else                                               <<01245>>05116000
              begin                                            <<01245>>05118000
                @STRING := OPTIONS(STRING'INDX);               <<01245>>05120000
                STRINGLENGTH := OPTIONS(STRNGLNTH'INDX);       <<01245>>05122000
              if not BOUNDSCHECK (@STRING, true) then          <<01254>>05124000
                ERROR := INVALID'STRING;                       <<01254>>05126000
              end;                                             <<01245>>05128000
          end;                                                 <<01245>>05130000
      end << SET'STRINGOPTNS >>;                               <<01245>>05132000
$PAGE                                                          <<01245>>05134000
    subroutine SETUP'OPTIONS;                                  <<01245>>05136000
    <<                                                                  05138000
       Function                                                         05140000
         Calls all other subroutines to set the initial values          05142000
         (default or user specified) for the various options            05144000
         possible in CREATEPROCESS.                                     05146000
    >>                                                                  05148000
    << Inputs                                                           05150000
         None.                                                          05152000
    >>                                                                  05154000
    << Outputs                                                          05156000
         None.                                                          05158000
    >>                                                                  05160000
      begin                                                    <<01245>>05162000
        << options which will not result in errors >>          <<01245>>05164000
        SET'PARMOPTN;                                          <<01245>>05166000
                                                               <<01245>>05168000
        SET'AUTOACTOPTN;                                       <<01245>>05170000
                                                               <<01245>>05172000
        << options which may be specified incorrectly >>       <<01245>>05174000
        SET'PRIOPTN;                                           <<01245>>05176000
                                                               <<01254>>05178000
        if ERROR = NO'ERROR then SET'LOADOPTNS;                <<01254>>05180000
                                                               <<01245>>05182000
        if ERROR = NO'ERROR then SET'STDXOPTNS;                <<01245>>05184000
                                                               <<01245>>05186000
        if ERROR = NO'ERROR then SET'STRINGOPTN;               <<01245>>05188000
      end << SETUP'OPTIONS >>;                                 <<01245>>05190000
$PAGE                                                          <<01245>>05192000
    logical subroutine SON'STILL'THERE;                        <<01427>>05194000
    <<                                                                  05196000
       Function                                                         05198000
         Determines whether the process undergoing creation             05200000
         still exists or is gone (i.e. was ABORTed).                    05202000
    >>                                                                  05204000
    << Inputs                                                           05206000
         None.                                                          05208000
    >>                                                                  05210000
    << Outputs                                                          05212000
         Returns true if the new son still exists in the                05214000
         creating process's structure.                                  05216000
    >>                                                                  05218000
      begin                                                    <<01427>>05220000
        PDISABLE;     << STARTPROCESS will PENABLE again >>    <<01427>>05222000
                                                               <<01427>>05224000
        SONPIN :=                                              <<MPEIV>>05226000
          PCB( MYPCBPTR+FATHERSONINFOWORDNUM).SONPINFIELD;     <<04610>>05228000
                                                               <<01427>>05230000
        while SONPIN <> 0 and SONPIN <> PIN do                 <<01427>>05232000
          SONPIN := PCB(SONPIN*PCBSIZE+                        <<MPEIV>>05234000
                          BROTHERINFOWORDNUM).BROTHERPINFIELD; <<MPEIV>>05236000
                                                               <<01427>>05238000
        SON'STILL'THERE := if SONPIN = PIN then true           <<01427>>05240000
                             else false;                       <<01427>>05242000
      end << SON'STILL'THERE >>;                               <<01427>>05244000
$PAGE                                                          <<01427>>05246000
    subroutine STARTPROCESS;                                   <<01245>>05248000
    <<                                                                  05250000
       Function                                                         05252000
         Starts a process by forcing it to go through INITIATE          05254000
         which opens $STDIN and $STDLIST for the process.  The          05256000
         new process will send a message (via PSEUDO MAIL) to the       05258000
         creating process indicating the success or failure of the      05260000
         opens on the standard files.                                   05262000
    >>                                                                  05264000
    << Inputs                                                           05266000
         None.                                                          05268000
    >>                                                                  05270000
    << Outputs                                                          05272000
         None.                                                          05274000
    >>                                                                  05276000
      begin                                                    <<01245>>05278000
        INIT'PSEUDOMAIL (PIN);                                 <<01427>>05280000
                                                               <<01427>>05282000
        if CI'CALL and not CIS'UDCNOBREAKOPT then              <<04601>>05284000
          FCONTROL (1, DISABLEBREAK, DUMMY);                   <<01265>>05286000
                                                               <<01427>>05288000
        << save current JCW for possible use later >>          <<01710>>05290000
        OLD'JCW := GETJCW;                                     <<01710>>05292000
                                                               <<01710>>05294000
       << Set son critical; reset after INITIATE. >>           <<01870>>05296000
       PCB(SONPCBPTR).CRITFLAG := 1;                           <<01870>>05298000
       << Start up son... >>                                   <<01870>>05300000
        AWAKE (SONPCBPTR, FATHERWAIT, JUNK'SONWAIT);           <<01427>>05302000
                                                               <<01245>>05304000
        RECV'PSEUDOMAIL (PIN, STARTUP'STATUS);                 <<01245>>05306000
                                                               <<01245>>05308000
        while SON'STILL'THERE and STARTUP'STATUS < 0 do        <<01427>>05310000
          begin  << a terminating son woke us instead >>       <<01427>>05312000
            << SON'STILL'THERE PDISABLEd - WAIT will PENABLE >><<01427>>05314000
            WAIT (-JUNK'SONWAIT, 0);                           <<01427>>05316000
            RECV'PSEUDOMAIL (PIN, STARTUP'STATUS);             <<01245>>05318000
          end;                                                 <<01245>>05320000
                                                               <<01245>>05322000
        PENABLE;                                               <<01427>>05324000
                                                               <<01427>>05326000
        if CI'CALL and not CIS'UDCNOBREAKOPT then              <<04601>>05328000
          FCONTROL (1, ENABLEBREAK, DUMMY);                    <<01265>>05330000
                                                               <<01427>>05332000
        FREE'PSEUDOMAIL (PIN);                                 <<01245>>05334000
                                                               <<01427>>05336000
        if \STARTUP'STATUS\ = 1 then                           <<01427>>05338000
          ERROR := INVALID'STDIN                               <<01427>>05340000
        else if \STARTUP'STATUS\ = 2 then                      <<01427>>05342000
          ERROR := INVALID'STDLIST;                            <<01427>>05344000
                                                               <<01427>>05346000
        if STARTUP'STATUS < 0 then                             <<01427>>05348000
          begin  << Fopen caused new process to ABORT >>       <<01427>>05350000
            STACKDST := 0;                                     <<01427>>05352000
            PIN := 0;                                          <<01427>>05354000
            << Aborted process has set JCW to fatal error. >>  <<01710>>05356000
            << Reset it to prior value if the current JCW  >>  <<01710>>05358000
            << does, in fact, indicate stackoverflow.      >>  <<01710>>05360000
            << Note that a window exists here where a the  >>  <<01710>>05362000
            << JCW can be reset over an error caused by a  >>  <<01710>>05364000
            << different process.                          >>  <<01710>>05366000
            if GETJCW = STKOVFLOW'JCW then                     <<01710>>05368000
              SETJCW (OLD'JCW);                                <<01710>>05370000
            RESETCRITICAL (CRITSTATE);                         <<01427>>05372000
          end;                                                 <<01427>>05374000
      end << STARTPROCESS >>;                                  <<01245>>05376000
$PAGE                                                          <<01740>>05378000
    subroutine RECORD'CREATE;                                  <<01740>>05380000
    COMMENT                                                    <<01740>>05382000
       Function                                                <<01740>>05384000
         Records certain statistics at create-time in the      <<01740>>05386000
         entry for the new process in the data segment for     <<01740>>05388000
         global process level instrumentation.  Note that      <<01740>>05390000
         this is done only if global process instrumentation   <<01740>>05392000
         is enabled.                                           <<01740>>05394000
                                                               <<01740>>05396000
       Inputs                                                  <<01740>>05398000
         None.                                                 <<01740>>05400000
                                                               <<01740>>05402000
       Outputs                                                 <<01740>>05404000
         None.  But the entry in the process instrumentation   <<01740>>05406000
         data segment corresponding to the new process (PIN)   <<01740>>05408000
         is initialized and filled with several pieces of      <<01740>>05410000
         information.                                          <<01740>>05412000
    ;                                                          <<01740>>05414000
      begin                                                    <<01740>>05416000
        << get program file name in proper format >>           <<04503>>05418000
        PROC'NAME := "  ";        << set name to blanks >>     <<04503>>05420000
        move PROC'NAME(1) := PROC'NAME, (11);                  <<04503>>05422000
        FILENAME := " ";                                       <<04503>>05424000
        move FILENAME(1) := FILENAME, (27);                    <<04503>>05426000
        PROGFNUM := FOPEN (PROGNAME, %2003, %767);             <<04503>>05428000
        if < then  << couldn't open program file >>            <<04503>>05430000
          move PROC'NAME := "UNAVAIL"                          <<04503>>05432000
        else                                                   <<04503>>05434000
          begin  << opened program file ok >>                  <<04503>>05436000
            FFILEINFO (PROGFNUM, 1, FILENAME);                 <<04503>>05438000
            << move prog file name into buffer >>              <<04503>>05440000
            move PROC'NAME'B := FILENAME while AN, 0;          <<04503>>05442000
            delb;                 << remove destination ptr >> <<04503>>05444000
            tos := tos + 1;       << ignore '.' >>             <<04503>>05446000
            << move group name into buffer >>                  <<04503>>05448000
            move PROC'NAME'B(8) := * while AN, 0;              <<04503>>05450000
            delb;                 << remove destination ptr >> <<04503>>05452000
            tos := tos + 1;       << ignore '.' >>             <<04503>>05454000
            << move account name into buffer >>                <<04503>>05456000
            move PROC'NAME'B(16) := * while AN;                <<04503>>05458000
            FCLOSE (PROGFNUM,0,0);                             <<04503>>05460000
          end;                                                 <<04503>>05462000
                                                               <<04503>>05464000
          SIRCOND := GETSIR ( MEASSIR );                       <<04503>>05466000
        << get pointer to appropriate entry >>                 <<01740>>05468000
        tos := MEASPROCXDSBANK;                                <<01740>>05470000
        tos := MEASPROCXDSBASE;                                <<01740>>05472000
        assemble (LSEA);          << get entry size >>         <<01740>>05474000
        MEASPROCENTSIZE := tos;   << remember entry size >>    <<01740>>05476000
        tos := PIN * MEASPROCENTSIZE;   << offset to entry >>  <<01740>>05478000
        assemble (LADD);          << absolute ptr to entry >>  <<01740>>05480000
        MEASPROCENTPTR := S0;     << remember entry pointer >> <<01740>>05482000
                                                               <<01740>>05484000
        << initialize entry with 0s >>                         <<01740>>05486000
        I := 0;                                                <<01740>>05488000
        while (I := I + 1) <= MEASPROCENTSIZE do               <<01740>>05490000
          begin                                                <<01740>>05492000
            tos := 0;                                          <<01740>>05494000
            assemble (SSEA);      << clear the word >>         <<01740>>05496000
            tos := tos + 1;       << ptr to next word to 0 >>  <<01740>>05498000
          end;                                                 <<01740>>05500000
                                                               <<01740>>05502000
        << fill in create time >>                              <<01740>>05504000
        S0 := MEASPROCENTPTR + logical(CP'CREATETIME);         <<01740>>05506000
        tos := TIMER;             << double word time stamp >> <<01740>>05508000
        assemble (SDEA);      << place create time in entry >> <<01740>>05510000
                                                               <<01740>>05512000
        << get ptr to job/session num in PCBX >>               <<01740>>05514000
        push (Q, DL);                                          <<01740>>05516000
        assemble (XCH,SUB; DUP,STAX);                          <<01740>>05518000
        tos := PCBX(X:=X-2) - PXFIX'JSNUM;                     <<01740>>05520000
        JSNUMPTR := tos - tos;                                 <<01740>>05522000
                                                               <<01740>>05524000
        << fill in job/session number >>                       <<01740>>05526000
        S0 := MEASPROCENTPTR + logical(CP'JOBSESSIONNUM);      <<01740>>05528000
        tos := PCBX(JSNUMPTR);    << j/s num in PCBX >>        <<01740>>05530000
        assemble (SSEA);          << place j/s num in entry >> <<01740>>05532000
                                                               <<01740>>05534000
        << fill in queue descriptor word >>                    <<01740>>05536000
        S0 := MEASPROCENTPTR + logical(CP'PROCQUESTOPWORD);    <<01740>>05538000
        tos := 0;                                              <<01740>>05540000
        S0.(0:4) := PCB(PIN*PCBSIZE+QUEUEINGINFOWORDNUM).QTYPE;<<01740>>05542000
        assemble (SSEA);      << place queue word in entry >>  <<01740>>05544000
                                                               <<01740>>05546000
        ddel;                     << xds bank & address >>     <<01740>>05548000
        << fill in program file name >>                        <<01740>>05552000
        tos := MEASPROCXDSNUM;                                 <<01740>>05554000
        tos := MEASPROCENTPTR - MEASPROCXDSBASE;   << offset >><<01740>>05556000
        tos := tos + logical(CP'PROGNAME);                     <<01740>>05558000
        tos := @PROC'NAME;                                     <<01740>>05560000
        tos := 12;                                             <<01740>>05562000
        assemble (MTDS);          << place name in entry >>    <<01740>>05564000
    RELSIR (MEASSIR, SIRCOND);                                 <<04503>>05566000
      end << RECORD'CREATE >>;                                 <<01740>>05568000
$PAGE                                                          <<01245>>05570000
    << CREATEPROCESS >>                                        <<01245>>05572000
    FORCE'STKOVFLOW;                                           <<01245>>05574000
    ERRORON;                                                   <<01245>>05576000
    BOUNDS := CHEK'NOABORT (ERRORRETURN, CHECKFLAGS,           <<01254>>05578000
                            PARMSCHECK D, PHCAP D,             <<01254>>05580000
                            OVMASK'REQD);                      <<01254>>05582000
    if < then                                                  <<01245>>05584000
      begin  << an error from CHEK >>                          <<01245>>05586000
        CHEK'ERR := ERRORGET (1).(8:8);                        <<01245>>05588000
        if CHEK'ERR = CHEK'ILLCAP then                         <<01245>>05590000
          ERROR := LACKS'PH                                    <<01245>>05592000
        else if CHEK'ERR = CHEK'OMITTDPARM then                <<01245>>05594000
          ERROR := REQDPARM'OMITTD                             <<01245>>05596000
        else                                                   <<01245>>05598000
          ERROR := REQDPARM'BADADR;                            <<01245>>05600000
        CONDITIONCODE := CCL;                                  <<01245>>05602000
        ERROREXIT (ERRORRETURN, 0, 0);                         <<01245>>05604000
      end;                                                     <<01245>>05606000
                                                               <<01245>>05608000
    ERROR := NO'ERROR;   PIN := 0;   CONDITIONCODE := CCE;     <<01245>>05610000
    move STDIN'FORMAL := "         ";                          <<01245>>05612000
    move STDLIST'FORMAL := "         ";                        <<01245>>05614000
                                                               <<01245>>05616000
    if NUMS'BUT'NOOPTS or OPTS'BUT'NONUMS then                 <<01245>>05618000
      ERROR := INVALID'OPTION                                  <<01245>>05620000
    else if HAVE'OPTIONS then                                  <<01245>>05622000
      FIGURE'OPTIONS;                                          <<01245>>05624000
                                                               <<01245>>05626000
    if ERROR = INVALID'OPTION then RECOVER                     <<01245>>05628000
      else SETUP'OPTIONS;                                      <<01245>>05630000
                                                               <<01245>>05632000
    if ERROR <> NO'ERROR then RECOVER                          <<01245>>05634000
    else                                                       <<01245>>05636000
      begin  << get a PCB >>                                   <<01245>>05638000
        CRITSTATE := SETCRITICAL;                              <<01245>>05640000
        PIN := GETENTRY (PCBB);                                <<01245>>05642000
        SONPCBPTR := PIN * PCBSIZE;                            <<01268>>05644000
      end;                                                     <<01245>>05646000
                                                               <<01245>>05648000
    if PIN = 0 then                                            <<01245>>05650000
      begin  << couldn't get a PCB right now >>                <<01245>>05652000
        ERROR := OUT'OF'RESOS;                                 <<01245>>05654000
        RESETCRITICAL (CRITSTATE);                             <<01254>>05656000
        RECOVER;                                               <<01245>>05658000
      end                                                      <<01245>>05660000
    else                                                       <<01245>>05662000
      LOAD (PROGNAME, ENTRYNAME, STARTCSTNUM, STARTDELTAP,     <<01245>>05664000
            STACKDST, PIN, LOADFLAGS, PCBXSIZE, DLSIZE,        <<01245>>05666000
            STACKSIZE, MAXDATA, GLOBALSIZE, STRING,            <<01245>>05668000
            STRINGLENGTH, PROGCAPABILITY);                     <<01245>>05670000
                                                               <<01245>>05672000
    if < then                                                  <<01245>>05674000
      begin  << Load failed >>                                 <<01245>>05676000
        LOADING'ERR := ERRORGET (1);                           <<01245>>05678000
        if LOADING'ERR = LERR53 then                           <<01265>>05680000
          begin  << error opening prog file >>                 <<01265>>05682000
            FILE'ERR := ERRORGET(2);                           <<01265>>05684000
            if FSERR50 <= FILE'ERR <= FSERR53 then             <<01265>>05686000
              ERROR := UNKNOWN'PROG                            <<01265>>05688000
            else                                               <<01265>>05690000
              ERROR := HARD'LOAD'ERR;                          <<01265>>05692000
          end                                                  <<01265>>05694000
        else if LOADING'ERR = LERR34 or LOADING'ERR = LERR31   <<01245>>05696000
          then ERROR := BAD'PROGFILE                           <<01245>>05698000
        else if LOADING'ERR = LERR21 or LOADING'ERR = LERR45   <<01245>>05700000
          then ERROR := BAD'ENTRYNAME                          <<01245>>05702000
        else if LOADING'ERR = LERR35 or LOADING'ERR = LERR36   <<01245>>05704000
          then ERROR := STACK'TOOBIG                           <<01245>>05706000
        else                                                   <<01245>>05708000
          ERROR := HARD'LOAD'ERR;                              <<01245>>05710000
        RECOVER;                                               <<01245>>05712000
      end                                                      <<01245>>05714000
    else                                                       <<01245>>05716000
      begin  << Load succeeded >>                              <<01245>>05718000
                                                               <<01245>>05720000
        if > then                                              <<01245>>05722000
          begin                                                <<01245>>05724000
            << Load returns the actual warning >>              <<01245>>05726000
            ERROR := ERRORGET (1);                             <<01245>>05728000
            CONDITIONCODE := CCG;                              <<01245>>05730000
          end;                                                 <<01245>>05732000
                                                               <<01245>>05734000
        CREATEFLAGS := (LOADFLAGS land %177004) lor            <<01245>>05736000
                         PROGCAPABILITY;                       <<01245>>05738000
        if NOCB then CREATEFLAGS.(11:1) := 1;                  <<01245>>05740000
                                                               <<01245>>05742000
        << set 'father activate' flag so that creating      >> <<01427>>05744000
        << process will be awakened if new process ABORTs   >> <<01427>>05746000
        << during Fopen of $STDIN or $STDLIST.              >> <<01427>>05748000
        if not SYSPROCESS'CALL then CREATEFLAGS.(4:1) := 1;    <<01427>>05750000
                                                               <<01427>>05752000
        PROCREATE (PIN, STARTCSTNUM, STARTDELTAP, STACKDST,    <<01245>>05754000
                   GLOBALSIZE, DLSIZE, STACKSIZE, PRIORITY,    <<01245>>05756000
                   @STRING, STRINGLENGTH, PARM, CREATEFLAGS,   <<01245>>05758000
                   MAXDATA, STDIN, STDLIST);                   <<01245>>05760000
                                                               <<01245>>05762000
        if not SYSPROCESS'CALL then STARTPROCESS;              <<01268>>05764000
      end;                                                     <<01245>>05766000
                                                               <<01245>>05768000
    if ERROR > NO'ERROR then RECOVER                           <<01245>>05770000
    else                                                       <<01245>>05772000
      begin  << finalization - possibily a subroutine later >> <<01245>>05774000
        << remove temp file equation tab entries - if any >>   <<01245>>05776000
        if STDIN'FORMAL <> "  " then                           <<01245>>05778000
          XREMJTENTRY (STDIN'FORMAL, BLNKPTR, BLNKPTR, 3);     <<01245>>05780000
        if STDLIST'FORMAL <> "  " then                         <<01245>>05782000
          XREMJTENTRY (STDLIST'FORMAL, BLNKPTR, BLNKPTR, 3);   <<01245>>05784000
                                                               <<01245>>05786000
        << set final priority for new process >>               <<01245>>05788000
        PCB(SONPCBPTR+QUEUEINGINFOWORDNUM).QTYPE :=            <<MPEIV>>05790000
                    FINAL'PRIORITY.QTYPE;                      <<MPEIV>>05792000
        PCB(SONPCBPTR+QUEUEINGINFOWORDNUM).PRIFIELD :=         <<MPEIV>>05794000
                    FINAL'PRIORITY.PRIFIELD;                   <<MPEIV>>05796000
                                                               <<01245>>05798000
        << set 'father activate' bit in PCB to correct value >><<01427>>05800000
        PCB(SONPCBPTR+PIINFONIMPPINWORDNUM).FACFLAG :=         <<MPEIV>>05802000
          if ACTIVATEFATHER then 1 else 0;                     <<MPEIV>>05804000
                                                               <<01740>>05806000
        << record creation if process instrumentation is set >><<01740>>05808000
        if GCLASSENABLEDMASK.CLASS15 then RECORD'CREATE;       <<01740>>05812000
                                                               <<01740>>05816000
        RESETCRITICAL (CRITSTATE);                             <<01245>>05818000
                                                               <<01245>>05820000
        if AUTOACT'INDX <> -1 then                             <<01245>>05822000
          AWAKE (SONPCBPTR, FATHERWAIT, SUSP);                 <<01245>>05824000
      end;                                                     <<01245>>05826000
                                                               <<01245>>05828000
    << all done - return values & condition code already set >><<01245>>05830000
    ERROREXIT (ERRORRETURN, 0, 0);                             <<01245>>05832000
  end << CREATEPROCESS >>;                                     <<01245>>05834000
$PAGE "PROCEDURE CREATE"                                       <<01245>>05836000
PROCEDURE CREATE(PROGNAME,ENTRYNAME,PIN,PARAM,FLAGS,STACKSIZE, <<01245>>05838000
                  DLSIZE,MAXDATA,PRIORITYCLASS,RANK);          <<01245>>05840000
VALUE PARAM,FLAGS,STACKSIZE,DLSIZE,MAXDATA,PRIORITYCLASS,RANK; <<01245>>05842000
LOGICAL FLAGS,PRIORITYCLASS;                                   <<01245>>05844000
INTEGER PIN,PARAM,STACKSIZE,DLSIZE,MAXDATA,RANK;               <<01245>>05846000
BYTE ARRAY PROGNAME,ENTRYNAME;                                 <<01245>>05848000
OPTION VARIABLE,PRIVILEGED;                                    <<01245>>05850000
                                                               <<01245>>05852000
COMMENT: ESTABLISHES A NEW PROCESS ON THE SYSTEM.              <<01245>>05854000
         LOADS PROPER PROGRAM.                                 <<01245>>05856000
                                                               <<01245>>05858000
                                                               <<01245>>05860000
         ERROR CODE: 100.                                      <<01245>>05862000
                                                               <<01245>>05864000
         ERROR SUBCODE:                                        <<01245>>05866000
            0     FROM CHEK                                    <<01245>>05868000
            5     NO PCB AVAILABLE FOR THE MOMENT              <<01245>>05870000
            20    SPECIFIED SUB QUEUE NOT EXISTANT             <<01245>>05872000
            24    NOT EXISTANT PORTION OF M Q REQUESTED        <<01245>>05874000
            25    PORTION OF M Q REQUESTED WITHOUT CAPABILITY  <<01245>>05876000
            26    ABSOLUTE PRIORITY REQUESTED WITHOUT CAPABILITY        05878000
            27    ILLEGAL CLASS SPECIFICATION                  <<01245>>05880000
            29    RANK SPECIFIED WITHOUT OPRATOR CAPABILITY    <<01245>>05882000
            30    LOAD ERROR                                   <<01245>>05884000
            31    FAILURE FROM PROCREATE(NO PCB AVALLABLE......)        05886000
                                                               <<01245>>05888000
      ;                                                        <<01245>>05890000
                                                               <<01245>>05892000
BEGIN                                                          <<01245>>05894000
      integer                                                  <<01427>>05896000
        ERROR,                      << for call to Errorexit >><<01427>>05898000
        INTRIN'ERRS,                << ptr to intrinsic errs >><<01427>>05900000
        ERR'LEVEL,                  << current error level >>  <<01427>>05902000
        COUNT,                      << # wrds of intrin area >><<01427>>05904000
        CC;                         << condition code return >><<01427>>05906000
                                                               <<01427>>05908000
      logical                                                  <<01427>>05910000
        EXIT'ERR        := 0,       << error to exit with >>   <<01427>>05912000
        FAKE'LOADERR,               << error Load once gave >> <<01427>>05914000
        OVMASK           = Q-4;     << option variable mask >> <<01427>>05916000
                                                               <<01427>>05918000
      integer array                                            <<01427>>05920000
        PCBX(*)          = Q+0,     << to address into PCBX >> <<01427>>05922000
        OPTIONNUMS(0:12);           << option numbers to use >><<01427>>05924000
                                                               <<01427>>05926000
      logical array                                            <<01427>>05928000
        OPTIONS(0:12);              << options to use >>       <<01427>>05930000
                                                               <<01427>>05932000
      equate                                                   <<01427>>05934000
        ERRCODE          = 100,     << Create intrinsic # >>   <<01427>>05936000
        PXERROR          = %43;     << ptr to intrinsic errs >><<01427>>05938000
                                                               <<01427>>05940000
      << errors returned from Createprocess >>                 <<01427>>05942000
      equate                                                   <<01427>>05944000
        OUT'OF'RESOS     =   4,                                <<01427>>05946000
        UNKNOWN'PROG     =   6,                                <<01427>>05948000
        BAD'ENTRYNAME    =   8,                                <<02303>>05950000
        DL'ROUNDED       = -12,                                <<01427>>05952000
        MAXDATA'DECRSED  = -13,                                <<01427>>05954000
        BAD'PRIORITY     =  17,                                <<01427>>05956000
        INVALID'STDIN    =  18,                                <<01427>>05958000
        INVALID'STDLIST  =  19;                                <<01427>>05960000
                                                               <<01427>>05962000
                                                               <<01427>>05964000
                                                               <<01427>>05966000
      << CREATE >>                                             <<01427>>05968000
      ERRORON;                                                 <<01245>>05970000
      STATUS.(5:1):=0;                 <<RESET CARRY BIT>>     <<01245>>05972000
      CHEK(ERRCODE&LSL(6)+11,10,DOUBLE(%57),DOUBLE(1),%577);   <<01245>>05974000
                                                               <<01245>>05976000
      << Map Create parameters into arrays for Createprocess >><<01427>>05978000
      X := 0;                                                  <<01245>>05980000
      if OVMASK&lsr(1) then                                    <<01245>>05982000
        begin  << priority specified >>                        <<01245>>05984000
          OPTIONNUMS(X) := 7;                                  <<01245>>05986000
          OPTIONS(X) := PRIORITYCLASS;                         <<01245>>05988000
          X := X + 1;                                          <<01245>>05990000
        end;                                                   <<01245>>05992000
                                                               <<01245>>05994000
      if OVMASK&lsr(2) then                                    <<01245>>05996000
        begin  << maxdata specified >>                         <<01245>>05998000
          OPTIONNUMS(X) := 6;                                  <<01245>>06000000
          OPTIONS(X) := MAXDATA;                               <<01245>>06002000
          X := X + 1;                                          <<01245>>06004000
        end;                                                   <<01245>>06006000
                                                               <<01245>>06008000
      if OVMASK&lsr(3) then                                    <<01245>>06010000
        begin  << dlsize specified >>                          <<01245>>06012000
          OPTIONNUMS(X) := 5;                                  <<01245>>06014000
          OPTIONS(X) := DLSIZE;                                <<01245>>06016000
          X := X + 1;                                          <<01245>>06018000
        end;                                                   <<01245>>06020000
                                                               <<01245>>06022000
      if OVMASK&lsr(4) then                                    <<01245>>06024000
        begin  << stacksize specified >>                       <<01245>>06026000
          OPTIONNUMS(X) := 4;                                  <<01245>>06028000
          OPTIONS(X) := STACKSIZE;                             <<01245>>06030000
          X := X + 1;                                          <<01245>>06032000
        end;                                                   <<01245>>06034000
                                                               <<01245>>06036000
      if OVMASK&lsr(5) then                                    <<01245>>06038000
        begin  << load flags specified >>                      <<01245>>06040000
          OPTIONNUMS(X) := 3;                                  <<01245>>06042000
          OPTIONS(X) := FLAGS;                                 <<01245>>06044000
          X := X + 1;                                          <<01245>>06046000
        end;                                                   <<01245>>06048000
                                                               <<01245>>06050000
      if OVMASK&lsr(6) then                                    <<01245>>06052000
        begin  << parm specified >>                            <<01245>>06054000
          OPTIONNUMS(X) := 2;                                  <<01245>>06056000
          OPTIONS(X) := PARAM;                                 <<01245>>06058000
          X := X + 1;                                          <<01245>>06060000
        end;                                                   <<01245>>06062000
                                                               <<01245>>06064000
      if OVMASK&lsr(8) then                                    <<01245>>06066000
        begin  << entry name specified >>                      <<01245>>06068000
          OPTIONNUMS(X) := 1;                                  <<01245>>06070000
          OPTIONS(X) := @ENTRYNAME;                            <<01245>>06072000
          X := X + 1;                                          <<01245>>06074000
        end;                                                   <<01245>>06076000
                                                               <<01245>>06078000
      OPTIONNUMS(X) := 0;   << end of option list >>           <<01245>>06080000
                                                               <<01245>>06082000
      CREATEPROCESS (ERROR, PIN, PROGNAME, OPTIONNUMS, OPTIONS);        06084000
                                                               <<01245>>06086000
      << Simulate old behavior of Create (i.e. ABORTs) by    >><<01427>>06088000
      << setting error parameter for call to Errorexit, if   >><<01427>>06090000
      << necessary.                                          >><<01427>>06092000
                                                               <<01427>>06094000
      if < then                                                <<01427>>06096000
        begin  << creation failed >>                           <<01427>>06098000
          CC := CCL;                                           <<01427>>06100000
          if ERROR = OUT'OF'RESOS or ERROR = INVALID'STDIN or  <<01427>>06102000
             ERROR = INVALID'STDLIST then                      <<01427>>06104000
            EXIT'ERR := 31                                     <<01427>>06106000
          else if ERROR=UNKNOWN'PROG or ERROR=BAD'ENTRYNAME    <<02303>>06108000
            then EXIT'ERR := 0       << don't abort>>          <<02303>>06110000
          else if ERROR = BAD'PRIORITY then                    <<01427>>06112000
            EXIT'ERR := CHECKPRIORITY (PRIORITYCLASS, 0)       <<01427>>06114000
          else                                                 <<01427>>06116000
            EXIT'ERR := 30;   << all others are Load errors >> <<01427>>06118000
        end                                                    <<01427>>06120000
      else if > then                                           <<01427>>06122000
        begin  << a Load warning occurred >>                   <<01427>>06124000
          if ERROR = DL'ROUNDED or ERROR = MAXDATA'DECRSED then<<01427>>06126000
            begin                                              <<01427>>06128000
              CC := CCG;                                       <<01427>>06130000
              EXIT'ERR := 0;                                   <<01427>>06132000
            end                                                <<01427>>06134000
          else                                                 <<01427>>06136000
            begin  << Create fails in these cases >>           <<01427>>06138000
              KILL (PIN);                                      <<01427>>06140000
              PIN := 0;                                        <<01427>>06142000
              CC := CCL;                                       <<01427>>06144000
              case -ERROR-9 of                                 <<01427>>06146000
                begin  << supply error Load used to return >>  <<01427>>06148000
                  FAKE'LOADERR := LERR23;   <<  9. bad stack >><<01427>>06150000
                  FAKE'LOADERR := LERR76;   << 10. bad dl >>   <<01427>>06152000
                  FAKE'LOADERR := LERR77;   << 11. bad mdata >><<01427>>06154000
                  ;                         << 12. dl round >> <<01427>>06156000
                  ;                         << 13. maxd down >><<01427>>06158000
                  FAKE'LOADERR := LERR25;   << 14. stk > md >> <<01427>>06160000
                end;                                           <<01427>>06162000
              ERRORPUT (FAKE'LOADERR, 2);                      <<01427>>06164000
              EXIT'ERR := 30;   << Load errors >>              <<01427>>06166000
            end;                                               <<01427>>06168000
        end                                                    <<01427>>06170000
      else   << no problem >>                                  <<01427>>06172000
        CC := CCE;                                             <<01427>>06174000
                                                               <<01245>>06176000
      if EXIT'ERR > 0 then                                     <<01427>>06178000
        begin  << must fix up intrinsic error area >>          <<01427>>06180000
          << get addressability into pxfixed area >>           <<01427>>06182000
          push (Q, DL);                                        <<01427>>06184000
          assemble (XCH,SUB; DUP,STAX);                        <<01427>>06186000
          tos := PCBX(X:=X-2) - PXERROR;                       <<01427>>06188000
          INTRIN'ERRS := tos - tos;   << ptr to intrin errs >> <<01427>>06190000
                                                               <<01427>>06192000
          << Move all lower level errors up so that it       >><<01427>>06194000
          << appears as though Createprocess was not called. >><<01427>>06196000
          << This allows ABORT to print all the errors that  >><<01427>>06198000
          << occurred (e.g. Create, Load, Filesystem).       >><<01427>>06200000
          ERR'LEVEL := PCBX(INTRIN'ERRS);                      <<01427>>06202000
          COUNT := 6 - ERR'LEVEL - 1;                          <<01427>>06204000
          move PCBX(INTRIN'ERRS+ERR'LEVEL+1) :=                <<01427>>06206000
                 PCBX(INTRIN'ERRS+ERR'LEVEL+2), (COUNT);       <<01427>>06208000
        end;                                                   <<01427>>06210000
                                                               <<01427>>06212000
      CONDITIONCODE := CC;                                     <<01245>>06214000
      TOS := ERRCODE&LSL(6)+11;                                <<01245>>06216000
      ERROREXIT (*, EXIT'ERR, 0);                              <<01245>>06218000
   END << CREATE >>;                                           <<01245>>06220000
                                                               <<01245>>06222000
$CONTROL SEGMENT=MAIN                                          <<01245>>06224000
end.                                                           <<01268>>06226000
