$CONTROL LIST,USLINIT,CODE,MAP                                 <<01604>>00010000
<<PROCSEG - MODULE 60    >>                                             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
$THIRTY                                                                 00028000
$CONTROL MAIN=PROCSEG                                          <<00652>>00030000
$CONTROL SEGMENT=PROCSEG                                       <<00652>>00032000
BEGIN                                                                   00034000
DEFINE   DISAPROC = ASSEMBLE( PSDB )#,                                  00036000
         ENAPROC = ASSEMBLE( PSEB )#,                                   00038000
         DISABLE = ASSEMBLE( SED 0 )#,                                  00040000
         ENABLE = ASSEMBLE( SED 1 )#;                          <<00652>>00042000
EQUATE   CPCB = 4,                                             <<00652>>00044000
         PCBB = 3,                                             <<00652>>00046000
        QI  = 5,                                               <<03048>>00048000
         PCBSIZE = 16,                                         <<00652>>00050000
         CCG  = 0,                                             <<00652>>00052000
         CCL  = 1,                                             <<00652>>00054000
         CCE  = 2;                                             <<00652>>00056000
                                                                        00058000
EQUATE RESABORTINFOWORDNUM=0,                                  <<01549>>00060000
       SLLIXWORDNUM=1,                                         <<01549>>00062000
       DBXDSINFOWORDNUM=2,                                     <<01549>>00064000
       STKINFOWORDNUM=3,                                       <<01549>>00066000
       WAKEMASKWORDNUM=4,                                      <<01549>>00068000
       FATHERSONINFOWORDNUM=5,                                 <<01549>>00070000
       BROTHERINFOWORDNUM=6,                                   <<01549>>00072000
       PIMPPINBKLINKWORDNUM=7,                                 <<01549>>00074000
       PIINFONIMPPINWORDNUM=%10,                               <<01549>>00076000
       PROCSTATEWORDNUM=%11,                                   <<01549>>00078000
       EVENTFLAGSWORDNUM=%12,                                  <<01549>>00080000
       MSGHARBORPTRWORDNUM=%13,                                <<01549>>00082000
       PBXWORDNUM=%14,                                         <<01549>>00084000
       QUEUEINGINFOWORDNUM=%15,                                <<01549>>00086000
       NQPTRWORDNUM=%16,                                       <<01549>>00088000
       PQPTRWORDNUM=%17;                                       <<01549>>00090000
                                                               <<01549>>00092000
DEFINE SARFLAG=(0:1)#,                                         <<01549>>00094000
       SCFLAG=(1:1)#,                                          <<01549>>00096000
       CRITFLAG=(2:1)#,                                        <<01549>>00098000
       HASSIRFLAG=(3:1)#,                                      <<01549>>00100000
       PIOVRFLAG=(4:1)#,                                       <<01549>>00102000
       INCPROTECTEXPFLAG=(6:1)#,                               <<01549>>00104000
       PREEMPTCAPFLAG=(7:1)#,                                  <<01549>>00106000
       MUSTPREMPTFLAG=(8:1)#,                                  <<01549>>00108000
       PCBLONGWAITFLAG=(9:1)#,                                 <<01549>>00110000
       PCBSHORTWAITFLAG=(10:1)#,                               <<01549>>00112000
       PCBTERMREADFLAG=(11:1)#,                                <<01549>>00114000
       USEDQUANTUMFLAG=(12:1)#,                                <<01549>>00116000
       HOLDIMPPRIFLAG=(13:1)#,                                 <<01549>>00118000
       PCBRITWAITFLAG=(15:1)#,                                 <<01549>>00120000
       ABSDBFLAG=(0:1)#,                                       <<01549>>00122000
       XDSDSTFIELD=(1:10)#,                                    <<01549>>00124000
       STOVRALLFLAG=(0:1)#,                                    <<01549>>00126000
       STKDSTFIELD=(1:10)#,                                    <<01549>>00128000
       INSYSTEMFLAG=(11:1)#,                                   <<01549>>00130000
       PIMPPINFIELD=(0:8)#,                                    <<01549>>00132000
       NIMPPINFIELD=(8:8)#,                                    <<01549>>00134000
       OAFIELD=(4:2)#,                                         <<01549>>00136000
       CRITEVENTFIELD=(12:4)#,                                 <<01549>>00138000
       NONCRITEVENTFIELD=(0:12)#,                              <<01549>>00140000
       MOURNWAITFLAG=(0:1)#,                                   <<01549>>00142000
       BLKDIOWAITFLAG=(4:1)#,                                  <<01549>>00144000
       IMPEDEDWAITFLAG=(12:1)#,                                <<01549>>00146000
       SIRWAITFLAG=(13:1)#,                                    <<01549>>00148000
       TIMERWAITFLAG=(14:1)#,                                  <<01549>>00150000
       FATHERSONWAKEFLAGS=(10:2)#,                             <<01549>>00152000
       MEMORYWAITFLAG=(15:1)#,                                 <<01549>>00154000
       MOURNWAKEFLAG=(0:1)#,                                   <<01549>>00156000
       IMPEDEDWAKEFLAG=(12:1)#,                                <<01549>>00158000
       SIRWAKEFLAG=(13:1)#,                                    <<01549>>00160000
       TIMERWAKEFLAG=(14:1)#,                                  <<01549>>00162000
       WWS=(9:1)#,                                             <<01549>>00164000
       MEMORYWAKEFLAG=(15:1)#,                                 <<01549>>00166000
       FATHERPINFIELD=(0:8)#,                                  <<01549>>00168000
       SONPINFIELD=(8:8)#,                                     <<01549>>00170000
       BROTHERPINFIELD=(0:8)#,                                 <<01549>>00172000
       BREAKPTLINKFIELD=(8:8)#,                                <<01549>>00174000
       PTYPEFIELD=(6:2)#,                                      <<01549>>00176000
       SYSTEMPROCFLAG=(6:1)#,                                  <<01549>>00178000
       ALIVEFLAG=(0:1)#,                                       <<01549>>00180000
       PIFLAGSFIELD=(10:6)#,                                   <<01549>>00182000
       HYBERNATEFLAG=(13:1)#,                                  <<01549>>00184000
       STOPFLAG=(12:1)#,                                       <<01549>>00186000
       CYFLAG=(14:1)#,                                         <<01549>>00188000
       BKFLAG=(15:1)#,                                         <<01549>>00190000
       PSIMFIELD=(0:3)#,                                       <<01549>>00192000
       DISPQFLAG=(0:1)#,                                       <<01549>>00194000
       LSCHEDFLAG=(1:1)#,                                      <<01549>>00196000
       CSCHEDFLAG=(2:1)#,                                      <<01549>>00198000
       DSCHEDFLAG=(3:1)#,                                      <<01549>>00200000
       ESCHEDFLAG=(4:1)#,                                      <<01549>>00202000
       INTERACTIVEFLAG=(5:1)#,                                 <<01549>>00204000
       PROCRESIDENTFLAG=(6:1)#,                                <<01549>>00206000
       HOLDSIRPRIFLAG=(5:1)#,                                  <<01549>>00208000
       SWAPQFLAG=(7:1)#,                                       <<01549>>00210000
       PRIFIELD=(8:8)#,                                        <<01549>>00212000
                                                           <<*DISP*00*>>00214000
                                                               <<01549>>00216000
          QTYPE     = (2:3)#,                              <<*DISP*00*>>00218000
          CQ        = (3:1)#,                              <<*DISP*00*>>00220000
          DQ        = (4:1)#,                              <<*DISP*00*>>00222000
          EQ        = (1:1)#,                              <<*DISP*00*>>00224000
          LQ        = (2:1)#,                              <<*DISP*00*>>00226000
          EQ'       = (5:1)#,   << NOT IN PCB >>           <<*DISP*00*>>00228000
          PTYPE     = (6:2)#,                              <<*DISP*00*>>00230000
          LTYPE     = (0:2)#,                              <<*DISP*00*>>00232000
          PIN'      = (8:8)#,                              <<*DISP*00*>>00234000
          JTYPE     = (0:2)#,                              <<*DISP*00*>>00236000
          JNUM      = (2:14)#;                             <<*DISP*00*>>00238000
                                                                        00240000
POINTER  PCB = 3;                                                       00242000
INTEGER POINTER  PCBI = 3;                                              00244000
                                                                        00246000
INTEGER                                                        <<04153>>00248000
  STATUS        = Q-1,                                                  00250000
  X             = X;                                                    00252000
                                                                        00254000
                                                                        00256000
                                                               <<03048>>00258000
<<STACKDB and SBANK for the current process are obtained         HM.XX  00260000
  from the two words preceding the dispatcher marker on          HM.XX  00262000
  the interrupt control stack.>>                               <<03048>>00264000
DEFINE CHECKDB =                                               <<03048>>00266000
   DISABLE;                                                    <<03048>>00268000
   PUSH(DB);                                                   <<03048>>00270000
   X := ABSOLUTE(QI)-5;                                        <<03048>>00272000
   TOS := ABSOLUTE(X);                                         <<03048>>00274000
   X := X+1;                                                   <<03048>>00276000
   TOS := ABSOLUTE(X);                                         <<03048>>00278000
   ENABLE;                                                     <<03048>>00280000
   ASSEMBLE(DCMP)#;                                            <<03048>>00282000
$INCLUDE RINSINCL                                              <<01604>>00284000
                                                                        00286000
INTEGER PROCEDURE BUILDSEGID(SEGTYPE,SEGNUMBER,PIN);           <<04523>>00288000
VALUE SEGTYPE,SEGNUMBER,PIN;                                   <<04523>>00290000
INTEGER SEGTYPE,SEGNUMBER,PIN;                                 <<04523>>00292000
OPTION EXTERNAL;                                               <<04523>>00294000
<<----------------------------------------------------->>      <<04523>>00296000
PROCEDURE FREEZESEG'(SEGIDENT,BLOCKEDLOCK);                    <<04523>>00298000
VALUE SEGIDENT,BLOCKEDLOCK;                                    <<04523>>00300000
INTEGER SEGIDENT;                                              <<04523>>00302000
LOGICAL BLOCKEDLOCK;                                           <<04523>>00304000
OPTION EXTERNAL;                                               <<04523>>00306000
<<----------------------------------------------------->>      <<04523>>00308000
INTEGER PROCEDURE CONVSEGIDTOSTINX(SEGIDENT);                  <<04523>>00310000
VALUE SEGIDENT;                                                <<04523>>00312000
LOGICAL SEGIDENT;                                              <<04523>>00314000
OPTION EXTERNAL;                                               <<04523>>00316000
<<----------------------------------------------------->>      <<04523>>00318000
PROCEDURE UNFREEZESEG'(SEGIDENT);                              <<04523>>00320000
VALUE SEGIDENT;                                                <<04523>>00322000
INTEGER SEGIDENT;                                              <<04523>>00324000
OPTION EXTERNAL;                                               <<04523>>00326000
$PAGE "  "                                                     <<01630>>00328000
<<------------------------------------------------------------------->> 00330000
                                                                        00332000
PROCEDURE HELP; OPTION EXTERNAL;                                        00334000
                                                                        00336000
<<------------------------------------------------------------------->> 00338000
                                                                        00340000
PROCEDURE SUDDENDEATH(N);VALUE N;INTEGER N;OPTION EXTERNAL;             00342000
                                                                        00344000
<<------------------------------------------------------------------->> 00346000
                                                                        00348000
INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                             00350000
VALUE WORD,BASE;DOUBLE WORD;INTEGER BASE;BYTE ARRAY STRING;             00352000
OPTION EXTERNAL;                                                        00354000
                                                                        00356000
<<------------------------------------------------------------------->> 00358000
                                                           <<*DISP*00*>>00360000
INTEGER PROCEDURE ASCII(WORD,BASE,STRING);                 <<*DISP*00*>>00362000
VALUE WORD,BASE; INTEGER WORD,BASE; BYTE ARRAY STRING;     <<*DISP*00*>>00364000
OPTION EXTERNAL;                                           <<*DISP*00*>>00366000
                                                           <<*DISP*00*>>00368000
<<------------------------------------------------------------------->> 00370000
                                                                        00372000
                                                                        00374000
<<------------------------------------------------------------------->> 00376000
                                                                        00378000
INTEGER PROCEDURE FAMILY(P,LP);VALUE P,LP;INTEGER P,LP;                 00380000
OPTION EXTERNAL;                                                        00382000
                                                                        00384000
<<------------------------------------------------------------------->> 00386000
                                                                        00388000
PROCEDURE PRINT(MESSAGE,LENGHT,CONTROL);                                00390000
VALUE LENGHT,CONTROL;ARRAY MESSAGE;INTEGER LENGHT,CONTROL;              00392000
OPTION EXTERNAL;                                                        00394000
                                                                        00396000
<<------------------------------------------------------------------->> 00398000
                                                                        00400000
PROCEDURE ERROREXIT(N,M,P);VALUE N,M,P;INTEGER N,M,P;                   00402000
OPTION EXTERNAL;                                                        00404000
                                                                        00406000
<<------------------------------------------------------------------->> 00408000
                                                                        00410000
PROCEDURE ERRORON;OPTION EXTERNAL;                                      00412000
                                                                        00414000
<<------------------------------------------------------------------->> 00416000
                                                                        00418000
LOGICAL PROCEDURE ERRORGET (LEVEL);                                     00420000
  VALUE LEVEL;                                                          00422000
  INTEGER LEVEL;                                                        00424000
  OPTION EXTERNAL;                                                      00426000
                                                                        00428000
<<--------------------------------------------------------->>           00430000
                                                                        00432000
DOUBLE PROCEDURE CHEK(INT,FL,PARM,CAPM,OVM);                            00434000
VALUE INT,FL,PARM,CAPM,OVM;                                             00436000
LOGICAL INT,FL,OVM; DOUBLE PARM,CAPM;                                   00438000
OPTION EXTERNAL,VARIABLE;                                               00440000
                                                                        00442000
<<------------------------------------------------------------------->> 00444000
                                                                        00446000
DOUBLE PROCEDURE CHEK'NOABORT (INTRINSIC, FLAGS, PARMS,                 00448000
                               CAPMASK, OPTVMASK);                      00450000
  VALUE INTRINSIC, FLAGS, PARMS, CAPMASK, OPTVMASK;                     00452000
  LOGICAL INTRINSIC, FLAGS, OPTVMASK;                                   00454000
  DOUBLE PARMS, CAPMASK;                                                00456000
  OPTION VARIABLE, PRIVILEGED, UNCALLABLE, EXTERNAL;                    00458000
                                                                        00460000
<<--------------------------------------------------------->>           00462000
                                                                        00464000
PROCEDURE ABORTPROCIO(PIN);VALUE PIN;INTEGER PIN;OPTION EXTERNAL;       00466000
<<------------------------------------------------------------------->> 00468000
                                                                        00470000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         00472000
VALUE PCBPT,N,WAITF;INTEGER PCBPT,N,WAITF;                              00474000
OPTION EXTERNAL;                                                        00476000
                                                                        00478000
<<------------------------------------------------------------------->> 00480000
                                                                        00482000
PROCEDURE RESETDB(A);VALUE A;LOGICAL A;OPTION EXTERNAL;                 00484000
                                                                        00486000
<<------------------------------------------------------------------->> 00488000
                                                                        00490000
LOGICAL PROCEDURE SETCRITICAL; OPTION EXTERNAL;                         00492000
                                                                        00494000
<<------------------------------------------------------------------->> 00496000
                                                                        00498000
PROCEDURE RESETCRITICAL(A);VALUE A;LOGICAL A;OPTION EXTERNAL;           00500000
                                                                        00502000
<<------------------------------------------------------------------->> 00504000
                                                                        00506000
LOGICAL PROCEDURE SETSYSDB; OPTION EXTERNAL;                            00508000
                                                                        00510000
<<------------------------------------------------------------------->> 00512000
                                                                        00514000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);VALUE DSTX;LOGICAL DSTX;             00516000
OPTION EXTERNAL;                                                        00518000
                                                                        00520000
<<------------------------------------------------------------------->> 00522000
                                                                        00524000
LOGICAL PROCEDURE GETSIR(A);VALUE A;LOGICAL A;OPTION EXTERNAL;          00526000
                                                                        00528000
<<------------------------------------------------------------------->> 00530000
                                                                        00532000
PROCEDURE RELSIR(A,B);VALUE A,B;LOGICAL A,B;OPTION EXTERNAL;            00534000
                                                                        00536000
<<------------------------------------------------------------------->> 00538000
                                                                        00540000
PROCEDURE WAIT(WF,JPCNTX);VALUE WF,JPCNTX;INTEGER WF,JPCNTX;            00542000
OPTION EXTERNAL;                                                        00544000
                                                                        00546000
<<------------------------------------------------------------------->> 00548000
                                                                        00550000
PROCEDURE BURRYPROC(PIN);VALUE PIN;INTEGER PIN;OPTION EXTERNAL;         00552000
                                                                        00554000
<<------------------------------------------------------------------->> 00556000
                                                                        00558000
DOUBLE PROCEDURE TIMER; OPTION EXTERNAL;                                00560000
                                                                        00562000
<<------------------------------------------------------------------->> 00564000
                                                                        00566000
PROCEDURE  SETJCW(A);                                                   00568000
VALUE A;  LOGICAL A;                                                    00570000
OPTION EXTERNAL;                                                        00572000
                                                                        00574000
<<------------------------------------------------------------------->> 00576000
                                                                        00578000
PROCEDURE  SET'PSIF(P,B);                                               00580000
VALUE P,B; INTEGER P,B;                                                 00582000
OPTION EXTERNAL;                                                        00584000
                                                                        00586000
<<------------------------------------------------------------------->> 00588000
                                                                        00590000
PROCEDURE  CLEAR'PSIF(P,B);                                             00592000
VALUE P,B; INTEGER P,B;                                                 00594000
OPTION EXTERNAL;                                                        00596000
                                                                        00598000
<<------------------------------------------------------------------->> 00600000
                                                                        00602000
PROCEDURE DELAY(T);                                                     00604000
VALUE T; DOUBLE T;                                                      00606000
OPTION EXTERNAL;                                                        00608000
                                                                        00610000
<<------------------------------------------------------------------->> 00612000
                                                           <<*DISP*00*>>00614000
INTEGER PROCEDURE ZSIZE(SIZE);                             <<*DISP*00*>>00616000
  VALUE SIZE; INTEGER SIZE;                                <<*DISP*00*>>00618000
  OPTION EXTERNAL;                                         <<*DISP*00*>>00620000
                                                           <<*DISP*00*>>00622000
<<------------------------------------------------------------------->> 00624000
                                                               <<DS.06>>00626000
LOGICAL PROCEDURE DSBREAK(TYPE,MAINPIN);                       <<DS.06>>00628000
  VALUE TYPE,MAINPIN; INTEGER TYPE,MAINPIN;                    <<DS.06>>00630000
  OPTION EXTERNAL;                                             <<DS.06>>00632000
                                                               <<DS.06>>00634000
<<------------------------------------------------------------------->> 00636000
                                                                        00638000
LOGICAL PROCEDURE CHEKTRLFREE;                             <<1.01>>     00640000
  OPTION EXTERNAL;                                         <<1.01>>     00642000
                                                                        00644000
<<--------------------------------------------------------------->>     00646000
                                                                        00648000
PROCEDURE REMRITENTRY'(PIN,FLAG);                              <<01399>>00650000
   VALUE PIN, FLAG; INTEGER PIN, FLAG;                         <<01399>>00652000
   OPTION EXTERNAL;                                            <<01399>>00654000
                                                               <<01399>>00656000
<<-------------------------------------------------------->>   <<00652>>00658000
LOGICAL PROCEDURE LOCKJIR;                                     <<00652>>00660000
  OPTION EXTERNAL;                                             <<00652>>00662000
<<-------------------------------------------------------->>   <<00652>>00664000
LOGICAL PROCEDURE TIMEOUT(DELAY,ALLOWSOFTINT);                 <<03048>>00666000
VALUE DELAY,ALLOWSOFTINT;                                      <<03048>>00668000
DOUBLE DELAY;                                                  <<03048>>00670000
LOGICAL ALLOWSOFTINT;                                          <<03048>>00672000
OPTION EXTERNAL;                                               <<03048>>00674000
<<-------------------------------------------------------->>   <<00652>>00676000
PROCEDURE UNLOCKJIR(B);                                        <<00652>>00678000
  VALUE B;LOGICAL B;OPTION EXTERNAL;                           <<00652>>00680000
<<-------------------------------------------------------->>   <<00652>>00682000
LOGICAL PROCEDURE DMOVE(X,D,N,L,F,M);                          <<00652>>00684000
  VALUE X,D,N,L,F,M;LOGICAL X,F;INTEGER D,N,L,M;               <<00652>>00686000
  OPTION EXTERNAL;                                             <<00652>>00688000
<<-------------------------------------------------------->>   <<00652>>00690000
LOGICAL PROCEDURE GETDATASEG(N,T);                             <<00652>>00692000
  VALUE   N,T;                                                 <<00652>>00694000
  INTEGER N,T;                                                 <<00652>>00696000
  OPTION EXTERNAL;                                             <<00652>>00698000
<<-------------------------------------------------------->>   <<00652>>00700000
PROCEDURE RELDATASEG(X);                                       <<00652>>00702000
  VALUE X; LOGICAL X; OPTION EXTERNAL;                         <<00652>>00704000
<<-------------------------------------------------------->>   <<00652>>00706000
LOGICAL PROCEDURE CHECKALIVE (PIN); VALUE PIN; INTEGER PIN;    <<01873>>00708000
OPTION EXTERNAL;                                               <<01873>>00710000
<<-------------------------------------------------------->>   <<01873>>00712000
PROCEDURE PROCFILE (PIN,FNAME);                                         00714000
 VALUE PIN;                                                             00716000
 INTEGER PIN;                                                           00718000
 BYTE ARRAY FNAME;                                                      00720000
 OPTION EXTERNAL;                                                       00722000
<<--------------------------------------------------------->>           00724000
                                                               <<00.EB>>00726000
INTEGER PROCEDURE GETORIGIN;                                            00728000
OPTION PRIVILEGED;                                                      00730000
                                                                        00732000
COMMENT: RETURNS THE ORIGIN OF THE LAST EFFECTIVE ACTIVATUON            00734000
         OF THE CALLER PROCESS.                                         00736000
                                                                        00738000
            1:    ACTIVATION FROM FATHER.                               00740000
            2:    ACTIVATION FROM ONE OF THE SONS.                      00742000
            0:    ACTIVATION FROM SOME OTHER SOURCE.                    00744000
                                                                        00746000
      ;                                                                 00748000
                                                                        00750000
GETORIGIN:=ABSOLUTE(ABSOLUTE(CPCB)+PIINFONIMPPINWORDNUM)                00752000
    .OAFIELD;                                                           00754000
$PAGE "PROCEDURE PROCINFO - DEFINITION"                                 00756000
PROCEDURE PROCINFO (ERROR1, ERROR2, PIN, OPTION1, ITEM1,                00758000
                                         OPTION2, ITEM2,                00760000
                                         OPTION3, ITEM3,                00762000
                                         OPTION4, ITEM4,                00764000
                                         OPTION5, ITEM5,                00766000
                                         OPTION6, ITEM6);               00768000
                                                                        00770000
  VALUE PIN, OPTION1, OPTION2, OPTION3, OPTION4, OPTION5, OPTION6 ;     00772000
  INTEGER ERROR1,ERROR2,PIN, OPTION1, OPTION2, OPTION3, OPTION4,        00774000
          OPTION5, OPTION6;                                             00776000
  BYTE ARRAY ITEM1, ITEM2, ITEM3, ITEM4, ITEM5, ITEM6;                  00778000
  OPTION PRIVILEGED,VARIABLE;                                           00780000
                                                                        00782000
  COMMENT: PROCINFO is an extendable procedure which will               00784000
  return process related information to the non-privileged              00786000
  or privileged user.                                                   00788000
                                                                        00790000
  Inputs:                                                               00792000
                                                                        00794000
  PIN:     An integer specifying the process identification             00796000
           number for which information is to be returned.              00798000
           A PIN of 0 will return information about the                 00800000
           calling process.                                             00802000
                                                                        00804000
  OPTIONn: An integer containing the item number (in any order)         00806000
           of the information option the caller wishes to               00808000
           have returned.  These are described below.                   00810000
                                                                        00812000
  Outputs:                                                              00814000
                                                                        00816000
  ERROR1:  An integer indicating the success or failure of the          00818000
           call.  Returned values are described below.                  00820000
                                                                        00822000
  ERROR2:  An integer which supplies additional information             00824000
           about the error specified in ERROR1.  Values are             00826000
           dependant on ERROR1.                                         00828000
                                                                        00830000
  Input/Output:                                                         00832000
                                                                        00834000
  ITEMn:   An array whose elements correspond to the option             00836000
           specified in the OPTIONn integer of the same index.          00838000
           Sometimes an ITEM element will be set by the                 00840000
           caller to point to where he wishes the data                  00842000
           returned, othertimes the information will be                 00844000
           in the ITEM element.  Which method that is used              00846000
           depends on the option.                                       00848000
                                                                        00850000
  Condition codes returned:                                             00852000
                                                                        00854000
  CCE:       Successful - ERROR1 and ERROR2 = 0                         00856000
  CCG:       Not returned by this intrinsic                             00858000
  CCL:       Unsuccessful - ERROR1 and ERROR2 set accordingly;          00860000
                                                                        00862000
$PAGE "PROCEDURE PROCINFO - DECLARATIONS"                               00864000
  BEGIN                                                                 00866000
                                                                        00868000
  <<Configuration values>>                                              00870000
  EQUATE                                                                00872000
    REQSTKSIZE         = 22,         <<PROCINFO needs 20 words...>>     00874000
    INTRINSIC'NUM      = 100,        <<is intrinsic # 100...>>          00876000
    NUM'PARMS          = 15,         <<has fifteen parameters>>         00878000
    NUM'PARMS'AND'MASK = 16,         <<plus one parm mask>>             00880000
    MAX'OPTION         = 12,         <<has options 0-12>>               00882000
    MAX'OPT'PARM       = 6;          <<and has up to 6 requests>>       00884000
  <<System related equates and defines>>                                00886000
  EQUATE                                                                00888000
    PROGEN'PIN    = 1,          <<pin of progen process>>               00890000
    B'TO'GRCAP    = 5,          <<Disp to gen resource cap>>            00892000
    ENTRY'SIZE    = 1,          <<Entry size word in systabs>>          00894000
    FLM'CPCB      = 4,          <<Fixed low mem CPCB loc>>              00896000
    FLM'PCB'BASE  = 3,          <<Fixed low mem PCBBASE loc>>           00898000
    MIN'PIN       = 1,          <<Minimum legal pin number>>            00900000
    NUM'CONFIG    = 0,          <<Num of entries in systabs>>           00902000
    MAX'PINS      = 256;        <<Maximum number of pins>>              00904000
                                                                        00906000
  DEFINE                                                                00908000
    ABS           = ABSOLUTE#,                                          00910000
    CC            = STATUS.(6:2)#,                                      00912000
    PM'FLAG       = STATUS.(0:1)#,                                      00914000
    PDISABLE      = ASSEMBLE(PSDB)#,                                    00916000
    PENABLE       = ASSEMBLE(PSEB)#,                                    00918000
    BRO'FIELD     = BROTHERPINFIELD#,                                   00920000
    BRO'WORD      = BROTHERINFOWORDNUM#,                                00922000
    DAD'FIELD     = FATHERPINFIELD#,                                    00924000
    DAD'WORD      = FATHERSONINFOWORDNUM#,                              00926000
    LIVE'FIELD    = ALIVEFLAG#,                                         00928000
    SON'FIELD     = SONPINFIELD#,                                       00930000
    SON'WORD      = FATHERSONINFOWORDNUM#,                              00932000
    QUEUE'WORD    = QUEUEINGINFOWORD#,                                  00934000
    STATE'WORD    = PROCSTATEWORDNUM#,                                  00936000
    SUSPN'FIELD   = (13:2)#,                                            00938000
    WAKE'WORD     = WAKEMASKWORDNUM#,                                   00940000
    DAD'SON'FIELD = (10:2)#,                                            00942000
    ACTIVITY'FIELD= (15:1)#,                                            00944000
    ORIGIN        = (7:2)#,                                             00946000
    PI'WORD       = %10#,                                               00948000
    OA'BITS       = (4:2)#,                                             00950000
    Q'INFO        = (4:3)#,                                             00952000
    Q'FIELD       = (1:3)#;                                             00954000
                                                                        00956000
                                                                        00958000
  <<Error equates>>                                                     00960000
  EQUATE                                                                00962000
    ILLG'CAP      = 1,          <<Invalid capability>>                  00964000
    OMIT'PARM     = 2,          <<Required parameter omited>>           00966000
    ILLG'ADDR     = 3,          <<Param addr out of range>>             00968000
    ILLG'OPTION   = 5,          <<Illegal option number>>               00970000
    ILLG'PIN      = 6,          <<Pin beyond config limits>>            00972000
    UNASSN'PIN    = 7,          <<Pin is unassigned>>                   00974000
    UNPAIRED'PARMS= 8;          <<Option parms are unpaired>>           00976000
                                                                        00978000
                                                                        00980000
  <<Misc procedure global declarations>>                                00982000
  EQUATE                                                                00984000
    INTRINSIC'ID  = [10/INTRINSIC'NUM, 6/NUM'PARMS'AND'MASK];           00986000
                                                                        00988000
  DOUBLE                                                                00990000
    ADDRESS'BNDS;     <<Min & max legal address for bnds ck>>           00992000
                                                                        00994000
  LOGICAL                                                               00996000
    CLEARENCE,        <<mask giving cap of caller: format>>             00998000
    PARM'VALUE = Q-4, <<Paramater mask>>                                01000000
    MORE'OPTIONS;     <<flag indicating additional options>>            01002000
                                                                        01004000
  INTEGER                                                               01006000
    CALLERS'PIN,      <<process id number of caller>>                   01008000
    OPTION'INDEX,     <<index of option of current interest>>           01010000
    OPTION'COUNT,     <<number of options requested>>                   01012000
    TARGET'PIN,       <<process id number of target proc>>              01014000
    DL'VAL,           <<DL reg value>>                                  01016000
    LOWER'BOUND = ADDRESS'BNDS,                                         01018000
    UPPER'BOUND = ADDRESS'BNDS + 1,                                     01020000
    PX'PTR;           <<ptr to PXFIXED area>>                           01022000
  BYTE POINTER                                                          01024000
    USERS'BYTE'ADDR;  <<user supplied byte address>>                    01026000
                                                                        01028000
                                                                        01030000
  <<Declarations for subroutine SCAN'TREE>>                             01032000
  EQUATE                                                                01034000
    SEARCH'ALL    = 0,          <<Tells sub to search all>>             01036000
    SEARCH'SONS   = 1;          <<Tells sub to search sons>>            01038000
                                                                        01040000
  LOGICAL                                                               01042000
    BROTHER'PIN,      <<pin of scan'pins brother>>                      01044000
    DAD'PIN,          <<pin of scan'pins father>>                       01046000
    MORE'TREE,        <<flag indicating all tree not scaned>>           01048000
    SCAN'PIN,         <<pin under current exaimination>>                01050000
    SCAN'MORE,        <<flag indicating all tree not scanned>>          01052000
    SON'PIN,          <<pin of scan'pins son>>                          01054000
    ANSTR'PIN,        <<pin of scan'pin ancestor>>                      01056000
    UNCLE'NOT'FOUND,  <<set when searching for cousins>>                01058000
    UNCLE'PIN;        <<pin of scan'pins uncle>>                        01060000
                                                                        01062000
                                                                        01064000
  <<Declarations for subroutine GET'CAPABILITIES>>                      01066000
  LOGICAL ARRAY STACK'DBREL(*) = DB + 0;                                01068000
                                                                        01070000
                                                                        01072000
  <<Declarations for subroutine SECURE'CHECK>>                          01074000
  EQUATE                                                                01076000
    ABORT         = TRUE,       <<exits if test failure>>               01078000
    AND'TEST      = TRUE,       <<test is to be AND>>                   01080000
    NO'ABORT      = FALSE,      <<return with test result>>             01082000
    OR'TEST       = FALSE,      <<test is to be OR>>                    01084000
    PH            = %000001,    <<caller has PH>>                       01086000
    SELF          = %000002,    <<caller req info about self>>          01088000
    SON           = %000004,    <<caller req info about son>>           01090000
    DECN          = %000010,    <<caller req info about decn>>          01092000
    PM            = %000100,    <<caller has PM>>                       01094000
    ANSTR         = %000020,    <<caller req info about ansc>>          01096000
    DAD           = %000040;    <<caller req info about dad>>           01098000
                                                                        01100000
  LOGICAL                                                               01102000
    IN'COMMON,        <<matching reqested cap and given cap>>           01104000
    SECURE'RESULT;    <<result of security test>>                       01106000
                                                                        01108000
    DOUBLE CHEK'PARM    := %2 D;                                        01110000
                                                                        01112000
  <<Declarations for external CHECK'NOABORT>>                           01114000
  EQUATE                                                                01116000
    CHEK'INFO     = [1/0, 7/0, 2/0, 1/0, 5/NUM'PARMS],                  01118000
    CHEK'OMTPAR   = 3,                                                  01120000
    OPT'MASK      = [1/0,3/0,3/7,3/7,3/7,3/7];                          01122000
  <<Declarations for OPTION subroutines>>                               01124000
                                                                        01126000
  INTEGER                                                               01128000
      CNT,            <<count for loop>>                                01130000
      NUM'SONS,       <<son count>>                                     01132000
      NUM'DECN,       <<descendant count>>                              01134000
      NUM'GENR,       <<generation count>>                              01136000
      GENR'CNT;       <<final generation tally>>                        01138000
                                                                        01140000
  INTEGER ARRAY PIN'ARRAY(0:MAX'PINS) ;  <<RETURN ARRAY INFO>>          01142000
  BYTE ARRAY BPIN'ARRAY(*) = PIN'ARRAY;                                 01144000
                                                                        01146000
  INTEGER POINTER PIN'ARRY'ADR;              <<ARRAY POINTER>>          01148000
                                                                        01150000
  LOGICAL ARRAY PIN'INFO(0:0);                << RETURN INFO>>          01152000
  BYTE ARRAY BPIN'INFO(*)=PIN'INFO;                                     01154000
                                                                        01156000
  LOGICAL                                                               01158000
                                                                        01160000
    CHEK'ERROR;       <<error return>>                                  01162000
$PAGE "PROCEDURE PROCINFO - UTILITY SUBROUTINES"                        01164000
  SUBROUTINE ERR'RETURN(ERROR'CODE,SUB'ERROR);                          01166000
    VALUE ERROR'CODE,SUB'ERROR;                                         01168000
    INTEGER ERROR'CODE,SUB'ERROR;                                       01170000
                                                                        01172000
    COMMENT: This subroutine will exit PROCINFO with an error           01174000
    condition;                                                          01176000
                                                                        01178000
    BEGIN                                                               01180000
    CC := CCL;                                                          01182000
    ERROR1 := ERROR'CODE;                                               01184000
    ERROR2 := SUB'ERROR;                                                01186000
    ERROREXIT (INTRINSIC'ID, 0, 0);      <<we never come back>>         01188000
    END;  <<Subroutine ERR'RETURN>>                                     01190000
                                                                        01192000
  INTEGER SUBROUTINE WORD'ADDRESS (BYTE'ADDRESS);                       01194000
    VALUE BYTE'ADDRESS;                                                 01196000
    LOGICAL BYTE'ADDRESS;                                               01198000
                                                                        01200000
    COMMENT: This subroutine will convert a DB rel byte                 01202000
    address to a word address.                                          01204000
                                                                        01206000
    BYTE'ADDRESS: The address to be converted;                          01208000
                                                                        01210000
    BEGIN                                                               01212000
                                                                        01214000
    TOS := WORD'ADDRESS := BYTE'ADDRESS & LSR(1);                       01216000
    PUSH(Z);                                                            01218000
    IF TOS <<word'address>> > <<z>> TOS THEN                            01220000
        WORD'ADDRESS.(0:1) := 1;                                        01222000
    END;  <<subroutine WORD'ADDRESS>>                                   01224000
                                                                        01226000
  LOGICAL SUBROUTINE PCB (PIN'NUM,DISPLACEMENT);                        01228000
    VALUE PIN'NUM, DISPLACEMENT;                                        01230000
    LOGICAL PIN'NUM, DISPLACEMENT;                                      01232000
                                                                        01234000
    COMMENT: This subrotine will return the specified cell              01236000
    from the PCB table.  The cell is specified as follows:              01238000
                                                                        01240000
    PIN'NUM: The process whose PCB entry is to be examined.             01242000
    DISPLACEMENT: The displacement within the entry;                    01244000
                                                                        01246000
    BEGIN                                                               01248000
    IF PIN'NUM = 0 THEN                                                 01250000
        PCB := ABS(ABS(FLM'PCB'BASE)+DISPLACEMENT)                      01252000
      ELSE                                                              01254000
        PCB := ABS(ABS(FLM'PCB'BASE)+DISPLACEMENT+                      01256000
               PIN'NUM * ABS(ABS(FLM'PCB'BASE)+ENTRY'SIZE));            01258000
    END;  <<subroutine PCB>>                                            01260000
                                                                        01262000
  SUBROUTINE CHECK'GOOD'PIN (PIN'NUM);                                  01264000
    VALUE PIN'NUM;                                                      01266000
    INTEGER PIN'NUM;                                                    01268000
                                                                        01270000
    COMMENT: This subroutine will make sure pin'num is a                01272000
    happy, healthy, bouncing process [I know this is corny:             01274000
    the hour is late]. If not, PROCINFO is exited with                  01276000
    the error field set accordingly:                                    01278000
                                                                        01280000
    PIN'NUM: The process who' integrity is examined                     01282000
                                                                        01284000
    WARNING: THIS SUBRTOUINE MUST BE CALLED WITH ONE                    01286000
             PDISABLE IN EFFECT: A PENABLE IS EXECUTED                  01288000
             IF AN ERROR IS DETECTED;                                   01290000
                                                                        01292000
    BEGIN                                                               01294000
                                                                        01296000
    IF NOT(MIN'PIN<=PIN'NUM<=INTEGER(PCB(0,NUM'CONFIG))) THEN           01298000
        BEGIN  <<Pin out of range of PCB table>>                        01300000
        PENABLE;                                                        01302000
        ERR'RETURN (ILLG'PIN,-1); <<illegal pin>>                       01304000
        END                                                             01306000
      ELSE                                                              01308000
        IF PCB(PIN'NUM,STATE'WORD).LIVE'FIELD = 0 THEN                  01310000
            BEGIN  <<Pin's live bit is not on>>                         01312000
            PENABLE;  <<Pin unassigned>>                                01314000
            ERR'RETURN (UNASSN'PIN,-1);                                 01316000
            END;                                                        01318000
    END; <<Subroutine CHECK'GOOD'PIN>>                                  01320000
                                                                        01322000
  SUBROUTINE SCAN'TREE(SCAN'TYPE,ROOT'PIN,MORE'TREE);                   01324000
    VALUE SCAN'TYPE,ROOT'PIN;                                           01326000
    LOGICAL SCAN'TYPE,ROOT'PIN,MORE'TREE;                               01328000
                                                                        01330000
    COMMENT: This subroutine will traverse a process tree and           01332000
    return the pin of either the Root'pins' closest decendant           01334000
    or the Root'pins father or uncle.                                   01336000
    SCAN'TYPE: Logical which defines type of scan                       01338000
      0 => Scan will be a search of the whole sub tree                  01340000
    ROOT'PIN: The pin of the root of the subtree to be scanned          01342000
    MORE'TREE: A logical which indicates whether or                     01344000
               the entire subtree has been scanned;                     01346000
                                                                        01348000
                                                                        01350000
                                                                        01352000
    BEGIN                                                               01354000
                                                                        01356000
    <<Confirm integrity of the root pin and tree structure>>            01358000
    CHECK'GOOD'PIN(ROOT'PIN);                                           01360000
                                                                        01362000
    <<Determine how much tree is to be traversed>>                      01364000
    IF SCAN'TYPE = 0 THEN                                               01366000
                                                                        01368000
        COMMENT: All of tree is to be traversed.  Start at              01370000
        root, scan down all sons.  Scan the last son's                  01372000
        brothers [and their respective subtrees], then the              01374000
        second-to-last sons brothers, etc. until we have                01376000
        worked our way back to the root;                                01378000
                                                                        01380000
        BEGIN                                                           01382000
                                                                        01384000
          SON'PIN := PCB(SCAN'PIN,SON'WORD).SON'FIELD;                  01386000
          IF SON'PIN <> 0 THEN      <<scan'pin have a son?>>            01388000
              SCAN'PIN := SON'PIN   <<yes, scan him next>>              01390000
            ELSE                                                        01392000
                                                                        01394000
              <<no son - at bottom of this family line>>                01396000
              BEGIN                                                     01398000
              BROTHER'PIN := PCB(SCAN'PIN,BRO'WORD).BRO'FIELD;          01400000
              IF BROTHER'PIN <> 0 THEN    <<have a bro?   >>            01402000
                  SCAN'PIN := BROTHER'PIN <<yes, scan next>>            01404000
                ELSE                                                    01406000
                                                                        01408000
                  <<no brothers - now check father's bros>>             01410000
                  BEGIN                                                 01412000
                  UNCLE'NOT'FOUND := TRUE;                              01414000
                                                                        01416000
                  <<Cycle up fathers until find uncle>>                 01418000
                  WHILE UNCLE'NOT'FOUND AND MORE'TREE DO                01420000
                    BEGIN                                               01422000
                    DAD'PIN :=                                          01424000
                      PCB(SCAN'PIN,DAD'WORD).DAD'FIELD;                 01426000
                    IF DAD'PIN = LOGICAL(TARGET'PIN) OR                 01428000
                       SCAN'PIN = PROGEN'PIN THEN                       01430000
                        MORE'TREE := FALSE  <<oops, ran out>>           01432000
                      ELSE                  <<of kin!      >>           01434000
                        BEGIN                                           01436000
                        UNCLE'PIN :=                                    01438000
                          PCB(DAD'PIN,BRO'WORD).BRO'FIELD;              01440000
                        IF UNCLE'PIN = 0 THEN                           01442000
                            <<no uncle here - try next genr>>           01444000
                            SCAN'PIN := DAD'PIN                         01446000
                          ELSE                                          01448000
                            <<found a new family line>>                 01450000
                            BEGIN  <<check it out    >>                 01452000
                            SCAN'PIN := UNCLE'PIN;                      01454000
                            UNCLE'NOT'FOUND := FALSE;                   01456000
                            END;  <<found new line>>                    01458000
                        END;  <<more tree remaining>>                   01460000
                    END;  <<while uncle not found>>                     01462000
                  END;  <<no brother>>                                  01464000
              END;  <<no son>>                                          01466000
                                                                        01468000
          COMMENT: Either we ran out of tree or found the               01470000
          pin.  Report which one;                                       01472000
                                                                        01474000
        END   <<Search'type = 0>>                                       01476000
      ELSE                                                              01478000
                                                                        01480000
        COMMENT: Just the son's of the root'pin are to be               01482000
        examined.  Start with son and look for brothers;                01484000
                                                                        01486000
          SCAN'PIN := PCB(SCAN'PIN,BRO'WORD).BRO'FIELD;                 01488000
    END;  <<subroutine SCAN'TREE>>                                      01490000
                                                                        01492000
LOGICAL SUBROUTINE SCAN'FOR'DECN(TREE'ROOT,PIN'OF'DECN);                01494000
  VALUE TREE'ROOT,PIN'OF'DECN;                                          01496000
  LOGICAL TREE'ROOT,PIN'OF'DECN;                                        01498000
                                                                        01500000
  COMMENT: This procedure scans the TREE'ROOT's subtree                 01502000
           for the process specified by PIN'OF'DECN. If                 01504000
           the process is found, bit 12 of the subroutine               01506000
           return is set. If not, it is not set;                        01508000
  BEGIN                                                                 01510000
  SON'PIN := PCB(TREE'ROOT,SON'WORD).SON'FIELD;                         01512000
  IF SON'PIN <> 0 THEN BEGIN                                            01514000
    PDISABLE;                                                           01516000
    SCAN'MORE:=TRUE;                                                    01518000
    SCAN'PIN:=TREE'ROOT;                                                01520000
    WHILE SCAN'PIN <> PIN'OF'DECN AND SCAN'MORE DO                      01522000
      SCAN'TREE(SEARCH'ALL,TREE'ROOT,SCAN'MORE);                        01524000
    IF SCAN'MORE THEN SCAN'FOR'DECN:=DECN                               01526000
                 ELSE SCAN'FOR'DECN:=0;                                 01528000
    PENABLE;                                                            01530000
  END;                                                                  01532000
  END;  <<subroutine SCAN'FOR'DECN>>                                    01534000
                                                                        01536000
                                                                        01538000
  LOGICAL SUBROUTINE SCAN'FOR'SON(TREE'ROOT,PIN'OF'SON);                01540000
    VALUE TREE'ROOT,PIN'OF'SON;                                         01542000
    LOGICAL TREE'ROOT,PIN'OF'SON;                                       01544000
                                                                        01546000
    COMMENT: This subroutine scans the TREE'ROOT's sons                 01548000
             for the process specified by PIN'OF'SON. If                01550000
             the process is found , bit 13 of the sub-                  01552000
             routine return is set. If not, it is not set;              01554000
                                                                        01556000
    BEGIN                                                               01558000
                                                                        01560000
    PDISABLE;                                                           01562000
    SCAN'MORE:=TRUE;                                                    01564000
    SCAN'PIN:=PCB(TREE'ROOT,SON'WORD).SON'FIELD;                        01566000
    WHILE SCAN'PIN <> 0 AND SCAN'PIN <> PIN'OF'SON DO                   01568000
      SCAN'TREE(SEARCH'SONS,TREE'ROOT,SCAN'MORE);                       01570000
    IF SCAN'PIN <> 0 THEN SCAN'FOR'SON:=SON                             01572000
                     ELSE SCAN'FOR'SON:=0;                              01574000
    PENABLE;                                                            01576000
                                                                        01578000
    END;  <<subroutine SCAN'FOR'SON>>                                   01580000
                                                                        01582000
  SUBROUTINE GET'CAPABILITIES;                                          01584000
                                                                        01586000
    COMMENT: Determines capabilities and fills in CLEARENCE;            01588000
                                                                        01590000
    BEGIN                                                               01592000
    CLEARENCE := 0;                                                     01594000
                                                                        01596000
    <<Fetch cap word from PCBX and fill in PM,PH>>                      01598000
    PUSH (DL);                                                          01600000
    DL'VAL := TOS;                     <<X=disp of DB to DL>>           01602000
    PX'PTR := STACK'DBREL(DL'VAL-2);                                    01604000
    X := DL'VAL - PX'PTR + B'TO'GRCAP;    <<X=disp of DB to GRC>>       01606000
    CLEARENCE := CLEARENCE + (PH LAND STACK'DBREL(X));                  01608000
    IF PM'FLAG = 1 THEN CLEARENCE := PM;                                01610000
    COMMENT: Now check for family relationships between                 01612000
    caller and the process whose information is requested;              01614000
                                                                        01616000
    IF TARGET'PIN = CALLERS'PIN THEN                                    01618000
        <<Caller is asking about himself>>                              01620000
        CLEARENCE := CLEARENCE + SELF                                   01622000
      ELSE                                                              01624000
                                                                        01626000
        BEGIN                                                           01628000
        COMMENT: Caller is not asking about himself.  Fill              01630000
        in family relationships with scan'tree;                         01632000
                                                                        01634000
        ANSTR'PIN := PCB(CALLERS'PIN,DAD'WORD).DAD'FIELD;               01636000
        WHILE ANSTR'PIN <> 0 AND ANSTR'PIN <> LOGICAL(TARGET'PIN) DO    01638000
          BEGIN                                                         01640000
          ANSTR'PIN := PCB(ANSTR'PIN,DAD'WORD).DAD'FIELD;               01642000
          END;                                                          01644000
        IF ANSTR'PIN = LOGICAL(TARGET'PIN) THEN                         01646000
          CLEARENCE := CLEARENCE + ANSTR                                01648000
                                                                        01650000
        ELSE                                                            01652000
          BEGIN                                                         01654000
          CLEARENCE :=  CLEARENCE +                                     01656000
            SCAN'FOR'DECN (CALLERS'PIN,PIN) +                           01658000
            SCAN'FOR'SON (CALLERS'PIN,PIN);                             01660000
          END;                                                          01662000
        END;                                                            01664000
    END;  <<subroutine GET'CAPABILITIES>>                               01666000
                                                                        01668000
                                                                        01670000
                                                                        01672000
                                                                        01674000
                                                                        01676000
  SUBROUTINE CHECK'BOUNDS (ADDRESS);                                    01678000
    VALUE ADDRESS;                                                      01680000
    INTEGER ADDRESS;                                                    01682000
                                                                        01684000
    COMMENT: This subroutine will ensure that ADDRESS falls             01686000
    between ADDRESS'BNDS.  If not, PROCINFO is terminated with          01688000
    the appropriate error code.                                         01690000
                                                                        01692000
    ADDRESS: The word address to be checked;                            01694000
                                                                        01696000
    BEGIN                                                               01698000
                                                                        01700000
    IF NOT (LOWER'BOUND <= ADDRESS <= UPPER'BOUND) THEN                 01702000
        ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                             01704000
                                                                        01706000
    END;  <<subroutine CHECK'BOUNDS>>                                   01708000
                                                                        01710000
  LOGICAL SUBROUTINE SECURE'CHECK (CHECK'TYPE,CHECK'LIST,               01712000
                                  EXIT'TYPE);                           01714000
    VALUE CHECK'TYPE,EXIT'TYPE,CHECK'LIST;                              01716000
    LOGICAL CHECK'TYPE,EXIT'TYPE,CHECK'LIST;                            01718000
                                                                        01720000
    COMMENT: This subroutine will perform a security check              01722000
    and will either return false or error return if the                 01724000
    security requirements are not met or will return true if            01726000
    they are.  Which conditions are checked and what action is          01728000
    taken is specified through the parameters as follows:               01730000
                                                                        01732000
    CHECK'TYPE: The type of check made to pass or fail                  01734000
      TRUE => check will be an AND check [ie. all conditions            01736000
        must be met to pass].                                           01738000
      FALSE => check will be an OR check [just one condition            01740000
        must be met to pass].                                           01742000
    EXIT'TYPE: The action taken when the test fails                     01744000
      TRUE => check failure will result in an exit from                 01746000
        PROCINFO with ERROR set based on capability is                  01748000
        missing.                                                        01750000
      FALSE => check failure will result in a subroutine return         01752000
        of false.                                                       01754000
    CHECK'LIST: a bit mask indicating which options are                 01756000
      checked.                                                          01758000
      (9:1)  => caller has PM capability                                01760000
      (10:1) => caller is requesting info about its father              01762000
      (11:1) => caller is requesting info about an ancestor             01764000
      (12:1) => caller is requesting info about an indirect             01766000
                decendant.                                              01768000
      (13:1) => caller is requesting info about a direct                01770000
                decendant.                                              01772000
      (14:1) => caller is requesting info about himself                 01774000
      (15:1) => caller has PH capability;                               01776000
                                                                        01778000
    BEGIN                                                               01780000
    IN'COMMON := CHECK'LIST LAND CLEARENCE;                             01782000
    IF CHECK'TYPE = OR'TEST THEN                                        01784000
        SECURE'RESULT := IN'COMMON <> 0 LOR CHECK'LIST = 0              01786000
      ELSE                                                              01788000
        SECURE'RESULT := IN'COMMON = CHECK'LIST;                        01790000
    IF NOT SECURE'RESULT AND EXIT'TYPE=ABORT THEN                       01792000
        ERR'RETURN (ILLG'CAP,OPTION'INDEX);                             01794000
    SECURE'CHECK := SECURE'RESULT;                                      01796000
    END;    <<SECURE'CHECK>>                                            01798000
$PAGE "PROCEDURE PROCINFO - OPTION SUBROUTINES"                         01800000
                                                                        01802000
SUBROUTINE  EXIT'PROCINFO;                                              01804000
  COMMENT: This subroutine will cause a normal termination              01806000
  of PROCINFO. No special capabilities are required.;                   01808000
                                                                        01810000
BEGIN                                                                   01812000
CC:=CCE;                                                                01814000
ERROR1:=0;                                                              01816000
ERROR2:=0;                                                              01818000
ERROREXIT(INTRINSIC'ID, 0,0);                                           01820000
END; <<subroutine PROCINFO>>                                            01822000
                                                                        01824000
                                                                        01826000
                                                                        01828000
                                                                        01830000
SUBROUTINE GET'CURRENT'PIN(RETURN'INFO);            <<Option 1>>        01832000
  BYTE ARRAY RETURN'INFO;                                               01834000
  COMMENT: This subroutine will return the PIN of the calling           01836000
  process.  No special capabilities are required;                       01838000
                                                                        01840000
  BEGIN                                                                 01842000
  PIN'INFO := CALLERS'PIN.(8:8);                                        01844000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    01846000
  END;  <<subroutine GET'CURRENT'PIN>>                                  01848000
                                                                        01850000
                                                                        01852000
                                                                        01854000
SUBROUTINE GET'FATHERS'PIN(RETURN'INFO);                                01856000
  BYTE ARRAY RETURN'INFO;                                               01858000
  BEGIN                                                                 01860000
                                                                        01862000
  <<check capabilities for this option>>                                01864000
                                                                        01866000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                01868000
         SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                      01870000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             01872000
                                                                        01874000
  PIN'INFO:=PCB(TARGET'PIN,DAD'WORD).DAD'FIELD;                         01876000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    01878000
  END;  <<subroutine GET'FATHERS'PIN>>                                  01880000
                                                                        01882000
SUBROUTINE GET'NUM'OF'SONS(RETURN'INFO);                                01884000
  BYTE ARRAY RETURN'INFO;                                               01886000
  BEGIN                                                                 01888000
  PDISABLE;                                                             01890000
                                                                        01892000
  <<check capabilities for this option>>                                01894000
                                                                        01896000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                01898000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   01900000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             01902000
                                                                        01904000
  SCAN'PIN:=PCB(TARGET'PIN,SON'WORD).SON'FIELD;                         01906000
  NUM'SONS:=0;                                                          01908000
  SCAN'MORE:=TRUE;                                                      01910000
  WHILE SCAN'PIN <> 0 DO                                                01912000
    BEGIN                                                               01914000
    SCAN'TREE(SEARCH'SONS,TARGET'PIN,SCAN'MORE);                        01916000
    NUM'SONS:=NUM'SONS + 1;                                             01918000
    END;                                                                01920000
  PIN'INFO:=NUM'SONS;                                                   01922000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    01924000
  PENABLE;                                                              01926000
  END;  <<subroutine GET'NUM'OF'SONS>>                                  01928000
                                                                        01930000
SUBROUTINE GET'NUM'OF'DECN(RETURN'INFO);                                01932000
  BYTE ARRAY RETURN'INFO;                                               01934000
  BEGIN                                                                 01936000
  PDISABLE;                                                             01938000
                                                                        01940000
  <<check capabilities for this option>>                                01942000
                                                                        01944000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                01946000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   01948000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             01950000
                                                                        01952000
  SCAN'PIN:=PCB(TARGET'PIN,SON'WORD).SON'FIELD;                         01954000
  NUM'DECN:=0;                                                          01956000
  IF SCAN'PIN <> 0 THEN                                                 01958000
    BEGIN                                                               01960000
    SCAN'MORE:=TRUE;                                                    01962000
    WHILE SCAN'MORE DO                                                  01964000
      BEGIN                                                             01966000
      NUM'DECN:=NUM'DECN+1;                                             01968000
      SCAN'TREE(SEARCH'ALL,TARGET'PIN,SCAN'MORE);                       01970000
      END;                                                              01972000
    END;                                                                01974000
  PIN'INFO:=NUM'DECN;                                                   01976000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    01978000
  PENABLE;                                                              01980000
  END;  <<subroutine GET'NUM'OF'DECN>>                                  01982000
                                                                        01984000
SUBROUTINE GET'NUM'OF'GENR(RETURN'INFO);                                01986000
  BYTE ARRAY RETURN'INFO;                                               01988000
  BEGIN                                                                 01990000
  PDISABLE;                                                             01992000
                                                                        01994000
  <<check capabilities for this option>>                                01996000
                                                                        01998000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                02000000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   02002000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             02004000
  SCAN'MORE := TRUE;                                                    02006000
  NUM'GENR:=1;                                                          02008000
  GENR'CNT:=1;                                                          02010000
  SCAN'PIN:=PCB(TARGET'PIN,SON'WORD).SON'FIELD;                         02012000
  IF SCAN'PIN <> 0 THEN                                                 02014000
    BEGIN                                                               02016000
    NUM'GENR:=NUM'GENR+1;                                               02018000
    WHILE SCAN'PIN<>0 AND SCAN'MORE DO                                  02020000
      BEGIN                                                             02022000
      SCAN'TREE(SEARCH'ALL,TARGET'PIN,SCAN'MORE);                       02024000
      IF SON'PIN <> 0 THEN NUM'GENR:=NUM'GENR+1                         02026000
        ELSE BEGIN                                                      02028000
        IF GENR'CNT < NUM'GENR THEN GENR'CNT:=NUM'GENR;                 02030000
        NUM'GENR:=2;                                                    02032000
        END;                                                            02034000
      END;                                                              02036000
    END;                                                                02038000
  PIN'INFO:=GENR'CNT;                                                   02040000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    02042000
  PENABLE;                                                              02044000
                                                                        02046000
  END;  <<subroutine GET'NUM'OF'GENR>>                                  02048000
                                                                        02050000
SUBROUTINE GET'SON'PINS(RETURN'INFO);                                   02052000
  BYTE ARRAY RETURN'INFO;                                               02054000
  BEGIN                                                                 02056000
  PDISABLE;                                                             02058000
                                                                        02060000
  <<check capabilities for this option>>                                02062000
                                                                        02064000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                02066000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   02068000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             02070000
                                                                        02072000
  SCAN'MORE:=TRUE;                                                      02074000
  CNT := 0;                                                             02076000
  MOVE BPIN'ARRAY := RETURN'INFO,(2);                                   02078000
  @PIN'ARRY'ADR := @PIN'ARRAY;                                          02080000
  SCAN'PIN:=PCB(TARGET'PIN,SON'WORD).SON'FIELD;                         02082000
  WHILE SCAN'PIN <> 0 AND CNT < PIN'ARRY'ADR(0) - 1 DO                  02084000
    BEGIN                                                               02086000
    CNT := CNT + 1;                                                     02088000
    PIN'ARRY'ADR(CNT):=SCAN'PIN;                                        02090000
    SCAN'TREE(SEARCH'SONS,TARGET'PIN,SCAN'MORE);                        02092000
    END;                                                                02094000
  IF SCAN'PIN = 0 THEN                                                  02096000
    BEGIN                                                               02098000
    WHILE CNT < PIN'ARRY'ADR(0) - 1 DO                                  02100000
      BEGIN                                                             02102000
      CNT := CNT + 1;                                                   02104000
      PIN'ARRY'ADR(CNT) := 0;                                           02106000
      END;                                                              02108000
    END                                                                 02110000
    ELSE ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                            02112000
    MOVE RETURN'INFO(2) := BPIN'ARRAY(2),(BPIN'ARRAY(1));               02114000
  PENABLE;                                                              02116000
  END;  <<subroutine GET'SON'PINS>>                                     02118000
SUBROUTINE GET'DECN'PINS(RETURN'INFO);                                  02120000
  BYTE ARRAY RETURN'INFO;                                               02122000
  BEGIN                                                                 02124000
  PDISABLE;                                                             02126000
                                                                        02128000
  <<check capabilities for this option>>                                02130000
                                                                        02132000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                02134000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   02136000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             02138000
                                                                        02140000
  SCAN'MORE:=TRUE;                                                      02142000
  CNT := 0;                                                             02144000
  MOVE BPIN'ARRAY := RETURN'INFO,(2);                                   02146000
  @PIN'ARRY'ADR := @PIN'ARRAY;                                          02148000
  SCAN'PIN:=PCB(TARGET'PIN,SON'WORD).SON'FIELD;                         02150000
  IF SCAN'PIN <> 0 THEN                                                 02152000
    WHILE SCAN'MORE AND CNT < PIN'ARRY'ADR(0) - 1 DO                    02154000
      BEGIN                                                             02156000
      CNT := CNT + 1;                                                   02158000
      PIN'ARRY'ADR(CNT):=SCAN'PIN;                                      02160000
      SCAN'TREE(SEARCH'ALL,SCAN'PIN,SCAN'MORE);                         02162000
      END                                                               02164000
  ELSE      << NO DESCENDANTS >>                                        02166000
    SCAN'MORE := FALSE;                                                 02168000
  IF NOT(SCAN'MORE) THEN                                                02170000
    BEGIN                                                               02172000
    WHILE CNT < PIN'ARRY'ADR(0) - 1 DO                                  02174000
      BEGIN                                                             02176000
      CNT := CNT + 1;                                                   02178000
      PIN'ARRY'ADR(CNT) := 0;                                           02180000
      END;                                                              02182000
    END                                                                 02184000
    ELSE ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                            02186000
  MOVE RETURN'INFO(2) := BPIN'ARRAY(2),(BPIN'ARRAY(1));                 02188000
  PENABLE;                                                              02190000
  END;  <<subroutine GET'DECN'PINS>>                                    02192000
SUBROUTINE GET'PRIORITY(RETURN'INFO);                                   02194000
  BYTE ARRAY RETURN'INFO;                                               02196000
  BEGIN                                                                 02198000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+SON,NO'ABORT))                    02200000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             02202000
  PIN'INFO :=PCB(TARGET'PIN,QUEUE'WORD).PRIFIELD;                       02204000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    02206000
  END;  <<subroutine GET'PRIORITY>>                                     02208000
                                                                        02210000
SUBROUTINE GET'PROCSTATE(RETURN'INFO);                                  02212000
  BYTE ARRAY RETURN'INFO;                                               02214000
  BEGIN                                                                 02216000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+SON,NO'ABORT))                    02218000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             02220000
  PIN'INFO .SUSPN'FIELD :=                                              02222000
    PCB(TARGET'PIN,WAKE'WORD).DAD'SON'FIELD;                            02224000
  PIN'INFO.ACTIVITY'FIELD :=                                            02226000
    IF PIN'INFO.SUSPN'FIELD = 0 THEN 1 ELSE 0;                          02228000
  PIN'INFO.ORIGIN:=                                                     02230000
    PCB(TARGET'PIN,PI'WORD).OA'BITS;                                    02232000
  PIN'INFO.Q'INFO := PCB(TARGET'PIN,QUEUE'WORD).Q'FIELD;                02234000
                                                                        02236000
  <<see if the process is really in the E queue>>                       02238000
                                                                        02240000
  IF PIN'INFO.Q'INFO = 0 THEN PIN'INFO.Q'INFO := 1;                     02242000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    02244000
                                                                        02246000
  END;  <<subroutine GET'PROCSTATE>>                                    02248000
                                                                        02250000
SUBROUTINE GET'PROG'NAME(RETURN'INFO);              <<Option 10>>       02252000
  BYTE ARRAY RETURN'INFO;                                               02254000
                                                                        02256000
  COMMENT:  This subroutine will returen the program name of            02258000
  specified process.  The specified process must be the                 02260000
  caller, direct son of caller or caller must be in priv                02262000
  mode;                                                                 02264000
                                                                        02266000
  BEGIN                                                                 02268000
                                                                        02270000
  <<Make sure he supplied enough room>>                                 02272000
  CHECK'BOUNDS(WORD'ADDRESS(RETURN'INFO));                              02274000
  CHECK'BOUNDS(WORD'ADDRESS(RETURN'INFO) + 13);                         02276000
  @USERS'BYTE'ADDR := @RETURN'INFO;                                     02278000
                                                                        02280000
  <<Check capabilities>>                                                02282000
  IF NOT (SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR               02284000
    SECURE'CHECK(AND'TEST,ANSTR,NO'ABORT))                              02286000
      THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                           02288000
                                                                        02290000
  <<ok so far, see if everyone is still alive>>                         02292000
  PDISABLE;                                                             02294000
  CHECK'GOOD'PIN (TARGET'PIN);                                          02296000
  PENABLE;                                                              02298000
                                                                        02300000
  <<ok fetch progname from load table>>                                 02302000
  PROCFILE (TARGET'PIN,USERS'BYTE'ADDR);                                02304000
  IF < THEN ERR'RETURN (UNASSN'PIN,-1);                                 02306000
                                                                        02308000
  END;  <<subroutine GET'PROG'NAME>>                                    02310000
                                                                        02312000
                                                                        02314000
SUBROUTINE SELECT'OPTION(OPTION'NUM,ITEM);                              02316000
                                                                        02318000
  COMMENT: This subroutine selects tand calls the appropriate           02320000
           subroutine for the option spec ified;                        02322000
                                                                        02324000
  VALUE OPTION'NUM;                                                     02326000
  INTEGER OPTION'NUM;                                                   02328000
  BYTE ARRAY ITEM;  <<byte array of returned info>>                     02330000
                                                                        02332000
  BEGIN                                                                 02334000
  <<check to make sure the option is within range>>                     02336000
                                                                        02338000
  IF NOT (0 <= OPTION'NUM <=MAX'OPTION) THEN                            02340000
     ERR'RETURN(ILLG'OPTION,OPTION'INDEX);                              02342000
                                                                        02344000
  <<ok- process the option>>                                            02346000
                                                                        02348000
  CASE OPTION'NUM OF                                                    02350000
    BEGIN                                                               02352000
    ;                                                                   02354000
    GET'CURRENT'PIN(ITEM);                                              02356000
    GET'FATHERS'PIN(ITEM);                                              02358000
    GET'NUM'OF'SONS(ITEM);                                              02360000
    GET'NUM'OF'DECN(ITEM);                                              02362000
    GET'NUM'OF'GENR(ITEM);                                              02364000
    GET'SON'PINS(ITEM);                                                 02366000
    GET'DECN'PINS(ITEM);                                                02368000
    GET'PRIORITY(ITEM);                                                 02370000
    GET'PROCSTATE(ITEM);                                                02372000
    GET'PROG'NAME(ITEM);                                                02374000
        ;    ;     <<for native mode info>>                             02376000
    END;                                                                02378000
  END;  <<subroutine SELECT'OPTION>>                                    02380000
                                                                        02382000
$PAGE "<< PROCINFO:  OUTER BLOCK >>"                                    02384000
                                                                        02386000
  ASSEMBLE(ADDS REQSTKSIZE);    <<Get required stack size>>             02388000
  ASSEMBLE(SUBS REQSTKSIZE);                                            02390000
                                                                        02392000
  COMMENT:  Perform initial verification with CHEK.                     02394000
            CHEK will abort the process if split stack                  02396000
            mode or if the first parameter is omitted;                  02398000
                                                                        02400000
  ADDRESS'BNDS:=CHEK'NOABORT(INTRINSIC'ID,CHEK'INFO,                    02402000
                             CHEK'PARM,,OPT'MASK);                      02404000
                                                                        02406000
  IF < THEN                                                             02408000
    BEGIN                                                               02410000
    CHEK'ERROR := ERRORGET(1).(8:8);                                    02412000
    IF CHEK'ERROR = CHEK'OMTPAR THEN                                    02414000
        ERR'RETURN(OMIT'PARM,-1)                                        02416000
      ELSE                                                              02418000
        ERR'RETURN(ILLG'ADDR,-1);                                       02420000
    END;                                                                02422000
                                                                        02424000
  <<Determine the caller's PIN and target pin>>                         02426000
                                                                        02428000
  CALLERS'PIN:=                                                         02430000
    (ABS(FLM'CPCB)-ABS(FLM'PCB'BASE))/PCB(0,ENTRY'SIZE);                02432000
  IF PIN = 0 THEN TARGET'PIN := CALLERS'PIN                             02434000
    ELSE BEGIN                                                          02436000
       PDISABLE;                                                        02438000
       CHECK'GOOD'PIN(PIN);                                             02440000
       TARGET'PIN:=PIN;                                                 02442000
       PENABLE;                                                         02444000
    END;                                                                02446000
                                                                        02448000
                                                                        02450000
  COMMENT: Determine the caller's capabilities, fill in                 02452000
           clearance.  If the target pin does not exist,                02454000
           or if it is invalid, PROCINFO will be termin-                02456000
           ated while attempting to determine capabilities;             02458000
                                                                        02460000
  GET'CAPABILITIES;                                                     02462000
                                                                        02464000
  COMMENT: Now cycle through the options;                               02466000
                                                                        02468000
  OPTION'INDEX:=1;                                                      02470000
                                                                        02472000
  WHILE OPTION'INDEX <= MAX'OPT'PARM  DO                                02474000
    BEGIN                                                               02476000
    IF PARM'VALUE & LSR((MAX'OPT'PARM*2)-(OPTION'INDEX*2-1)) THEN       02478000
      BEGIN                                                             02480000
      IF PARM'VALUE & LSR((MAX'OPT'PARM*2)-(OPTION'INDEX*2)) THEN       02482000
        BEGIN  <<found a matched option pair>>                          02484000
        CASE OPTION'INDEX OF                                            02486000
          BEGIN                                                         02488000
          ;                                                             02490000
          SELECT'OPTION(OPTION1,ITEM1);                                 02492000
          SELECT'OPTION(OPTION2,ITEM2);                                 02494000
          SELECT'OPTION(OPTION3,ITEM3);                                 02496000
          SELECT'OPTION(OPTION4,ITEM4);                                 02498000
          SELECT'OPTION(OPTION5,ITEM5);                                 02500000
          SELECT'OPTION(OPTION6,ITEM6);                                 02502000
          END                                                           02504000
        END                                                             02506000
       ELSE ERR'RETURN(UNPAIRED'PARMS,OPTION'INDEX);                    02508000
     END                                                                02510000
     ELSE BEGIN                                                         02512000
       IF PARM'VALUE & LSR ((MAX'OPT'PARM*2)-(OPTION'INDEX*2))          02514000
          THEN ERR'RETURN(UNPAIRED'PARMS,OPTION'INDEX);                 02516000
     END;                                                               02518000
     OPTION'INDEX:=OPTION'INDEX+1;                                      02520000
  END;                                                                  02522000
  EXIT'PROCINFO;                                                        02524000
END;  <<PROCINFO>>                                                      02526000
                                                                        02528000
DOUBLE PROCEDURE GETPROCINFO(PIN);                                      02530000
VALUE PIN; INTEGER PIN;                                                 02532000
OPTION PRIVILEGED;                                                      02534000
                                                                        02536000
COMMENT: RETURNS DOUBLE WORD CONTAINING INFORMATION ABOUT               02538000
         REQUIRED PROCESS.                                              02540000
               WORD 1:                 0/PRIORITY.                      02542000
               WORD 2:                 SQ/ORIGIN ACT/REACTCNT/SST/A.    02544000
                                                                        02546000
         ;                                                              02548000
                                                                        02550000
BEGIN                                                                   02552000
      INTEGER CC,S0=S-0;                                                02554000
INTEGER RETWORD0:=0,                                           <<01549>>02556000
        RETWORD1:=0,                                           <<01549>>02558000
        PCBPT;                                                 <<01549>>02560000
                                                                        02562000
      IF PIN=0 THEN                    <<FATHER>>                       02564000
      BEGIN                                                             02566000
         PIN:=ABSOLUTE(ABSOLUTE(CPCB)+5).(0:8); GOTO GP1;               02568000
      END ELSE                         <<SON>>                          02570000
      BEGIN                                                             02572000
         IF PCB(PIN*PCBSIZE+5).(0:8)<>                                  02574000
            (ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE                     02576000
            OR NOT CHECKALIVE (PIN)                            <<01873>>02578000
        OR NOT (1<=PIN<=PCBI(0)) THEN                          <<01549>>02580000
         BEGIN CC:=1; GOTO GP2; END;                                    02582000
      END;                                                              02584000
                                                                        02586000
GP1:                                                                    02588000
      DISABLE;                                                          02590000
      IF PCBI(PIN*PCBSIZE+9) > 0 THEN  <<NOT ALIVE>>                    02592000
      BEGIN CC:=0;GOTO GP2; END;       <<CCG>>                          02594000
                                                                        02596000
      CC:=2;                           <<CCE>>                          02598000
                                                                        02600000
     PCBPT:=PIN*PCBSIZE;                                       <<01549>>02602000
      RETWORD0:=PCB(PCBPT+QUEUEINGINFOWORDNUM).PRIFIELD;       <<01630>>02604000
      RETWORD1.(13:2):=PCB(PCBPT                               <<01630>>02606000
                          +WAKEMASKWORDNUM).FATHERSONWAKEFLAGS;<<01630>>02608000
      RETWORD1.(15:1):=IF RETWORD1.(13:2) = 0 THEN 1 ELSE 0;   <<01630>>02610000
      RETWORD1.(7:2):=PCB(PCBPT+PIINFONIMPPINWORDNUM).OAFIELD; <<01630>>02612000
      RETWORD1.(4:3):=PCB(PCBPT+QUEUEINGINFOWORDNUM).(1:3);    <<01630>>02614000
      << SEE IF PROCESS IS REALLY SCHEDULED IN ES QUEUE >>     <<01630>>02616000
      IF RETWORD1.(4:3) = 0 THEN RETWORD1.(4:3) := 1;          <<01630>>02618000
      TOS:=RETWORD0;                                           <<01630>>02620000
      TOS:=RETWORD1;                                           <<01630>>02622000
                                                                        02624000
      GETPROCINFO:=TOS;                                                 02626000
GP2:  STATUS.(6:2):=CC;                <<CC RETURNED>>                  02628000
                                                                        02630000
END;  << G E T P R O C I N F O  >>                                      02632000
                                                                        02634000
PROCEDURE SUSPEND(SUSP,RIN'RELEASE);                           <<01604>>02636000
VALUE SUSP,RIN'RELEASE;                                        <<01604>>02638000
LOGICAL SUSP;                                                           02640000
INTEGER RIN'RELEASE;                                           <<01604>>02642000
OPTION PRIVILEGED,VARIABLE;                                             02644000
                                                                        02646000
COMMENT: PUTS A PROCESS IN A WAIT STATE CORRESPONDING TO SUSP CONDITION 02648000
         IF RIN IS SPECIFIED RELEASES THE RIN AT THE SAME TIME.         02650000
                                                                        02652000
         ERROR CODE:    103.                                            02654000
         ERROR SUBCODE                                                  02656000
                        0              CALLABILITY                      02658000
                                                                        02660000
         DB CAN BE NOT POINTING TO STACK.                               02662000
      ;                                                                 02664000
                                                                        02666000
                                                                        02668000
BEGIN                                                                   02670000
       EQUATE JITX =6,FIR=43;                                  <<01714>>02672000
                                                               <<01714>>02674000
      EQUATE ERRCODE=103;                                               02676000
      EQUATE RINSIR=38;                                                 02678000
                                                                        02680000
      DEFINE NOSON = SUSP=2 AND PCB(PIN*PCBSIZE+5).(8:8)=0#;   <<00229>>02682000
        <<WAIT ON SON BUT NO SON EXISTS>>                      <<00229>>02684000
                                                                        02686000
      INTEGER DB,I,CX,NEXT;                                             02688000
      INTEGER ARRAY JOBINF(*)=DB+0;                                     02690000
                                                               <<01604>>02692000
      LOGICAL  C1:= 0, C2:=1;                                           02694000
      DOUBLE CAPAB=C1;                                                  02696000
      INTEGER ARRAY PCBX(*)=Q+0;                                        02698000
      INTEGER RINPTR;                                          <<01604>>02700000
      LOGICAL VAR=Q-4;                                                  02702000
      INTEGER STATUS=Q-1,PIN,T;                                         02704000
      INTEGER S;                                                        02706000
                                                                        02708000
                                                                        02710000
      SUBROUTINE PROCEXIT( COND );                             <<01604>>02712000
        VALUE COND;                                            <<01604>>02714000
        INTEGER COND;                                          <<01604>>02716000
        COMMENT : SUBROUTINE EXECUTES STANDARD EXIT            <<01604>>02718000
                  PROCEDURES;                                  <<01604>>02720000
                                                               <<01604>>02722000
        BEGIN                                                  <<01604>>02724000
          RELSIR(RINSIR,S);                                    <<01604>>02726000
          STATUS.(6:2) := COND;                                <<01604>>02728000
          EXCHANGEDB(DB);                                      <<01604>>02730000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>02732000
        END; << PROCEXIT >>                                    <<01604>>02734000
                                                               <<01604>>02736000
                                                                        02738000
                                                                        02740000
      ERRORON;                                                          02742000
      CHEK(ERRCODE&LSL(6)+3,%100002,,CAPAB,1);                          02744000
      SUSP:=SUSP.(14:2);                                                02746000
                                                               <<01604>>02748000
      IF SUSP=0 THEN                                           <<01604>>02750000
      BEGIN                                                    <<01604>>02752000
        STATUS.(6:2) := CCL;                                   <<01604>>02754000
        ERROREXIT((ERRCODE*64)+3,0,0);                         <<01604>>02756000
        RETURN;                                                <<01604>>02758000
      END;                                                     <<01604>>02760000
      PIN := (ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE;          <<01604>>02762000
                                                               <<01604>>02764000
      IF NOT(VAR) THEN                  <<NO RIN TO RELEASE>>  <<01604>>02766000
      BEGIN                                                    <<01604>>02768000
        DISAPROC;                                              <<01604>>02770000
        IF NOSON THEN                                          <<01604>>02772000
        BEGIN                                                  <<01604>>02774000
          ENAPROC;                                             <<01604>>02776000
          STATUS.(6:2) := CCL;                                 <<01604>>02778000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>02780000
          RETURN;                                              <<01604>>02782000
        END;                                                   <<01604>>02784000
        WAIT(SUSP,0);                                          <<01604>>02786000
        STATUS.(6:2) := CCE;                                   <<01604>>02788000
        ERROREXIT((ERRCODE*64)+3,0,0);                         <<01604>>02790000
        RETURN;                                                <<01604>>02792000
      END                                                      <<01604>>02794000
      ELSE                                                     <<01604>>02796000
      BEGIN                                                    <<01604>>02798000
        IF RIN'RELEASE = 0 THEN                                <<01604>>02800000
        BEGIN                                                  <<01604>>02802000
          STATUS.(6:2) := CCL;                                 <<01604>>02804000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>02806000
          RETURN;                                              <<01604>>02808000
        END;                                                   <<01604>>02810000
                                                               <<01604>>02812000
        PUSH(Q,DL);                                            <<01604>>02814000
        ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                       <<01604>>02816000
        TOS := -PCBX(X);                                       <<01604>>02818000
        ASSEMBLE(ADD);                                         <<01604>>02820000
        TOS := TOS+JITX;                                       <<01604>>02822000
        ASSEMBLE(STAX);                                        <<01604>>02824000
        TOS := PCBX(X).(6:10);                                 <<01604>>02826000
        ASSEMBLE(ZERO,XCH);                                    <<01604>>02828000
        DB := EXCHANGEDB(*);                                   <<01604>>02830000
        S := GETSIR(RINSIR);                                   <<01604>>02832000
        RINPTR := JOBINF(FIR)*RIN'LENGTH;                      <<01604>>02834000
        IF RINPTR = 0 THEN                                     <<01604>>02836000
        BEGIN                                                  <<01604>>02838000
          PROCEXIT( CCL );                                     <<01604>>02840000
          RETURN;                                              <<01604>>02842000
        END;                                                   <<01604>>02844000
                                                               <<01604>>02846000
         EXCHANGEDB(RIN'DST);                                  <<01714>>02848000
        CX := 0;                                               <<01604>>02850000
        WHILE (CX:=CX+1) < RIN'RELEASE DO                      <<01604>>02852000
        BEGIN                                                  <<01604>>02854000
          RINPTR := RIN'E'INDEX*RIN'LENGTH;                    <<01604>>02856000
          IF RINPTR = 0 THEN                                   <<01604>>02858000
          BEGIN                                                <<01604>>02860000
            PROCEXIT( CCL );                                   <<01604>>02862000
            RETURN;                                            <<01604>>02864000
          END;                                                 <<01604>>02866000
        END;                                                   <<01604>>02868000
                                                               <<01604>>02870000
      DISAPROC;                                                <<01714>>02872000
        IF NOSON THEN                                          <<01604>>02874000
        BEGIN                                                  <<01604>>02876000
          ENAPROC;                                             <<01604>>02878000
          PROCEXIT( CCL );                                     <<01604>>02880000
          RETURN;                                              <<01604>>02882000
        END;                                                   <<01604>>02884000
        IF RIN'E'HOLDER = PIN THEN                             <<01604>>02886000
        BEGIN            << THE PROCESS HAS THE RIN >>         <<01604>>02888000
          NEXT := RIN'E'HEADQ;                                 <<01604>>02890000
          RIN'E'HOLDER := RIN'E'HEADQ;                         <<01604>>02892000
          IF NEXT <> 0 THEN                                    <<01604>>02894000
             RIN'E'HEADQ := PCB(NEXT*PCBSIZE+8).(8:8);         <<01604>>02896000
        END                                                    <<01604>>02898000
        ELSE                                                   <<01604>>02900000
        BEGIN                                                  <<01604>>02902000
          ENAPROC;                                             <<01604>>02904000
          PROCEXIT( CCL );                                     <<01604>>02906000
          RETURN;                                              <<01604>>02908000
       END;                                                    <<01604>>02910000
        RELSIR(RINSIR,S);                                      <<01604>>02912000
        IF NEXT <> 0 THEN AWAKE(NEXT*PCBSIZE,%1000,SUSP)       <<01604>>02914000
                     ELSE WAIT(SUSP,0);                        <<01604>>02916000
      END;                                                     <<01604>>02918000
                                                               <<01604>>02920000
      EXCHANGEDB(DB);                                          <<01604>>02922000
      STATUS.(6:2) := CCE;                                     <<01604>>02924000
      ERROREXIT((ERRCODE*64)+3,0,0);                           <<01604>>02926000
                                                               <<01604>>02928000
                                                                        02930000
END;  << S U S P E N D   >>                                             02932000
                                                                        02934000
LOGICAL PROCEDURE FATHER;                                               02936000
OPTION PRIVILEGED;                                                      02938000
COMMENT: RETURNS THE PROCESS IDENTIFICATION NUMBER(PIN)                 02940000
         OF THE CALLERS FATHER.                                         02942000
         RETUNRS  CCL IF FATHER IS A SYSTEM PROCESS.                    02944000
                  CCG IF FATHER IS A MAIN PROCESS.                      02946000
                  CCE OTHERWISE.                                        02948000
         CALLABLE.                                                      02950000
      ;                                                                 02952000
                                                                        02954000
BEGIN                                                                   02956000
      LOGICAL V=Q-4;                                                    02958000
      INTEGER CC;                      <<CONDITION CODE>>               02960000
                                                                        02962000
                                                                        02964000
      FATHER:=ABSOLUTE(ABSOLUTE(CPCB)+5)&LSR(8);                        02966000
      TOS:=PCB(V*PCBSIZE+9); <<PROCESS TYPE>>                           02968000
      CC:=CCE;                         <<INITIALIZE CC>>                02970000
      ASSEMBLE(DUP);                                                    02972000
      IF TOS.(7:1) THEN CC:=CCG;                                        02974000
      IF TOS.(6:1) THEN CC:=CCL;                                        02976000
      STATUS.(6:2):=CC;                <<SET CONDITION CODE>>           02978000
                                                                        02980000
END;  << F A T H E R  >>                                                02982000
                                                                        02984000
PROCEDURE ACTIVATE(PIN,SUSP);                                           02986000
VALUE PIN,SUSP;                                                         02988000
INTEGER PIN;                                                            02990000
LOGICAL SUSP;                                                           02992000
OPTION VARIABLE,PRIVILEGED;                                             02994000
                                                                        02996000
COMMENT: CALLABLE INTRINSIC THAT ACTIVATES A PROCESS.                   02998000
         (EITHER SON OR FATHER).                                        03000000
         IF PIN=0 THE PROCESS ACTIVATED WILL BE THE FATHER              03002000
         SUSP#0 MEANS A SIMULTANEOUS SUSPENSION OF THE CALLER.          03004000
                                                                        03006000
         ERROR CODE:    104.                                            03008000
         ERROR SUBCODE                                                  03010000
         20 ACTIVATION OF A SYSTEM PROCESS FORBIDDEN.                   03012000
         21 ACTIVATION OF A MAIN PROCESS FORBIDDEN.                     03014000
                                                                        03016000
      CONDITION CODES                                                   03018000
         CCE:  OK                                                       03020000
         CCG:  PROCESS ALREADY ACTIVE                                   03022000
         CCL:  ACTIVATION NOT EXPECTED                                  03024000
                                                                        03026000
         DB CAN BE NOT POINTING TO THE SATCK.                           03028000
         ;                                                              03030000
                                                                        03032000
                                                                        03034000
BEGIN                                                                   03036000
      EQUATE F=%100002;                                                 03038000
      EQUATE ERRCODE=104;                                               03040000
      LOGICAL C1:=0,C2:=1;                                              03042000
      DOUBLE CM=C1;                                                     03044000
      LOGICAL VAR=Q-4;                                                  03046000
      LOGICAL DB;                                                       03048000
      INTEGER MASK;                                                     03050000
      INTEGER I;                                                        03052000
      INTEGER POINTER PCBTABLE = 3;                                     03054000
      INTEGER PINPT,CALPT,CALPIN,CC;                                    03056000
                                                                        03058000
                                                                        03060000
      ERRORON;                                                          03062000
      I:=ERRCODE&LSL(6)+3;                                              03064000
      CHEK(I,F,,CM,1);                 <<CHECK FOR CALL VALIDITY>>      03066000
      IF  NOT VAR  THEN  SUSP := 0;                                     03068000
      SUSP := SUSP.(14:2);                                     <<00.01>>03070000
      TOS:=I;                                                           03072000
      CALPT:=ABSOLUTE(CPCB)-ABSOLUTE(PCBB);                             03074000
      CALPIN:=CALPT/PCBSIZE;                                            03076000
      IF PIN=0 THEN                    <<ACTIVATE FATHER>>              03078000
      BEGIN                                                             03080000
         PIN:=PCBTABLE(CALPT+5)&LSR(8);<<FATHER POINTER>>               03082000
         PINPT:=PIN*PCBSIZE;                                            03084000
         GOTO A1;                                                       03086000
      END ELSE                                                          03088000
      BEGIN                                                             03090000
         PINPT:=PIN*PCBSIZE;                                            03092000
         IF NOT (1<=PIN<=PCBTABLE(0)) THEN GO A3;              <<02729>>03094000
         IF PCBTABLE(PINPT+5).(0:8)=CALPIN THEN                         03096000
         BEGIN                                                          03098000
            MASK:=1;                                                    03100000
            GOTO OK;                                                    03102000
         END;                                                           03104000
A3:         CC:=CCL;                   <<ILLEGAL PROCESS>>              03106000
            GOTO FIN;                                                   03108000
      END;                                                              03110000
                                                                        03112000
A1:      MASK := 2;                                                     03114000
         IF LOGICAL(PCBTABLE(CALPT+9)&LSR(9))     <<SYSTEM PROC>>       03116000
         THEN GOTO OK;                                                  03118000
         TOS:=LOGICAL(PCBTABLE(PINPT+9)&LSR(7)) LAND 7;<<PROC TYPE>>    03120000
         ASSEMBLE(DUP);                                                 03122000
         IF TOS&LSR(2) THEN            <<A=1==SYSTEM PROCESS>>          03124000
         BEGIN                                                          03126000
            ASSEMBLE(DEL);                                              03128000
            TOS:=20;                   <<ERROR 20>>                     03130000
A2:         TOS:=0;                                                     03132000
            ERROREXIT(*,*,*);                                           03134000
         END;                                                           03136000
         IF TOS=2 THEN                 <<JOB/SESS MAIN PROCESS>>        03138000
         BEGIN                                                          03140000
            TOS:=21;                   <<ERROR 21 >>                    03142000
            GOTO A2;                                                    03144000
         END;                                                           03146000
OK:                                                                     03148000
      << ALIVE TEST:>>                                                  03150000
      DISABLE;                                                          03152000
      IF PCBTABLE(PINPT+9).(0:1) = 0 THEN                      <<02729>>03154000
      BEGIN                                                    <<02729>>03156000
         CC := CCL;                                            <<02729>>03158000
         GO TO FIN;                                            <<02729>>03160000
      END;                                                     <<02729>>03162000
      IF PCBTABLE(X:=X-5).(0:10) <> 0 THEN                     <<04897>>03164000
         BEGIN <<TO THIS USER, SON IS "ACTIVE">>                        03166000
         IF SUSP <> 0 THEN                                              03168000
            BEGIN                                                       03170000
            WAIT(SUSP,0);                                               03172000
            IF < THEN BEGIN CC:=CCL; GOTO FIN; END;                     03174000
            END;                                                        03176000
         CC:=CCG; GOTO FIN;                                             03178000
         END <<ACTIVE SON>>;                                            03180000
      AWAKE(PINPT,MASK,SUSP);                                           03182000
      PUSH(STATUS);                                                     03184000
      CC:=TOS&LSR(8);                                                   03186000
FIN:                                                                    03188000
      STATUS.(6:2):=CC;                                                 03190000
      ERROREXIT(*,0,0);                                                 03192000
                                                                        03194000
END;  <<ACTIVATE>>                                                      03196000
                                                                        03198000
                                                                        03200000
         <<*DISP*00*...>>                                               03202000
                                                                        03204000
                                                                        03206000
PROCEDURE SHOWPROC(PDATA,BUFP);                                         03208000
  VALUE PDATA,BUFP;                                                     03210000
  DOUBLE PDATA;                                                         03212000
  BYTE POINTER BUFP;                                                    03214000
  OPTION UNCALLABLE,PRIVILEGED,INTERNAL;                                03216000
                                                                        03218000
  COMMENT FORMAT ONE COLUMN OF SHOWQ OUTPUT;                            03220000
                                                                        03222000
                                                                        03224000
  COMMENT EACH PDATA IS FORMATTED AS FOLLOWS:                           03226000
                                                                        03228000
     0   1   2   3   4   5   6   7   8                                  03230000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03232000
   + LTYPE +   QTYPE   +EQ'+ PTYPE +             PIN               +    03234000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03236000
   + JTYPE +                     JNUMBER                           +    03238000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03240000
                                                                        03242000
              LTYPE - LIST TYPE: 2 - READY, 1 - DISCARD, 0 - OUT        03244000
              QTYPE - SCHEDULING QUEUE TYPE = PCB08.(2:3)               03246000
                      4 - LINEAR, 2 - CQ, 3 - CQTEMP, 1 - DQ            03248000
              EQ'   - PCB08.(1:1) IS E SUBQUEUE BIT                     03250000
              PTYPE - PROCESS TYPE = PCB09.(6:2)                        03252000
                      3 - UCOP, 2 - SYSTEM, 1 - MAIN, 0 - USER          03254000
              PIN   - PROCESS IDENTIFICATION NUMBER                     03256000
              JTYPE - JOB TYPE: 1 - SESSION, 2 - BATCH                  03258000
                                                                        03260000
                                                                        03262000
          ;                                                             03264000
  BEGIN                                                                 03266000
                                                                        03268000
  LOGICAL PDATA1 = PDATA;                                               03270000
  LOGICAL PDATA2 = PDATA1+1;                                            03272000
  INTEGER LEN;                                                          03274000
  BYTE ARRAY SYM1(0:3), SYM2(0:3), SYM3(0:3);                           03276000
  BYTE ARRAY SYMS(*) = SYM1;                                            03278000
                                                                        03280000
  BYTE ARRAY NUMBER(0:5);                                               03282000
                                                                        03284000
  << DATA FOR 1 PROCESS  =>  OUTPUT BUFFER >>                           03286000
                                                                        03288000
  MOVE SYMS := "LDCDUM  ?SJ?";                                          03290000
  IF PDATA1.QTYPE > 0 THEN                                              03292000
    BUFP := SYM1(PDATA1.QTYPE LAND 3);                                  03294000
  IF PDATA1.EQ' THEN BUFP := "E";  << EQ SPECIAL CASE OF DQ >>          03296000
  BUFP(3) := SYM2(PDATA1.PTYPE);                                        03298000
  LEN := ASCII(PDATA1.PIN',10,BUFP(4));                                 03300000
  IF PDATA1.PTYPE < 2 AND PDATA2 <> 0 THEN                     <<00.01>>03302000
    BEGIN  << PRINT JOB NUMBER >>                                       03304000
    BUFP(9) := "#";                                                     03306000
    BUFP(10) := SYM3(PDATA2.JTYPE);                                     03308000
    ASCII(PDATA2.JNUM,10,BUFP(11));                                     03310000
    END;                                                                03312000
                                                                        03314000
  END;                                                                  03316000
                                                                        03318000
PROCEDURE SHOWMQ;                                                       03320000
  OPTION UNCALLABLE,PRIVILEGED;                                         03322000
                                                                        03324000
                                                                        03326000
                                                                        03328000
  BEGIN                                                                 03330000
                                                                        03332000
  COMMENT PRINT PROCESS QUEUES;                                         03334000
                                                                        03336000
  INTEGER OLDZ, P, X=X, S0=S-0, TOTAL, LASTPCB, I, J, LEN;              03338000
                                                                        03340000
  INTEGER ARRAY LISTLEN(0:2)=Q, PTRS(0:2);                              03342000
                                                                        03344000
  EQUATE SYSGLOB'PCBPOINTER=%1003;                             <<01549>>03346000
  LOGICAL POINTER ICS'L=%177005;                               <<01549>>03348000
  INTEGER POINTER ICS=%177005;  <<ABSOLUTE POINTER TO ICS>>    <<01549>>03350000
$INCLUDE INCLICS                                               <<01553>>03352000
EQUATE CQMIN=-ICS'MINCFILTERCELL-%1000, CQMAX=-ICS'MAXCFILTERCELL-%1000,03354000
    CQBASE=-ICS'CSCHEDBASECELL-%1000, CQLIMIT=-ICS'WORSTCPRICELL-%1000, 03356000
    DQMIN=-ICS'CURDFILTERCELL-%1000, DQMAX=-ICS'CURDFILTERCELL-%1000,   03358000
    DQBASE=-ICS'DSCHEDBASECELL-%1000, DQLIMIT=-ICS'WORSTDPRICELL-%1000, 03360000
    EQMIN=-ICS'CUREFILTERCELL-%1000,  EQMAX=-ICS'CUREFILTERCELL-%1000,  03362000
    EQBASE=-ICS'ESCHEDBASECELL-%1000, EQLIMIT=-ICS'WORSTEPRICELL-%1000; 03364000
         <<SYSGLOB RELATIVE OFFSETS INTO ICS>>                 <<01549>>03366000
  EQUATE CLOCKCYCLE=%1353;                                     <<01549>>03368000
  INTEGER ARRAY MIN(0:2)=PB:=CQMIN,DQMIN,EQMIN;                <<01549>>03370000
  INTEGER ARRAY MAX(0:2)=PB:=CQMAX,DQMAX,EQMAX;                <<01549>>03372000
  INTEGER ARRAY BASE(0:2)=PB:=CQBASE,DQBASE,EQBASE;            <<01549>>03374000
  INTEGER ARRAY LIMIT(0:2)=PB:=CQLIMIT,DQLIMIT,EQLIMIT;        <<01549>>03376000
  EQUATE  PJXREF    = 50,                                               03378000
          RL        = PCBSIZE,                                          03380000
          DL        = RL+PCBSIZE,                                       03382000
          DL'BLINK  = DL+10,                                            03384000
          BUFSZ'    = 29,                                               03386000
          BUFSZ     = BUFSZ'-1,                                         03388000
          FIRSTPCB  = DL+PCBSIZE,                                       03390000
          DBLSPACE  = %60;                                              03392000
                                                                        03394000
  ARRAY BUF(0:BUFSZ);                                                   03396000
  BYTE POINTER BUF';                                                    03398000
                                                                        03400000
  ARRAY JOBNUM(*) = DB+0;                                               03402000
  BYTE POINTER BPS0=S-0;                                       <<01549>>03404000
  ARRAY DJ'D(0:1)=Q;                                           <<01549>>03406000
  DOUBLE DJ=DJ'D;                                              <<01549>>03408000
                                                                        03410000
  DEFINE  CULDATA   =                                                   03412000
   TOS:=(PCB(P+QUEUEINGINFOWORDNUM) LAND %74000) & LSR(1);     <<01549>>03414000
                                                               <<01549>>03416000
                                                               <<01549>>03418000
   TOS:=PCB(P+PROCSTATEWORDNUM) LAND %1400;                    <<01549>>03420000
   TOS:=P&LSR(4);  <<PIN NUMBER>>                              <<01549>>03422000
    X := S0;                                                            03424000
    TOS := TOS LOR TOS LOR TOS LOR TOS;                                 03426000
    TOS := JOBNUM(X);                                                   03428000
    #;                                                                  03430000
                                                                        03432000
  BYTE ARRAY HEAD(*) = PB := "Q  PIN   JOBNUM";                         03434000
                                                                        03436000
  DEFINE CLEARBUF = BUF:="  "; MOVE BUF(1):=BUF,(BUFSZ)#;               03438000
                                                                        03440000
  INTEGER ARRAY LISTLOC(0:1)=PB:=%1271,%1273;                  <<01549>>03442000
                                                               <<01549>>03444000
  INTEGER ARRAY LISTTYPE(0:2) = PB := %100000,%40000,0;                 03446000
                                                               <<01549>>03448000
  INTEGER ARRAY COLS    (0:2) = PB := 42,21,0;                          03450000
  INTEGER ARRAY LINELEN (0:2) = PB := 29,19,8;                          03452000
                                                                        03454000
  INTEGER LINESIZE;                                                     03456000
  DOUBLE ARRAY STORE(@);              <<TOP OF STACK IS LOCAL STORE>>   03458000
                                                                        03460000
  COMMENT THE FORMAT OF EACH ENTRY IN THE STORE ARRAY IS:               03462000
                                                                        03464000
              LTYPE - LIST TYPE: 2 - READY, 1 - DISCARD, 0 - OUT        03466000
              QTYPE - SCHEDULING QUEUE TYPE = PCB08.(2:3)               03468000
                      4 - LINEAR, 2 - CQ, 3 - CQTEMP, 1 - DQ            03470000
              EQ'   - PCB08.(1:1) IS E SUBQUEUE BIT                     03472000
              PTYPE - PROCESS TYPE = PCB09.(6:2)                        03474000
                      3 - UCOP, 2 - SYSTEM, 1 - MAIN, 0 - USER          03476000
              PIN   - PROCESS IDENTIFICATION NUMBER                     03478000
              JTYPE - JOB TYPE: 1 - SESSION, 2 - BATCH                  03480000
                                                                        03482000
                                                                        03484000
     0   1   2   3   4   5   6   7   8                                  03486000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03488000
   + LTYPE +   QTYPE   +EQ'+ PTYPE +             PIN               +    03490000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03492000
   + JTYPE +                     JNUMBER                           +    03494000
   +***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+***+    03496000
                                                                        03498000
                                                                        03500000
          ;                                                             03502000
                                                                        03504000
                                                                        03506000
  << INITIALIZE >>                                                      03508000
                                                                        03510000
  OLDZ := X := 0;                                                       03512000
  LASTPCB := PCB(X)*PCBSIZE;                                            03514000
  DO LISTLEN(X):=0 UNTIL (X:=X+1)>2;                                    03516000
                                                                        03518000
  TOS := 0;  << ZSIZE RETURN >>                                         03520000
  PUSH(S,STATUS,Z);                                                     03522000
  ASSEMBLE( XCH );                                                      03524000
  TOS.(2:1) := 0;                                                       03526000
  SET(STATUS); << TURN TRAPS OFF >>                                     03528000
  ASSEMBLE( DUP,CAB );  << NEW ORDER IS Z,Z,S ON TOS >>                 03530000
  @STORE := S0;         << INITIALIZE >>                                03532000
  TOS := TOS-TOS;                                                       03534000
  IF TOS > 600 THEN DDEL << Z AND ZSIZE RETURN: HAVE ROOM ENUF >>       03536000
  ELSE                                                                  03538000
    BEGIN  << NEED ROOM ON THE TOS FOR TEMPORARY STORAGE >>             03540000
    OLDZ := S0;  << OLDZ > 0  =>  ZSIZE ON EXIT >>                      03542000
    TOS := TOS+600;                                                     03544000
    ZSIZE(*);                                                           03546000
    IF <> THEN                                                          03548000
      BEGIN  << STACK IS TOO SMALL >>                                   03550000
      MOVE BUF':="STACK TOO SMALL TO EXECUTE COMMAND",1;       <<01549>>03552000
      LEN:=TOS-@BUF';                                          <<01549>>03554000
      PRINT (BUF,-LEN,0);                                      <<01549>>03556000
      RETURN;<< MESSAGE NEEDED HERE >>                                  03558000
      END;                                                              03560000
    END;                                                                03562000
                                                                        03564000
  << COLLECT DATA FROM PCB >>                                           03566000
  EXCHANGEDB(PJXREF);                                                   03568000
  I := 0;                                                               03570000
                                                                        03572000
  DISAPROC;                                                             03574000
                                                                        03576000
                                                               <<01549>>03578000
    DISABLE;                                                            03580000
    P:=ABSOLUTE(LISTLOC(I));                                   <<01549>>03582000
    WHILE P<>0 DO                                              <<01549>>03584000
      BEGIN  << GET NEXT PROCESS IN THIS LIST >>                        03586000
    P:=P-ABSOLUTE(SYSGLOB'PCBPOINTER);                         <<01549>>03588000
      TOS := LISTTYPE(I);                                               03590000
      CULDATA;                                                          03592000
      LISTLEN(X) := LISTLEN(I)+1; <<PROCESS COUNT, THIS LIST>>          03594000
      P:=PCB(P+NQPTRWORDNUM);                                  <<01549>>03596000
    END                                                        <<01549>>03598000
;                                                              <<01549>>03600000
    ENABLE;                                                             03602000
                                                               <<01549>>03604000
                                                               <<01549>>03606000
                                                                        03608000
  << FIND PROCESSES ON NO LIST >>                                       03610000
  DISABLE;                                                              03612000
  P:=0;                                                        <<01549>>03614000
  WHILE (P:=P+PCBSIZE)<=LASTPCB DO                             <<01549>>03616000
    IF PCB(P+PROCSTATEWORDNUM).ALIVEFLAG AND                   <<01549>>03618000
       NOT PCB(P+QUEUEINGINFOWORDNUM).DISPQFLAG THEN           <<01549>>03620000
       BEGIN                                                   <<01549>>03622000
                                                               <<01549>>03624000
      TOS := 0;                                                         03626000
      CULDATA;                                                          03628000
      LISTLEN(X) := LISTLEN(2) + 1;                                     03630000
      END;                                                              03632000
  ENABLE;                                                               03634000
                                                                        03636000
  ENAPROC;                                                              03638000
                                                                        03640000
  EXCHANGEDB(0);                                                        03642000
                                                                        03644000
  << PRINT HEADING >>                                                   03646000
  @BUF' := @BUF&LSL(1);                                                 03648000
  CLEARBUF;                                                             03650000
  PRINT(BUF,0,0);                                                       03652000
  MOVE BUF'(COLS(2)+1) := "DORMANT";                                    03654000
  MOVE BUF'(COLS(1)+1) := "WAITING";                                    03656000
  MOVE BUF'(COLS(0)+1) := "RUNNING";                                    03658000
  PRINT(BUF,BUFSZ',0);                                                  03660000
  I := 0;                                                               03662000
  CLEARBUF;                                                             03664000
  DO  MOVE BUF'(COLS(I)) := HEAD,(15)  UNTIL  (I:=I+1)>2;               03666000
  PRINT(BUF,BUFSZ',DBLSPACE);                                           03668000
                                                                        03670000
  << INITIALIZE FOR QUEUE DISPLAY >>                                    03672000
  TOTAL := X := 0;                                                      03674000
  PTRS(X) := 0;                                                         03676000
  DO BEGIN  << SET UP POINTERS, GET TOTAL MEANWHILE >>                  03678000
    TOTAL := LISTLEN(X)+TOTAL;                                          03680000
    PTRS(X:=X+1) := TOTAL;                                              03682000
    END                                                                 03684000
  UNTIL X>1;                                                            03686000
  TOTAL := LISTLEN(X) + TOTAL; << GRAND TOTAL INCL. OUT PROCS >>        03688000
                                                                        03690000
                                                                        03692000
  << DISPLAY QUEUES >>                                                  03694000
  I := 0;                                                               03696000
  DO BEGIN  << OUTPUT A LINE >>                                         03698000
    LINESIZE := J := 0;                                                 03700000
    CLEARBUF;                                                           03702000
    DO BEGIN  << OUTPUT UP TO 3 COLUMNS >>                              03704000
      TOS := LISTLEN(J) - 1;                                            03706000
      IF < THEN DEL  << LIST IS EMPTY, DELETE COUNT >>                  03708000
      ELSE                                                              03710000
        BEGIN  << DISPLAY NEXT IN LIST >>                               03712000
        LISTLEN(X) := TOS;                                              03714000
        TOS := STORE(PTRS(J));                                          03716000
        TOS := @BUF'(COLS(J));                                          03718000
        SHOWPROC(*,*);                                                  03720000
        PTRS(X) := PTRS(J)+1;  << POINT TO NEXT PROCESS >>              03722000
        IF LINELEN(J) > LINESIZE THEN LINESIZE := LINELEN(X);           03724000
        END;                                                            03726000
      END                                                               03728000
    UNTIL (J:=J+1)>2;                                                   03730000
    PRINT(BUF,LINESIZE,0);                                              03732000
    TOS := X := 0;                                                      03734000
    DO  TOS := TOS+LISTLEN(X)  UNTIL (X:=X+1)>2;                        03736000
    END                                                                 03738000
  UNTIL TOS<=0;                                                         03740000
                                                                        03742000
  CLEARBUF;                                                    <<01549>>03744000
  PRINT(BUF,0,0);                                              <<01549>>03746000
  I:=-1;                                                       <<01549>>03748000
  WHILE (I:=I+1)<3 DO                                          <<01549>>03750000
  BEGIN                                                        <<01549>>03752000
     BUF':="C"+I;                                              <<01549>>03754000
     MOVE BUF'(1):="Q MINQUANTUM=",2;                          <<01549>>03756000
     LEN:=ASCII((J:=ICS'L(MIN(I))),10,BPS0);                   <<01549>>03758000
     TOS:=TOS+LEN;                                             <<01549>>03760000
     MOVE *:=", MAXQUANTUM=",2;                                <<01549>>03762000
     LEN:=ASCII((J:=ICS'L(MAX(I))),10,BPS0);                   <<01549>>03764000
     TOS:=TOS+LEN;                                             <<01549>>03766000
     MOVE *:=", BASEPRI=",2;                                   <<01549>>03768000
     LEN:=ASCII((J:=ICS'L(BASE(I))),10,BPS0);                  <<01549>>03770000
     TOS:=TOS+LEN;                                             <<01549>>03772000
     MOVE *:=", LIMITPRI=",2;                                  <<01549>>03774000
     LEN:=ASCII((J:=ICS'L(LIMIT(I))),10,BPS0);                 <<01549>>03776000
     TOS:=TOS+LEN;                                             <<01549>>03778000
     LEN:=TOS-@BUF';                                           <<01549>>03780000
     PRINT(BUF,-LEN,0);                                        <<01549>>03782000
     CLEARBUF;                                                 <<01549>>03784000
  END;                                                         <<01549>>03786000
  MOVE BUF':="MINIMUM CLOCK CYCLE=",2;                         <<01549>>03788000
  DJ'D:=ABSOLUTE(CLOCKCYCLE);                                  <<01549>>03790000
  DJ'D(1):=ABSOLUTE(CLOCKCYCLE+1);                             <<01549>>03792000
  LEN:=DASCII(DJ,10,BPS0);                                     <<01549>>03794000
  TOS:=TOS+LEN;                                                <<01549>>03796000
  LEN:=TOS-@BUF';                                              <<01549>>03798000
  PRINT(BUF,-LEN,0);                                           <<01549>>03800000
  IF OLDZ > 0 THEN ZSIZE(OLDZ);                                         03802000
  END;                                                                  03804000
                                                                        03806000
                                                                        03808000
         <<...*DISP*00*>>                                               03810000
                                                                        03812000
                                                                        03814000
PROCEDURE SHOWSQ(B);                                                    03816000
   VALUE B;                                                             03818000
   BYTE B;                                                              03820000
   OPTION PRIVILEGED,UNCALLABLE;                                        03822000
   BEGIN                                                                03824000
   SHOWMQ;                                                              03826000
   END;                                                                 03828000
                                                                        03830000
PROCEDURE ABORTJOB(MAINPIN);                                            03832000
VALUE MAINPIN;                                                          03834000
INTEGER MAINPIN;                                                        03836000
OPTION UNCALLABLE,PRIVILEGED;                                           03838000
                                                                        03840000
                                                                        03842000
COMMENT: USED TO ABORT ANY BATCH,JOB OR SESSION.                        03844000
         NORMALLY USED FROM OPERATOR CONSOLE.                           03846000
                                                                        03848000
         RETURN:                                                        03850000
            CCE   OK                                                    03852000
            CCG   IF MAIN NOT ALIVE                                     03854000
            CCL   IF PROCESS NOT A MAIN                                 03856000
      ;                                                                 03858000
                                                                        03860000
                                                                        03862000
BEGIN                                                                   03864000
                                                                        03866000
 INTEGER   FATHER;                                             <<SB.01>>03868000
 INTEGER   SON:=1;                                             <<SB.01>>03870000
 DEFINE   FATHER'PNTR  =  PCB(FATHER*PCBSIZE+5).(0:8)#,        <<SB.01>>03872000
          SON'PNTR     =  PCB(FATHER*PCBSIZE+5).(8:8)#,        <<SB.01>>03874000
          BROTHER'PNTR =  PCB(FATHER*PCBSIZE+6).(0:8)#;        <<SB.01>>03876000
                                                               <<SB.01>>03878000
      DISABLE;                                                          03880000
      TOS:=PCB(MAINPIN*PCBSIZE+9);                                      03882000
      IF > THEN TOS:=CCG                <<NOT ALIVE>>                   03884000
      ELSE                                                              03886000
      BEGIN                                                             03888000
         IF TOS.(6:2)<>1 THEN TOS:=CCL  <<NOT A MAIN>>                  03890000
         ELSE                                                           03892000
         BEGIN                                                          03894000
            TOS:=CCE;                                          <<SB.01>>03896000
            SET'PSIF(X-9,%20);   << SOFT KILL>>                <<SB.01>>03898000
            ENABLE;                                            <<SB.01>>03900000
            ABORTPROCIO(MAINPIN);  <<ABORT IO ON PROCESS>>     <<SB.01>>03902000
            FATHER:=MAINPIN;                                   <<SB.01>>03904000
            IF SON'PNTR <> 0 THEN  <<WE HAVE A FAMILY>>        <<SB.01>>03906000
                                                               <<SB.01>>03908000
              << ABORT IO FOR ALL FAMILY MEMBERS.         >>   <<SB.01>>03910000
              << DO NOT ABORT IO ON FATHER OR BROTHERS OF >>   <<SB.01>>03912000
              << MAINPIN                                  >>   <<SB.01>>03914000
                                                               <<SB.01>>03916000
                                                                        03918000
              DO BEGIN  << ABORT IO FOR FAMILY >>              <<SB.01>>03920000
                 DISABLE;                                      <<SB.01>>03922000
                 IF (SON'PNTR=0) OR (SON=0) THEN               <<SB.01>>03924000
                    SON:=BROTHER'PNTR                          <<SB.01>>03926000
                 ELSE                                          <<SB.01>>03928000
                    SON:=SON'PNTR;                             <<SB.01>>03930000
                 IF SON <> 0 THEN                              <<SB.01>>03932000
                    BEGIN                                      <<SB.01>>03934000
                       FATHER:=SON;  <<SETUP FOR LP TERMINATE>><<SB.01>>03936000
                       TOS:=PCB(SON*PCBSIZE+9);                <<SB.01>>03938000
                       DEL;                                    <<SB.01>>03940000
                       IF < THEN       <<ALIVE>>               <<SB.01>>03942000
                          BEGIN                                <<SB.01>>03944000
                             ENABLE;                           <<SB.01>>03946000
                             ABORTPROCIO(SON);                 <<SB.01>>03948000
                          END;                                 <<SB.01>>03950000
                    END                                        <<SB.01>>03952000
                 ELSE            <<NO MORE SONS OR BROTHERS>>  <<SB.01>>03954000
                                 <<FOR THIS FATHER         >>  <<SB.01>>03956000
                    IF FATHER <> MAINPIN THEN                  <<SB.01>>03958000
                       FATHER:=FATHER'PNTR; <<GET HIS FATHER>> <<SB.01>>03960000
                 END << ABORT IO FOR FAMILY >>                 <<SB.01>>03962000
               UNTIL FATHER=MAINPIN;                           <<SB.01>>03964000
            REMRITENTRY'(MAINPIN,1); <<CLEAR CONSOLE REPLY>>   <<01399>>03966000
         END;                                                           03968000
      END;                                                              03970000
                                                                        03972000
      STATUS.(6:2):=TOS;                                                03974000
                                                                        03976000
                                                                        03978000
END;  << A B O R T J O B  >>                                            03980000
                                                                        03982000
PROCEDURE ABORTPROG;                                                    03984000
OPTION UNCALLABLE,PRIVILEGED;                                           03986000
                                                                        03988000
                                                                        03990000
COMMENT: KILLS SON OF MAIN.                                             03992000
         TO BE CALLED FROM BREAK MODE IN COMMAND INTERPRETER.           03994000
         ;                                                              03996000
                                                                        03998000
BEGIN                                                                   04000000
      INTEGER SON = Q+1;                                                04002000
                                                                        04004000
                                                                        04006000
                                                                        04008000
                                                                        04010000
      TOS:=PCBSIZE*ABSOLUTE(ABSOLUTE(CPCB)+5).(8:8);  <<FIRST SON>>     04012000
      IF = THEN SUDDENDEATH(302);                                       04014000
      IF PCBI(SON+9)<0 THEN            <<TEST FOR ALIVE>>               04016000
      BEGIN                            <<ALIVE>>                        04018000
         TOS := SETCRITICAL;                                            04020000
         SET'PSIF(SON,%20);            << SOFT KILL >>                  04022000
         ABORTPROCIO(SON/PCBSIZE);                                      04024000
         AWAKE(SON,%400,0); <<ABORT MAIL WAIT>>                <<01163>>04026000
         REMRITENTRY'(SON/PCBSIZE,1);  <<CLEAR CONSOLE REPLY>> <<01399>>04028000
         DISABLE;                                                       04030000
         IF NOT LOGICAL(PCBI(SON+8).(6:1)) THEN WAIT(%4000,0);          04032000
         <<MOURNING WAIT>>                                              04034000
         ENABLE;                                                        04036000
         BURRYPROC(SON);                                                04038000
         RESETCRITICAL(*);                                              04040000
      END ELSE                                                          04042000
      BEGIN                                                             04044000
         DISABLE;                                                       04046000
         CLEAR'PSIF(SON,4);            <<HYP:=0>>                       04048000
         WAIT(2,0);                    <<WAIT FOR SON>>                 04050000
         ENABLE;                                                        04052000
      END;                                                              04054000
                                                                        04056000
      SETJCW(%140000);   <<"SYSTEM 0">>                        <<U.RAO>>04058000
                                                                        04060000
END;  << A B O R T P R O G  >>                                          04062000
                                                                        04064000
PROCEDURE  QUANTUM(TS,TP,NP,CP);                                        04066000
VALUE  TS,TP,NP,CP;                                                     04068000
LOGICAL TS;                                                             04070000
INTEGER TP,NP,CP;                                                       04072000
OPTION  PRIVILEGED, UNCALLABLE;                                         04074000
BEGIN                                                                   04076000
<<                                                                      04078000
      CHANGES QUANTUM AND PRIORITES FOR A TIMESHARE PROCESS             04080000
>>                                                                      04082000
                                                                        04084000
   ARRAY  PARAM(*) = Q-11;                                              04086000
                                                                        04088000
END;  << Q U A N T U M  >>                                              04090000
                                                                        04092000
PROCEDURE BREAKJOB(LDEV,PINWORD);                              <<DS.06>>04094000
VALUE   LDEV,PINWORD;                                          <<DS.06>>04096000
INTEGER LDEV,PINWORD;                                          <<DS.06>>04098000
OPTION PRIVILEGED,UNCALLABLE;                                           04100000
                                                                        04102000
                                                                        04104000
COMMENT: PUTS ALL THE PROCESSES OF THE SUB TREE IN HYBERNATING          04106000
         PSEUDO INTERRUPT STATE (BREAKJOB).                    <<DS.06>>04108000
         PUTS THE BREAK OR CY PSEUDO INT BIT ON IN MAIN OR CY PROC.     04110000
         PINWORD.(0:8) = 0       (BREAKJOB)                    <<DS.06>>04112000
                       = MAINPIN (BREAKSS)                     <<DS.06>>04114000
                .(8:8) = MAINPIN (BREAKJOB)                    <<DS.06>>04116000
                       = CY'PIN  (BREAKSS)                     <<DS.06>>04118000
                                                                        04120000
         RETURNS                                                        04122000
            CCE   OK                                                    04124000
            CCL:  IF MAIN NOT WAITING FOR SON (BREAKJOB)       <<DS.06>>04126000
                  IF NO LIVE CONTROL Y PROCESS (BREAKSS)       <<DS.06>>04128000
      ;                                                                 04130000
                                                                        04132000
                                                                        04134000
BEGIN                                                                   04136000
      ENTRY BREAKSS;                                           <<DS.06>>04138000
                                                               <<DS.06>>04140000
      DEFINE DSBRKPLAB = ABSOLUTE(%1360)#;                     <<DS.06>>04142000
      DEFINE LPDTSZSH  = ASL(1)#,                              <<DS.06>>04144000
             PCBSZSH   = ASL(4)#;                              <<DS.06>>04146000
      INTEGER CC:=CCL;                                         <<01549>>04148000
      LOGICAL BRKFLAG:=FALSE;                                  <<01549>>04150000
      INTEGER IBRKFLAG = BRKFLAG;                              <<DS.06>>04152000
      INTEGER NEXT:=0;                                         <<01549>>04154000
      INTEGER POINTER  LPDT = 8;                                        04156000
                                                                        04158000
                                                                        04160000
      <<THE MAIN MUST BE WAITING FOR SON EXCLUSIVELY>>                  04162000
          BRKFLAG:=TRUE;                                       <<01549>>04164000
BREAKSS:                                                       <<DS.06>>04166000
      DISAPROC;                                                         04168000
      << THE FOLLOWING SECTION IGNORES A BREAK WHEN:        >> <<01929>>04170000
      <<     1. BRKFLG IS NOT SET,                          >> <<01929>>04172000
      <<     2. NOT WAITING ON UCOP OR SON WAIT,            >> <<01929>>04174000
      <<     3. WAITING ON SON OR UCOP, AND OTHER WAITS ARE >> <<01929>>04176000
      <<        PRESENT. (EXMPL: A JUNKSONWAIT IS IGNORED)  >> <<01929>>04178000
      << THE IDEA HERE IS TO PREVENT BREAKS FROM OCCURRING  >> <<01929>>04180000
      << WHEN THE SYSTEM IS IN IMPORTANT SYNCHRONOUS CODE.  >> <<01929>>04182000
      << FOR EXAMPLE: WHEN THE CI IS INITIATING A SON.      >> <<01929>>04184000
      IF NOT BRKFLAG  OR                                       <<01929>>04186000
       (LOGICAL(PCBI(PINWORD&PCBSZSH+4)) LAND %1040)=0 OR      <<01929>>04188000
       (LOGICAL(PCBI(PINWORD&PCBSZSH+4)) LAND %176720)<>0 THEN <<01929>>04190000
         BEGIN  << SET BREAKABLE COMMAND OR SSBREAK BIT >>     <<DS.06>>04192000
         IF PINWORD.(8:8) = 0 THEN GO DSCY;                    <<DS.06>>04194000
         DISABLE;                                                       04196000
         TOS := LPDT(LDEV&LPDTSZSH+1);                         <<DS.06>>04198000
         IF BRKFLAG THEN                                       <<DS.06>>04200000
            BEGIN                                              <<DS.06>>04202000
            TOS.(10:1):=1;         << BREAK BIT >>             <<DS.06>>04204000
            IF = THEN CC:=CC+1;    << CCE >>                   <<DS.06>>04206000
            END                                                <<DS.06>>04208000
         ELSE TOS.(4:1):=1;        << CY BIT >>                <<DS.06>>04210000
         LPDT(X) := TOS;                                                04212000
         ENABLE;                                               <<DS.06>>04214000
         IF BRKFLAG THEN GO  FIN;                              <<DS.06>>04216000
         END;                                                           04218000
                                                               <<DS.06>>04220000
      TOS:=IF BRKFLAG THEN PCBI(X:=X+1) ELSE PINWORD;          <<DS.06>>04222000
   TOS:=TOS.(8:8);  <<GET SONS PTR FOR BREAK>>                 <<00594>>04224000
   IF = AND BRKFLAG THEN GO TO NO'SONS;<<NO SONS TO HYBERNATE>><<00594>>04226000
   X:=TOS&PCBSZSH+9;                                           <<00594>>04228000
      IF PCBI(X) >= 0 THEN                                     <<DS.06>>04230000
      BEGIN                                                    <<DS.06>>04232000
        ENAPROC;                                               <<DS.06>>04234000
        GO OUT;                                                <<DS.06>>04236000
      END;                                                     <<DS.06>>04238000
      << PROCESS IS EXPIRING, DO NOT ALLOW >>                  <<DS.06>>04240000
                                                                        04242000
      CC:=CC+1;    << CCE >>                                   <<DS.06>>04244000
      IF BRKFLAG THEN                                          <<DS.06>>04246000
         BEGIN                                                 <<DS.06>>04248000
         TOS:=TOS+PINWORD;    << NEXT >>                       <<DS.06>>04250000
         <<SET HYBERNATING BIT IN SUB TREE >>                  <<DS.06>>04252000
         WHILE (NEXT:=FAMILY(NEXT,PINWORD))<>PINWORD DO        <<DS.06>>04254000
         SET'PSIF( NEXT&PCBSZSH,4 );   << HYBERNATE SONS >>    <<DS.06>>04256000
         END;                                                  <<DS.06>>04258000
NO'SONS:                                                       <<00594>>04260000
      SET'PSIF( PINWORD.(8:8)&PCBSZSH,IBRKFLAG+2);  << SET BREAK/CY >>  04262000
      IF BRKFLAG THEN                                          <<00594>>04264000
      BEGIN  <<FIND OUT WHETHER BREAKING ON RIT OR SON WAIT>>  <<00594>>04266000
         TOS:=PCBI(PINWORD&PCBSZSH+4).(6:1); <<RIT WAIT FLAG>> <<00594>>04268000
   PCB(PINWORD*PCBSIZE+RESABORTINFOWORDNUM).PCBRITWAITFLAG:=   <<01549>>04270000
            PCBI(PINWORD&PCBSZSH+4).(6:1);  <<SET BREAK TYPE>> <<00594>>04272000
         IF TOS THEN AWAKE(PINWORD&PCBSZSH,%40,0)              <<00594>>04274000
                ELSE AWAKE(PINWORD&PCBSZSH,%02,0);             <<00594>>04276000
       END                                                     <<01549>>04278000
    ELSE                                                       <<01549>>04280000
DSCY: PINWORD:=PINWORD.(0:8);                                  <<DS.06>>04282000
FIN:  ENAPROC;                                                          04284000
      TOS:=0;                                                  <<DS.06>>04286000
      TOS:=BRKFLAG;                                            <<DS.06>>04288000
      TOS:=PINWORD;                                            <<DS.06>>04290000
      TOS:=DSBRKPLAB;                                          <<DS.06>>04292000
      IF <> THEN ASSEMBLE(PCAL 0);                             <<DS.06>>04294000
      << TOS:=DSBREAK(BRKFLAG,MAINPIN) >>                      <<DS.06>>04296000
      IF TOS THEN CC:=CCE;                                     <<DS.06>>04298000
OUT:  STATUS.(6:2):=CC;                                        <<DS.06>>04300000
                                                                        04302000
                                                                        04304000
END;  << B R E A K J O B  >>                                            04306000
                                                                        04308000
PROCEDURE CAUSEBREAK;                                                   04310000
OPTION PRIVILEGED;                                                      04312000
                                                                        04314000
COMMENT: SIMULATES PROGRAMMATICALLY A BREAK TO COMMAND                  04316000
         INTERPRETER.                                                   04318000
         RETURNS CCL IF NOT A SESSION.                                  04320000
      ;                                                                 04322000
                                                                        04324000
BEGIN                                                                   04326000
      EQUATE TYP=6;                                                     04328000
      EQUATE STIN=3;                                                    04330000
                                                                        04332000
      ARRAY PCBX(*)=Q+0;                                                04334000
      DEFINE  CC = STATUS.(6:2)#;                                       04336000
      INTEGER LDEV,FAT,NEXT;                                            04338000
      ENTRY CAUSEBREAK';                                                04340000
                                                                        04342000
CAUSEBREAK':                                                            04344000
      ERRORON;                                                          04346000
      CHEK(56&LSL(5),0);                                                04348000
      PUSH(Q,DL);                                                       04350000
      ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                                  04352000
      TOS:=-PCBX(X);                                                    04354000
      ASSEMBLE(ADD);                                                    04356000
      TOS:=TOS+TYP;                                                     04358000
      ASSEMBLE(STAX);                                                   04360000
      TOS:=PCBX(X);                                                     04362000
      IF TOS.(2:2)<>1                  <<TEST FOR SESSION>>             04364000
      THEN                                                              04366000
      BEGIN                                                             04368000
         CC:=CCL;                                                       04370000
         GOTO EX;                                                       04372000
      END;                                                              04374000
                                                                        04376000
      CC:=CCE;                                                          04378000
      LDEV:=PCBX(X-3).(8:8);           <<STDIN>>                        04380000
      FAT:=ABSOLUTE(ABSOLUTE(CPCB)+5).(0:8);                            04382000
      WHILE PCBI(FAT*PCBSIZE+9).(6:2)<>1 DO                             04384000
      FAT := PCBI(X-4).(0:8);                                  <<RN.03>>04386000
      <<HERE FAT CONTAINS MAIN'S PIN>>                                  04388000
      NEXT:=FAT;                                                        04390000
      DISAPROC;                                                         04392000
                                                                        04394000
      WHILE (NEXT:=FAMILY(NEXT,FAT))<>FAT DO                            04396000
      SET'PSIF( NEXT*PCBSIZE,4 );  << HYBERNATE >>                      04398000
                                                                        04400000
      SET'PSIF( FAT*PCBSIZE,1 );  << SET BREAK BIT >>                   04402000
      AWAKE( FAT*PCBSIZE,2,0 );   << WAKE UP >>                         04404000
      ASSEMBLE( DISP );           << FORCE DISPATCH ENTRY >>            04406000
      ENAPROC;                                                          04408000
                                                                        04410000
EX:   ERROREXIT(56&LSL(6),0,0);                                         04412000
      HELP;  << FOR BREAKPOINT LINKING >>                               04414000
                                                                        04416000
END;  << C A U S E B R E A K  >>                                        04418000
                                                                        04420000
DOUBLE PROCEDURE CLOCK;                                                 04422000
   OPTION     PRIVILEGED;                                               04424000
   BEGIN                                                                04426000
     LOGICAL C1=Q-6, C2=Q-5, C3=Q-4;                                    04428000
     ARRAY Q0(*)=Q+0;                                                   04430000
     INTEGER TYPE := -4;                                                04432000
     ENTRY CALENDAR;                                                    04434000
     INTEGER  S',S,M,H,                                        <<01.03>>04436000
              DATE,  << YEAR:JULIAN DAY >>                     <<01.03>>04438000
              DAY,                                             <<01.03>>04440000
              DAYS'SINCE,                                      <<01.03>>04442000
              DAYS'THIS'YEAR;                                  <<01.03>>04444000
     POINTER  TRL = 10;                                                 04446000
     EQUATE   ONE'YEAR= [7/1,9/0];                             <<01.03>>04448000
     DEFINE   F         =ABSOLUTE#,                                     04450000
              TIME'MOD'TOS=ASSEMBLE(DDIV;DELB)#,               <<01.02>>04452000
              LEAP'YEAR=DATE.(5:2)=0#;                         <<01.03>>04454000
         TYPE := TYPE - 1;                                              04456000
     CALENDAR:                                                          04458000
         PUSH(STATUS);                                                  04460000
         TOS.(2:1) := 0;                <<DISABLE TRAPS>>               04462000
         SET(STATUS);                                                   04464000
         TOS := TIMER;  << # MILLISECONDS SINCE MIDNIGHT >>    <<01.03>>04466000
                        << PRECEEDING SYSTEM COLD LOAD   >>    <<01.03>>04468000
         TOS := 100D;                                                   04470000
         ASSEMBLE(DDIV;DDEL); <<IGNORE SEC/100>>               <<01.02>>04472000
         TOS := 10D;                                                    04474000
         TIME'MOD'TOS;                 <<TENTH SECONDS>>                04476000
         S' := TOS;                                                     04478000
         TOS := 60D;                                                    04480000
         TIME'MOD'TOS;                 <<SECONDS>>                      04482000
         S := TOS;                                                      04484000
         TOS := 60D;                                                    04486000
         TIME'MOD'TOS;                 <<MINUTES>>                      04488000
         M := TOS;                                                      04490000
         TOS := 24D;                                                    04492000
         TIME'MOD'TOS;                 <<HOURS>>                        04494000
         H := TOS;                                                      04496000
         DELB;                                                          04498000
         DAYS'SINCE := TOS; << DAYS SINCE COLD LOAD >>         <<01.03>>04500000
         DATE := TRL(7); << DATE AT COLD LOAD >>               <<01.03>>04502000
         DAYS'THIS'YEAR := IF LEAP'YEAR THEN 366 ELSE 365;     <<01.03>>04504000
         IF (DAY:=DATE.(7:9)+DAYS'SINCE) > DAYS'THIS'YEAR THEN <<01.03>>04506000
            BEGIN                                              <<01.03>>04508000
            DAY := DAY - DAYS'THIS'YEAR;                       <<01.03>>04510000
            DATE := DATE + ONE'YEAR;                           <<01.03>>04512000
            END;                                               <<01.03>>04514000
         DATE.(7:9) := DAY;                                    <<01.03>>04516000
         Q0(TYPE) := DATE;  << CURRENT DATE >>                 <<01.03>>04518000
         X := X + 4;                                                    04520000
         IF = THEN RETURN;     <<CALENDAR>>                             04522000
         TOS := H&LSL(8);                                               04524000
         C2 := TOS LOR LOGICAL(M);      <<HOURS:MINUTES>>               04526000
         TOS := S&LSL(8);                                               04528000
         C3 := TOS LOR LOGICAL(S');     <<SECONDS:SECONDS/10>>          04530000
   END <<CHRONOS>> ;                                                    04532000
$PAGE "PAUSE INTRINSIC"                                        <<03048>>04534000
PROCEDURE PAUSE(TIME);                                         <<03048>>04536000
REAL TIME;                                                              04538000
OPTION PRIVILEGED;                                                      04540000
                                                                        04542000
<<THIS ROUTINE SUSPENDS THE CALLING PROCESS FOR "TIME"                  04544000
  SECONDS.                                                              04546000
                                                                        04548000
  CONDITION CODES:                                                      04550000
                                                                        04552000
     CCL - ILLEGAL PARAMETER                                            04554000
     CCE - ALL OK                                                       04556000
     CCG - TRL ENTRY NOT AVAILABLE>>                                    04558000
                                                                        04560000
   BEGIN                                                                04562000
   ENTRY    PAUSEX;   <<IF ABORTED BY SOFT INT, WILL ADJUST TIME PARM>> 04564000
Comment Q + 1 has to be reserved in case we have to move       <<04523>>04566000
        the stack marker down by one. This will occur only     <<04523>>04568000
        when PAUSE was called via a PCAL 0 instruction and     <<04523>>04570000
        following a soft interrupt we have to recall PAUSE.    <<04523>>04572000
        Since a PCAL 0 deletes the procedure label, we have    <<04523>>04574000
        to put it back before recalling PAUSE, and thus        <<04523>>04576000
        insert the procedure label at Q - 4.                   <<04523>>04578000
                                                               <<04523>>04580000
        The variable PLACE'HOLDER has to be the first declared <<04523>>04582000
        variable in this procedure.                            <<04523>>04584000
;                                                              <<04523>>04586000
   INTEGER PLACE'HOLDER;                                       <<04523>>04588000
   DOUBLE  STARTIME;                                                    04590000
   REAL    DURATION;                                                    04592000
   INTEGER RESULT;                                                      04594000
   INTEGER PREGISTER=Q-2;                                               04596000
   DOUBLE  PAUSETIME:=-1D;    << "TIME" IN MILLISECONDS >>              04598000
   EQUATE  PAUSEHANG'  = [10/45,6/0];                                   04600000
   EQUATE  PAUSEHANG   = [10/45,6/1];                                   04602000
   EQUATE  SOFTINTOCCURRED=2;                                           04604000
   EQUATE SL = 1,                                              <<04523>>04606000
          NON'SL = 2,                                          <<04523>>04608000
          PCAL'0 = %31000;                                     <<04523>>04610000
   INTEGER SEGTYPE,                                            <<04523>>04612000
           SEGIDENT,                                           <<04523>>04614000
           DESCSTINX,                                          <<04523>>04616000
           THISPIN;                                            <<04523>>04618000
   LOGICAL MOVE'MARKER := FALSE,                               <<04523>>04620000
           BLOCKEDLOCK;                                        <<04523>>04622000
   INTEGER POINTER DST = 2;                                    <<04523>>04624000
   ARRAY QARRAY(*) = Q + 0;                                    <<04523>>04626000
   DEFINE  MSECS24DAYS = 2073600000D#;                                  04628000
   DEFINE  ASMB=ASSEMBLE#;                                              04630000
   LOGICAL STATUS=Q-1;                                                  04632000
   LOGICAL DECAY;                                                       04634000
   DEFINE  CONDCODE=STATUS.(6:2)#;                                      04636000
   EQUATE  TRLXEXHAUSTED=1;                                             04638000
   EQUATE  ALLOWSOFTINT  = TRUE;                                        04640000
   EQUATE  PRIMARYENTRY = TRUE;                                         04642000
                                                                        04644000
                                                                        04646000
   SUBROUTINE PEXIT(RETURNCODE,NUMPARMS);                               04648000
   VALUE RETURNCODE,NUMPARMS;                                           04650000
   INTEGER RETURNCODE;                                                  04652000
   LOGICAL NUMPARMS;                                                    04654000
      BEGIN                                                             04656000
      CONDCODE:=RETURNCODE;                                             04658000
      IF MOVE'MARKER THEN                                      <<04523>>04660000
         BEGIN                                                 <<04523>>04662000
         << Time to move the marker by one and put the       >><<04523>>04664000
         << procedure label of PAUSE at Q - 3.               >><<04523>>04666000
         QARRAY(1) := QARRAY(0) + 1;                           <<04523>>04668000
         QARRAY(0) := QARRAY(-1);                              <<04523>>04670000
         QARRAY(-1) := QARRAY(-2);                             <<04523>>04672000
         QARRAY(-2) := QARRAY(-3);                             <<04523>>04674000
         QARRAY(-3) := @PAUSE;                                 <<04523>>04676000
         << Can't allow DB to move around now.               >><<04523>>04678000
         ASSEMBLE(SED 0);                                      <<04523>>04680000
         PUSH(Q);                                              <<04523>>04682000
         TOS := TOS + 1;                                       <<04523>>04684000
         SET(Q);                                               <<04523>>04686000
         << Allow external interrupts.                       >><<04523>>04688000
         ASSEMBLE(SED 1);                                      <<04523>>04690000
         END;                                                  <<04523>>04692000
      ERROREXIT(PAUSEHANG' LOR NUMPARMS,0,0);                           04694000
      END;  <<PEXIT>>                                                   04696000
   <<INITIALIZE>>                                                       04698000
   IF PRIMARYENTRY THEN                                                 04700000
      DECAY:=FALSE                                                      04702000
   ELSE                                                                 04704000
      BEGIN  <<SECONDARY ENTRY,  ADJUST TIME IF SOFT INTERRUPT>>        04706000
      PAUSEX:                                                           04708000
      DECAY:=TRUE;                                                      04710000
      END;                                                              04712000
                                                                        04714000
   ERRORON;                                                             04716000
   PUSH(STATUS); TOS.(2:1):=0; SET(STATUS);  <<TURN OFF TRACE BIT>>     04718000
                                                                        04720000
   <<BOUNDS CHECK ON TIME PARAMETER>>                                   04722000
   CHECKDB;                                                             04724000
   IF <> THEN CHEK(PAUSEHANG,1,2D);  <<USER CALLED SPLIT STACK>>        04726000
   X:=@TIME; PUSH(DL,Q); TOS:=TOS-4;                                    04728000
   IF NOT (TOS <= X <= TOS) THEN CHEK(PAUSEHANG,1,2D);  <<BOUNDS VIOL>> 04730000
                                                                        04732000
   IF TIME < 1.0E+10 THEN                                               04734000
      BEGIN  <<USER ACTUALLY WANTS A FINITE DELAY>>                     04736000
      STARTIME:=TIMER;                                                  04738000
      <<CONVERT REAL SECONDS TO DOUBLE INTEGER MILLISECONDS>>           04740000
      TOS:=TIME*1000.0;                                                 04742000
      IF OVERFLOW THEN PEXIT(CCL,1);                                    04744000
      ASMB(FIXR);                                                       04746000
      IF < OR OVERFLOW THEN PEXIT(CCL,1);                               04748000
      PAUSETIME:=TOS;                                                   04750000
      END;                                                              04752000
                                                                        04754000
   IF (RESULT:=TIMEOUT(PAUSETIME,ALLOWSOFTINT)) = TRLXEXHAUSTED THEN    04756000
      PEXIT(CCG,1);                                                     04758000
                                                                        04760000
   IF RESULT = SOFTINTOCCURRED THEN                                     04762000
      BEGIN  <<FORCE USER TO RECALL PAUSE>>                             04764000
      Comment check to see if call to PAUSE was done via       <<04523>>04766000
              a PCAL 0 instruction.                            <<04523>>04768000
      ;                                                        <<04523>>04770000
      << Have to freeze the code segment first, but we have  >><<04523>>04772000
      << to get the segment number in the proper format first>><<04523>>04774000
      THISPIN := (ABSOLUTE(CPCB) - ABSOLUTE(PCBB))/PCBSIZE;    <<04523>>04776000
      SEGTYPE := IF STATUS.(8:8) < %300 THEN SL ELSE NON'SL;   <<04523>>04778000
      SEGIDENT := BUILDSEGID(SEGTYPE,STATUS.(8:8),THISPIN);    <<04523>>04780000
      FREEZESEG'(SEGIDENT,BLOCKEDLOCK<< ignored >>);           <<04523>>04782000
      << Calculate the CST or CSTX entry as an offset of DST >><<04523>>04784000
      << base.                                               >><<04523>>04786000
      DESCSTINX := CONVSEGIDTOSTINX(SEGIDENT);                 <<04523>>04788000
      << Put down effective address of the instruction >>      <<04523>>04790000
      TOS := DST(X := DESCSTINX + 2);                          <<04523>>04792000
      TOS := DST(X := X + 1);                                  <<04523>>04794000
      TOS := PREGISTER - 1;                                    <<04523>>04796000
      ASSEMBLE(LADD);                                          <<04523>>04798000
      ASSEMBLE(LSEA);                                          <<04523>>04800000
      IF TOS = PCAL'0 THEN                                     <<04523>>04802000
         MOVE'MARKER := TRUE;                                  <<04523>>04804000
      << Now we are done and going to unfreeze the segment >>  <<04523>>04806000
      UNFREEZESEG'(SEGIDENT);                                  <<04523>>04808000
      PREGISTER:=PREGISTER-1;                                           04810000
      PREGISTER.(0:1):=1;  <<FORCE ERROREXIT TO TRAP TO ININ>>          04812000
      IF DECAY AND PAUSETIME <> 0D THEN                                 04814000
         BEGIN  <<ADJUST CALLER'S TIME PARM FOR TIME SPENT IN WAIT>>    04816000
         TOS:=TIMER-STARTIME;                                           04818000
         IF < THEN TOS:=TOS+MSECS24DAYS;                                04820000
         TOS:=TOS/1000D;                                                04822000
         ASMB(FLT); DURATION:=TOS; TIME:=TIME-DURATION;                 04824000
         END;                                                           04826000
      PEXIT(CCE,0);                                                     04828000
      END;                                                              04830000
   PEXIT(CCE,1);                                                        04832000
   END;  <<PAUSE>>                                                      04834000
$PAGE                                                                   04836000
            << >>                                                       04840000
            <<TEST FOR ALIVE FATHER/SON PCB.                            04842000
               PIN   =0  FATHER                                         04844000
                     <>0 SON                                            04846000
               RETURNS  :=  TRUE   ALIVE                                04848000
                         FALSE  NOT ALIVE      >>                       04850000
            << >>                                                       04852000
LOGICAL PROCEDURE TESTALIVE(PIN);                                       04854000
  VALUE   PIN;                                                          04856000
  LOGICAL PIN;                                                          04858000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               04860000
  BEGIN                                                                 04862000
          EQUATE     PCBB=3,       <<PCB>>                              04864000
                     CPCB=4,                                            04866000
                     FATHERL=5,    <<PCB TABLE>>                        04868000
                     ALIVEL =9;                                         04870000
          DEFINE     FATHERF=(0:8)#,   <<PCB>>                          04872000
                     ALIVEF =(0:1)#;                                    04874000
            << >>                                                       04876000
          IF PIN=0 THEN PIN := ABSOLUTE(ABSOLUTE(CPCB)+FATHERL).FATHERF;04878000
          TESTALIVE := ABSOLUTE(ABSOLUTE(PCBB)+PIN*PCBSIZE              04880000
                                   +ALIVEL).ALIVEF;                     04882000
  END;                                                                  04884000
                                                                        04886000
                                                                        04888000
            << >>                                                       04890000
            <<CHECKS VALIDITY OF FATHER/SON PCB#                        04892000
          RETURNS    -MAILBOX PCB #                                     04894000
                     -0 IF ILLEGAL                                      04896000
               PIN <>0 -SON -CHECK IF EXISTS                            04898000
               PIN = 0 -FATHER -INVALID IF JMP OR SMP                   04900000
                                   UNLESS PRIVILEGED USER  >>           04902000
            << >>                                                       04904000
LOGICAL PROCEDURE CHEKMAILPCB(PIN);                                     04906000
  VALUE   PIN;                                                          04908000
  LOGICAL PIN;                                                          04910000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               04912000
  BEGIN                                                                 04914000
          EQUATE     PCBB=3,       <<PCB>>                              04916000
                     CPCB=4,                                            04918000
                     FATHERL=5,                                         04920000
                     FIRSTSONL=5,                                       04922000
                     BROTHERL=6,                                        04924000
                     PROCTYPEL=9;                                       04926000
          DEFINE     FIRSTSONF=(8:8)#, <<PCB>>                          04928000
                     BROTHERF=(0:8)#,                                   04930000
                     FATHERF=(0:8)#,                                    04932000
                     MAINF  =(6:2)#,                                    04934000
                     MAINSJF=(6:3)#;                                    04936000
          INTEGER ARRAY STAK(*)=Q+0;                                    04938000
          LOGICAL PINX,PINY;                                            04940000
          INTEGER X=X;                                                  04942000
            << >>                                                       04944000
          TOS := LOCKJIR;                                               04946000
          IF PIN=0 THEN GOTO CONT;                                      04948000
          PINX := ABSOLUTE(ABSOLUTE(CPCB)+FIRSTSONL).FIRSTSONF;         04950000
          WHILE PINX<>0 AND PINX<>PIN DO                                04952000
               PINX := ABSOLUTE(ABSOLUTE(PCBB)+PINX*PCBSIZE             04954000
                                   +BROTHERL).BROTHERF;                 04956000
          GOTO FIN;                                                     04958000
  CONT:   PINX := (ABSOLUTE(CPCB)-ABSOLUTE(PCBB))/PCBSIZE;              04960000
          PINY := ABSOLUTE(ABSOLUTE(CPCB)+FATHERL).FATHERF;             04962000
          IF STAK(-STAK(0)-1)<0 THEN GOTO FIN;                          04964000
          IF ABSOLUTE(ABSOLUTE(CPCB)+PROCTYPEL).MAINF=1                 04966000
                                   THEN PINX := 0;                      04968000
          IF ABSOLUTE(ABSOLUTE(PCBB)+PINY*PCBSIZE+PROCTYPEL)            04970000
                     .MAINSJF=2    THEN PINX := 0;                      04972000
  FIN:    UNLOCKJIR(*);                                                 04974000
          CHEKMAILPCB := PINX;                                          04976000
  END;                                                                  04978000
                                                                        04980000
                                                                        04982000
            << >>                                                       04984000
            <<GET THE MAILBOX STATUS RELATIVE TO MAILBOX                04986000
               IN SON                                                   04988000
               00-   NULL                                               04990000
               01-   OUTGOING FROM SON                                  04992000
               02-   INCOMING TO SON                                    04994000
               03-   BLOCKED                                            04996000
               IF BLOCKED THEN AUTO GOES INTO A BLOCKED                 04998000
               (MAIL) WAIT SUBSTATE ELSE RETURNS AND                    05000000
               SETS A BLOCKED CONDITION IN MAILBOX                      05002000
               IF DIRECTION<3                                           05004000
                                                                        05006000
               IN:   PIN  =0 (FATHER)                                   05008000
                          #0 (SON)                                      05010000
                     DIRECTION =0 SEND                                  05012000
                               =1 RECEIVE                               05014000
                               =2 ABORT                                 05016000
                                                                        05018000
               OUT: GETMAILSTATUS := STATUS BITS      >>                05020000
            << >>                                                       05022000
LOGICAL PROCEDURE GETMAILSTATUS(PIN,DIRECTION);                         05024000
  VALUE   PIN,DIRECTION;                                                05026000
  LOGICAL PIN,DIRECTION;                                                05028000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               05030000
  BEGIN                                                                 05032000
          EQUATE     PCBB=3,       <<PCB>>                              05034000
                     CPCB=4,                                            05036000
                     PPCOML=9,                                          05038000
                     BLOKWAIT=%420;  <<BLOCKED MAIL WAIT STATE>>        05040000
          DEFINE     PPCOMF  =(0:5)#,  <<P-P COM>>                      05042000
                     PPWAITF =(1:2)#,                                   05044000
                     PPSTATF =(3:2)#;                                   05046000
          LOGICAL PCBNUM,LOC,SELF,BITS;                                 05048000
          INTEGER X=X;                                                  05050000
            << >>                                                       05052000
  RETRY:  LOC :=  SELF := ABSOLUTE(CPCB);                               05054000
          IF PIN<>0 THEN LOC := ABSOLUTE(PCBB)+PIN*PCBSIZE;             05056000
          X := LOC+PPCOML;                                              05058000
          DISAPROC;                                            <<00652>>05060000
          BITS := ABSOLUTE(X).PPSTATF;                                  05062000
          IF DIRECTION>2 THEN GOTO CONT;                                05064000
          IF BITS=3 THEN                                                05066000
               BEGIN WAIT(BLOKWAIT,0);   <<BLOCKED MAIL WAIT>>          05068000
                     GOTO RETRY;                                        05070000
               END;                                                     05072000
          ABSOLUTE(X).PPSTATF := 3;                                     05074000
  CONT:   ENAPROC;                                             <<00652>>05076000
          TOS := BITS;                                                  05078000
          IF PIN<>0 THEN ASSEMBLE(ZERO; DCSR 1; LSR 14; OR);            05080000
          GETMAILSTATUS := TOS;                                         05082000
  END;                                                                  05084000
                                                                        05086000
                                                                        05088000
            << >>                                                       05090000
            <<SET THE MAILBOX STATUS.                                   05092000
               IF REQUESTED WAIT FOR MAIL                               05094000
               AWAKEN ANY WAITING PROCESS                               05096000
                                                                        05098000
               IN:   PIN=0 FATHER                                       05100000
                        #0 SON                                          05102000
                     BITS=STATUS BITS                                   05104000
                     WAITFLAG=TRUE COND WAIT                            05106000
                              FALSE NO WAIT                             05108000
                     DIRECTION =0 SEND                                  05110000
                               =1 RECEIVE                               05112000
                               =2 ABORT                                 05114000
                                                                        05116000
               OUT:  SETMAILSTATUS := TRUE OK.                          05118000
                                   := FALSE ILLEGAL WAIT      >>        05120000
            << >>                                                       05122000
LOGICAL PROCEDURE SETMAILSTATUS(PIN,BITS,WAITFLAG,DIRECTION);           05124000
  VALUE   PIN,BITS,WAITFLAG,DIRECTION;                                  05126000
  LOGICAL PIN,BITS,WAITFLAG,DIRECTION;                                  05128000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               05130000
  BEGIN                                                                 05132000
          EQUATE     PCBB=3,       <<PCB>>                              05134000
                     CPCB=4,                                            05136000
                     SUBSTATEL=4,                                       05138000
                     FATHERL=5,                                         05140000
                     PPCOML=9,                                          05142000
                     MAILWAIT=%400;  <<MAIL WAIT FIELD>>                05144000
          DEFINE     PPCOMF  =(1:4)#,  <<P-P COM>>                      05146000
                     PPWAITF =(1:2)#,                                   05148000
                     PPSTATF =(3:2)#,                                   05150000
                     FATHERF =(0:8)#,  <<PCB>>                          05152000
                     MAILWAITF=(3:1)#, <<MAIL WAIT BIT>>                05154000
                     BLOKWAITF=(7:1)#, <<BLOCKED MAIL WAIT>>            05156000
                     AWAKEF  =(0:13)#; <<MAIL AWAKE>>                   05158000
          DEFINE  SOFTKILL=ABSOLUTE(ABSOLUTE(CPCB)+9).(11:1)#; <<00142>>05160000
          LOGICAL LOC,SELF,HIM,DSELF,DHIM;                              05162000
          INTEGER X=X;                                                  05164000
            << >>                                                       05166000
          SELF := ABSOLUTE(CPCB);                                       05168000
          IF (DSELF:=DIRECTION) > 2 THEN GO TO FIN1;                    05170000
          IF PIN=0                                                      05172000
            THEN BEGIN LOC := SELF;                                     05174000
                       HIM := ABSOLUTE(PCBB)+PCBSIZE*(ABSOLUTE          05176000
                                   (SELF+FATHERL).FATHERF);             05178000
                 END                                                    05180000
            ELSE BEGIN LOC := HIM := ABSOLUTE(PCBB)+PIN*PCBSIZE;        05182000
                       TOS := BITS;                                     05184000
                       ASSEMBLE( ZERO; DCSR 1; LSR 14; OR);             05186000
                       BITS := TOS;                                     05188000
                       DSELF := DSELF+2;                                05190000
                 END;                                                   05192000
          DISAPROC;                                            <<00652>>05194000
          TOS := ABSOLUTE(HIM+SUBSTATEL);                               05196000
          TOS.MAILWAITF := 0;                                           05198000
          IF = THEN GOTO CONT;                                          05200000
          TOS.BLOKWAITF := 0;                                           05202000
          IF <> THEN GOTO AWAKEN;                                       05204000
          DHIM := ABSOLUTE(HIM+PPCOML).PPWAITF;                         05206000
          IF PIN=0                                                      05208000
            THEN BEGIN IF DHIM<2 THEN GOTO CONT;                        05210000
                       DHIM := DHIM-2;                                  05212000
                 END                                                    05214000
            ELSE IF DHIM>=2 THEN GOTO CONT;                             05216000
          IF WAITFLAG AND DHIM=DIRECTION THEN                           05218000
               BEGIN SETMAILSTATUS := FALSE;                            05220000
                     ABSOLUTE(LOC+PPCOML).PPSTATF:=BITS;       <<00142>>05222000
                     ENAPROC;                                  <<00652>>05224000
                     RETURN;                                            05226000
               END;                                                     05228000
  AWAKEN:                                                               05230000
          ABSOLUTE(HIM+PPCOML).PPWAITF := 0;                            05232000
          AWAKE( HIM-ABSOLUTE(PCBB),%420,0 );                           05234000
  CONT:                                                                 05236000
          ABSOLUTE(LOC+PPCOML).PPSTATF := BITS;                         05238000
          IF NOT WAITFLAG THEN GOTO FIN;                                05240000
          IF DIRECTION=2 THEN GOTO FIN;                                 05242000
          ABSOLUTE(SELF+PPCOML).PPWAITF := DSELF;                       05244000
          IF SOFTKILL THEN ENAPROC ELSE WAIT(MAILWAIT,0);      <<00652>>05246000
          SETMAILSTATUS:=IF SOFTKILL THEN FALSE ELSE TRUE;     <<00142>>05248000
             <<IF S.K. THEN PRODUCE DUMMY ERROR>>              <<00142>>05250000
          RETURN;                                                       05252000
  FIN:    ENAPROC;                                             <<00652>>05254000
  FIN1:   SETMAILSTATUS := TRUE;                                        05256000
  END;                                                                  05258000
                                                                        05260000
                                                                        05262000
            << >>                                                       05264000
            << GET MAILBOX INFO FROM P-P COM TABLE >>                   05266000
            << >>                                                       05268000
DOUBLE PROCEDURE GETMAILINFO(PCBNUM);                                   05270000
  VALUE   PCBNUM;                                                       05272000
  LOGICAL PCBNUM;                                                       05274000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               05276000
  BEGIN                                                                 05278000
          EQUATE     PPCTDSTN=10;  <<P-P COM TABLE>>                    05280000
          INTEGER  T = Q-6;                                             05282000
            << >>                                                       05284000
          TOS := @T;               << DESTINATION >>                    05286000
          TOS := PPCTDSTN;         << DATA SEGMENT >>                   05288000
          TOS := PCBNUM&LSL(1);    << OFFSET IN DS >>                   05290000
          TOS := 2;                << WORD COUNT >>                     05292000
          ASSEMBLE( MFDS 4 );      << MOVE IT >>                        05294000
  END;                                                                  05296000
                                                                        05298000
                                                                        05300000
            << >>                                                       05302000
            << SET MAILBOX INFO IN P-P COM TABLE>>                      05304000
            << >>                                                       05306000
PROCEDURE SETMAILINFO(D,PCBNUM);                                        05308000
  VALUE   D,PCBNUM;                                                     05310000
  LOGICAL PCBNUM;                                                       05312000
  DOUBLE  D;                                                            05314000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               05316000
  BEGIN                                                                 05318000
          EQUATE     PPCTDSTN=10;  <<P-P COM TABLE>>                    05320000
            << >>                                                       05322000
          TOS := PPCTDSTN;  TOS := PCBNUM&LSL(1);                       05324000
          TOS := @D;                                                    05326000
          TOS := 2;                                                     05328000
          ASSEMBLE( MTDS 4 );                                           05330000
  END;                                                                  05332000
                                                                        05334000
                                                                        05336000
            << >>                                                       05338000
            <<ABORT MAILBOX INFORMATION.                                05340000
               CLEAR MAIL AND RELEASE DATA SEGMENT     >>               05342000
            << >>                                                       05344000
PROCEDURE ABORTMAILINFO(PCBNUM);                                        05346000
  VALUE   PCBNUM;                                                       05348000
  LOGICAL PCBNUM;                                                       05350000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               05352000
  BEGIN                                                                 05354000
          TOS := GETMAILINFO(PCBNUM);                                   05356000
          ASSEMBLE(XCH);                                                05358000
          IF TOS=1 THEN DEL ELSE RELDATASEG(*);                         05360000
          SETMAILINFO(0D,PCBNUM);                                       05362000
  END;                                                                  05364000
                                                                        05366000
                                                                        05368000
            << >>                                                       05370000
            <<ABORT MAIL. CALLED AT TERMINATION OF PROCESS.             05372000
               FATHER MAIL                                              05374000
                     - NOT ALIVE   -ABORT ANY MAIL                      05376000
                     - ALIVE       -RESPECTS SEND/BLOCK,ABORT           05378000
                                       ANY OTHER                        05380000
                                   -ABORT ALL IF ABNORMAL               05382000
                                       TERMINATION                      05384000
                     - EITHER      -AWAKEN FATHER IF WAITING            05386000
               SON MAIL                                                 05388000
                     - AWAKEN SONS IF WAITING FOR MAIL     >>           05390000
            << >>                                                       05392000
PROCEDURE ABORTMAIL;                                                    05394000
  OPTION  PRIVILEGED,UNCALLABLE;                                        05396000
  BEGIN                                                                 05398000
          EQUATE     PCBB=3,       <<PCB>>                              05400000
                     CPCB=4,                                            05402000
                     FATHERL=5,    <<PCB TABLE>>                        05404000
                     FIRSTSONL=5,                                       05406000
                     BROTHERL=6,                                        05408000
                     PSIML=8,                                  <<03096>>05410000
                     PXABORTY=12;      <<PCBX>>                         05412000
          DEFINE     FATHERF=(0:8)#,   <<PCB>>                          05414000
                     FIRSTSONF=(8:8)#,                                  05416000
                     BROTHERF=(0:8)#,                                   05418000
                     PSIMF=(0:3)#;                                      05420000
          INTEGER ARRAY STAK(*)=Q+0;                                    05422000
          LOGICAL PIN,PCBNUM,BITS,CODE,CRIT;                            05424000
          INTEGER X=X;                                                  05426000
          SWITCH SW := FREE,OUT,IN,WAIT;                                05428000
          << >>                                                         05430000
          CRIT := SETCRITICAL;                                          05432000
          PIN := 0;                                                     05434000
          PCBNUM := CHEKMAILPCB(PIN);                                   05436000
  AGAIN:  BITS := GETMAILSTATUS(PIN,2);                                 05438000
          GOTO SW(CODE := BITS);                                        05440000
          << >>                                                         05442000
  FREE:   GOTO CONT;                                                    05444000
          << >>                                                         05446000
  OUT:    IF NOT TESTALIVE(PIN) THEN GOTO IN;                           05448000
          IF ABSOLUTE(ABSOLUTE(CPCB)+PSIML).PSIMF<>7 THEN GOTO IN;      05450000
          PUSH(Q,DL);                                                   05452000
          ASSEMBLE(XCH,SUB; DUP,STAX);                                  05454000
          TOS := STAK(X := X-2);                                        05456000
          TOS := TOS-TOS;                                               05458000
          X := TOS+PXABORTY;                                            05460000
          TOS := STAK(X);                                               05462000
          DEL;                                                          05464000
          IF < THEN GOTO IN;                                            05466000
          GOTO WAIT;                                                    05468000
          << >>                                                         05470000
  IN:     ABORTMAILINFO(PCBNUM);                                        05472000
          GOTO CONT;                                                    05474000
          << >>                                                         05476000
  WAIT:   SETMAILSTATUS(PIN,CODE,TRUE,0);                               05478000
          GOTO AGAIN;                                                   05480000
          << >>                                                         05482000
  CONT:   CODE := 0;                                                    05484000
          SETMAILSTATUS(PIN,CODE,FALSE,2);                              05486000
  CONTX:  TOS := LOCKJIR;                                               05488000
          PIN := ABSOLUTE(ABSOLUTE(CPCB)+FIRSTSONL).FIRSTSONF;          05490000
          WHILE PIN<>0 DO                                               05492000
               BEGIN SETMAILSTATUS(PIN,0,FALSE,2);                      05494000
                     PIN := ABSOLUTE(ABSOLUTE(PCBB)+PIN*PCBSIZE         05496000
                                   +BROTHERL).BROTHERF;                 05498000
               END;                                                     05500000
          UNLOCKJIR(*);                                                 05502000
          RESETCRITICAL(CRIT);                                          05504000
  END;                                                                  05506000
                                                                        05508000
                                                                        05510000
            << >>                                                       05512000
<<********************************************************>>            05514000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            05516000
<<********************************************************>>            05518000
            << TEST THE MAILBOX FOR STATUS. IF INCOMING                 05520000
               THEN RETURNS COUNT                                       05522000
                                                                        05524000
               PIN   = 0 FATHER                                         05526000
                     > 0 SON                                            05528000
                                                                        05530000
               MAIL   :=  0 - NULL                                      05532000
                       1 - OUTGOING                                     05534000
                       2 - INCOMING                                     05536000
                       3 - ERROR                                        05538000
                       4 - BLOCKED                                      05540000
               COUNT  :=  # OF WORDS OF MAIL                            05542000
                                                                        05544000
               CODE: CC=0 OK.                                           05546000
                     CC>0 NO.  - ILLEGAL PIN(3)                         05548000
                     CC<0 (NULL)       >>                               05550000
<<********************************************************>>            05552000
            << >>                                                       05554000
LOGICAL PROCEDURE MAIL(PIN,COUNT);                                      05556000
  VALUE   PIN;                                                          05558000
  INTEGER PIN,COUNT;                                                    05560000
    OPTION PRIVILEGED;                                                  05562000
  BEGIN                                                                 05564000
          EQUATE ERRN=106, CAP1=1, EXITN=2;                             05566000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               05568000
          EQUATE CCE=2,                                                 05570000
                 CCG=0,                                                 05572000
                 CCL=1;                                                 05574000
          DEFINE     CCFLD=(6:2)#;                                      05576000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                05578000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             05580000
          SWITCH SW := FREE,OUT,IN,BLOK;                                05582000
          << >>                                                         05584000
          ERRORON;                                                      05586000
          CHEK(ERREX,%102,%10D,DOUBLE(CAP1));                           05588000
          CRIT := SETCRITICAL;                                          05590000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        05592000
  ILL:         BEGIN CCERR := CCG;                                      05594000
                     BITS := 3;                                         05596000
                     GOTO FINX;                                         05598000
               END;                                                     05600000
          BITS := GETMAILSTATUS(PIN,3);                                 05602000
          GOTO SW(CODE := BITS);                                        05604000
          << >>                                                         05606000
  FREE:   IF NOT TESTALIVE(PIN) THEN GOTO ILLX;                         05608000
          GOTO FIN;                                                     05610000
            << >>                                                       05612000
  OUT:    IF NOT TESTALIVE(PIN) THEN GOTO ILLX;                         05614000
          GOTO FIN;                                                     05616000
            << >>                                                       05618000
  IN:     IF PIN=0 AND NOT TESTALIVE(PIN) THEN GOTO ILLX;               05620000
          TOS := GETMAILINFO(PCBNUM);                                   05622000
          DEL;                                                          05624000
          COUNT := TOS;                                                 05626000
          GOTO FIN;                                                     05628000
          << >>                                                         05630000
  BLOK:   BITS := 4;                                                    05632000
          GOTO FIN;                                                     05634000
          << >>                                                         05636000
  ILLX:   CCERR := CCG;                                                 05638000
          BITS := 3;                                                    05640000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,3);                              05642000
  FINX:   STATUS.CCFLD := CCERR;                                        05644000
          MAIL := BITS;                                                 05646000
          RESETCRITICAL(CRIT);                                          05648000
          ERROREXIT(ERREX,0,0);                                         05650000
  END;                                                                  05652000
                                                                        05654000
                                                                        05656000
            << >>                                                       05658000
<<********************************************************>>            05660000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            05662000
<<********************************************************>>            05664000
            <<PREPARE AND SEND THE MAIL.                                05666000
               STATUS IS RETURNED TO INDICATE COMPLETION OR             05668000
               OTHERWISE. ANY PREVIOUS MAIL WHICH WAS SENT              05670000
               BUT NOT COLLECTED,IS EITHER AUTO OVERWRITTEN             05672000
               WITH THE NEW MAIL OR ALLOWED TO BE COLLECTED             05674000
               BEFORE CONTINUING THE REQUEST,DEPENDING ON THE           05676000
               VALUE OF WAITFLAG. THE MAILBOX MAY ALSO BE               05678000
               EXPLICITELY CLEARED. A BLOCKED CONDITION CAUSES          05680000
               AN EXPLICIT "WAIT" UNTIL READY                           05682000
                                                                        05684000
               PIN   =0 FATHER                                          05686000
                     <>0 SON                                            05688000
               LENGTH = LENGTH OF TRANSFER                              05690000
               LOCATION = ADDRESS OF MAIL                               05692000
               WAITFLAG =TRUE WAIT UNTIL PREVIOUS MAIL SENT             05694000
                        =FALSE OVERWRITE PREVIOUS MAIL                  05696000
                                                                        05698000
               SENDMAIL  :=  0 - OK SEND COMPLETED                      05700000
                          1 - OK OVERWRITE OR CLEAR                     05702000
                          2 - INCOMING                                  05704000
                          3 - ERROR                                     05706000
                          4 - NOWAIT                                    05708000
                          5 - MAXDATA                                   05710000
                          6 - RESOURCE                                  05712000
                                                                        05714000
               CODE: CC=0 OK.                                           05716000
                     CC>0 NO.  - ILLEGAL PIN(3)                         05718000
                               - ILLEGAL 0>LENGTH>SYS MAX(5)            05720000
                               - STORAGE RESOURCE UNAVAILABLE(6)        05722000
                     CC<0 NO.  - BOUNDS FAILURE(3)                      05724000
                               - BOTH PROCESSES WAITING TO SEND(4) >>   05726000
<<********************************************************>>            05728000
            << >>                                                       05730000
LOGICAL PROCEDURE SENDMAIL(PIN,LENGTH,LOCATION,WAITFLAG);               05732000
  VALUE   PIN,LENGTH,WAITFLAG;                                          05734000
  LOGICAL WAITFLAG;                                                     05736000
  INTEGER PIN,LENGTH;                                                   05738000
  ARRAY   LOCATION;                                                     05740000
  OPTION  PRIVILEGED;                                                   05742000
  BEGIN                                                                 05744000
          EQUATE ERRN=107, CAP1=1, EXITN=4;                             05746000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               05748000
          EQUATE BOUND=-EXITN-4;                                        05750000
          EQUATE CCE=2,                                                 05752000
                 CCG=0,                                                 05754000
                 CCL=1;                                                 05756000
          EQUATE     MAXDSEG=3;                                         05758000
          DEFINE     CCFLD=(6:2)#;                                      05760000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                05762000
          DOUBLE DD;                                                    05764000
          INTEGER COUNT=DD;                                             05766000
          LOGICAL DSTX=DD+1;                                            05768000
          INTEGER LOC=Q-5;                                              05770000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             05772000
          SWITCH SW := FREE,OUT,IN,WAIT;                                05774000
            << >>                                                       05776000
          ERRORON;                                                      05778000
          CHEK(ERREX,%104,%40D,DOUBLE(CAP1));                           05780000
          CRIT := SETCRITICAL;                                          05782000
          IF LENGTH<0 OR LENGTH>ABSOLUTE(MAXDSEG) THEN                  05784000
               BEGIN CCERR := CCG;                                      05786000
                     BITS := 5;                                         05788000
                     GOTO FINX;                                         05790000
               END;                                                     05792000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        05794000
  ILL:         BEGIN CCERR := CCG;                                      05796000
                     BITS := 3;                                         05798000
                     GOTO FINX;                                         05800000
               END;                                                     05802000
  AGAIN:  BITS := GETMAILSTATUS(PIN,0);                                 05804000
          GOTO SW(CODE := BITS);                                        05806000
            << >>                                                       05808000
  FREE:   IF NOT TESTALIVE(PIN) THEN                                    05810000
               BEGIN CCERR := CCG;                                      05812000
                     BITS := 3;                                         05814000
                     GOTO FIN;                                          05816000
               END;                                                     05818000
          IF LENGTH=0 THEN GOTO FIN;                                    05820000
          IF LENGTH=1 THEN                                              05822000
               BEGIN DSTX := LOCATION;                                  05824000
                     GOTO FINY;                                         05826000
               END;                                                     05828000
          COUNT := (LENGTH+3)&LSR(2)&LSL(2);                            05830000
          IF (DSTX := GETDATASEG(COUNT,0))=0 THEN                       05832000
               BEGIN CCERR := CCG;                                      05834000
                     BITS := 6;                                         05836000
                     GOTO FIN;                                          05838000
               END;                                                     05840000
          TOS := DMOVE(DSTX,0,LENGTH,LOC,FALSE,BOUND);                  05842000
          IF TOS<>CCE THEN                                              05844000
               BEGIN RELDATASEG(DSTX);                                  05846000
                     CCERR := CCL;                                      05848000
                     BITS := 3;                                         05850000
                     GOTO FIN;                                          05852000
               END;                                                     05854000
  FINY:   COUNT := LENGTH;                                              05856000
          SETMAILINFO(DD,PCBNUM);                                       05858000
          CODE := 1;                                                    05860000
          GOTO FIN;                                                     05862000
            << >>                                                       05864000
  OUT:    IF WAITFLAG THEN GOTO WAIT;                                   05866000
          ABORTMAILINFO(PCBNUM);                                        05868000
          IF LENGTH<>0 THEN GOTO FREE;                                  05870000
          CODE := 0;                                                    05872000
          GOTO FIN;                                                     05874000
            << >>                                                       05876000
  IN:     IF LENGTH <> 0 THEN  GO FIN;                                  05878000
          ABORTMAILINFO(PCBNUM);                                        05880000
          CODE := 0;                                                    05882000
          SETMAILSTATUS(PIN,CODE,FALSE,1);                              05884000
          BITS := 1;                                                    05886000
          GO  FINX;                                                     05888000
            << >>                                                       05890000
  WAIT:   IF NOT SETMAILSTATUS(PIN,CODE,TRUE,0) THEN                    05892000
               BEGIN CCERR := CCL;                                      05894000
                     BITS := 4;                                         05896000
                     GOTO FINX;                                         05898000
               END;                                                     05900000
          GOTO AGAIN;                                                   05902000
            << >>                                                       05904000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,0);                              05906000
  FINX:   STATUS.CCFLD := CCERR;                                        05908000
          SENDMAIL := BITS;                                             05910000
          RESETCRITICAL(CRIT);                                          05912000
          ERROREXIT(ERREX,0,0);                                         05914000
  END;                                                                  05916000
                                                                        05918000
                                                                        05920000
            << >>                                                       05922000
<<********************************************************>>            05924000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            05926000
<<********************************************************>>            05928000
            << RECEIVE THE INCOMING MAIL.                               05930000
               STATUS IS RETURNED TO INDICATE RECEIPT OR                05932000
               OTHERWISE.THE PARAMETER WAITFLAG DETERMINES THE          05934000
               ACTION TAKEN IF THE MAILBOX IS EMPTY - WAIT              05936000
               OR RETURN.A BLOCKED CONDITION CAUSES AN                  05938000
               EXPLICIT "WAIT" UNTIL READY.                             05940000
                                                                        05942000
               PIN   = 0 FATHER                                         05944000
                     <>0 SON                                            05946000
               LOCATION = RECEIVER'S BUFFER ADDRESS                     05948000
               WAITFLAG =TRUE  WAIT FOR MAIL                            05950000
                        =FALSE RETURN                                   05952000
                                                                        05954000
               RECEIVEMAIL  :=  0 - NULL                                05956000
                             1 - OUTGOING                               05958000
                             2 - OK MAIL RECEIVED                       05960000
                             3 - ERROR                                  05962000
                             4 - NOWAIT                                 05964000
                                                                        05966000
               CODE: CC=0 OK.                                           05968000
                     CC>0 NO.  - ILLEGAL PIN(3)                         05970000
                     CC<0 NO.  - BOUNDS FAILURE(3)                      05972000
                               - BOTH WAITING TO RECEIVE(4)  >>         05974000
<<********************************************************>>            05976000
            << >>                                                       05978000
LOGICAL PROCEDURE RECEIVEMAIL(PIN,LOCATION,WAITFLAG);                   05980000
  VALUE   PIN,WAITFLAG;                                                 05982000
  LOGICAL WAITFLAG;                                                     05984000
  INTEGER PIN;                                                          05986000
  ARRAY   LOCATION;                                                     05988000
  OPTION  PRIVILEGED;                                                   05990000
  BEGIN                                                                 05992000
          EQUATE ERRN=108, CAP1=1, EXITN=3;                             05994000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               05996000
          EQUATE BOUND=-EXITN-4;                                        05998000
          EQUATE CCE=2,                                                 06000000
                 CCG=0,                                                 06002000
                 CCL=1;                                                 06004000
          DEFINE     CCFLD=(6:2)#;                                      06006000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                06008000
          DOUBLE DD;                                                    06010000
          INTEGER COUNT=DD;                                             06012000
          LOGICAL DSTX=DD+1;                                            06014000
          INTEGER LOC=Q-5;                                              06016000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             06018000
          SWITCH SW := FREE,OUT,IN,WAIT;                                06020000
            << >>                                                       06022000
          ERRORON;                                                      06024000
          CHEK(ERREX,%103,%10D,DOUBLE(CAP1));                           06026000
          CRIT := SETCRITICAL;                                          06028000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        06030000
  ILL:         BEGIN CCERR := CCG;                                      06032000
                     BITS := 3;                                         06034000
                     GOTO FINX;                                         06036000
               END;                                                     06038000
  AGAIN:  BITS := GETMAILSTATUS(PIN,1);                                 06040000
          GOTO SW(CODE := BITS);                                        06042000
            << >>                                                       06044000
  FREE:   IF NOT WAITFLAG THEN  GO FIN;                                 06046000
          IF NOT TESTALIVE(PIN) THEN                                    06048000
             BEGIN                                                      06050000
             CCERR := CCG;                                              06052000
             BITS := 3;                                                 06054000
             GO FIN;                                                    06056000
             END;                                                       06058000
          GO WAIT;                                                      06060000
            << >>                                                       06062000
  OUT:    GOTO FIN;                                                     06064000
            << >>                                                       06066000
  IN:     IF PIN=0 AND NOT TESTALIVE(PIN) THEN                          06068000
               BEGIN CCERR := CCG;                                      06070000
                     BITS := 3;                                         06072000
                     GOTO FIN;                                          06074000
               END;                                                     06076000
          DD := GETMAILINFO(PCBNUM);                                    06078000
          IF COUNT=1 THEN                                               06080000
               BEGIN LOCATION := DSTX;                                  06082000
                     GOTO FINY;                                         06084000
               END;                                                     06086000
          TOS := DMOVE(DSTX,0,COUNT,LOC,TRUE,BOUND);                    06088000
          IF TOS<>CCE THEN                                              06090000
               BEGIN CCERR := CCL;                                      06092000
                     BITS := 3;                                         06094000
                     GOTO FIN;                                          06096000
               END;                                                     06098000
  FINY:   ABORTMAILINFO(PCBNUM);                                        06100000
          CODE := 0;                                                    06102000
          GOTO FIN;                                                     06104000
            << >>                                                       06106000
  WAIT:   IF NOT SETMAILSTATUS(PIN,CODE,TRUE,1) THEN                    06108000
               BEGIN CCERR := CCL;                                      06110000
                     BITS := 4;                                         06112000
                     GOTO FINX;                                         06114000
               END;                                                     06116000
          GOTO AGAIN;                                                   06118000
            << >>                                                       06120000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,1);                              06122000
  FINX:   STATUS.CCFLD := CCERR;                                        06124000
          RECEIVEMAIL := BITS;                                          06126000
          RESETCRITICAL(CRIT);                                          06128000
          ERROREXIT(ERREX,0,0);                                         06130000
          HELP; << DUMMY CALL TO LINK BREAKPOINTS >>                    06132000
  END;                                                                  06134000
                                                                        06136000
                                                                        06138000
                                                                        06140000
                                                                        06142000
$CONTROL SEGMENT=MAIN                                                   06144000
SHOWMQ;                                                        <<01549>>06146000
END.  << PROCSEG >>                                            <<00652>>06148000
