<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$CONTROL LIST,USLINIT,CODE,MAP                                 <<01604>>00010000
<<PROCSEG - MODULE 60    >>                                             00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$CONTROL MAIN=PROCSEG                                          <<00652>>00060000
$CONTROL SEGMENT=PROCSEG                                       <<00652>>00065000
BEGIN                                                                   00070000
DEFINE   DISAPROC = ASSEMBLE( PSDB )#,                                  00075000
         ENAPROC = ASSEMBLE( PSEB )#,                                   00080000
         DISABLE = ASSEMBLE( SED 0 )#,                                  00085000
         ENABLE = ASSEMBLE( SED 1 )#;                          <<00652>>00090000
EQUATE                                                         <<06644>>00095000
        QI  = 5,                                               <<03048>>00100000
         CCG  = 0,                                             <<00652>>00105000
         CCL  = 1,                                             <<00652>>00110000
         CCE  = 2;                                             <<00652>>00115000
                                                                        00120000
$INCLUDE INCLPCB5                                              <<06644>>00125000
$INCLUDE INCLICS                                               <<06644>>00130000
                                                           <<*DISP*00*>>00135000
DEFINE                                                         <<06644>>00140000
          QTYPE     = (2:3)#,                              <<*DISP*00*>>00145000
          CQ        = (3:1)#,                              <<*DISP*00*>>00150000
          DQ        = (4:1)#,                              <<*DISP*00*>>00155000
          EQ        = (1:1)#,                              <<*DISP*00*>>00160000
          LQ        = (2:1)#,                              <<*DISP*00*>>00165000
          EQ'       = (5:1)#,   << NOT IN PCB >>           <<*DISP*00*>>00170000
          PTYPE     = (6:2)#,                              <<*DISP*00*>>00175000
          LTYPE     = (0:2)#,                              <<*DISP*00*>>00180000
          PIN'      = (8:8)#,                              <<*DISP*00*>>00185000
          JTYPE     = (0:2)#,                              <<*DISP*00*>>00190000
          JNUM      = (2:14)#;                             <<*DISP*00*>>00195000
                                                                        00200000
POINTER  PCB = 3;                                                       00205000
INTEGER POINTER  PCBI = 3;                                              00210000
                                                                        00215000
INTEGER                                                        <<04153>>00220000
  STATUS        = Q-1,                                                  00225000
  S0            = S-0,                                         <<06630>>00230000
  X             = X;                                                    00235000
                                                                        00240000
LOGICAL                                                        <<06644>>00245000
                                                               <<06644>>00250000
  LS0 = S - 0;                                                 <<06644>>00255000
                                                                        00260000
                                                               <<03048>>00265000
<<STACKDB and SBANK for the current process are obtained         HM.XX  00270000
  from the two words preceding the dispatcher marker on          HM.XX  00275000
  the interrupt control stack.>>                               <<03048>>00280000
DEFINE CHECKDB =                                               <<03048>>00285000
   DISABLE;                                                    <<03048>>00290000
   PUSH(DB);                                                   <<03048>>00295000
   X := ABSOLUTE(QI)-5;                                        <<03048>>00300000
   TOS := ABSOLUTE(X);                                         <<03048>>00305000
   X := X+1;                                                   <<03048>>00310000
   TOS := ABSOLUTE(X);                                         <<03048>>00315000
   ENABLE;                                                     <<03048>>00320000
   ASSEMBLE(DCMP)#;                                            <<03048>>00325000
$INCLUDE INCLRINS                                              <<06271>>00330000
ARRAY QARRAY(*) = Q+0;                                         <<*7771>>00335000
$INCLUDE INCLPXDL                                              <<*7771>>00340000
$INCLUDE INCLPXGT                                              <<*7771>>00345000
$INCLUDE INCLPXFT                                              <<*7771>>00350000
$INCLUDE INCLTRL                                               <<sktrl  00355000
$INCLUDE INCLJIT                                               <<06880>>00360000
                                                                        00365000
DOUBLE PROCEDURE BUILDSEGID(SEGTYPE,SEGNUMBER,PIN);            <<06657>>00370000
VALUE SEGTYPE,SEGNUMBER,PIN;                                   <<04523>>00375000
INTEGER SEGTYPE,SEGNUMBER,PIN;                                 <<04523>>00380000
OPTION EXTERNAL;                                               <<04523>>00385000
<<----------------------------------------------------->>      <<04523>>00390000
LOGICAL PROCEDURE MARKER'IS'SL'SEG(STATUS',DELTAP,PCBPT);      <<07364>>00395000
VALUE PCBPT,STATUS',DELTAP;                                    <<07364>>00400000
INTEGER PCBPT,STATUS',DELTAP;                                  <<07364>>00405000
OPTION EXTERNAL;                                               <<06350>>00410000
<<----------------------------------------------------->>      <<06350>>00415000
PROCEDURE FREEZESEG'(OBJIDENT,BLOCKEDLOCK);                    <<06657>>00420000
VALUE OBJIDENT,BLOCKEDLOCK;                                    <<06657>>00425000
DOUBLE OBJIDENT;                                               <<06657>>00430000
LOGICAL BLOCKEDLOCK;                                           <<04523>>00435000
OPTION EXTERNAL;                                               <<04523>>00440000
<<----------------------------------------------------->>      <<04523>>00445000
INTEGER PROCEDURE CONVSEGIDTOSTINX(OBJIDENT);                  <<06657>>00450000
VALUE OBJIDENT;                                                <<06657>>00455000
DOUBLE OBJIDENT;                                               <<06657>>00460000
OPTION EXTERNAL;                                               <<04523>>00465000
<<----------------------------------------------------->>      <<04523>>00470000
PROCEDURE UNFREEZESEG'(OBJIDENT);                              <<06657>>00475000
VALUE OBJIDENT;                                                <<06657>>00480000
DOUBLE OBJIDENT;                                               <<06657>>00485000
OPTION EXTERNAL;                                               <<04523>>00490000
$PAGE "  "                                                     <<01630>>00495000
<<------------------------------------------------------------------->> 00500000
                                                                        00505000
PROCEDURE HELP; OPTION EXTERNAL;                                        00510000
                                                                        00515000
<<------------------------------------------------------------------->> 00520000
                                                                        00525000
PROCEDURE SUDDENDEATH(N);VALUE N;INTEGER N;OPTION EXTERNAL;             00530000
                                                                        00535000
<<------------------------------------------------------------------->> 00540000
                                                                        00545000
INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                             00550000
VALUE WORD,BASE;DOUBLE WORD;INTEGER BASE;BYTE ARRAY STRING;             00555000
OPTION EXTERNAL;                                                        00560000
                                                                        00565000
<<------------------------------------------------------------------->> 00570000
                                                           <<*DISP*00*>>00575000
INTEGER PROCEDURE ASCII(WORD,BASE,STRING);                 <<*DISP*00*>>00580000
VALUE WORD,BASE; INTEGER WORD,BASE; BYTE ARRAY STRING;     <<*DISP*00*>>00585000
OPTION EXTERNAL;                                           <<*DISP*00*>>00590000
                                                           <<*DISP*00*>>00595000
<<------------------------------------------------------------------->> 00600000
                                                                        00605000
                                                                        00610000
<<------------------------------------------------------------------->> 00615000
                                                                        00620000
INTEGER PROCEDURE FAMILY(P,LP);VALUE P,LP;INTEGER P,LP;                 00625000
OPTION EXTERNAL;                                                        00630000
                                                                        00635000
<<------------------------------------------------------------------->> 00640000
                                                                        00645000
PROCEDURE PRINT(MESSAGE,LENGHT,CONTROL);                                00650000
VALUE LENGHT,CONTROL;ARRAY MESSAGE;INTEGER LENGHT,CONTROL;              00655000
OPTION EXTERNAL;                                                        00660000
                                                                        00665000
<<------------------------------------------------------------------->> 00670000
                                                                        00675000
PROCEDURE ERROREXIT(N,M,P);VALUE N,M,P;INTEGER N,M,P;                   00680000
OPTION EXTERNAL;                                                        00685000
                                                                        00690000
<<------------------------------------------------------------------->> 00695000
                                                                        00700000
PROCEDURE ERRORON;OPTION EXTERNAL;                                      00705000
                                                                        00710000
<<------------------------------------------------------------------->> 00715000
                                                                        00720000
LOGICAL PROCEDURE ERRORGET (LEVEL);                                     00725000
  VALUE LEVEL;                                                          00730000
  INTEGER LEVEL;                                                        00735000
  OPTION EXTERNAL;                                                      00740000
                                                                        00745000
<<--------------------------------------------------------->>           00750000
                                                                        00755000
DOUBLE PROCEDURE CHEK(INT,FL,PARM,CAPM,OVM);                            00760000
VALUE INT,FL,PARM,CAPM,OVM;                                             00765000
LOGICAL INT,FL,OVM; DOUBLE PARM,CAPM;                                   00770000
OPTION EXTERNAL,VARIABLE;                                               00775000
                                                                        00780000
<<------------------------------------------------------------------->> 00785000
                                                                        00790000
DOUBLE PROCEDURE CHEK'NOABORT (INTRINSIC, FLAGS, PARMS,                 00795000
                               CAPMASK, OPTVMASK);                      00800000
  VALUE INTRINSIC, FLAGS, PARMS, CAPMASK, OPTVMASK;                     00805000
  LOGICAL INTRINSIC, FLAGS, OPTVMASK;                                   00810000
  DOUBLE PARMS, CAPMASK;                                                00815000
  OPTION VARIABLE, PRIVILEGED, UNCALLABLE, EXTERNAL;                    00820000
                                                                        00825000
<<--------------------------------------------------------->>           00830000
                                                                        00835000
PROCEDURE ABORTPROCIO(PIN);VALUE PIN;INTEGER PIN;OPTION EXTERNAL;       00840000
<<------------------------------------------------------------------->> 00845000
                                                                        00850000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         00855000
VALUE PCBPT,N,WAITF;INTEGER PCBPT,N,WAITF;                              00860000
OPTION EXTERNAL;                                                        00865000
                                                                        00870000
<<------------------------------------------------------------------->> 00875000
                                                                        00880000
PROCEDURE RESETDB(A);VALUE A;LOGICAL A;OPTION EXTERNAL;                 00885000
                                                                        00890000
<<------------------------------------------------------------------->> 00895000
                                                                        00900000
LOGICAL PROCEDURE SETCRITICAL; OPTION EXTERNAL;                         00905000
                                                                        00910000
<<------------------------------------------------------------------->> 00915000
                                                                        00920000
PROCEDURE RESETCRITICAL(A);VALUE A;LOGICAL A;OPTION EXTERNAL;           00925000
                                                                        00930000
<<------------------------------------------------------------------->> 00935000
                                                                        00940000
LOGICAL PROCEDURE SETSYSDB; OPTION EXTERNAL;                            00945000
                                                                        00950000
<<------------------------------------------------------------------->> 00955000
                                                                        00960000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);VALUE DSTX;LOGICAL DSTX;             00965000
OPTION EXTERNAL;                                                        00970000
                                                                        00975000
<<------------------------------------------------------------------->> 00980000
                                                                        00985000
LOGICAL PROCEDURE GETSIR(A);VALUE A;LOGICAL A;OPTION EXTERNAL;          00990000
                                                                        00995000
<<------------------------------------------------------------------->> 01000000
                                                                        01005000
PROCEDURE RELSIR(A,B);VALUE A,B;LOGICAL A,B;OPTION EXTERNAL;            01010000
                                                                        01015000
<<------------------------------------------------------------------->> 01020000
                                                                        01025000
PROCEDURE WAIT(WF,JPCNTX);VALUE WF,JPCNTX;INTEGER WF,JPCNTX;            01030000
OPTION EXTERNAL;                                                        01035000
                                                                        01040000
<<------------------------------------------------------------------->> 01045000
                                                                        01050000
PROCEDURE BURRYPROC(PIN);VALUE PIN;INTEGER PIN;OPTION EXTERNAL;         01055000
                                                                        01060000
<<------------------------------------------------------------------->> 01065000
                                                                        01070000
DOUBLE PROCEDURE TIMER; OPTION EXTERNAL;                                01075000
                                                                        01080000
<<------------------------------------------------------------------->> 01085000
                                                                        01090000
PROCEDURE  SETJCW(A);                                                   01095000
VALUE A;  LOGICAL A;                                                    01100000
OPTION EXTERNAL;                                                        01105000
                                                                        01110000
<<------------------------------------------------------------------->> 01115000
                                                                        01120000
PROCEDURE  SET'PSIF(P,B);                                               01125000
VALUE P,B; INTEGER P,B;                                                 01130000
OPTION EXTERNAL;                                                        01135000
                                                                        01140000
<<------------------------------------------------------------------->> 01145000
                                                                        01150000
PROCEDURE  CLEAR'PSIF(P,B);                                             01155000
VALUE P,B; INTEGER P,B;                                                 01160000
OPTION EXTERNAL;                                                        01165000
                                                                        01170000
<<------------------------------------------------------------------->> 01175000
                                                                        01180000
PROCEDURE DELAY(T);                                                     01185000
VALUE T; DOUBLE T;                                                      01190000
OPTION EXTERNAL;                                                        01195000
                                                                        01200000
<<------------------------------------------------------------------->> 01205000
                                                           <<*DISP*00*>>01210000
INTEGER PROCEDURE ZSIZE(SIZE);                             <<*DISP*00*>>01215000
  VALUE SIZE; INTEGER SIZE;                                <<*DISP*00*>>01220000
  OPTION EXTERNAL;                                         <<*DISP*00*>>01225000
                                                           <<*DISP*00*>>01230000
<<------------------------------------------------------------------->> 01235000
                                                               <<DS.06>>01240000
LOGICAL PROCEDURE DSBREAK(TYPE,MAINPIN);                       <<DS.06>>01245000
  VALUE TYPE,MAINPIN; INTEGER TYPE,MAINPIN;                    <<DS.06>>01250000
  OPTION EXTERNAL;                                             <<DS.06>>01255000
                                                               <<DS.06>>01260000
<<------------------------------------------------------------------->> 01265000
                                                                        01270000
LOGICAL PROCEDURE CHEKTRLFREE;                             <<1.01>>     01275000
  OPTION EXTERNAL;                                         <<1.01>>     01280000
                                                                        01285000
<<--------------------------------------------------------------->>     01290000
                                                                        01295000
PROCEDURE REMRITENTRY'(PIN,FLAG);                              <<01399>>01300000
   VALUE PIN, FLAG; INTEGER PIN, FLAG;                         <<01399>>01305000
   OPTION EXTERNAL;                                            <<01399>>01310000
                                                               <<01399>>01315000
<<-------------------------------------------------------->>   <<00652>>01320000
LOGICAL PROCEDURE LOCKJIR;                                     <<00652>>01325000
  OPTION EXTERNAL;                                             <<00652>>01330000
<<-------------------------------------------------------->>   <<00652>>01335000
LOGICAL PROCEDURE TIMEOUT(DELAY,ALLOWSOFTINT);                 <<03048>>01340000
VALUE DELAY,ALLOWSOFTINT;                                      <<03048>>01345000
DOUBLE DELAY;                                                  <<03048>>01350000
LOGICAL ALLOWSOFTINT;                                          <<03048>>01355000
OPTION EXTERNAL;                                               <<03048>>01360000
<<-------------------------------------------------------->>   <<00652>>01365000
PROCEDURE UNLOCKJIR(B);                                        <<00652>>01370000
  VALUE B;LOGICAL B;OPTION EXTERNAL;                           <<00652>>01375000
<<-------------------------------------------------------->>   <<00652>>01380000
LOGICAL PROCEDURE DMOVE(X,D,N,L,F,M);                          <<00652>>01385000
  VALUE X,D,N,L,F,M;LOGICAL X,F;INTEGER D,N,L,M;               <<00652>>01390000
  OPTION EXTERNAL;                                             <<00652>>01395000
<<-------------------------------------------------------->>   <<00652>>01400000
LOGICAL PROCEDURE GETDATASEG(N,T);                             <<00652>>01405000
  VALUE   N,T;                                                 <<00652>>01410000
  INTEGER N,T;                                                 <<00652>>01415000
  OPTION EXTERNAL;                                             <<00652>>01420000
<<-------------------------------------------------------->>   <<00652>>01425000
PROCEDURE RELDATASEG(X);                                       <<00652>>01430000
  VALUE X; LOGICAL X; OPTION EXTERNAL;                         <<00652>>01435000
<<-------------------------------------------------------->>   <<00652>>01440000
LOGICAL PROCEDURE CHECKALIVE (PIN); VALUE PIN; INTEGER PIN;    <<01873>>01445000
OPTION EXTERNAL;                                               <<01873>>01450000
<<-------------------------------------------------------->>   <<01873>>01455000
PROCEDURE PROCFILE (PIN,FNAME);                                         01460000
 VALUE PIN;                                                             01465000
 INTEGER PIN;                                                           01470000
 BYTE ARRAY FNAME;                                                      01475000
 OPTION EXTERNAL;                                                       01480000
<<--------------------------------------------------------->>           01485000
PROCEDURE PINJOBMAP(PIN,FJINFO,RJINFO);                        <<06644>>01490000
VALUE PIN;                                                     <<06644>>01495000
LOGICAL PIN,RJINFO;                                            <<06644>>01500000
BYTE ARRAY FJINFO;                                             <<06644>>01505000
OPTION EXTERNAL;                                               <<06644>>01510000
                                                               <<06644>>01515000
LOGICAL PROCEDURE TESTALIVE(PIN);                              <<07312>>01520000
   VALUE PIN;                                                  <<07312>>01525000
   LOGICAL PIN;                                                <<07312>>01530000
   OPTION FORWARD;                                             <<07312>>01535000
                                                               <<07312>>01540000
                                                               <<07312>>01545000
INTEGER PROCEDURE GETORIGIN;                                            01550000
OPTION PRIVILEGED;                                                      01555000
                                                                        01560000
COMMENT: RETURNS THE ORIGIN OF THE LAST EFFECTIVE ACTIVATUON            01565000
         OF THE CALLER PROCESS.                                         01570000
                                                                        01575000
            1:    ACTIVATION FROM FATHER.                               01580000
            2:    ACTIVATION FROM ONE OF THE SONS.                      01585000
            0:    ACTIVATION FROM SOME OTHER SOURCE.                    01590000
                                                                        01595000
      ;                                                                 01600000
                                                                        01605000
GETORIGIN := PCB(CURPRC+PIINFOWORDNUM)                         <<06644>>01610000
    .OAFIELD;                                                           01615000
$PAGE "PROCEDURE PROCINFO - DEFINITION"                                 01620000
PROCEDURE PROCINFO (ERROR1, ERROR2, PIN, OPTION1, ITEM1,                01625000
                                         OPTION2, ITEM2,                01630000
                                         OPTION3, ITEM3,                01635000
                                         OPTION4, ITEM4,                01640000
                                         OPTION5, ITEM5,                01645000
                                         OPTION6, ITEM6);               01650000
                                                                        01655000
  VALUE PIN, OPTION1, OPTION2, OPTION3, OPTION4, OPTION5, OPTION6 ;     01660000
  INTEGER ERROR1,ERROR2,PIN, OPTION1, OPTION2, OPTION3, OPTION4,        01665000
          OPTION5, OPTION6;                                             01670000
  BYTE ARRAY ITEM1, ITEM2, ITEM3, ITEM4, ITEM5, ITEM6;                  01675000
  OPTION PRIVILEGED,VARIABLE;                                           01680000
                                                                        01685000
  COMMENT: PROCINFO is an extendable procedure which will               01690000
  return process related information to the non-privileged              01695000
  or privileged user.                                                   01700000
                                                                        01705000
  Inputs:                                                               01710000
                                                                        01715000
  PIN:     An integer specifying the process identification             01720000
           number for which information is to be returned.              01725000
           A PIN of 0 will return information about the                 01730000
           calling process.                                             01735000
                                                                        01740000
  OPTIONn: An integer containing the item number (in any order)         01745000
           of the information option the caller wishes to               01750000
           have returned.  These are described below.                   01755000
                                                                        01760000
  Outputs:                                                              01765000
                                                                        01770000
  ERROR1:  An integer indicating the success or failure of the          01775000
           call.  Returned values are described below.                  01780000
                                                                        01785000
  ERROR2:  An integer which supplies additional information             01790000
           about the error specified in ERROR1.  Values are             01795000
           dependant on ERROR1.                                         01800000
                                                                        01805000
  Input/Output:                                                         01810000
                                                                        01815000
  ITEMn:   An array whose elements correspond to the option             01820000
           specified in the OPTIONn integer of the same index.          01825000
           Sometimes an ITEM element will be set by the                 01830000
           caller to point to where he wishes the data                  01835000
           returned, othertimes the information will be                 01840000
           in the ITEM element.  Which method that is used              01845000
           depends on the option.                                       01850000
                                                                        01855000
  Condition codes returned:                                             01860000
                                                                        01865000
  CCE:       Successful - ERROR1 and ERROR2 = 0                         01870000
  CCG:       Not returned by this intrinsic                             01875000
  CCL:       Unsuccessful - ERROR1 and ERROR2 set accordingly;          01880000
                                                                        01885000
$PAGE "PROCEDURE PROCINFO - DECLARATIONS"                               01890000
  BEGIN                                                                 01895000
                                                                        01900000
  <<Configuration values>>                                              01905000
  EQUATE                                                                01910000
    REQSTKSIZE         = 22,         <<PROCINFO needs 20 words...>>     01915000
    INTRINSIC'NUM      = 100,        <<is intrinsic # 100...>>          01920000
    NUM'PARMS          = 15,         <<has fifteen parameters>>         01925000
    NUM'PARMS'AND'MASK = 16,         <<plus one parm mask>>             01930000
    MAX'OPTION         = 12,         <<has options 0-12>>               01935000
    MAX'OPT'PARM       = 6;          <<and has up to 6 requests>>       01940000
  <<System related equates and defines>>                                01945000
  EQUATE                                                                01950000
    PROGEN'PIN    = 1,          <<pin of progen process>>               01955000
    ENTRY'SIZE    = 1,          <<Entry size word in systabs>>          01960000
    FLM'CPCB      = 4,          <<Fixed low mem CPCB loc>>              01965000
    FLM'PCB'BASE  = 3,          <<Fixed low mem PCBBASE loc>>           01970000
    MIN'PIN       = 1,          <<Minimum legal pin number>>            01975000
    NUM'CONFIG    = 0,          <<Num of entries in systabs>>           01980000
    MAX'PINS      = 256;        <<Maximum number of pins>>              01985000
                                                                        01990000
  DEFINE                                                                01995000
    ABS           = ABSOLUTE#,                                          02000000
    CC            = STATUS.(6:2)#,                                      02005000
    PM'FLAG       = STATUS.(0:1)#,                                      02010000
    PDISABLE      = ASSEMBLE(PSDB)#,                                    02015000
    PENABLE       = ASSEMBLE(PSEB)#,                                    02020000
    BRO'FIELD     = BROTHERPINFIELD#,                                   02025000
    BRO'WORD      = BROTHERINFOWORDNUM#,                                02030000
    DAD'FIELD     = FATHERPINFIELD#,                                    02035000
  DAD'WORD      = FATHERINFOWORDNUM#,                          <<06644>>02040000
    LIVE'FIELD    = ALIVEFLAG#,                                         02045000
    SON'FIELD     = SONPINFIELD#,                                       02050000
  SON'WORD      = SONINFOWORDNUM#,                             <<06644>>02055000
    QUEUE'WORD    = QUEUEINGINFOWORD#,                                  02060000
    STATE'WORD    = PROCSTATEWORDNUM#,                                  02065000
    SUSPN'FIELD   = (13:2)#,                                            02070000
    WAKE'WORD     = WAKEMASKWORDNUM#,                                   02075000
  DAD'SON'FIELD = FATHERSONWAKEFLAGS#,                         <<06644>>02080000
    ACTIVITY'FIELD= (15:1)#,                                            02085000
    ORIGIN        = (7:2)#,                                             02090000
  PI'WORD       = PIINFOWORDNUM#,                              <<06644>>02095000
  OA'BITS       = OAFIELD#,                                    <<06644>>02100000
    Q'INFO        = (4:3)#,                                             02105000
  Q'FIELD       = QUEUEFIELD#;                                 <<06644>>02110000
                                                                        02115000
                                                                        02120000
  <<Error equates>>                                                     02125000
  EQUATE                                                                02130000
    ILLG'CAP      = 1,          <<Invalid capability>>                  02135000
    OMIT'PARM     = 2,          <<Required parameter omited>>           02140000
    ILLG'ADDR     = 3,          <<Param addr out of range>>             02145000
    ILLG'OPTION   = 5,          <<Illegal option number>>               02150000
    ILLG'PIN      = 6,          <<Pin beyond config limits>>            02155000
    UNASSN'PIN    = 7,          <<Pin is unassigned>>                   02160000
    UNPAIRED'PARMS= 8;          <<Option parms are unpaired>>           02165000
                                                                        02170000
                                                                        02175000
  <<Misc procedure global declarations>>                                02180000
  EQUATE                                                                02185000
    INTRINSIC'ID  = [10/INTRINSIC'NUM, 6/NUM'PARMS'AND'MASK];           02190000
                                                                        02195000
  DOUBLE                                                                02200000
    ADDRESS'BNDS;     <<Min & max legal address for bnds ck>>           02205000
                                                                        02210000
  LOGICAL                                                               02215000
    CLEARENCE,        <<mask giving cap of caller: format>>             02220000
    PARM'VALUE = Q-4, <<Paramater mask>>                                02225000
    MORE'OPTIONS;     <<flag indicating additional options>>            02230000
                                                                        02235000
  INTEGER                                                               02240000
    CALLERS'PIN,      <<process id number of caller>>                   02245000
    OPTION'INDEX,     <<index of option of current interest>>           02250000
    OPTION'COUNT,     <<number of options requested>>                   02255000
    TARGET'PIN,       <<process id number of target proc>>              02260000
    DL'VAL,           <<DL reg value>>                                  02265000
    LOWER'BOUND = ADDRESS'BNDS,                                         02270000
    UPPER'BOUND = ADDRESS'BNDS + 1;                            <<06630>>02275000
  BYTE POINTER                                                          02280000
    USERS'BYTE'ADDR;  <<user supplied byte address>>                    02285000
                                                                        02290000
                                                                        02295000
  <<Declarations for subroutine SCAN'TREE>>                             02300000
  EQUATE                                                                02305000
    SEARCH'ALL    = 0,          <<Tells sub to search all>>             02310000
    SEARCH'SONS   = 1;          <<Tells sub to search sons>>            02315000
                                                                        02320000
  LOGICAL                                                               02325000
    BROTHER'PIN,      <<pin of scan'pins brother>>                      02330000
    DAD'PIN,          <<pin of scan'pins father>>                       02335000
    MORE'TREE,        <<flag indicating all tree not scaned>>           02340000
    SCAN'PIN,         <<pin under current exaimination>>                02345000
    SCAN'MORE,        <<flag indicating all tree not scanned>>          02350000
    SON'PIN,          <<pin of scan'pins son>>                          02355000
    ANSTR'PIN,        <<pin of scan'pin ancestor>>                      02360000
    UNCLE'NOT'FOUND,  <<set when searching for cousins>>                02365000
    UNCLE'PIN;        <<pin of scan'pins uncle>>                        02370000
                                                                        02375000
                                                                        02380000
  <<Declarations for subroutine GET'CAPABILITIES>>             <<06630>>02385000
  LOGICAL ARRAY QARRAY(*) = Q+0;                               <<06630>>02390000
  LOGICAL PXFIXEDLOC;                                          <<06630>>02395000
                                                                        02400000
                                                                        02405000
  <<Declarations for subroutine SECURE'CHECK>>                          02410000
  EQUATE                                                                02415000
    ABORT         = TRUE,       <<exits if test failure>>               02420000
    AND'TEST      = TRUE,       <<test is to be AND>>                   02425000
    NO'ABORT      = FALSE,      <<return with test result>>             02430000
    OR'TEST       = FALSE,      <<test is to be OR>>                    02435000
    PH            = %000001,    <<caller has PH>>                       02440000
    SELF          = %000002,    <<caller req info about self>>          02445000
    SON           = %000004,    <<caller req info about son>>           02450000
    DECN          = %000010,    <<caller req info about decn>>          02455000
    PM            = %000100,    <<caller has PM>>                       02460000
    ANSTR         = %000020,    <<caller req info about ansc>>          02465000
    DAD           = %000040;    <<caller req info about dad>>           02470000
                                                                        02475000
  LOGICAL                                                               02480000
    IN'COMMON,        <<matching reqested cap and given cap>>           02485000
    SECURE'RESULT;    <<result of security test>>                       02490000
                                                                        02495000
    DOUBLE CHEK'PARM    := %2 D;                                        02500000
                                                                        02505000
  <<Declarations for external CHECK'NOABORT>>                           02510000
  EQUATE                                                                02515000
    CHEK'INFO     = [1/0, 7/0, 2/0, 1/0, 5/NUM'PARMS],                  02520000
    CHEK'OMTPAR   = 3,                                                  02525000
    OPT'MASK      = [1/0,3/0,3/7,3/7,3/7,3/7];                          02530000
  <<Declarations for OPTION subroutines>>                               02535000
                                                                        02540000
  INTEGER                                                               02545000
      CNT,            <<count for loop>>                                02550000
      NUM'SONS,       <<son count>>                                     02555000
      NUM'DECN,       <<descendant count>>                              02560000
      NUM'GENR,       <<generation count>>                              02565000
      GENR'CNT;       <<final generation tally>>                        02570000
                                                                        02575000
  INTEGER ARRAY PIN'ARRAY(0:MAX'PINS) ;  <<RETURN ARRAY INFO>>          02580000
  BYTE ARRAY BPIN'ARRAY(*) = PIN'ARRAY;                                 02585000
                                                                        02590000
  INTEGER POINTER PIN'ARRY'ADR;              <<ARRAY POINTER>>          02595000
                                                                        02600000
  LOGICAL ARRAY PIN'INFO(0:0);                << RETURN INFO>>          02605000
  BYTE ARRAY BPIN'INFO(*)=PIN'INFO;                                     02610000
                                                                        02615000
  LOGICAL                                                               02620000
                                                                        02625000
    CHEK'ERROR;       <<error return>>                                  02630000
$PAGE "PROCEDURE PROCINFO - UTILITY SUBROUTINES"                        02635000
  SUBROUTINE ERR'RETURN(ERROR'CODE,SUB'ERROR);                          02640000
    VALUE ERROR'CODE,SUB'ERROR;                                         02645000
    INTEGER ERROR'CODE,SUB'ERROR;                                       02650000
                                                                        02655000
    COMMENT: This subroutine will exit PROCINFO with an error           02660000
    condition;                                                          02665000
                                                                        02670000
    BEGIN                                                               02675000
    CC := CCL;                                                          02680000
    ERROR1 := ERROR'CODE;                                               02685000
    ERROR2 := SUB'ERROR;                                                02690000
    ERROREXIT (INTRINSIC'ID, 0, 0);      <<we never come back>>         02695000
    END;  <<Subroutine ERR'RETURN>>                                     02700000
                                                                        02705000
  INTEGER SUBROUTINE WORD'ADDRESS (BYTE'ADDRESS);                       02710000
    VALUE BYTE'ADDRESS;                                                 02715000
    LOGICAL BYTE'ADDRESS;                                               02720000
                                                                        02725000
    COMMENT: This subroutine will convert a DB rel byte                 02730000
    address to a word address.                                          02735000
                                                                        02740000
    BYTE'ADDRESS: The address to be converted;                          02745000
                                                                        02750000
    BEGIN                                                               02755000
                                                                        02760000
    TOS := WORD'ADDRESS := BYTE'ADDRESS & LSR(1);                       02765000
    PUSH(Z);                                                            02770000
    IF TOS <<word'address>> > <<z>> TOS THEN                            02775000
        WORD'ADDRESS.(0:1) := 1;                                        02780000
    END;  <<subroutine WORD'ADDRESS>>                                   02785000
                                                                        02790000
  SUBROUTINE CHECK'GOOD'PIN (PIN'NUM);                                  02795000
    VALUE PIN'NUM;                                                      02800000
    INTEGER PIN'NUM;                                                    02805000
                                                                        02810000
    COMMENT: This subroutine will make sure pin'num is a                02815000
    happy, healthy, bouncing process [I know this is corny:             02820000
    the hour is late]. If not, PROCINFO is exited with                  02825000
    the error field set accordingly:                                    02830000
                                                                        02835000
    PIN'NUM: The process who' integrity is examined                     02840000
                                                                        02845000
    WARNING: THIS SUBRTOUINE MUST BE CALLED WITH ONE                    02850000
             PDISABLE IN EFFECT: A PENABLE IS EXECUTED                  02855000
             IF AN ERROR IS DETECTED;                                   02860000
                                                                        02865000
    BEGIN                                                               02870000
                                                                        02875000
  IF NOT(MIN'PIN<=PIN'NUM<=INTEGER(PCB(NUM'CONFIG))) THEN      <<06644>>02880000
        BEGIN  <<Pin out of range of PCB table>>                        02885000
        PENABLE;                                                        02890000
        ERR'RETURN (ILLG'PIN,-1); <<illegal pin>>                       02895000
        END                                                             02900000
      ELSE                                                              02905000
      IF NOT PCB(PIN'NUM*PCBSIZE+STATE'WORD).LIVE'FIELD THEN   <<06644>>02910000
            BEGIN  <<Pin's live bit is not on>>                         02915000
            PENABLE;  <<Pin unassigned>>                                02920000
            ERR'RETURN (UNASSN'PIN,-1);                                 02925000
            END;                                                        02930000
    END; <<Subroutine CHECK'GOOD'PIN>>                                  02935000
                                                                        02940000
  SUBROUTINE SCAN'TREE(SCAN'TYPE,ROOT'PIN,MORE'TREE);                   02945000
    VALUE SCAN'TYPE,ROOT'PIN;                                           02950000
    LOGICAL SCAN'TYPE,ROOT'PIN,MORE'TREE;                               02955000
                                                                        02960000
    COMMENT: This subroutine will traverse a process tree and           02965000
    return the pin of either the Root'pins' closest decendant           02970000
    or the Root'pins father or uncle.                                   02975000
    SCAN'TYPE: Logical which defines type of scan                       02980000
      0 => Scan will be a search of the whole sub tree                  02985000
    ROOT'PIN: The pin of the root of the subtree to be scanned          02990000
    MORE'TREE: A logical which indicates whether or                     02995000
               the entire subtree has been scanned;                     03000000
                                                                        03005000
                                                                        03010000
                                                                        03015000
    BEGIN                                                               03020000
                                                                        03025000
    <<Confirm integrity of the root pin and tree structure>>            03030000
    CHECK'GOOD'PIN(ROOT'PIN);                                           03035000
                                                                        03040000
    <<Determine how much tree is to be traversed>>                      03045000
    IF SCAN'TYPE = 0 THEN                                               03050000
                                                                        03055000
        COMMENT: All of tree is to be traversed.  Start at              03060000
        root, scan down all sons.  Scan the last son's                  03065000
        brothers [and their respective subtrees], then the              03070000
        second-to-last sons brothers, etc. until we have                03075000
        worked our way back to the root;                                03080000
                                                                        03085000
        BEGIN                                                           03090000
                                                                        03095000
        SON'PIN := PCB(SCAN'PIN*PCBSIZE+SON'WORD)/PCBSIZE;     <<06644>>03100000
          IF SON'PIN <> 0 THEN      <<scan'pin have a son?>>            03105000
              SCAN'PIN := SON'PIN   <<yes, scan him next>>              03110000
            ELSE                                                        03115000
                                                                        03120000
              <<no son - at bottom of this family line>>                03125000
              BEGIN                                                     03130000
            BROTHER'PIN := PCB(SCAN'PIN*PCBSIZE+BRO'WORD)/     <<06644>>03135000
                           PCBSIZE;                            <<06644>>03140000
              IF BROTHER'PIN <> 0 THEN    <<have a bro?   >>            03145000
                  SCAN'PIN := BROTHER'PIN <<yes, scan next>>            03150000
                ELSE                                                    03155000
                                                                        03160000
                  <<no brothers - now check father's bros>>             03165000
                  BEGIN                                                 03170000
                  UNCLE'NOT'FOUND := TRUE;                              03175000
                                                                        03180000
                  <<Cycle up fathers until find uncle>>                 03185000
                  WHILE UNCLE'NOT'FOUND AND MORE'TREE DO                03190000
                    BEGIN                                               03195000
                  DAD'PIN := PCB(SCAN'PIN*PCBSIZE+DAD'WORD)/   <<06644>>03200000
                             PCBSIZE;                          <<06644>>03205000
                    IF DAD'PIN = LOGICAL(TARGET'PIN) OR                 03210000
                       SCAN'PIN = PROGEN'PIN THEN                       03215000
                        MORE'TREE := FALSE  <<oops, ran out>>           03220000
                      ELSE                  <<of kin!      >>           03225000
                        BEGIN                                           03230000
                        UNCLE'PIN :=                                    03235000
                      PCB(DAD'PIN*PCBSIZE+BRO'WORD)/           <<06644>>03240000
                      PCBSIZE;                                 <<06644>>03245000
                        IF UNCLE'PIN = 0 THEN                           03250000
                            <<no uncle here - try next genr>>           03255000
                            SCAN'PIN := DAD'PIN                         03260000
                          ELSE                                          03265000
                            <<found a new family line>>                 03270000
                            BEGIN  <<check it out    >>                 03275000
                            SCAN'PIN := UNCLE'PIN;                      03280000
                            UNCLE'NOT'FOUND := FALSE;                   03285000
                            END;  <<found new line>>                    03290000
                        END;  <<more tree remaining>>                   03295000
                    END;  <<while uncle not found>>                     03300000
                  END;  <<no brother>>                                  03305000
              END;  <<no son>>                                          03310000
                                                                        03315000
          COMMENT: Either we ran out of tree or found the               03320000
          pin.  Report which one;                                       03325000
                                                                        03330000
        END   <<Search'type = 0>>                                       03335000
      ELSE                                                              03340000
                                                                        03345000
        COMMENT: Just the son's of the root'pin are to be               03350000
        examined.  Start with son and look for brothers;                03355000
                                                                        03360000
          SCAN'PIN := PCB(SCAN'PIN*PCBSIZE+BRO'WORD)/          <<06644>>03365000
                      PCBSIZE;                                 <<06644>>03370000
    END;  <<subroutine SCAN'TREE>>                                      03375000
                                                                        03380000
LOGICAL SUBROUTINE SCAN'FOR'DECN(TREE'ROOT,PIN'OF'DECN);                03385000
  VALUE TREE'ROOT,PIN'OF'DECN;                                          03390000
  LOGICAL TREE'ROOT,PIN'OF'DECN;                                        03395000
                                                                        03400000
  COMMENT: This procedure scans the TREE'ROOT's subtree                 03405000
           for the process specified by PIN'OF'DECN. If                 03410000
           the process is found, bit 12 of the subroutine               03415000
           return is set. If not, it is not set;                        03420000
  BEGIN                                                                 03425000
  SON'PIN := PCB(TREE'ROOT*PCBSIZE+SON'WORD)/PCBSIZE;          <<06644>>03430000
  IF SON'PIN <> 0 THEN BEGIN                                            03435000
    PDISABLE;                                                           03440000
    SCAN'MORE:=TRUE;                                                    03445000
    SCAN'PIN:=TREE'ROOT;                                                03450000
    WHILE SCAN'PIN <> PIN'OF'DECN AND SCAN'MORE DO                      03455000
      SCAN'TREE(SEARCH'ALL,TREE'ROOT,SCAN'MORE);                        03460000
    IF SCAN'MORE THEN SCAN'FOR'DECN:=DECN                               03465000
                 ELSE SCAN'FOR'DECN:=0;                                 03470000
    PENABLE;                                                            03475000
  END;                                                                  03480000
  END;  <<subroutine SCAN'FOR'DECN>>                                    03485000
                                                                        03490000
                                                                        03495000
  LOGICAL SUBROUTINE SCAN'FOR'SON(TREE'ROOT,PIN'OF'SON);                03500000
    VALUE TREE'ROOT,PIN'OF'SON;                                         03505000
    LOGICAL TREE'ROOT,PIN'OF'SON;                                       03510000
                                                                        03515000
    COMMENT: This subroutine scans the TREE'ROOT's sons                 03520000
             for the process specified by PIN'OF'SON. If                03525000
             the process is found , bit 13 of the sub-                  03530000
             routine return is set. If not, it is not set;              03535000
                                                                        03540000
    BEGIN                                                               03545000
                                                                        03550000
    PDISABLE;                                                           03555000
    SCAN'MORE:=TRUE;                                                    03560000
  SCAN'PIN := PCB(TREE'ROOT*PCBSIZE+SON'WORD)/PCBSIZE;         <<06644>>03565000
    WHILE SCAN'PIN <> 0 AND SCAN'PIN <> PIN'OF'SON DO                   03570000
      SCAN'TREE(SEARCH'SONS,TREE'ROOT,SCAN'MORE);                       03575000
    IF SCAN'PIN <> 0 THEN SCAN'FOR'SON:=SON                             03580000
                     ELSE SCAN'FOR'SON:=0;                              03585000
    PENABLE;                                                            03590000
                                                                        03595000
    END;  <<subroutine SCAN'FOR'SON>>                                   03600000
                                                                        03605000
  SUBROUTINE GET'CAPABILITIES;                                          03610000
                                                                        03615000
    COMMENT: Determines capabilities and fills in CLEARENCE;            03620000
                                                                        03625000
    BEGIN                                                               03630000
    CLEARENCE := 0;                                                     03635000
                                                                        03640000
    <<Fetch cap word from PCBX and fill in PM,PH>>                      03645000
    PXFIXED;                                                   <<06630>>03650000
    CLEARENCE := CLEARENCE + (PH LAND PXFXCAP);                <<06630>>03655000
    IF PM'FLAG = 1 THEN CLEARENCE := PM;                                03660000
    COMMENT: Now check for family relationships between                 03665000
    caller and the process whose information is requested;              03670000
                                                                        03675000
    IF TARGET'PIN = CALLERS'PIN THEN                                    03680000
        <<Caller is asking about himself>>                              03685000
        CLEARENCE := CLEARENCE + SELF                                   03690000
      ELSE                                                              03695000
                                                                        03700000
        BEGIN                                                           03705000
        COMMENT: Caller is not asking about himself.  Fill              03710000
        in family relationships with scan'tree;                         03715000
                                                                        03720000
      ANSTR'PIN := PCB(CALLERS'PIN*PCBSIZE+DAD'WORD)/          <<06644>>03725000
                   PCBSIZE;                                    <<06644>>03730000
        WHILE ANSTR'PIN <> 0 AND ANSTR'PIN <> LOGICAL(TARGET'PIN) DO    03735000
          BEGIN                                                         03740000
        ANSTR'PIN := PCB(ANSTR'PIN*PCBSIZE+DAD'WORD)/          <<06644>>03745000
                     PCBSIZE;                                  <<06644>>03750000
          END;                                                          03755000
        IF ANSTR'PIN = LOGICAL(TARGET'PIN) THEN                         03760000
          CLEARENCE := CLEARENCE + ANSTR                                03765000
                                                                        03770000
        ELSE                                                            03775000
          BEGIN                                                         03780000
          CLEARENCE :=  CLEARENCE +                                     03785000
            SCAN'FOR'DECN (CALLERS'PIN,PIN) +                           03790000
            SCAN'FOR'SON (CALLERS'PIN,PIN);                             03795000
          END;                                                          03800000
        END;                                                            03805000
    END;  <<subroutine GET'CAPABILITIES>>                               03810000
                                                                        03815000
                                                                        03820000
                                                                        03825000
                                                                        03830000
                                                                        03835000
  SUBROUTINE CHECK'BOUNDS (ADDRESS);                                    03840000
    VALUE ADDRESS;                                                      03845000
    INTEGER ADDRESS;                                                    03850000
                                                                        03855000
    COMMENT: This subroutine will ensure that ADDRESS falls             03860000
    between ADDRESS'BNDS.  If not, PROCINFO is terminated with          03865000
    the appropriate error code.                                         03870000
                                                                        03875000
    ADDRESS: The word address to be checked;                            03880000
                                                                        03885000
    BEGIN                                                               03890000
                                                                        03895000
    IF NOT (LOWER'BOUND <= ADDRESS <= UPPER'BOUND) THEN                 03900000
        ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                             03905000
                                                                        03910000
    END;  <<subroutine CHECK'BOUNDS>>                                   03915000
                                                                        03920000
  LOGICAL SUBROUTINE SECURE'CHECK (CHECK'TYPE,CHECK'LIST,               03925000
                                  EXIT'TYPE);                           03930000
    VALUE CHECK'TYPE,EXIT'TYPE,CHECK'LIST;                              03935000
    LOGICAL CHECK'TYPE,EXIT'TYPE,CHECK'LIST;                            03940000
                                                                        03945000
    COMMENT: This subroutine will perform a security check              03950000
    and will either return false or error return if the                 03955000
    security requirements are not met or will return true if            03960000
    they are.  Which conditions are checked and what action is          03965000
    taken is specified through the parameters as follows:               03970000
                                                                        03975000
    CHECK'TYPE: The type of check made to pass or fail                  03980000
      TRUE => check will be an AND check [ie. all conditions            03985000
        must be met to pass].                                           03990000
      FALSE => check will be an OR check [just one condition            03995000
        must be met to pass].                                           04000000
    EXIT'TYPE: The action taken when the test fails                     04005000
      TRUE => check failure will result in an exit from                 04010000
        PROCINFO with ERROR set based on capability is                  04015000
        missing.                                                        04020000
      FALSE => check failure will result in a subroutine return         04025000
        of false.                                                       04030000
    CHECK'LIST: a bit mask indicating which options are                 04035000
      checked.                                                          04040000
      (9:1)  => caller has PM capability                                04045000
      (10:1) => caller is requesting info about its father              04050000
      (11:1) => caller is requesting info about an ancestor             04055000
      (12:1) => caller is requesting info about an indirect             04060000
                decendant.                                              04065000
      (13:1) => caller is requesting info about a direct                04070000
                decendant.                                              04075000
      (14:1) => caller is requesting info about himself                 04080000
      (15:1) => caller has PH capability;                               04085000
                                                                        04090000
    BEGIN                                                               04095000
    IN'COMMON := CHECK'LIST LAND CLEARENCE;                             04100000
    IF CHECK'TYPE = OR'TEST THEN                                        04105000
        SECURE'RESULT := IN'COMMON <> 0 LOR CHECK'LIST = 0              04110000
      ELSE                                                              04115000
        SECURE'RESULT := IN'COMMON = CHECK'LIST;                        04120000
    IF NOT SECURE'RESULT AND EXIT'TYPE=ABORT THEN                       04125000
        ERR'RETURN (ILLG'CAP,OPTION'INDEX);                             04130000
    SECURE'CHECK := SECURE'RESULT;                                      04135000
    END;    <<SECURE'CHECK>>                                            04140000
$PAGE "PROCEDURE PROCINFO - OPTION SUBROUTINES"                         04145000
                                                                        04150000
SUBROUTINE  EXIT'PROCINFO;                                              04155000
  COMMENT: This subroutine will cause a normal termination              04160000
  of PROCINFO. No special capabilities are required.;                   04165000
                                                                        04170000
BEGIN                                                                   04175000
CC:=CCE;                                                                04180000
ERROR1:=0;                                                              04185000
ERROR2:=0;                                                              04190000
ERROREXIT(INTRINSIC'ID, 0,0);                                           04195000
END; <<subroutine PROCINFO>>                                            04200000
                                                                        04205000
                                                                        04210000
                                                                        04215000
                                                                        04220000
SUBROUTINE GET'CURRENT'PIN(RETURN'INFO);            <<Option 1>>        04225000
  BYTE ARRAY RETURN'INFO;                                               04230000
  COMMENT: This subroutine will return the PIN of the calling           04235000
  process.  No special capabilities are required;                       04240000
                                                                        04245000
  BEGIN                                                                 04250000
  PIN'INFO := CALLERS'PIN;                                     <<07312>>04255000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    04260000
  END;  <<subroutine GET'CURRENT'PIN>>                                  04265000
                                                                        04270000
                                                                        04275000
                                                                        04280000
SUBROUTINE GET'FATHERS'PIN(RETURN'INFO);                                04285000
  BYTE ARRAY RETURN'INFO;                                               04290000
  BEGIN                                                                 04295000
                                                                        04300000
  <<check capabilities for this option>>                                04305000
                                                                        04310000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04315000
         SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                      04320000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04325000
                                                                        04330000
  PIN'INFO := PCB(TARGET'PIN*PCBSIZE+DAD'WORD)/PCBSIZE;        <<06644>>04335000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    04340000
  END;  <<subroutine GET'FATHERS'PIN>>                                  04345000
                                                                        04350000
SUBROUTINE GET'NUM'OF'SONS(RETURN'INFO);                                04355000
  BYTE ARRAY RETURN'INFO;                                               04360000
  BEGIN                                                                 04365000
  PDISABLE;                                                             04370000
                                                                        04375000
  <<check capabilities for this option>>                                04380000
                                                                        04385000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04390000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   04395000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04400000
                                                                        04405000
  SCAN'PIN := PCB(TARGET'PIN*PCBSIZE+SON'WORD)/PCBSIZE;        <<06644>>04410000
  NUM'SONS:=0;                                                          04415000
  SCAN'MORE:=TRUE;                                                      04420000
  WHILE SCAN'PIN <> 0 DO                                                04425000
    BEGIN                                                               04430000
    SCAN'TREE(SEARCH'SONS,TARGET'PIN,SCAN'MORE);                        04435000
    NUM'SONS:=NUM'SONS + 1;                                             04440000
    END;                                                                04445000
  PIN'INFO:=NUM'SONS;                                                   04450000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    04455000
  PENABLE;                                                              04460000
  END;  <<subroutine GET'NUM'OF'SONS>>                                  04465000
                                                                        04470000
SUBROUTINE GET'NUM'OF'DECN(RETURN'INFO);                                04475000
  BYTE ARRAY RETURN'INFO;                                               04480000
  BEGIN                                                                 04485000
  PDISABLE;                                                             04490000
                                                                        04495000
  <<check capabilities for this option>>                                04500000
                                                                        04505000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04510000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   04515000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04520000
                                                                        04525000
  SCAN'PIN := PCB(TARGET'PIN*PCBSIZE+SON'WORD)/PCBSIZE;        <<06644>>04530000
  NUM'DECN:=0;                                                          04535000
  IF SCAN'PIN <> 0 THEN                                                 04540000
    BEGIN                                                               04545000
    SCAN'MORE:=TRUE;                                                    04550000
    WHILE SCAN'MORE DO                                                  04555000
      BEGIN                                                             04560000
      NUM'DECN:=NUM'DECN+1;                                             04565000
      SCAN'TREE(SEARCH'ALL,TARGET'PIN,SCAN'MORE);                       04570000
      END;                                                              04575000
    END;                                                                04580000
  PIN'INFO:=NUM'DECN;                                                   04585000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    04590000
  PENABLE;                                                              04595000
  END;  <<subroutine GET'NUM'OF'DECN>>                                  04600000
                                                                        04605000
SUBROUTINE GET'NUM'OF'GENR(RETURN'INFO);                                04610000
  BYTE ARRAY RETURN'INFO;                                               04615000
  BEGIN                                                                 04620000
  PDISABLE;                                                             04625000
                                                                        04630000
  <<check capabilities for this option>>                                04635000
                                                                        04640000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04645000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   04650000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04655000
  SCAN'MORE := TRUE;                                                    04660000
  NUM'GENR:=1;                                                          04665000
  GENR'CNT:=1;                                                          04670000
  SCAN'PIN := PCB(TARGET'PIN*PCBSIZE+SON'WORD)/PCBSIZE;        <<06644>>04675000
  IF SCAN'PIN <> 0 THEN                                                 04680000
    BEGIN                                                               04685000
    NUM'GENR:=NUM'GENR+1;                                               04690000
    WHILE SCAN'PIN<>0 AND SCAN'MORE DO                                  04695000
      BEGIN                                                             04700000
      SCAN'TREE(SEARCH'ALL,TARGET'PIN,SCAN'MORE);                       04705000
      IF SON'PIN <> 0 THEN NUM'GENR:=NUM'GENR+1                         04710000
        ELSE BEGIN                                                      04715000
        IF GENR'CNT < NUM'GENR THEN GENR'CNT:=NUM'GENR;                 04720000
        NUM'GENR:=2;                                                    04725000
        END;                                                            04730000
      END;                                                              04735000
    END;                                                                04740000
  PIN'INFO:=GENR'CNT;                                                   04745000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    04750000
  PENABLE;                                                              04755000
                                                                        04760000
  END;  <<subroutine GET'NUM'OF'GENR>>                                  04765000
                                                                        04770000
SUBROUTINE GET'SON'PINS(RETURN'INFO);                                   04775000
  BYTE ARRAY RETURN'INFO;                                               04780000
  BEGIN                                                                 04785000
  PDISABLE;                                                             04790000
                                                                        04795000
  <<check capabilities for this option>>                                04800000
                                                                        04805000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04810000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   04815000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04820000
                                                                        04825000
  SCAN'MORE:=TRUE;                                                      04830000
  CNT := 0;                                                             04835000
  MOVE BPIN'ARRAY := RETURN'INFO,(2);                                   04840000
  @PIN'ARRY'ADR := @PIN'ARRAY;                                          04845000
  SCAN'PIN := PCB(TARGET'PIN*PCBSIZE+SON'WORD)/PCBSIZE;        <<06644>>04850000
  WHILE SCAN'PIN <> 0 AND CNT < PIN'ARRY'ADR(0) - 1 DO                  04855000
    BEGIN                                                               04860000
    CNT := CNT + 1;                                                     04865000
    PIN'ARRY'ADR(CNT):=SCAN'PIN;                                        04870000
    SCAN'TREE(SEARCH'SONS,TARGET'PIN,SCAN'MORE);                        04875000
    END;                                                                04880000
  IF SCAN'PIN = 0 THEN                                                  04885000
    BEGIN                                                               04890000
    WHILE CNT < PIN'ARRY'ADR(0) - 1 DO                                  04895000
      BEGIN                                                             04900000
      CNT := CNT + 1;                                                   04905000
      PIN'ARRY'ADR(CNT) := 0;                                           04910000
      END;                                                              04915000
    END                                                                 04920000
    ELSE ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                            04925000
    MOVE RETURN'INFO(2) := BPIN'ARRAY(2),(BPIN'ARRAY(1));               04930000
  PENABLE;                                                              04935000
  END;  <<subroutine GET'SON'PINS>>                                     04940000
SUBROUTINE GET'DECN'PINS(RETURN'INFO);                                  04945000
  BYTE ARRAY RETURN'INFO;                                               04950000
  BEGIN                                                                 04955000
  PDISABLE;                                                             04960000
                                                                        04965000
  <<check capabilities for this option>>                                04970000
                                                                        04975000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR                04980000
            SECURE'CHECK(AND'TEST,PH+ANSTR,NO'ABORT))                   04985000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             04990000
                                                                        04995000
  SCAN'MORE:=TRUE;                                                      05000000
  CNT := 0;                                                             05005000
  MOVE BPIN'ARRAY := RETURN'INFO,(2);                                   05010000
  @PIN'ARRY'ADR := @PIN'ARRAY;                                          05015000
  SCAN'PIN := PCB(TARGET'PIN*PCBSIZE+SON'WORD)/PCBSIZE;        <<06644>>05020000
  IF SCAN'PIN <> 0 THEN                                                 05025000
    WHILE SCAN'MORE AND CNT < PIN'ARRY'ADR(0) - 1 DO                    05030000
      BEGIN                                                             05035000
      CNT := CNT + 1;                                                   05040000
      PIN'ARRY'ADR(CNT):=SCAN'PIN;                                      05045000
      SCAN'TREE(SEARCH'ALL,SCAN'PIN,SCAN'MORE);                         05050000
      END                                                               05055000
  ELSE      << NO DESCENDANTS >>                                        05060000
    SCAN'MORE := FALSE;                                                 05065000
  IF NOT(SCAN'MORE) THEN                                                05070000
    BEGIN                                                               05075000
    WHILE CNT < PIN'ARRY'ADR(0) - 1 DO                                  05080000
      BEGIN                                                             05085000
      CNT := CNT + 1;                                                   05090000
      PIN'ARRY'ADR(CNT) := 0;                                           05095000
      END;                                                              05100000
    END                                                                 05105000
    ELSE ERR'RETURN(ILLG'ADDR,OPTION'INDEX);                            05110000
  MOVE RETURN'INFO(2) := BPIN'ARRAY(2),(BPIN'ARRAY(1));                 05115000
  PENABLE;                                                              05120000
  END;  <<subroutine GET'DECN'PINS>>                                    05125000
SUBROUTINE GET'PRIORITY(RETURN'INFO);                                   05130000
  BYTE ARRAY RETURN'INFO;                                               05135000
  BEGIN                                                                 05140000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+SON,NO'ABORT))                    05145000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             05150000
  PIN'INFO := PCB(TARGET'PIN*PCBSIZE+QUEUE'WORD).PRIFIELD;     <<06644>>05155000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    05160000
  END;  <<subroutine GET'PRIORITY>>                                     05165000
                                                                        05170000
SUBROUTINE GET'PROCSTATE(RETURN'INFO);                                  05175000
  BYTE ARRAY RETURN'INFO;                                               05180000
  BEGIN                                                                 05185000
  IF NOT(SECURE'CHECK(OR'TEST,PM+SELF+SON,NO'ABORT))                    05190000
    THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                             05195000
  PIN'INFO .SUSPN'FIELD :=                                              05200000
    PCB(TARGET'PIN*PCBSIZE+WAKE'WORD).DAD'SON'FIELD;           <<06644>>05205000
  PIN'INFO.ACTIVITY'FIELD :=                                            05210000
    IF PIN'INFO.SUSPN'FIELD = 0 THEN 1 ELSE 0;                          05215000
  PIN'INFO.ORIGIN:=                                                     05220000
    PCB(TARGET'PIN*PCBSIZE+PI'WORD).OA'BITS;                   <<06644>>05225000
    PIN'INFO.Q'INFO := PCB(TARGET'PIN*PCBSIZE+QUEUE'WORD).     <<06644>>05230000
                       Q'FIELD;                                <<06644>>05235000
                                                                        05240000
  <<see if the process is really in the E queue>>                       05245000
                                                                        05250000
  IF PIN'INFO.Q'INFO = 0 THEN PIN'INFO.Q'INFO := 1;                     05255000
  MOVE RETURN'INFO := BPIN'INFO,(2);                                    05260000
                                                                        05265000
  END;  <<subroutine GET'PROCSTATE>>                                    05270000
                                                                        05275000
SUBROUTINE GET'PROG'NAME(RETURN'INFO);              <<Option 10>>       05280000
  BYTE ARRAY RETURN'INFO;                                               05285000
                                                                        05290000
  COMMENT:  This subroutine will returen the program name of            05295000
  specified process.  The specified process must be the                 05300000
  caller, direct son of caller or caller must be in priv                05305000
  mode;                                                                 05310000
                                                                        05315000
  BEGIN                                                                 05320000
                                                                        05325000
  <<Make sure he supplied enough room>>                                 05330000
  CHECK'BOUNDS(WORD'ADDRESS(RETURN'INFO));                              05335000
  CHECK'BOUNDS(WORD'ADDRESS(RETURN'INFO) + 13);                         05340000
  @USERS'BYTE'ADDR := @RETURN'INFO;                                     05345000
                                                                        05350000
  <<Check capabilities>>                                                05355000
  IF NOT (SECURE'CHECK(OR'TEST,PM+SELF+DECN,NO'ABORT) LOR               05360000
    SECURE'CHECK(AND'TEST,ANSTR,NO'ABORT))                              05365000
      THEN ERR'RETURN(ILLG'CAP,OPTION'INDEX);                           05370000
                                                                        05375000
  <<ok so far, see if everyone is still alive>>                         05380000
  PDISABLE;                                                             05385000
  CHECK'GOOD'PIN (TARGET'PIN);                                          05390000
  PENABLE;                                                              05395000
                                                                        05400000
  <<ok fetch progname from load table>>                                 05405000
  PROCFILE (TARGET'PIN,USERS'BYTE'ADDR);                                05410000
  IF < THEN ERR'RETURN (UNASSN'PIN,-1);                                 05415000
                                                                        05420000
  END;  <<subroutine GET'PROG'NAME>>                                    05425000
                                                                        05430000
                                                                        05435000
SUBROUTINE SELECT'OPTION(OPTION'NUM,ITEM);                              05440000
                                                                        05445000
  COMMENT: This subroutine selects tand calls the appropriate           05450000
           subroutine for the option spec ified;                        05455000
                                                                        05460000
  VALUE OPTION'NUM;                                                     05465000
  INTEGER OPTION'NUM;                                                   05470000
  BYTE ARRAY ITEM;  <<byte array of returned info>>                     05475000
                                                                        05480000
  BEGIN                                                                 05485000
  <<check to make sure the option is within range>>                     05490000
                                                                        05495000
  IF NOT (0 <= OPTION'NUM <=MAX'OPTION) THEN                            05500000
     ERR'RETURN(ILLG'OPTION,OPTION'INDEX);                              05505000
                                                                        05510000
  <<ok- process the option>>                                            05515000
                                                                        05520000
  CASE OPTION'NUM OF                                                    05525000
    BEGIN                                                               05530000
    ;                                                                   05535000
    GET'CURRENT'PIN(ITEM);                                              05540000
    GET'FATHERS'PIN(ITEM);                                              05545000
    GET'NUM'OF'SONS(ITEM);                                              05550000
    GET'NUM'OF'DECN(ITEM);                                              05555000
    GET'NUM'OF'GENR(ITEM);                                              05560000
    GET'SON'PINS(ITEM);                                                 05565000
    GET'DECN'PINS(ITEM);                                                05570000
    GET'PRIORITY(ITEM);                                                 05575000
    GET'PROCSTATE(ITEM);                                                05580000
    GET'PROG'NAME(ITEM);                                                05585000
        ;    ;     <<for native mode info>>                             05590000
    END;                                                                05595000
  END;  <<subroutine SELECT'OPTION>>                                    05600000
                                                                        05605000
$PAGE "<< PROCINFO:  OUTER BLOCK >>"                                    05610000
                                                                        05615000
  ASSEMBLE(ADDS REQSTKSIZE);    <<Get required stack size>>             05620000
  ASSEMBLE(SUBS REQSTKSIZE);                                            05625000
                                                                        05630000
  COMMENT:  Perform initial verification with CHEK.                     05635000
            CHEK will abort the process if split stack                  05640000
            mode or if the first parameter is omitted;                  05645000
                                                                        05650000
  ADDRESS'BNDS:=CHEK'NOABORT(INTRINSIC'ID,CHEK'INFO,                    05655000
                             CHEK'PARM,,OPT'MASK);                      05660000
                                                                        05665000
  IF < THEN                                                             05670000
    BEGIN                                                               05675000
    CHEK'ERROR := ERRORGET(1).(8:8);                                    05680000
    IF CHEK'ERROR = CHEK'OMTPAR THEN                                    05685000
        ERR'RETURN(OMIT'PARM,-1)                                        05690000
      ELSE                                                              05695000
        ERR'RETURN(ILLG'ADDR,-1);                                       05700000
    END;                                                                05705000
                                                                        05710000
  <<Determine the caller's PIN and target pin>>                         05715000
                                                                        05720000
  CALLERS'PIN:=                                                         05725000
  (CURPRC)/PCBSIZE;                                            <<06644>>05730000
  IF PIN = 0 THEN TARGET'PIN := CALLERS'PIN                             05735000
    ELSE BEGIN                                                          05740000
       PDISABLE;                                                        05745000
       CHECK'GOOD'PIN(PIN);                                             05750000
       TARGET'PIN:=PIN;                                                 05755000
       PENABLE;                                                         05760000
    END;                                                                05765000
                                                                        05770000
                                                                        05775000
  COMMENT: Determine the caller's capabilities, fill in                 05780000
           clearance.  If the target pin does not exist,                05785000
           or if it is invalid, PROCINFO will be termin-                05790000
           ated while attempting to determine capabilities;             05795000
                                                                        05800000
  GET'CAPABILITIES;                                                     05805000
                                                                        05810000
  COMMENT: Now cycle through the options;                               05815000
                                                                        05820000
  OPTION'INDEX:=1;                                                      05825000
                                                                        05830000
  WHILE OPTION'INDEX <= MAX'OPT'PARM  DO                                05835000
    BEGIN                                                               05840000
    IF PARM'VALUE & LSR((MAX'OPT'PARM*2)-(OPTION'INDEX*2-1)) THEN       05845000
      BEGIN                                                             05850000
      IF PARM'VALUE & LSR((MAX'OPT'PARM*2)-(OPTION'INDEX*2)) THEN       05855000
        BEGIN  <<found a matched option pair>>                          05860000
        CASE OPTION'INDEX OF                                            05865000
          BEGIN                                                         05870000
          ;                                                             05875000
          SELECT'OPTION(OPTION1,ITEM1);                                 05880000
          SELECT'OPTION(OPTION2,ITEM2);                                 05885000
          SELECT'OPTION(OPTION3,ITEM3);                                 05890000
          SELECT'OPTION(OPTION4,ITEM4);                                 05895000
          SELECT'OPTION(OPTION5,ITEM5);                                 05900000
          SELECT'OPTION(OPTION6,ITEM6);                                 05905000
          END                                                           05910000
        END                                                             05915000
       ELSE ERR'RETURN(UNPAIRED'PARMS,OPTION'INDEX);                    05920000
     END                                                                05925000
     ELSE BEGIN                                                         05930000
       IF PARM'VALUE & LSR ((MAX'OPT'PARM*2)-(OPTION'INDEX*2))          05935000
          THEN ERR'RETURN(UNPAIRED'PARMS,OPTION'INDEX);                 05940000
     END;                                                               05945000
     OPTION'INDEX:=OPTION'INDEX+1;                                      05950000
  END;                                                                  05955000
  EXIT'PROCINFO;                                                        05960000
END;  <<PROCINFO>>                                                      05965000
                                                                        05970000
DOUBLE PROCEDURE GETPROCINFO(PIN);                                      05975000
VALUE PIN; INTEGER PIN;                                                 05980000
OPTION PRIVILEGED;                                                      05985000
                                                                        05990000
COMMENT: RETURNS DOUBLE WORD CONTAINING INFORMATION ABOUT               05995000
         REQUIRED PROCESS.                                              06000000
               WORD 1:                 0/PRIORITY.                      06005000
               WORD 2:                 SQ/ORIGIN ACT/REACTCNT/SST/A.    06010000
                                                                        06015000
         ;                                                              06020000
                                                                        06025000
BEGIN                                                                   06030000
      INTEGER CC,S0=S-0;                                                06035000
INTEGER RETWORD0:=0,                                           <<01549>>06040000
        RETWORD1:=0,                                           <<01549>>06045000
        PCBPT;                                                 <<01549>>06050000
                                                                        06055000
      PCBPT := CURPRC;                                         <<06644>>06060000
      IF PIN=0 THEN                    <<FATHER>>                       06065000
      BEGIN                                                             06070000
         PIN := FATHERINFO/PCBSIZE; GO TO GP1;                 <<06644>>06075000
      END ELSE                         <<SON>>                          06080000
      BEGIN                                                             06085000
         IF PCB(PIN*PCBSIZE+FATHERINFOWORDNUM)                 <<06644>>06090000
          <> (CURPRC)                                          <<07312>>06095000
            OR NOT CHECKALIVE (PIN)                            <<01873>>06100000
        OR NOT (1<=PIN<=PCBI(0)) THEN                          <<01549>>06105000
         BEGIN CC:=1; GOTO GP2; END;                                    06110000
      END;                                                              06115000
                                                                        06120000
GP1:                                                                    06125000
      DISABLE;                                                          06130000
      IF NOT PCB(PIN*PCBSIZE+PROCSTATEWORDNUM).ALIVEFLAG THEN  <<06644>>06135000
      BEGIN CC:=0;GOTO GP2; END;       <<CCG>>                          06140000
                                                                        06145000
      CC:=2;                           <<CCE>>                          06150000
                                                                        06155000
     PCBPT:=PIN*PCBSIZE;                                       <<01549>>06160000
      RETWORD0:=PCB(PCBPT+QUEUEINGINFOWORDNUM).PRIFIELD;       <<01630>>06165000
      RETWORD1.(13:2):=PCB(PCBPT                               <<01630>>06170000
                          +WAKEMASKWORDNUM).FATHERSONWAKEFLAGS;<<01630>>06175000
      RETWORD1.(15:1):=IF RETWORD1.(13:2) = 0 THEN 1 ELSE 0;   <<01630>>06180000
      RETWORD1.(7:2):=PCB(PCBPT+PIINFOWORDNUM).OAFIELD;        <<06644>>06185000
      RETWORD1.(4:3) := QUEUEINGINFO.QUEUEFIELD';              <<06644>>06190000
      << SEE IF PROCESS IS REALLY SCHEDULED IN ES QUEUE >>     <<01630>>06195000
      IF RETWORD1.(4:3) = 0 THEN RETWORD1.(4:3) := 1;          <<01630>>06200000
      TOS:=RETWORD0;                                           <<01630>>06205000
      TOS:=RETWORD1;                                           <<01630>>06210000
                                                                        06215000
      GETPROCINFO:=TOS;                                                 06220000
GP2:  STATUS.(6:2):=CC;                <<CC RETURNED>>                  06225000
                                                                        06230000
END;  << G E T P R O C I N F O  >>                                      06235000
                                                                        06240000
PROCEDURE SUSPEND(SUSP,RIN'RELEASE);                           <<01604>>06245000
VALUE SUSP,RIN'RELEASE;                                        <<01604>>06250000
LOGICAL SUSP;                                                           06255000
INTEGER RIN'RELEASE;                                           <<01604>>06260000
OPTION PRIVILEGED,VARIABLE;                                             06265000
                                                                        06270000
COMMENT: PUTS A PROCESS IN A WAIT STATE CORRESPONDING TO SUSP CONDITION 06275000
         IF RIN IS SPECIFIED RELEASES THE RIN AT THE SAME TIME.         06280000
                                                                        06285000
         ERROR CODE:    103.                                            06290000
         ERROR SUBCODE                                                  06295000
                        0              CALLABILITY                      06300000
                                                                        06305000
         DB CAN BE NOT POINTING TO STACK.                               06310000
      ;                                                                 06315000
                                                                        06320000
                                                                        06325000
BEGIN                                                                   06330000
       EQUATE JITX =6;                                         <<06880>>06335000
                                                               <<01714>>06340000
      EQUATE ERRCODE=103;                                               06345000
                                                                        06350000
      DEFINE NOSON=SUSP=2 AND PCB(PIN*PCBSIZE+                 <<06644>>06355000
                   SONINFOWORDNUM)/PCBSIZE = 0#;               <<06644>>06360000
        <<WAIT ON SON BUT NO SON EXISTS>>                      <<00229>>06365000
                                                                        06370000
      INTEGER DB,I,CX,NEXT;                                             06375000
       INTEGER ARRAY JITARR(*)=DB+0;                           <<06880>>06380000
                                                               <<01604>>06385000
      LOGICAL  C1:= 0, C2:=1;                                           06390000
      DOUBLE CAPAB=C1;                                                  06395000
      LOGICAL ARRAY QARRAY(*)=Q+0;                             <<06630>>06400000
      INTEGER PCBGLOBLOC;                                      <<06630>>06405000
      INTEGER RINPTR;                                          <<01604>>06410000
      LOGICAL VAR=Q-4;                                                  06415000
      INTEGER STATUS=Q-1,PIN,T;                                         06420000
      INTEGER S;                                                        06425000
                                                                        06430000
                                                                        06435000
      SUBROUTINE PROCEXIT( COND );                             <<01604>>06440000
        VALUE COND;                                            <<01604>>06445000
        INTEGER COND;                                          <<01604>>06450000
        COMMENT : SUBROUTINE EXECUTES STANDARD EXIT            <<01604>>06455000
                  PROCEDURES;                                  <<01604>>06460000
                                                               <<01604>>06465000
        BEGIN                                                  <<01604>>06470000
          RELSIR(RIN'SIR,S);                                   <<06271>>06475000
          STATUS.(6:2) := COND;                                <<01604>>06480000
          EXCHANGEDB(DB);                                      <<01604>>06485000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>06490000
        END; << PROCEXIT >>                                    <<01604>>06495000
                                                               <<01604>>06500000
                                                                        06505000
                                                                        06510000
      ERRORON;                                                          06515000
      CHEK(ERRCODE&LSL(6)+3,%100002,,CAPAB,1);                          06520000
      SUSP:=SUSP.(14:2);                                                06525000
                                                               <<01604>>06530000
      IF SUSP=0 THEN                                           <<01604>>06535000
      BEGIN                                                    <<01604>>06540000
        STATUS.(6:2) := CCL;                                   <<01604>>06545000
        ERROREXIT((ERRCODE*64)+3,0,0);                         <<01604>>06550000
        RETURN;                                                <<01604>>06555000
      END;                                                     <<01604>>06560000
      PIN := (CURPRC)/PCBSIZE;                                 <<06644>>06565000
                                                               <<01604>>06570000
      IF NOT(VAR) THEN                  <<NO RIN TO RELEASE>>  <<01604>>06575000
      BEGIN                                                    <<01604>>06580000
        DISAPROC;                                              <<01604>>06585000
        IF NOSON THEN                                          <<01604>>06590000
        BEGIN                                                  <<01604>>06595000
          ENAPROC;                                             <<01604>>06600000
          STATUS.(6:2) := CCL;                                 <<01604>>06605000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>06610000
          RETURN;                                              <<01604>>06615000
        END;                                                   <<01604>>06620000
        WAIT(SUSP,0);                                          <<01604>>06625000
        STATUS.(6:2) := CCE;                                   <<01604>>06630000
        ERROREXIT((ERRCODE*64)+3,0,0);                         <<01604>>06635000
        RETURN;                                                <<01604>>06640000
      END                                                      <<01604>>06645000
      ELSE                                                     <<01604>>06650000
      BEGIN                                                    <<01604>>06655000
        IF RIN'RELEASE = 0 THEN                                <<01604>>06660000
        BEGIN                                                  <<01604>>06665000
          STATUS.(6:2) := CCL;                                 <<01604>>06670000
          ERROREXIT((ERRCODE*64)+3,0,0);                       <<01604>>06675000
          RETURN;                                              <<01604>>06680000
        END;                                                   <<01604>>06685000
                                                               <<01604>>06690000
         PXGLOBAL;                                             <<06630>>06695000
        TOS := PXG'JITDST;                                     <<06630>>06700000
        ASSEMBLE(ZERO,XCH);                                    <<01604>>06705000
        DB := EXCHANGEDB(*);                                   <<01604>>06710000
        S := GETSIR(RIN'SIR);                                  <<06271>>06715000
        RINPTR := JITLOCALRINPTR*RIN'LENGTH;                   <<06880>>06720000
        IF RINPTR = 0 THEN                                     <<01604>>06725000
        BEGIN                                                  <<01604>>06730000
          PROCEXIT( CCL );                                     <<01604>>06735000
          RETURN;                                              <<01604>>06740000
        END;                                                   <<01604>>06745000
                                                               <<01604>>06750000
         EXCHANGEDB(RIN'DST);                                  <<01714>>06755000
        CX := 0;                                               <<01604>>06760000
        WHILE (CX:=CX+1) < RIN'RELEASE DO                      <<01604>>06765000
        BEGIN                                                  <<01604>>06770000
          RINPTR := RIN'E'INDEX*RIN'LENGTH;                    <<01604>>06775000
          IF RINPTR = 0 THEN                                   <<01604>>06780000
          BEGIN                                                <<01604>>06785000
            PROCEXIT( CCL );                                   <<01604>>06790000
            RETURN;                                            <<01604>>06795000
          END;                                                 <<01604>>06800000
        END;                                                   <<01604>>06805000
                                                               <<01604>>06810000
      DISAPROC;                                                <<01714>>06815000
        IF NOSON THEN                                          <<01604>>06820000
        BEGIN                                                  <<01604>>06825000
          ENAPROC;                                             <<01604>>06830000
          PROCEXIT( CCL );                                     <<01604>>06835000
          RETURN;                                              <<01604>>06840000
        END;                                                   <<01604>>06845000
        IF RIN'E'HOLDER = PIN THEN                             <<01604>>06850000
        BEGIN            << THE PROCESS HAS THE RIN >>         <<01604>>06855000
          NEXT := RIN'E'HEADQ;                                 <<01604>>06860000
          RIN'E'HOLDER := RIN'E'HEADQ;                         <<01604>>06865000
          IF NEXT <> 0 THEN                                    <<01604>>06870000
             RIN'E'HEADQ := PCB(NEXT*PCBSIZE+                  <<06644>>06875000
                NIMPPINWORDNUM)/PCBSIZE;                       <<06644>>06880000
        END                                                    <<01604>>06885000
        ELSE                                                   <<01604>>06890000
        BEGIN                                                  <<01604>>06895000
          ENAPROC;                                             <<01604>>06900000
          PROCEXIT( CCL );                                     <<01604>>06905000
          RETURN;                                              <<01604>>06910000
       END;                                                    <<01604>>06915000
        RELSIR(RIN'SIR,S);                                     <<06271>>06920000
        IF NEXT <> 0 THEN AWAKE(NEXT*PCBSIZE,%1000,SUSP)       <<01604>>06925000
                     ELSE WAIT(SUSP,0);                        <<01604>>06930000
      END;                                                     <<01604>>06935000
                                                               <<01604>>06940000
      EXCHANGEDB(DB);                                          <<01604>>06945000
      STATUS.(6:2) := CCE;                                     <<01604>>06950000
      ERROREXIT((ERRCODE*64)+3,0,0);                           <<01604>>06955000
                                                               <<01604>>06960000
                                                                        06965000
END;  << S U S P E N D   >>                                             06970000
                                                                        06975000
LOGICAL PROCEDURE FATHER;                                               06980000
OPTION PRIVILEGED;                                                      06985000
COMMENT: RETURNS THE PROCESS IDENTIFICATION NUMBER(PIN)                 06990000
         OF THE CALLERS FATHER.                                         06995000
         RETUNRS  CCL IF FATHER IS A SYSTEM PROCESS.                    07000000
                  CCG IF FATHER IS A MAIN PROCESS.                      07005000
                  CCE OTHERWISE.                                        07010000
         CALLABLE.                                                      07015000
      ;                                                                 07020000
                                                                        07025000
BEGIN                                                                   07030000
      LOGICAL V=Q-4;                                                    07035000
      INTEGER CC;                      <<CONDITION CODE>>               07040000
      INTEGER PCBPT;                                           <<06644>>07045000
                                                                        07050000
      PCBPT := CURPRC;                                         <<06644>>07055000
     FATHER := FATHERINFO/PCBSIZE;                             <<06644>>07060000
     TOS := PCB(V*PCBSIZE+PROCSTATEWORDNUM);                   <<06644>>07065000
      CC:=CCE;                         <<INITIALIZE CC>>                07070000
      ASSEMBLE(DUP);                                                    07075000
     IF TOS.MAINPROCFLAG THEN CC := CCG;                       <<06644>>07080000
     IF TOS.SYSTEMPROCFLAG THEN CC := CCL;                     <<06644>>07085000
      STATUS.(6:2):=CC;                <<SET CONDITION CODE>>           07090000
                                                                        07095000
END;  << F A T H E R  >>                                                07100000
                                                                        07105000
PROCEDURE ACTIVATE(PIN,SUSP);                                           07110000
VALUE PIN,SUSP;                                                         07115000
INTEGER PIN;                                                            07120000
LOGICAL SUSP;                                                           07125000
OPTION VARIABLE,PRIVILEGED;                                             07130000
                                                                        07135000
COMMENT: CALLABLE INTRINSIC THAT ACTIVATES A PROCESS.                   07140000
         (EITHER SON OR FATHER).                                        07145000
         IF PIN=0 THE PROCESS ACTIVATED WILL BE THE FATHER              07150000
         SUSP#0 MEANS A SIMULTANEOUS SUSPENSION OF THE CALLER.          07155000
                                                                        07160000
         ERROR CODE:    104.                                            07165000
         ERROR SUBCODE                                                  07170000
         20 ACTIVATION OF A SYSTEM PROCESS FORBIDDEN.                   07175000
         21 ACTIVATION OF A MAIN PROCESS FORBIDDEN.                     07180000
                                                                        07185000
      CONDITION CODES                                                   07190000
         CCE:  OK                                                       07195000
         CCG:  PROCESS ALREADY ACTIVE                                   07200000
         CCL:  ACTIVATION NOT EXPECTED                                  07205000
                                                                        07210000
         DB CAN BE NOT POINTING TO THE SATCK.                           07215000
         ;                                                              07220000
                                                                        07225000
                                                                        07230000
BEGIN                                                                   07235000
      EQUATE F=%100002;                                                 07240000
      EQUATE ERRCODE=104;                                               07245000
      LOGICAL C1:=0,C2:=1;                                              07250000
      DOUBLE CM=C1;                                                     07255000
      LOGICAL VAR=Q-4;                                                  07260000
      LOGICAL DB;                                                       07265000
      INTEGER MASK;                                                     07270000
      INTEGER I;                                                        07275000
      INTEGER POINTER PCBTABLE = 3;                                     07280000
      INTEGER PINPT,CALPT,CALPIN,CC;                                    07285000
                                                                        07290000
                                                                        07295000
      ERRORON;                                                          07300000
      I:=ERRCODE&LSL(6)+3;                                              07305000
      CHEK(I,F,,CM,1);                 <<CHECK FOR CALL VALIDITY>>      07310000
      IF  NOT VAR  THEN  SUSP := 0;                                     07315000
      SUSP := SUSP.(14:2);                                     <<00.01>>07320000
      TOS:=I;                                                           07325000
      CALPT := (CURPRC);                                       <<06644>>07330000
      CALPIN:=CALPT/PCBSIZE;                                            07335000
      IF PIN=0 THEN                    <<ACTIVATE FATHER>>              07340000
      BEGIN                                                             07345000
         PIN := PCB(CALPT+FATHERINFOWORDNUM)/                  <<06644>>07350000
                PCBSIZE;                                       <<06644>>07355000
         PINPT:=PIN*PCBSIZE;                                            07360000
         GOTO A1;                                                       07365000
      END ELSE                                                          07370000
      BEGIN                                                             07375000
         PINPT:=PIN*PCBSIZE;                                            07380000
         IF NOT (1<=PIN<=PCBTABLE(0)) THEN GO A3;              <<02729>>07385000
         IF PCBTABLE(PINPT+FATHERINFOWORDNUM)/                 <<06644>>07390000
            PCBSIZE = CALPIN THEN                              <<06644>>07395000
         BEGIN                                                          07400000
            MASK:=1;                                                    07405000
            GOTO OK;                                                    07410000
         END;                                                           07415000
A3:         CC:=CCL;                   <<ILLEGAL PROCESS>>              07420000
            GOTO FIN;                                                   07425000
      END;                                                              07430000
                                                                        07435000
A1:      MASK := 2;                                                     07440000
         IF PCB(CALPT+PROCSTATEWORDNUM).SYSTEMPROCFLAG THEN    <<06644>>07445000
           GOTO OK;                                            <<06732>>07450000
         TOS := PCB(PINPT+PROCSTATEWORDNUM).PTYPEFIELD;        <<06644>>07455000
         ASSEMBLE(DUP);                                                 07460000
         IF TOS&LSR(2) THEN            <<A=1==SYSTEM PROCESS>>          07465000
         BEGIN                                                          07470000
            ASSEMBLE(DEL);                                              07475000
            TOS:=20;                   <<ERROR 20>>                     07480000
A2:         TOS:=0;                                                     07485000
            ERROREXIT(*,*,*);                                           07490000
         END;                                                           07495000
         IF TOS=2 THEN                 <<JOB/SESS MAIN PROCESS>>        07500000
         BEGIN                                                          07505000
            TOS:=21;                   <<ERROR 21 >>                    07510000
            GOTO A2;                                                    07515000
         END;                                                           07520000
OK:                                                                     07525000
      << ALIVE TEST:>>                                                  07530000
      DISABLE;                                                          07535000
      IF NOT PCB(PINPT+PROCSTATEWORDNUM).ALIVEFLAG THEN        <<06644>>07540000
      BEGIN                                                    <<02729>>07545000
         CC := CCL;                                            <<02729>>07550000
         GO TO FIN;                                            <<02729>>07555000
      END;                                                     <<02729>>07560000
      IF PCBTABLE(PINPT+WAKEMASKWORDNUM).NONCRITEVENTFLD'      <<06644>>07565000
         <> 0 THEN                                             <<06644>>07570000
         BEGIN <<TO THIS USER, SON IS "ACTIVE">>                        07575000
         IF SUSP <> 0 THEN                                              07580000
            BEGIN                                                       07585000
            WAIT(SUSP,0);                                               07590000
            IF < THEN BEGIN CC:=CCL; GOTO FIN; END;                     07595000
            END;                                                        07600000
         CC:=CCG; GOTO FIN;                                             07605000
         END <<ACTIVE SON>>;                                            07610000
      AWAKE(PINPT,MASK,SUSP);                                           07615000
      PUSH(STATUS);                                                     07620000
      CC:=TOS&LSR(8);                                                   07625000
FIN:                                                                    07630000
      STATUS.(6:2):=CC;                                                 07635000
      ERROREXIT(*,0,0);                                                 07640000
                                                                        07645000
END;  <<ACTIVATE>>                                                      07650000
PROCEDURE SHOWMQ;                                              <<06644>>07655000
OPTION PRIVILEGED,UNCALLABLE;                                  <<06644>>07660000
BEGIN                                                          <<06644>>07665000
DEFINE                                                         <<06644>>07670000
   TURNOFFTRAPS = PUSH(STATUS);                                <<06644>>07675000
                  TOS.(2:1) := 0;                              <<06644>>07680000
                  SET(STATUS)#,                                <<06644>>07685000
   DISPQHEAD = ABSOLUTE(%1271)#,                               <<06644>>07690000
   CLEARBUF = BUF := "  ";                                     <<06644>>07695000
              MOVE BUF(1) := BUF,(BUFSIZE - 1)#;               <<07312>>07700000
EQUATE                                                         <<06644>>07705000
   USER = 0,                                                   <<06644>>07710000
   SON'OF'MAIN = 1,                                            <<06644>>07715000
   BUFSIZE = 40,                                               <<06644>>07720000
   JOBOFFSET = 9,                                              <<06644>>07725000
   PINOFFSET = 4,                                              <<06644>>07730000
   PTYPEOFFSET = 3,                                            <<06644>>07735000
   DOUBLE'SPACE = %60,                                         <<06644>>07740000
   PTYPE'MASK = %1600,                                         <<06644>>07745000
   QUEUE'MASK = %74000,                                        <<06644>>07750000
   TEMP'ARRAY'ENTRY'SIZE = 2,                                  <<06644>>07755000
   CQMIN = -ICS'MINCFILTERCELL,                                <<06644>>07760000
   CQMAX = -ICS'MAXCFILTERCELL,                                <<06644>>07765000
   CQBASE = -ICS'CSCHEDBASECELL,                               <<06644>>07770000
   CQLIMIT = -ICS'WORSTCPRICELL,                               <<06644>>07775000
   DQMIN = -ICS'CURDFILTERCELL,                                <<06644>>07780000
   DQMAX = -ICS'CURDFILTERCELL,                                <<06644>>07785000
   DQBASE = -ICS'DSCHEDBASECELL,                               <<06644>>07790000
   DQLIMIT = -ICS'WORSTDPRICELL,                               <<06644>>07795000
   EQMIN = -ICS'CUREFILTERCELL,                                <<06644>>07800000
   EQMAX = -ICS'CUREFILTERCELL,                                <<06644>>07805000
   EQBASE = -ICS'ESCHEDBASECELL,                               <<06644>>07810000
   EQLIMIT = -ICS'WORSTEPRICELL,                               <<06644>>07815000
   CLOCKCYCLE = %1353;                                         <<06644>>07820000
                                                               <<06644>>07825000
INTEGER ARRAY                                                  <<06644>>07830000
   MIN(0:2) = PB := CQMIN,DQMIN,EQMIN;                         <<06644>>07835000
INTEGER ARRAY                                                  <<06644>>07840000
   MAX(0:2) = PB := CQMAX,DQMAX,EQMAX;                         <<06644>>07845000
INTEGER ARRAY                                                  <<06644>>07850000
   BASE(0:2) = PB := CQBASE,DQBASE,EQBASE;                     <<06644>>07855000
INTEGER ARRAY                                                  <<06644>>07860000
   LIMIT(0:2) = PB := CQLIMIT,DQLIMIT,EQLIMIT;                 <<06644>>07865000
ARRAY                                                          <<06644>>07870000
   DJ'D(0:1) = Q;                                              <<06644>>07875000
DOUBLE                                                         <<06644>>07880000
   DJ = DJ'D;                                                  <<06644>>07885000
ARRAY                                                          <<06644>>07890000
   BUF(0:40);                                                  <<06644>>07895000
BYTE POINTER                                                   <<06644>>07900000
   BUF';                                                       <<06644>>07905000
LOGICAL                                                        <<06644>>07910000
   PCBPT,                                                      <<06644>>07915000
   TEMP,                                                       <<06644>>07920000
   S0 = S - 0,                                                 <<06644>>07925000
   OFFSET';                                                    <<06644>>07930000
LOGICAL POINTER                                                <<06644>>07935000
   DYNAMIC'ARRAY;                                              <<06644>>07940000
BYTE POINTER                                                   <<06644>>07945000
   BPS0 = S - 0;                                               <<06644>>07950000
INTEGER                                                        <<06644>>07955000
   S'TO'Z,                                                     <<06644>>07960000
   OLD'Z := 0,                                                 <<06644>>07965000
   LEN := 0,                                                   <<06644>>07970000
   NUM'DISPQ'PROCS := 0,                                       <<06644>>07975000
   NUM'NO'Q'PROCS := 0,                                        <<06644>>07980000
   I := -1,                                                    <<06644>>07985000
   J := -1,                                                    <<06644>>07990000
   ARRAY'SIZE;                                                 <<06644>>07995000
LOGICAL POINTER                                                <<06644>>08000000
   ICS'L = 7;                                                  <<06644>>08005000
                                                               <<06644>>08010000
                                                               <<06644>>08015000
SUBROUTINE PUTBUF(SCHED'PTYPE'INFO,OFFSET,PCB'INDEX);          <<06644>>08020000
VALUE SCHED'PTYPE'INFO,OFFSET,PCB'INDEX;                       <<06644>>08025000
LOGICAL SCHED'PTYPE'INFO,OFFSET,PCB'INDEX;                     <<06644>>08030000
                                                               <<06644>>08035000
                                                               <<06644>>08040000
BEGIN                                                          <<06644>>08045000
IF SCHED'PTYPE'INFO.LSCHEDFLAG THEN                            <<06644>>08050000
   BUF'(OFFSET) := "L"                                         <<06644>>08055000
ELSE                                                           <<06644>>08060000
   IF SCHED'PTYPE'INFO.CSCHEDFLAG THEN                         <<06644>>08065000
      BUF'(OFFSET) := "C"                                      <<06644>>08070000
   ELSE                                                        <<06644>>08075000
      IF SCHED'PTYPE'INFO.DSCHEDFLAG THEN                      <<06644>>08080000
         BUF'(OFFSET) := "D"                                   <<06644>>08085000
      ELSE                                                     <<06644>>08090000
         IF SCHED'PTYPE'INFO.ESCHEDFLAG THEN                   <<06644>>08095000
            BUF'(OFFSET) := "E";                               <<06644>>08100000
IF SCHED'PTYPE'INFO.PTYPEFIELD = MAIN OR                       <<06644>>08105000
   SCHED'PTYPE'INFO.PTYPEFIELD = USER OR                       <<06644>>08110000
   SCHED'PTYPE'INFO.PTYPEFIELD = SON'OF'MAIN THEN              <<06644>>08115000
   BEGIN                                                       <<06644>>08120000
   BUF'(OFFSET + PTYPEOFFSET) := IF SCHED'PTYPE'INFO.PTYPEFIELD<<06644>>08125000
                                 = MAIN THEN                   <<06644>>08130000
                                    "M"                        <<06644>>08135000
                                 ELSE                          <<06644>>08140000
                                    "U";                       <<06644>>08145000
   PINJOBMAP(PCB'INDEX/PCBSIZE,BUF'(OFFSET + JOBOFFSET),TEMP); <<06644>>08150000
   END;                                                        <<06644>>08155000
ASCII(PCB'INDEX/PCBSIZE,10,BUF'(OFFSET + PINOFFSET));          <<06644>>08160000
                                                               <<06644>>08165000
END; << SUBROUTINE PUTBUF >>                                   <<06644>>08170000
                                                               <<06644>>08175000
                                                               <<06644>>08180000
TURNOFFTRAPS;                                                  <<06644>>08185000
@BUF' := @BUF & LSL(1);                                        <<06644>>08190000
ARRAY'SIZE := TEMP'ARRAY'ENTRY'SIZE * PCB(0);                  <<06644>>08195000
<< see if we have enough room >>                               <<06644>>08200000
PUSH(S,Z);                                                     <<06644>>08205000
S'TO'Z := TOS - TOS; << space between S and Z >>               <<06644>>08210000
IF S'TO'Z < ARRAY'SIZE THEN << have to expand >>               <<06644>>08215000
   BEGIN                                                       <<06644>>08220000
   PUSH(Z);                                                    <<06644>>08225000
   OLD'Z := TOS;                                               <<06644>>08230000
   S'TO'Z := OLD'Z + ARRAY'SIZE;                               <<06644>>08235000
   ZSIZE(S'TO'Z);                                              <<06644>>08240000
   IF <> THEN << no room >>                                    <<06644>>08245000
      BEGIN                                                    <<06644>>08250000
      MOVE BUF' := "Stack too small to execute command",2;     <<06644>>08255000
      LEN := TOS - @BUF';                                      <<06644>>08260000
      PRINT(BUF,-LEN,0);                                       <<06644>>08265000
      RETURN;                                                  <<06644>>08270000
      END;                                                     <<06644>>08275000
   END; << stack expansion >>                                  <<06644>>08280000
PUSH(S);                                                       <<06644>>08285000
@DYNAMIC'ARRAY := TOS; << initialize dynamic array ptr >>      <<06644>>08290000
TOS := ARRAY'SIZE;                                             <<06644>>08295000
ASSEMBLE(ADDS 0);                                              <<06644>>08300000
                                                               <<06644>>08305000
DISABLE; << no process switch, no interrupts >>                <<06644>>08310000
                                                               <<06644>>08315000
<< do the dispatcher's q first >>                              <<06644>>08320000
PCBPT := DISPQHEAD;                                            <<06644>>08325000
WHILE PCBPT <> 0 DO                                            <<06644>>08330000
   BEGIN                                                       <<06644>>08335000
   DYNAMIC'ARRAY(I:=I+1) := (QUEUEINGINFO LAND QUEUE'MASK) LOR <<06644>>08340000
                                (PROCSTATE LAND PTYPE'MASK);   <<06644>>08345000
   DYNAMIC'ARRAY(I := I + 1) := PCBPT;                         <<06644>>08350000
   PCBPT := NQPTR;                                             <<06644>>08355000
   END;                                                        <<06644>>08360000
                                                               <<06644>>08365000
NUM'DISPQ'PROCS :=  I + 1;                                     <<06644>>08370000
<< do processes on no list >>                                  <<06644>>08375000
PCBPT := 0;                                                    <<06644>>08380000
WHILE INTEGER((PCBPT := PCBPT + PCBSIZE)) <                    <<06733>>08385000
      INTEGER(PCB(0) * PCBSIZE) DO                             <<06644>>08390000
   BEGIN                                                       <<06644>>08395000
   IF PROCSTATE.ALIVEFLAG AND                                  <<06644>>08400000
      NOT QUEUEINGINFO.DISPQFLAG THEN                          <<06644>>08405000
      BEGIN                                                    <<06644>>08410000
      DYNAMIC'ARRAY(I:=I+1):=(QUEUEINGINFO LAND QUEUE'MASK) LOR<<06644>>08415000
                                   (PROCSTATE LAND PTYPE'MASK);<<06644>>08420000
      DYNAMIC'ARRAY(I := I + 1) := PCBPT;                      <<06644>>08425000
      END;                                                     <<06644>>08430000
   END;                                                        <<06644>>08435000
NUM'NO'Q'PROCS := I + 1;                                       <<06644>>08440000
                                                               <<06644>>08445000
ENABLE;                                                        <<06644>>08450000
CLEARBUF;                                                      <<06644>>08455000
PRINT(BUF,0,0);                                                <<06644>>08460000
MOVE BUF'(1) := "DORMANT";                                     <<06644>>08465000
MOVE BUF'(22) := "WAITING";                                    <<06644>>08470000
MOVE BUF'(43) := "RUNNING";                                    <<06644>>08475000
PRINT(BUF,BUFSIZE,0);                                          <<06644>>08480000
CLEARBUF;                                                      <<06644>>08485000
MOVE BUF' := "Q  PIN   JOBNUM";                                <<06644>>08490000
MOVE BUF'(21) := BUF',(15);                                    <<06644>>08495000
MOVE BUF'(42) := BUF',(15);                                    <<06644>>08500000
                                                               <<06644>>08505000
PRINT(BUF,30,0);                                               <<06644>>08510000
PRINT(BUF,0,DOUBLE'SPACE);                                     <<06644>>08515000
I := 0;                                                        <<06644>>08520000
J := NUM'DISPQ'PROCS;                                          <<06644>>08525000
WHILE (I + J) < (NUM'NO'Q'PROCS + NUM'DISPQ'PROCS) DO          <<06644>>08530000
   BEGIN                                                       <<06644>>08535000
   CLEARBUF;                                                   <<06644>>08540000
   IF I < NUM'DISPQ'PROCS THEN                                 <<06644>>08545000
      BEGIN                                                    <<06644>>08550000
      OFFSET' := 42;                                           <<06644>>08555000
      PUTBUF(DYNAMIC'ARRAY(I),OFFSET',DYNAMIC'ARRAY(I + 1));   <<06644>>08560000
      I := I + 2;                                              <<06644>>08565000
      END;                                                     <<06644>>08570000
   IF J < NUM'NO'Q'PROCS THEN                                  <<06644>>08575000
      BEGIN                                                    <<06644>>08580000
      OFFSET' := 0;                                            <<06644>>08585000
      PUTBUF(DYNAMIC'ARRAY(J),OFFSET',DYNAMIC'ARRAY(J + 1));   <<06644>>08590000
      J := J + 2;                                              <<06644>>08595000
      END;                                                     <<06644>>08600000
   PRINT(BUF,30,0);                                            <<06644>>08605000
   END;                                                        <<06644>>08610000
                                                               <<06644>>08615000
                                                               <<06644>>08620000
  CLEARBUF;                                                    <<01549>>08625000
  PRINT(BUF,0,0);                                              <<01549>>08630000
  I:=-1;                                                       <<01549>>08635000
  WHILE (I:=I+1)<3 DO                                          <<01549>>08640000
  BEGIN                                                        <<01549>>08645000
     BUF':="C"+I;                                              <<01549>>08650000
     MOVE BUF'(1):="Q MINQUANTUM=",2;                          <<01549>>08655000
     LEN:=ASCII((J:=ICS'L(MIN(I))),10,BPS0);                   <<01549>>08660000
     TOS:=TOS+LEN;                                             <<01549>>08665000
     MOVE *:=", MAXQUANTUM=",2;                                <<01549>>08670000
     LEN:=ASCII((J:=ICS'L(MAX(I))),10,BPS0);                   <<01549>>08675000
     TOS:=TOS+LEN;                                             <<01549>>08680000
     MOVE *:=", BASEPRI=",2;                                   <<01549>>08685000
     LEN:=ASCII((J:=ICS'L(BASE(I))),10,BPS0);                  <<01549>>08690000
     TOS:=TOS+LEN;                                             <<01549>>08695000
     MOVE *:=", LIMITPRI=",2;                                  <<01549>>08700000
     LEN:=ASCII((J:=ICS'L(LIMIT(I))),10,BPS0);                 <<01549>>08705000
     TOS:=TOS+LEN;                                             <<01549>>08710000
     LEN:=TOS-@BUF';                                           <<01549>>08715000
     PRINT(BUF,-LEN,0);                                        <<01549>>08720000
     CLEARBUF;                                                 <<01549>>08725000
  END;                                                         <<01549>>08730000
  MOVE BUF':="MINIMUM CLOCK CYCLE=",2;                         <<01549>>08735000
  DJ'D:=ABSOLUTE(CLOCKCYCLE);                                  <<01549>>08740000
  DJ'D(1):=ABSOLUTE(CLOCKCYCLE+1);                             <<01549>>08745000
  LEN:=DASCII(DJ,10,BPS0);                                     <<01549>>08750000
  TOS:=TOS+LEN;                                                <<01549>>08755000
  LEN:=TOS-@BUF';                                              <<01549>>08760000
  PRINT(BUF,-LEN,0);                                           <<01549>>08765000
IF OLD'Z <> 0 THEN                                             <<06644>>08770000
   ZSIZE(OLD'Z);                                               <<06644>>08775000
END; << showq >>                                               <<06644>>08780000
                                                                        08785000
                                                                        08790000
         <<...*DISP*00*>>                                               08795000
                                                                        08800000
                                                                        08805000
PROCEDURE SHOWSQ(B);                                                    08810000
   VALUE B;                                                             08815000
   BYTE B;                                                              08820000
   OPTION PRIVILEGED,UNCALLABLE;                                        08825000
   BEGIN                                                                08830000
   SHOWMQ;                                                              08835000
   END;                                                                 08840000
                                                                        08845000
PROCEDURE ABORTJOB(MAINPIN);                                            08850000
VALUE MAINPIN;                                                          08855000
INTEGER MAINPIN;                                                        08860000
OPTION UNCALLABLE,PRIVILEGED;                                           08865000
                                                                        08870000
                                                                        08875000
COMMENT: USED TO ABORT ANY BATCH,JOB OR SESSION.                        08880000
         NORMALLY USED FROM OPERATOR CONSOLE.                           08885000
                                                                        08890000
         RETURN:                                                        08895000
            CCE   OK                                                    08900000
            CCG   IF MAIN NOT ALIVE                                     08905000
            CCL   IF PROCESS NOT A MAIN                                 08910000
      ;                                                                 08915000
                                                                        08920000
                                                                        08925000
BEGIN                                                                   08930000
                                                                        08935000
 INTEGER   FATHER;                                             <<SB.01>>08940000
 INTEGER   SON:=1;                                             <<SB.01>>08945000
 DEFINE FATHER'PNTR=PCB(FATHER*PCBSIZE+FATHERINFOWORDNUM)/     <<06644>>08950000
                    PCBSIZE#,                                  <<06644>>08955000
        SON'PNTR=PCB(FATHER*PCBSIZE+SONINFOWORDNUM)/           <<06644>>08960000
                 PCBSIZE#,                                     <<06644>>08965000
        BROTHER'PNTR=PCB(FATHER*PCBSIZE+BROTHERINFOWORDNUM)/   <<06644>>08970000
                     PCBSIZE#;                                 <<06644>>08975000
                                                               <<SB.01>>08980000
      DISABLE;                                                          08985000
      TOS := PCB(MAINPIN*PCBSIZE+PROCSTATEWORDNUM);            <<06644>>08990000
      IF NOT LS0.ALIVEFLAG THEN TOS := CCG                     <<06644>>08995000
      ELSE                                                              09000000
      BEGIN                                                             09005000
         IF NOT TOS.MAINPROCFLAG THEN TOS := CCL               <<06644>>09010000
         ELSE                                                           09015000
         BEGIN                                                          09020000
            TOS:=CCE;                                          <<SB.01>>09025000
            SET'PSIF(MAINPIN*PCBSIZE,%20);                     <<06644>>09030000
            ENABLE;                                            <<SB.01>>09035000
            ABORTPROCIO(MAINPIN);  <<ABORT IO ON PROCESS>>     <<SB.01>>09040000
            FATHER:=MAINPIN;                                   <<SB.01>>09045000
            IF SON'PNTR <> 0 THEN  <<WE HAVE A FAMILY>>        <<SB.01>>09050000
                                                               <<SB.01>>09055000
              << ABORT IO FOR ALL FAMILY MEMBERS.         >>   <<SB.01>>09060000
              << DO NOT ABORT IO ON FATHER OR BROTHERS OF >>   <<SB.01>>09065000
              << MAINPIN                                  >>   <<SB.01>>09070000
                                                               <<SB.01>>09075000
                                                                        09080000
              DO BEGIN  << ABORT IO FOR FAMILY >>              <<SB.01>>09085000
                 DISABLE;                                      <<SB.01>>09090000
                 IF (SON'PNTR=0) OR (SON=0) THEN               <<SB.01>>09095000
                    SON:=BROTHER'PNTR                          <<SB.01>>09100000
                 ELSE                                          <<SB.01>>09105000
                    SON:=SON'PNTR;                             <<SB.01>>09110000
                 IF SON <> 0 THEN                              <<SB.01>>09115000
                    BEGIN                                      <<SB.01>>09120000
                       FATHER:=SON;  <<SETUP FOR LP TERMINATE>><<SB.01>>09125000
                       IF PCB(SON*PCBSIZE+PROCSTATEWORDNUM).   <<06644>>09130000
                          ALIVEFLAG THEN                       <<06644>>09135000
                          BEGIN                                <<SB.01>>09140000
                             ENABLE;                           <<SB.01>>09145000
                             ABORTPROCIO(SON);                 <<SB.01>>09150000
                          END;                                 <<SB.01>>09155000
                    END                                        <<SB.01>>09160000
                 ELSE            <<NO MORE SONS OR BROTHERS>>  <<SB.01>>09165000
                                 <<FOR THIS FATHER         >>  <<SB.01>>09170000
                    IF FATHER <> MAINPIN THEN                  <<SB.01>>09175000
                       FATHER:=FATHER'PNTR; <<GET HIS FATHER>> <<SB.01>>09180000
                 END << ABORT IO FOR FAMILY >>                 <<SB.01>>09185000
               UNTIL FATHER=MAINPIN;                           <<SB.01>>09190000
            REMRITENTRY'(MAINPIN,1); <<CLEAR CONSOLE REPLY>>   <<01399>>09195000
         END;                                                           09200000
      END;                                                              09205000
                                                                        09210000
      STATUS.(6:2):=TOS;                                                09215000
                                                                        09220000
                                                                        09225000
END;  << A B O R T J O B  >>                                            09230000
                                                                        09235000
PROCEDURE ABORTPROG;                                                    09240000
OPTION UNCALLABLE,PRIVILEGED;                                           09245000
                                                                        09250000
                                                                        09255000
COMMENT: KILLS SON OF MAIN.                                             09260000
         TO BE CALLED FROM BREAK MODE IN COMMAND INTERPRETER.           09265000
         ;                                                              09270000
                                                                        09275000
BEGIN                                                                   09280000
      INTEGER                                                  <<06644>>09285000
         SON,                                                  <<06644>>09290000
         PCBPT;                                                <<06644>>09295000
                                                                        09300000
                                                                        09305000
                                                                        09310000
      PCBPT := CURPRC;                                         <<06644>>09315000
      SON := SONINFO;                                          <<06644>>09320000
      IF SON = 0 THEN                                          <<06644>>09325000
         SUDDENDEATH(302);                                     <<06644>>09330000
      IF PCB(SON+PROCSTATEWORDNUM).ALIVEFLAG THEN              <<06644>>09335000
      BEGIN                            <<ALIVE>>                        09340000
         TOS := SETCRITICAL;                                            09345000
         SET'PSIF(SON,%20);            << SOFT KILL >>                  09350000
         ABORTPROCIO(SON/PCBSIZE);                                      09355000
         AWAKE(SON,%400,0); <<ABORT MAIL WAIT>>                <<01163>>09360000
         REMRITENTRY'(SON/PCBSIZE,1);  <<CLEAR CONSOLE REPLY>> <<01399>>09365000
         DISABLE;                                                       09370000
         IF NOT  PCB(SON+PIINFOWORDNUM).DEADFLAG THEN          <<06644>>09375000
            WAIT(%4000,0);                                     <<06644>>09380000
         <<MOURNING WAIT>>                                              09385000
         ENABLE;                                                        09390000
         BURRYPROC(SON);                                                09395000
         RESETCRITICAL(*);                                              09400000
      END ELSE                                                          09405000
      BEGIN                                                             09410000
         DISABLE;                                                       09415000
         CLEAR'PSIF(SON,4);            <<HYP:=0>>                       09420000
         WAIT(2,0);                    <<WAIT FOR SON>>                 09425000
         ENABLE;                                                        09430000
      END;                                                              09435000
                                                                        09440000
      SETJCW(%140000);   <<"SYSTEM 0">>                        <<U.RAO>>09445000
                                                                        09450000
END;  << A B O R T P R O G  >>                                          09455000
                                                                        09460000
PROCEDURE  QUANTUM(TS,TP,NP,CP);                                        09465000
VALUE  TS,TP,NP,CP;                                                     09470000
LOGICAL TS;                                                             09475000
INTEGER TP,NP,CP;                                                       09480000
OPTION  PRIVILEGED, UNCALLABLE;                                         09485000
BEGIN                                                                   09490000
<<                                                                      09495000
      CHANGES QUANTUM AND PRIORITES FOR A TIMESHARE PROCESS             09500000
>>                                                                      09505000
                                                                        09510000
   ARRAY  PARAM(*) = Q-11;                                              09515000
                                                                        09520000
END;  << Q U A N T U M  >>                                              09525000
                                                                        09530000
PROCEDURE BREAKJOB(LDEV,BRKFLAG,MAINPIN,CY'PIN);               <<06644>>09535000
VALUE LDEV,BRKFLAG,MAINPIN,CY'PIN;                             <<06644>>09540000
INTEGER LDEV;                                                  <<06644>>09545000
LOGICAL BRKFLAG,MAINPIN,CY'PIN;                                <<06644>>09550000
OPTION PRIVILEGED,UNCALLABLE;                                  <<06644>>09555000
                                                               <<06644>>09560000
BEGIN << PROCEDURE BREAKJOB >>                                 <<06644>>09565000
COMMENT                                                        <<06644>>09570000
                                                               <<06644>>09575000
The following procedure will send a pseudo interrupt against   <<06644>>09580000
all sons if BRKFLAG is true (i.e. we want a BREAKJOB) thus     <<06644>>09585000
causing the sons of MAINPIN to be hybernated. It will also,    <<06644>>09590000
in the case of BREAKJOB awake the MAINPIN. In the event that   <<06644>>09595000
BREAKJOB is to be done, MAINPIN should contain the PCB relative<<06644>>09600000
index of the MAIN pin, and CY'PIN should contain a zero. It    <<06644>>09605000
is assumed that the caller will check that LDEV belongs to     <<06644>>09610000
a session, as only session can be broken via the BREAKJOB      <<06644>>09615000
mechanism. In the event that BRKFLAG is false, the procedure   <<06644>>09620000
expects the PCB relative index of MAINPIN in MAINPIN and       <<06644>>09625000
the PCB relative value of CY'PIN in CY'PIN. In the event       <<06644>>09630000
that BRKFLAG is false,the pseudo interrupt is a control Y      <<06644>>09635000
type sent against CY'PIN.DS will have to flag calling this     <<06644>>09640000
procedure by using bit (0:1) of the BRKFLAG parameter.         <<06644>>09645000
In using the BRKFLAG parameter , please pass in only  0 or a 1 <<06644>>09650000
in bit 15, as for now bit 0 is reserved to DS.                 <<06644>>09655000
                                                               <<06644>>09660000
Returns are as follows : CCE    OK                             <<06644>>09665000
                         CCL    If main not waiting for son    <<06644>>09670000
                                (Return valid when BREAKJOB)   <<06644>>09675000
                                If the CY'PIN is not live      <<06644>>09680000
                                (Return valid when BREAKSS)    <<06644>>09685000
                         CCG    Invalid or conflicting parms.  <<06644>>09690000
                                                               <<06644>>09695000
;                                                              <<06644>>09700000
DEFINE                                                         <<06644>>09705000
   PDISABLE = ASSEMBLE(PSDB)#,                                 <<06644>>09710000
   PENABLE = ASSEMBLE(PSEB)#,                                  <<06644>>09715000
   DSBRKPLAB = ABSOLUTE(%1360)#;                               <<06644>>09720000
EQUATE                                                         <<06644>>09725000
   LPDT'ENTRYSIZE = 4,                                         <<06644>>09730000
   LPDTSTATEWORDNUM = 1,                                       <<06644>>09735000
   UCOPSONWAIT = %1040,                                        <<06644>>09740000
   HYBERNATE = 4,                                              <<06644>>09745000
   BREAK = 1,                                                  <<06644>>09750000
   RITWAIT = %40,                                              <<06644>>09755000
   SONWAIT = 2,                                                <<06644>>09760000
   CONTROLY = 2,                                               <<06644>>09765000
   UCPSNOTHR = %176720;                                        <<06644>>09770000
INTEGER                                                        <<06644>>09775000
   CC := CCL,                                                  <<06644>>09780000
   NEXT := 0;                                                  <<06644>>09785000
LOGICAL POINTER                                                <<06644>>09790000
   LPDT = 8;                                                   <<06644>>09795000
DEFINE                                                         <<06644>>09800000
   CONTROLYFLAG = (4:1)#,                                      <<06644>>09805000
   BREAKFLAG = (10:1)#;                                        <<06644>>09810000
LOGICAL                                                        <<06644>>09815000
   LPDTSTATE := 0,                                             <<06644>>09820000
   DS'CALL := FALSE,                                           <<06644>>09825000
   RIT'WAIT := FALSE,                                          <<06644>>09830000
   REFUSE'BREAK := FALSE;                                      <<06644>>09835000
                                                               <<06644>>09840000
SUBROUTINE PEXIT(CONDITION'CODE,PSEUDO'ENABLE);                <<06644>>09845000
VALUE CONDITION'CODE,PSEUDO'ENABLE;                            <<06644>>09850000
INTEGER CONDITION'CODE;                                        <<06644>>09855000
LOGICAL PSEUDO'ENABLE;                                         <<06644>>09860000
                                                               <<06644>>09865000
<< begin SUBROUTINE PEXIT >>                                   <<06644>>09870000
BEGIN                                                          <<06644>>09875000
CC := CONDITION'CODE;                                          <<06644>>09880000
STATUS.(6:2) := CC;                                            <<06644>>09885000
IF PSEUDO'ENABLE THEN                                          <<06644>>09890000
   PENABLE;                                                    <<06644>>09895000
TOS := 4; << number of parameters for this procedure >>        <<06644>>09900000
TOS := TOS + %31400; << exit intruction >>                     <<06644>>09905000
ASSEMBLE(XEQ 0);                                               <<06644>>09910000
END; << subroutine PEXIT >>                                    <<06644>>09915000
                                                               <<06644>>09920000
<< Begin procedure >>                                          <<06644>>09925000
PDISABLE; <<  don't want any process switches >>               <<06644>>09930000
DS'CALL := IF CY'PIN = 0 AND NOT BRKFLAG THEN TRUE ELSE FALSE; <<07312>>09935000
<< integrity check >>                                          <<06644>>09940000
IF ((MAINPIN = 0) LOR (MAINPIN > PCB(0) * PCBSIZE)) THEN       <<06644>>09945000
   PEXIT(CCG,TRUE);                                            <<06644>>09950000
                                                               <<06644>>09955000
IF NOT DS'CALL THEN                                            <<07312>>09960000
   IF NOT BRKFLAG AND                                          <<07312>>09965000
   ((CY'PIN = 0) LOR (CY'PIN > PCB(0) * PCBSIZE)) THEN         <<06644>>09970000
   PEXIT(CCG,TRUE);                                            <<06644>>09975000
                                                               <<06644>>09980000
IF BRKFLAG.(1:14) <> 0 THEN                                    <<06644>>09985000
   PEXIT(CCG,TRUE);                                            <<06644>>09990000
                                                               <<06644>>09995000
<< check if break is allowed >>                                <<06644>>10000000
IF NOT TESTALIVE(MAINPIN/PCBSIZE) THEN                         <<07312>>10005000
   PEXIT(CCL,TRUE);                                            <<06644>>10010000
IF NOT DS'CALL THEN                                            <<07312>>10015000
   IF NOT BRKFLAG AND                                          <<07312>>10020000
   NOT TESTALIVE(CY'PIN/PCBSIZE) THEN                          <<07312>>10025000
   PEXIT(CCL,TRUE);                                            <<06644>>10030000
IF NOT DS'CALL THEN                                            <<07312>>10035000
   BEGIN                                                       <<06644>>10040000
   DISABLE;                                                    <<06644>>10045000
   LPDTSTATE := LPDT(LDEV * LPDT'ENTRYSIZE + LPDTSTATEWORDNUM);<<06644>>10050000
   IF NOT BRKFLAG THEN << ss break >>                          <<06644>>10055000
      BEGIN                                                    <<06644>>10060000
      LPDTSTATE.CONTROLYFLAG := 1;                             <<06644>>10065000
      LPDT(LDEV*LPDT'ENTRYSIZE+LPDTSTATEWORDNUM):=LPDTSTATE;   <<06644>>10070000
      END                                                      <<06644>>10075000
   ELSE                                                        <<06644>>10080000
      IF (PCB(MAINPIN + WAKEMASKWORDNUM) LAND UCOPSONWAIT)=0 OR<<06644>>10085000
         (PCB(MAINPIN + WAKEMASKWORDNUM) LAND UCPSNOTHR)<>0THEN<<06644>>10090000
         BEGIN                                                 <<06644>>10095000
         LPDTSTATE.BREAKFLAG := 1;                             <<06644>>10100000
         IF = THEN                                             <<06644>>10105000
            CC := CCE;                                         <<06644>>10110000
         LPDT(LDEV*LPDT'ENTRYSIZE+LPDTSTATEWORDNUM):=LPDTSTATE;<<06644>>10115000
         REFUSE'BREAK := TRUE;                                 <<06644>>10120000
         END;                                                  <<06644>>10125000
   ENABLE;                                                     <<06644>>10130000
   IF NOT REFUSE'BREAK THEN                                    <<06644>>10135000
      BEGIN                                                    <<06644>>10140000
      CC := CCE;                                               <<06644>>10145000
      IF BRKFLAG THEN                                          <<06644>>10150000
         BEGIN                                                 <<06644>>10155000
         IF PCB(MAINPIN + SONINFOWORDNUM) <> 0 THEN            <<06644>>10160000
            BEGIN                                              <<06644>>10165000
            NEXT := MAINPIN;                                   <<06644>>10170000
            WHILE << hybernate all sons >>                     <<06644>>10175000
            (NEXT:=FAMILY(NEXT/PCBSIZE,MAINPIN/PCBSIZE)*       <<06644>>10180000
                     PCBSIZE) <> INTEGER(MAINPIN)              <<06644>>10185000
               DO                                              <<06644>>10190000
                  SET'PSIF(NEXT,HYBERNATE);                    <<06644>>10195000
            END;                                               <<06644>>10200000
         SET'PSIF(MAINPIN,BREAK);                              <<06644>>10205000
         RIT'WAIT:=PCB(MAINPIN + WAKEMASKWORDNUM).             <<06644>>10210000
                   RIT'UCOPWAITFLAG;                           <<06644>>10215000
         PCB(MAINPIN + RESABORTINFOWORDNUM).RITBRKFLAG :=      <<06644>>10220000
             RIT'WAIT;                                         <<06644>>10225000
         IF RIT'WAIT THEN                                      <<06644>>10230000
            AWAKE(MAINPIN,RITWAIT,0)                           <<06644>>10235000
         ELSE                                                  <<06644>>10240000
            AWAKE(MAINPIN,SONWAIT,0);                          <<06644>>10245000
         END                                                   <<06644>>10250000
      ELSE                                                     <<06644>>10255000
         SET'PSIF(CY'PIN,CONTROLY);                            <<06644>>10260000
      END;                                                     <<06644>>10265000
   END;                                                        <<06644>>10270000
<< DS control y >>                                             <<06644>>10275000
PENABLE;                                                       <<06644>>10280000
TOS := 0;                                                      <<06644>>10285000
TOS := BRKFLAG;                                                <<06644>>10290000
TOS := MAINPIN;                                                <<06644>>10295000
TOS := CY'PIN;                                                 <<06644>>10300000
TOS := DSBRKPLAB;                                              <<06644>>10305000
IF <> THEN                                                     <<06644>>10310000
   ASSEMBLE(PCAL 0);                                           <<06644>>10315000
IF TOS THEN                                                    <<06644>>10320000
   CC := CCE;                                                  <<06644>>10325000
PEXIT(CC,FALSE);                                               <<06644>>10330000
                                                               <<06644>>10335000
                                                               <<06644>>10340000
END;  << BREAKJOB >>                                           <<06644>>10345000
                                                                        10350000
PROCEDURE CAUSEBREAK;                                                   10355000
OPTION PRIVILEGED;                                                      10360000
                                                                        10365000
COMMENT: SIMULATES PROGRAMMATICALLY A BREAK TO COMMAND                  10370000
         INTERPRETER.                                                   10375000
         RETURNS CCL IF NOT A SESSION.                                  10380000
      ;                                                                 10385000
                                                                        10390000
BEGIN                                                                   10395000
      EQUATE TYP=6;                                                     10400000
      EQUATE STIN=3;                                                    10405000
                                                                        10410000
      LOGICAL ARRAY QARRAY(*)=Q+0;                             <<06630>>10415000
      INTEGER PCBGLOBLOC;                                      <<06630>>10420000
      DEFINE  CC = STATUS.(6:2)#;                                       10425000
      INTEGER LDEV,FAT,NEXT;                                            10430000
      INTEGER PCBPT;                                           <<06644>>10435000
      ENTRY CAUSEBREAK';                                                10440000
                                                                        10445000
CAUSEBREAK':                                                            10450000
      ERRORON;                                                          10455000
      PCBPT := CURPRC;                                         <<06644>>10460000
      CHEK(56&LSL(5),0);                                                10465000
      PXGLOBAL;                                                <<06630>>10470000
      IF PXG'JOBTYPE<>1                  <<TEST FOR SESSION>>  <<06630>>10475000
      THEN                                                              10480000
      BEGIN                                                             10485000
         CC:=CCL;                                                       10490000
         GOTO EX;                                                       10495000
      END;                                                              10500000
                                                                        10505000
      CC:=CCE;                                                          10510000
      LDEV:=PXG'INPUTLDEV;           <<STDIN>>                 <<06630>>10515000
      FAT := FATHERINFO/PCBSIZE;                               <<06644>>10520000
      WHILE NOT PCB(FAT*PCBSIZE+PROCSTATEWORDNUM).             <<06644>>10525000
                MAINPROCFLAG DO                                <<06644>>10530000
      FAT := PCBI(FAT*PCBSIZE+FATHERINFOWORDNUM)/              <<06644>>10535000
             PCBSIZE;                                          <<06644>>10540000
      <<HERE FAT CONTAINS MAIN'S PIN>>                                  10545000
      NEXT:=FAT;                                                        10550000
      DISAPROC;                                                         10555000
                                                                        10560000
      WHILE (NEXT:=FAMILY(NEXT,FAT))<>FAT DO                            10565000
      SET'PSIF( NEXT*PCBSIZE,4 );  << HYBERNATE >>                      10570000
                                                                        10575000
      SET'PSIF( FAT*PCBSIZE,1 );  << SET BREAK BIT >>                   10580000
      AWAKE( FAT*PCBSIZE,2,0 );   << WAKE UP >>                         10585000
      ASSEMBLE( DISP );           << FORCE DISPATCH ENTRY >>            10590000
      ENAPROC;                                                          10595000
                                                                        10600000
EX:   ERROREXIT(56&LSL(6),0,0);                                         10605000
      HELP;  << FOR BREAKPOINT LINKING >>                               10610000
                                                                        10615000
END;  << C A U S E B R E A K  >>                                        10620000
                                                                        10625000
DOUBLE PROCEDURE CLOCK;                                                 10630000
   OPTION     PRIVILEGED;                                               10635000
   BEGIN                                                                10640000
     LOGICAL C1=Q-6, C2=Q-5, C3=Q-4;                                    10645000
     ARRAY Q0(*)=Q+0;                                                   10650000
     INTEGER TYPE := -4;                                                10655000
     ENTRY CALENDAR;                                                    10660000
     INTEGER  S',S,M,H,                                        <<01.03>>10665000
              DATE,  << YEAR:JULIAN DAY >>                     <<01.03>>10670000
              DAY,                                             <<01.03>>10675000
              DAYS'SINCE,                                      <<01.03>>10680000
              DAYS'THIS'YEAR;                                  <<01.03>>10685000
     EQUATE   ONE'YEAR= [7/1,9/0];                             <<01.03>>10690000
     DEFINE   F         =ABSOLUTE#,                                     10695000
              TIME'MOD'TOS=ASSEMBLE(DDIV;DELB)#,               <<01.02>>10700000
              LEAP'YEAR=DATE.(5:2)=0#;                         <<01.03>>10705000
         TYPE := TYPE - 1;                                              10710000
     CALENDAR:                                                          10715000
         PUSH(STATUS);                                                  10720000
         TOS.(2:1) := 0;                <<DISABLE TRAPS>>               10725000
         SET(STATUS);                                                   10730000
         TOS := TIMER;  << # MILLISECONDS SINCE MIDNIGHT >>    <<01.03>>10735000
                        << PRECEEDING SYSTEM COLD LOAD   >>    <<01.03>>10740000
         TOS := 100D;                                                   10745000
         ASSEMBLE(DDIV;DDEL); <<IGNORE SEC/100>>               <<01.02>>10750000
         TOS := 10D;                                                    10755000
         TIME'MOD'TOS;                 <<TENTH SECONDS>>                10760000
         S' := TOS;                                                     10765000
         TOS := 60D;                                                    10770000
         TIME'MOD'TOS;                 <<SECONDS>>                      10775000
         S := TOS;                                                      10780000
         TOS := 60D;                                                    10785000
         TIME'MOD'TOS;                 <<MINUTES>>                      10790000
         M := TOS;                                                      10795000
         TOS := 24D;                                                    10800000
         TIME'MOD'TOS;                 <<HOURS>>                        10805000
         H := TOS;                                                      10810000
         DELB;                                                          10815000
         DAYS'SINCE := TOS; << DAYS SINCE COLD LOAD >>         <<01.03>>10820000
          DATE := TRLDATE;  <<DAYS SINCE COLD LOAD>>           <<06879>>10825000
         DAYS'THIS'YEAR := IF LEAP'YEAR THEN 366 ELSE 365;     <<01.03>>10830000
         IF (DAY:=DATE.(7:9)+DAYS'SINCE) > DAYS'THIS'YEAR THEN <<01.03>>10835000
            BEGIN                                              <<01.03>>10840000
            DAY := DAY - DAYS'THIS'YEAR;                       <<01.03>>10845000
            DATE := DATE + ONE'YEAR;                           <<01.03>>10850000
            END;                                               <<01.03>>10855000
         DATE.(7:9) := DAY;                                    <<01.03>>10860000
         Q0(TYPE) := DATE;  << CURRENT DATE >>                 <<01.03>>10865000
         X := X + 4;                                                    10870000
         IF = THEN RETURN;     <<CALENDAR>>                             10875000
         TOS := H&LSL(8);                                               10880000
         C2 := TOS LOR LOGICAL(M);      <<HOURS:MINUTES>>               10885000
         TOS := S&LSL(8);                                               10890000
         C3 := TOS LOR LOGICAL(S');     <<SECONDS:SECONDS/10>>          10895000
   END <<CHRONOS>> ;                                                    10900000
$PAGE "PAUSE INTRINSIC"                                        <<03048>>10905000
PROCEDURE PAUSE(TIME);                                         <<03048>>10910000
REAL TIME;                                                              10915000
OPTION PRIVILEGED;                                                      10920000
                                                                        10925000
<<THIS ROUTINE SUSPENDS THE CALLING PROCESS FOR "TIME"                  10930000
  SECONDS.                                                              10935000
                                                                        10940000
  CONDITION CODES:                                                      10945000
                                                                        10950000
     CCL - ILLEGAL PARAMETER                                            10955000
     CCE - ALL OK                                                       10960000
     CCG - TRL ENTRY NOT AVAILABLE>>                                    10965000
                                                                        10970000
   BEGIN                                                                10975000
   ENTRY    PAUSEX;   <<IF ABORTED BY SOFT INT, WILL ADJUST TIME PARM>> 10980000
Comment Q + 1 has to be reserved in case we have to move       <<04523>>10985000
        the stack marker down by one. This will occur only     <<04523>>10990000
        when PAUSE was called via a PCAL 0 instruction and     <<04523>>10995000
        following a soft interrupt we have to recall PAUSE.    <<04523>>11000000
        Since a PCAL 0 deletes the procedure label, we have    <<04523>>11005000
        to put it back before recalling PAUSE, and thus        <<04523>>11010000
        insert the procedure label at Q - 4.                   <<04523>>11015000
                                                               <<04523>>11020000
        The variable PLACE'HOLDER has to be the first declared <<04523>>11025000
        variable in this procedure.                            <<04523>>11030000
;                                                              <<04523>>11035000
   INTEGER PLACE'HOLDER;                                       <<04523>>11040000
   DOUBLE  STARTIME;                                                    11045000
   REAL    DURATION;                                                    11050000
   INTEGER RESULT;                                                      11055000
   INTEGER PREGISTER=Q-2;                                               11060000
   DOUBLE  PAUSETIME:=-1D;    << "TIME" IN MILLISECONDS >>              11065000
   EQUATE  PAUSEHANG'  = [10/45,6/0];                                   11070000
   EQUATE  PAUSEHANG   = [10/45,6/1];                                   11075000
   EQUATE  SOFTINTOCCURRED=2;                                           11080000
   EQUATE SL = 1,                                              <<04523>>11085000
          NON'SL = 2,                                          <<04523>>11090000
          PCAL'0 = %31000;                                     <<04523>>11095000
   INTEGER SEGTYPE,                                            <<04523>>11100000
           DESCSTINX,                                          <<04523>>11105000
           THISPIN;                                            <<04523>>11110000
                                                               <<06657>>11115000
   DOUBLE OBJIDENT;                                            <<06657>>11120000
                                                               <<06657>>11125000
   LOGICAL MOVE'MARKER := FALSE,                               <<04523>>11130000
           BLOCKEDLOCK;                                        <<04523>>11135000
   INTEGER POINTER DST = 2;                                    <<04523>>11140000
   ARRAY QARRAY(*) = Q + 0;                                    <<04523>>11145000
   DEFINE  MSECS24DAYS = 2073600000D#;                                  11150000
   DEFINE  ASMB=ASSEMBLE#;                                              11155000
   LOGICAL STATUS=Q-1;                                                  11160000
   LOGICAL DECAY;                                                       11165000
   DEFINE  CONDCODE=STATUS.(6:2)#;                                      11170000
   EQUATE  TRLXEXHAUSTED=1;                                             11175000
   EQUATE  ALLOWSOFTINT  = TRUE;                                        11180000
   EQUATE  PRIMARYENTRY = TRUE;                                         11185000
                                                                        11190000
                                                                        11195000
   SUBROUTINE PEXIT(RETURNCODE,NUMPARMS);                               11200000
   VALUE RETURNCODE,NUMPARMS;                                           11205000
   INTEGER RETURNCODE;                                                  11210000
   LOGICAL NUMPARMS;                                                    11215000
      BEGIN                                                             11220000
      CONDCODE:=RETURNCODE;                                             11225000
      IF MOVE'MARKER THEN                                      <<04523>>11230000
         BEGIN                                                 <<04523>>11235000
         << Time to move the marker by one and put the       >><<04523>>11240000
         << procedure label of PAUSE at Q - 3.               >><<04523>>11245000
         QARRAY(1) := QARRAY(0) + 1;                           <<04523>>11250000
         QARRAY(0) := QARRAY(-1);                              <<04523>>11255000
         QARRAY(-1) := QARRAY(-2);                             <<04523>>11260000
         QARRAY(-2) := QARRAY(-3);                             <<04523>>11265000
         QARRAY(-3) := @PAUSE;                                 <<04523>>11270000
         << Can't allow DB to move around now.               >><<04523>>11275000
         ASSEMBLE(SED 0);                                      <<04523>>11280000
         PUSH(Q);                                              <<04523>>11285000
         TOS := TOS + 1;                                       <<04523>>11290000
         SET(Q);                                               <<04523>>11295000
         << Allow external interrupts.                       >><<04523>>11300000
         ASSEMBLE(SED 1);                                      <<04523>>11305000
         END;                                                  <<04523>>11310000
      ERROREXIT(PAUSEHANG' LOR NUMPARMS,0,0);                           11315000
      END;  <<PEXIT>>                                                   11320000
   <<INITIALIZE>>                                                       11325000
   IF PRIMARYENTRY THEN                                                 11330000
      DECAY:=FALSE                                                      11335000
   ELSE                                                                 11340000
      BEGIN  <<SECONDARY ENTRY,  ADJUST TIME IF SOFT INTERRUPT>>        11345000
      PAUSEX:                                                           11350000
      DECAY:=TRUE;                                                      11355000
      END;                                                              11360000
                                                                        11365000
   ERRORON;                                                             11370000
   PUSH(STATUS); TOS.(2:1):=0; SET(STATUS);  <<TURN OFF TRACE BIT>>     11375000
                                                                        11380000
   <<BOUNDS CHECK ON TIME PARAMETER>>                                   11385000
   CHECKDB;                                                             11390000
   IF <> THEN CHEK(PAUSEHANG,1,2D);  <<USER CALLED SPLIT STACK>>        11395000
   X:=@TIME; PUSH(DL,Q); TOS:=TOS-4;                                    11400000
   IF NOT (TOS <= X <= TOS) THEN CHEK(PAUSEHANG,1,2D);  <<BOUNDS VIOL>> 11405000
                                                                        11410000
   IF TIME < 1.0E+10 THEN                                               11415000
      BEGIN  <<USER ACTUALLY WANTS A FINITE DELAY>>                     11420000
      STARTIME:=TIMER;                                                  11425000
      <<CONVERT REAL SECONDS TO DOUBLE INTEGER MILLISECONDS>>           11430000
      TOS:=TIME*1000.0;                                                 11435000
      IF OVERFLOW THEN PEXIT(CCL,1);                                    11440000
      ASMB(FIXR);                                                       11445000
      IF < OR OVERFLOW THEN PEXIT(CCL,1);                               11450000
      PAUSETIME:=TOS;                                                   11455000
      END;                                                              11460000
                                                                        11465000
   IF (RESULT:=TIMEOUT(PAUSETIME,ALLOWSOFTINT)) = TRLXEXHAUSTED THEN    11470000
      PEXIT(CCG,1);                                                     11475000
                                                                        11480000
   IF RESULT = SOFTINTOCCURRED THEN                                     11485000
      BEGIN  <<FORCE USER TO RECALL PAUSE>>                             11490000
      Comment check to see if call to PAUSE was done via       <<04523>>11495000
              a PCAL 0 instruction.                            <<04523>>11500000
      ;                                                        <<04523>>11505000
      << Have to freeze the code segment first, but we have  >><<04523>>11510000
      << to get the segment number in the proper format first>><<04523>>11515000
      THISPIN := (CURPRC)/PCBSIZE;                             <<06644>>11520000
      SEGTYPE := IF MARKER'IS'SL'SEG(QARRAY(-1),QARRAY(-2),0)  <<07364>>11525000
                    THEN SL                                    <<07364>>11530000
                    ELSE NON'SL;                               <<07364>>11535000
      OBJIDENT := BUILDSEGID(SEGTYPE,STATUS.(8:8),THISPIN);    <<06657>>11540000
      FREEZESEG'(OBJIDENT,BLOCKEDLOCK<< ignored >>);           <<06657>>11545000
      << Calculate the CST or CSTX entry as an offset of DST >><<04523>>11550000
      << base.                                               >><<04523>>11555000
      DESCSTINX := CONVSEGIDTOSTINX(OBJIDENT);                 <<06657>>11560000
      << Put down effective address of the instruction >>      <<04523>>11565000
      TOS := DST(X := DESCSTINX + 2);                          <<04523>>11570000
      TOS := DST(X := X + 1);                                  <<04523>>11575000
      TOS := PREGISTER - 1;                                    <<04523>>11580000
      ASSEMBLE(LADD);                                          <<04523>>11585000
      ASSEMBLE(LSEA);                                          <<04523>>11590000
      IF TOS = PCAL'0 THEN                                     <<04523>>11595000
         MOVE'MARKER := TRUE;                                  <<04523>>11600000
      << Now we are done and going to unfreeze the segment >>  <<04523>>11605000
      UNFREEZESEG'(OBJIDENT);                                  <<06657>>11610000
      PREGISTER:=PREGISTER-1;                                           11615000
      PREGISTER.(0:1):=1;  <<FORCE ERROREXIT TO TRAP TO ININ>>          11620000
      IF DECAY AND PAUSETIME <> 0D THEN                                 11625000
         BEGIN  <<ADJUST CALLER'S TIME PARM FOR TIME SPENT IN WAIT>>    11630000
         TOS:=TIMER-STARTIME;                                           11635000
         IF < THEN TOS:=TOS+MSECS24DAYS;                                11640000
         TOS:=TOS/1000D;                                                11645000
         ASMB(FLT); DURATION:=TOS; TIME:=TIME-DURATION;                 11650000
         END;                                                           11655000
      PEXIT(CCE,0);                                                     11660000
      END;                                                              11665000
   PEXIT(CCE,1);                                                        11670000
   END;  <<PAUSE>>                                                      11675000
$PAGE                                                                   11680000
            << >>                                                       11685000
            <<TEST FOR ALIVE FATHER/SON PCB.                            11690000
               PIN   =0  FATHER                                         11695000
                     <>0 SON                                            11700000
               RETURNS  :=  TRUE   ALIVE                                11705000
                         FALSE  NOT ALIVE      >>                       11710000
            << >>                                                       11715000
LOGICAL PROCEDURE TESTALIVE(PIN);                                       11720000
  VALUE   PIN;                                                          11725000
  LOGICAL PIN;                                                          11730000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               11735000
  BEGIN                                                                 11740000
          INTEGER PCBPT;                                       <<06644>>11745000
          EQUATE     PCBB=3,       <<PCB>>                              11750000
                     CPCB=4,                                            11755000
                     FATHERL=5,    <<PCB TABLE>>                        11760000
                     ALIVEL =9;                                         11765000
          DEFINE     FATHERF=(0:8)#,   <<PCB>>                          11770000
                     ALIVEF =(0:1)#;                                    11775000
            << >>                                                       11780000
          PCBPT := CURPRC;                                     <<06644>>11785000
          IF PIN = 0 THEN PIN:=FATHERINFO/PCBSIZE;             <<06644>>11790000
          TESTALIVE := PCB(PIN*PCBSIZE+PROCSTATEWORDNUM).      <<06644>>11795000
                       ALIVEFLAG;                              <<06644>>11800000
  END;                                                                  11805000
                                                                        11810000
                                                                        11815000
            << >>                                                       11820000
            <<CHECKS VALIDITY OF FATHER/SON PCB#                        11825000
          RETURNS    -MAILBOX PCB #                                     11830000
                     -0 IF ILLEGAL                                      11835000
               PIN <>0 -SON -CHECK IF EXISTS                            11840000
               PIN = 0 -FATHER -INVALID IF JMP OR SMP                   11845000
                                   UNLESS PRIVILEGED USER  >>           11850000
            << >>                                                       11855000
LOGICAL PROCEDURE CHEKMAILPCB(PIN);                                     11860000
  VALUE   PIN;                                                          11865000
  LOGICAL PIN;                                                          11870000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               11875000
  BEGIN                                                                 11880000
          INTEGER ARRAY STAK(*)=Q+0;                                    11885000
          LOGICAL PINX,PINY;                                            11890000
            << >>                                                       11895000
          TOS := LOCKJIR;                                               11900000
          IF PIN=0 THEN GOTO CONT;                                      11905000
        PINX := PCB(CURPRC + SONINFOWORDNUM)/                  <<06644>>11910000
                PCBSIZE;                                       <<06644>>11915000
          WHILE PINX<>0 AND PINX<>PIN DO                                11920000
             PINX := PCB(PINX*PCBSIZE+BROTHERINFOWORDNUM)/     <<06644>>11925000
                     PCBSIZE;                                  <<06644>>11930000
          GOTO FIN;                                                     11935000
CONT:   PINX := (CURPRC)/PCBSIZE;                              <<06644>>11940000
        PINY := PCB(CURPRC+FATHERINFOWORDNUM)/                 <<06644>>11945000
                PCBSIZE;                                       <<06644>>11950000
          IF STAK(-STAK(0)-1)<0 THEN GOTO FIN;                          11955000
        IF PCB(CURPRC+PROCSTATEWORDNUM).PTYPEFIELD' = 1        <<06644>>11960000
                                   THEN PINX := 0;                      11965000
        IF PCB(PINY*PCBSIZE+PROCSTATEWORDNUM).                 <<06644>>11970000
           PTYPEFIELD = 2 THEN PINX := 0;                      <<06644>>11975000
  FIN:    UNLOCKJIR(*);                                                 11980000
          CHEKMAILPCB := PINX;                                          11985000
  END;                                                                  11990000
                                                                        11995000
                                                                        12000000
            << >>                                                       12005000
            <<GET THE MAILBOX STATUS RELATIVE TO MAILBOX                12010000
               IN SON                                                   12015000
               00-   NULL                                               12020000
               01-   OUTGOING FROM SON                                  12025000
               02-   INCOMING TO SON                                    12030000
               03-   BLOCKED                                            12035000
               IF BLOCKED THEN AUTO GOES INTO A BLOCKED                 12040000
               (MAIL) WAIT SUBSTATE ELSE RETURNS AND                    12045000
               SETS A BLOCKED CONDITION IN MAILBOX                      12050000
               IF DIRECTION<3                                           12055000
                                                                        12060000
               IN:   PIN  =0 (FATHER)                                   12065000
                          #0 (SON)                                      12070000
                     DIRECTION =0 SEND                                  12075000
                               =1 RECEIVE                               12080000
                               =2 ABORT                                 12085000
                                                                        12090000
               OUT: GETMAILSTATUS := STATUS BITS      >>                12095000
            << >>                                                       12100000
LOGICAL PROCEDURE GETMAILSTATUS(PIN,DIRECTION);                         12105000
  VALUE   PIN,DIRECTION;                                                12110000
  LOGICAL PIN,DIRECTION;                                                12115000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               12120000
  BEGIN                                                                 12125000
EQUATE                                                         <<06644>>12130000
   BLOKWAIT = %420;                                            <<06644>>12135000
          LOGICAL PCBNUM,LOC,SELF,BITS;                                 12140000
            << >>                                                       12145000
RETRY:    LOC := SELF := CURPRC;                               <<06644>>12150000
          IF PIN <> 0 THEN LOC := PIN*PCBSIZE;                 <<06644>>12155000
          DISAPROC;                                            <<00652>>12160000
          BITS := PCB(LOC+PROCSTATEWORDNUM).PPCFIELD;          <<06644>>12165000
          IF DIRECTION>2 THEN GOTO CONT;                                12170000
          IF BITS=3 THEN                                                12175000
               BEGIN WAIT(BLOKWAIT,0);   <<BLOCKED MAIL WAIT>>          12180000
                     GOTO RETRY;                                        12185000
               END;                                                     12190000
          PCB(LOC+PROCSTATEWORDNUM).PPCFIELD := 3;             <<06644>>12195000
  CONT:   ENAPROC;                                             <<00652>>12200000
          TOS := BITS;                                                  12205000
          IF PIN<>0 THEN ASSEMBLE(ZERO; DCSR 1; LSR 14; OR);            12210000
          GETMAILSTATUS := TOS;                                         12215000
  END;                                                                  12220000
                                                                        12225000
                                                                        12230000
            << >>                                                       12235000
            <<SET THE MAILBOX STATUS.                                   12240000
               IF REQUESTED WAIT FOR MAIL                               12245000
               AWAKEN ANY WAITING PROCESS                               12250000
                                                                        12255000
               IN:   PIN=0 FATHER                                       12260000
                        #0 SON                                          12265000
                     BITS=STATUS BITS                                   12270000
                     WAITFLAG=TRUE COND WAIT                            12275000
                              FALSE NO WAIT                             12280000
                     DIRECTION =0 SEND                                  12285000
                               =1 RECEIVE                               12290000
                               =2 ABORT                                 12295000
                                                                        12300000
               OUT:  SETMAILSTATUS := TRUE OK.                          12305000
                                   := FALSE ILLEGAL WAIT      >>        12310000
            << >>                                                       12315000
LOGICAL PROCEDURE SETMAILSTATUS(PIN,BITS,WAITFLAG,DIRECTION);           12320000
  VALUE   PIN,BITS,WAITFLAG,DIRECTION;                                  12325000
  LOGICAL PIN,BITS,WAITFLAG,DIRECTION;                                  12330000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               12335000
  BEGIN                                                                 12340000
EQUATE                                                         <<06644>>12345000
   MAILWAIT = %400;                                            <<06644>>12350000
         DEFINE SOFTKILL=PCB(CURPRC+PROCSTATEWORDNUM).         <<06644>>12355000
                         SOFTKILLFLAG#;                        <<06644>>12360000
          LOGICAL LOC,SELF,HIM,DSELF,DHIM;                              12365000
          INTEGER X=X;                                                  12370000
            << >>                                                       12375000
         SELF := CURPRC;                                       <<06644>>12380000
          IF (DSELF:=DIRECTION) > 2 THEN GO TO FIN1;                    12385000
          IF PIN=0                                                      12390000
            THEN BEGIN LOC := SELF;                                     12395000
                      HIM := PCB(FATHERINFOWORDNUM+SELF);      <<06644>>12400000
                 END                                                    12405000
           ELSE BEGIN LOC := HIM := PIN * PCBSIZE;             <<06644>>12410000
                       TOS := BITS;                                     12415000
                       ASSEMBLE( ZERO; DCSR 1; LSR 14; OR);             12420000
                       BITS := TOS;                                     12425000
                       DSELF := DSELF+2;                                12430000
                 END;                                                   12435000
          DISAPROC;                                            <<00652>>12440000
         TOS := PCB(HIM+WAKEMASKWORDNUM);                      <<06644>>12445000
         TOS.MAILWAITFLAG := 0;                                <<06644>>12450000
          IF = THEN GOTO CONT;                                          12455000
         TOS.JUNKWAITFLAG := 0;                                <<06644>>12460000
          IF <> THEN GOTO AWAKEN;                                       12465000
         DHIM := PCB(HIM+PROCSTATEWORDNUM).PPCWAITFIELD;       <<06644>>12470000
          IF PIN=0                                                      12475000
            THEN BEGIN IF DHIM<2 THEN GOTO CONT;                        12480000
                       DHIM := DHIM-2;                                  12485000
                 END                                                    12490000
            ELSE IF DHIM>=2 THEN GOTO CONT;                             12495000
          IF WAITFLAG AND DHIM=DIRECTION THEN                           12500000
               BEGIN SETMAILSTATUS := FALSE;                            12505000
                    PCB(LOC+PROCSTATEWORDNUM).PPCFIELD:=BITS;  <<06644>>12510000
                     ENAPROC;                                  <<00652>>12515000
                     RETURN;                                            12520000
               END;                                                     12525000
  AWAKEN:                                                               12530000
         PCB(HIM+PROCSTATEWORDNUM).PPCWAITFIELD := 0;          <<06644>>12535000
         AWAKE(HIM,%420,0);                                    <<06644>>12540000
  CONT:                                                                 12545000
         PCB(LOC+PROCSTATEWORDNUM).PPCFIELD := BITS;           <<06644>>12550000
          IF NOT WAITFLAG THEN GOTO FIN;                                12555000
          IF DIRECTION=2 THEN GOTO FIN;                                 12560000
          PCB(SELF+PROCSTATEWORDNUM).PPCWAITFIELD := DSELF;    <<06644>>12565000
          IF SOFTKILL THEN ENAPROC ELSE WAIT(MAILWAIT,0);      <<00652>>12570000
          SETMAILSTATUS:=IF SOFTKILL THEN FALSE ELSE TRUE;     <<00142>>12575000
             <<IF S.K. THEN PRODUCE DUMMY ERROR>>              <<00142>>12580000
          RETURN;                                                       12585000
  FIN:    ENAPROC;                                             <<00652>>12590000
  FIN1:   SETMAILSTATUS := TRUE;                                        12595000
  END;                                                                  12600000
                                                                        12605000
                                                                        12610000
            << >>                                                       12615000
            << GET MAILBOX INFO FROM P-P COM TABLE >>                   12620000
            << >>                                                       12625000
DOUBLE PROCEDURE GETMAILINFO(PCBNUM);                                   12630000
  VALUE   PCBNUM;                                                       12635000
  LOGICAL PCBNUM;                                                       12640000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               12645000
  BEGIN                                                                 12650000
          EQUATE     PPCTDSTN=10;  <<P-P COM TABLE>>                    12655000
          INTEGER  T = Q-6;                                             12660000
            << >>                                                       12665000
          TOS := @T;               << DESTINATION >>                    12670000
          TOS := PPCTDSTN;         << DATA SEGMENT >>                   12675000
          TOS := PCBNUM&LSL(1);    << OFFSET IN DS >>                   12680000
          TOS := 2;                << WORD COUNT >>                     12685000
          ASSEMBLE( MFDS 4 );      << MOVE IT >>                        12690000
  END;                                                                  12695000
                                                                        12700000
                                                                        12705000
            << >>                                                       12710000
            << SET MAILBOX INFO IN P-P COM TABLE>>                      12715000
            << >>                                                       12720000
PROCEDURE SETMAILINFO(D,PCBNUM);                                        12725000
  VALUE   D,PCBNUM;                                                     12730000
  LOGICAL PCBNUM;                                                       12735000
  DOUBLE  D;                                                            12740000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               12745000
  BEGIN                                                                 12750000
          EQUATE     PPCTDSTN=10;  <<P-P COM TABLE>>                    12755000
            << >>                                                       12760000
          TOS := PPCTDSTN;  TOS := PCBNUM&LSL(1);                       12765000
          TOS := @D;                                                    12770000
          TOS := 2;                                                     12775000
          ASSEMBLE( MTDS 4 );                                           12780000
  END;                                                                  12785000
                                                                        12790000
                                                                        12795000
            << >>                                                       12800000
            <<ABORT MAILBOX INFORMATION.                                12805000
               CLEAR MAIL AND RELEASE DATA SEGMENT     >>               12810000
            << >>                                                       12815000
PROCEDURE ABORTMAILINFO(PCBNUM);                                        12820000
  VALUE   PCBNUM;                                                       12825000
  LOGICAL PCBNUM;                                                       12830000
  OPTION  PRIVILEGED,UNCALLABLE,INTERNAL;                               12835000
  BEGIN                                                                 12840000
          TOS := GETMAILINFO(PCBNUM);                                   12845000
          ASSEMBLE(XCH);                                                12850000
          IF TOS=1 THEN DEL ELSE RELDATASEG(*);                         12855000
          SETMAILINFO(0D,PCBNUM);                                       12860000
  END;                                                                  12865000
                                                                        12870000
                                                                        12875000
            << >>                                                       12880000
            <<ABORT MAIL. CALLED AT TERMINATION OF PROCESS.             12885000
               FATHER MAIL                                              12890000
                     - NOT ALIVE   -ABORT ANY MAIL                      12895000
                     - ALIVE       -RESPECTS SEND/BLOCK,ABORT           12900000
                                       ANY OTHER                        12905000
                                   -ABORT ALL IF ABNORMAL               12910000
                                       TERMINATION                      12915000
                     - EITHER      -AWAKEN FATHER IF WAITING            12920000
               SON MAIL                                                 12925000
                     - AWAKEN SONS IF WAITING FOR MAIL     >>           12930000
            << >>                                                       12935000
PROCEDURE ABORTMAIL;                                                    12940000
  OPTION  PRIVILEGED,UNCALLABLE;                                        12945000
  BEGIN                                                                 12950000
EQUATE                                                         <<06644>>12955000
   PXABORTY = 12;                                              <<06644>>12960000
          DEFINE ABORTFLAG = (1:1)#; <<ABORT FLAG IN PXFIXED>> <<06098>>12965000
          LOGICAL ARRAY QARRAY(*) = Q+0;                       <<06630>>12970000
          LOGICAL PXFIXEDLOC;                                  <<06630>>12975000
          LOGICAL PIN,PCBNUM,BITS,CODE,CRIT;                            12980000
          INTEGER X=X;                                                  12985000
          SWITCH SW := FREE,OUT,IN,WAIT;                                12990000
          << >>                                                         12995000
          CRIT := SETCRITICAL;                                          13000000
          PIN := 0;                                                     13005000
          PCBNUM := CHEKMAILPCB(PIN);                                   13010000
  AGAIN:  BITS := GETMAILSTATUS(PIN,2);                                 13015000
          GOTO SW(CODE := BITS);                                        13020000
          << >>                                                         13025000
  FREE:   GOTO CONT;                                                    13030000
          << >>                                                         13035000
  OUT:    IF NOT TESTALIVE(PIN) THEN GOTO IN;                           13040000
          IF PCB(CURPRC+PIINFOWORDNUM).                        <<06644>>13045000
             PSIMFIELD <> 7 THEN GOTO IN;                      <<06644>>13050000
          PXFIXED;                                             <<06630>>13055000
          IF PXFXAIP = 0                                       <<06630>>13060000
            THEN GO WAIT;  <<ABORT NOT IN PROGRESS>>           <<06098>>13065000
          << >>                                                         13070000
  IN:     ABORTMAILINFO(PCBNUM);                                        13075000
          GOTO CONT;                                                    13080000
          << >>                                                         13085000
  WAIT:   SETMAILSTATUS(PIN,CODE,TRUE,0);                               13090000
          GOTO AGAIN;                                                   13095000
          << >>                                                         13100000
  CONT:   CODE := 0;                                                    13105000
          SETMAILSTATUS(PIN,CODE,FALSE,2);                              13110000
  CONTX:  TOS := LOCKJIR;                                               13115000
          PIN:=PCB(CURPRC+SONINFOWORDNUM)/PCBSIZE;             <<06644>>13120000
          WHILE PIN<>0 DO                                               13125000
               BEGIN SETMAILSTATUS(PIN,0,FALSE,2);                      13130000
                     PIN:=PCB(PIN*PCBSIZE+BROTHERINFOWORDNUM)  <<06644>>13135000
                          /PCBSIZE;                            <<06644>>13140000
               END;                                                     13145000
          UNLOCKJIR(*);                                                 13150000
          RESETCRITICAL(CRIT);                                          13155000
  END;                                                                  13160000
                                                                        13165000
                                                                        13170000
            << >>                                                       13175000
<<********************************************************>>            13180000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            13185000
<<********************************************************>>            13190000
            << TEST THE MAILBOX FOR STATUS. IF INCOMING                 13195000
               THEN RETURNS COUNT                                       13200000
                                                                        13205000
               PIN   = 0 FATHER                                         13210000
                     > 0 SON                                            13215000
                                                                        13220000
               MAIL   :=  0 - NULL                                      13225000
                       1 - OUTGOING                                     13230000
                       2 - INCOMING                                     13235000
                       3 - ERROR                                        13240000
                       4 - BLOCKED                                      13245000
               COUNT  :=  # OF WORDS OF MAIL                            13250000
                                                                        13255000
               CODE: CC=0 OK.                                           13260000
                     CC>0 NO.  - ILLEGAL PIN(3)                         13265000
                     CC<0 (NULL)       >>                               13270000
<<********************************************************>>            13275000
            << >>                                                       13280000
LOGICAL PROCEDURE MAIL(PIN,COUNT);                                      13285000
  VALUE   PIN;                                                          13290000
  INTEGER PIN,COUNT;                                                    13295000
    OPTION PRIVILEGED;                                                  13300000
  BEGIN                                                                 13305000
          EQUATE ERRN=106, CAP1=1, EXITN=2;                             13310000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               13315000
          EQUATE CCE=2,                                                 13320000
                 CCG=0,                                                 13325000
                 CCL=1;                                                 13330000
          DEFINE     CCFLD=(6:2)#;                                      13335000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                13340000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             13345000
          SWITCH SW := FREE,OUT,IN,BLOK;                                13350000
          << >>                                                         13355000
          ERRORON;                                                      13360000
          CHEK(ERREX,%102,%10D,DOUBLE(CAP1));                           13365000
          CRIT := SETCRITICAL;                                          13370000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        13375000
  ILL:         BEGIN CCERR := CCG;                                      13380000
                     BITS := 3;                                         13385000
                     GOTO FINX;                                         13390000
               END;                                                     13395000
          BITS := GETMAILSTATUS(PIN,3);                                 13400000
          GOTO SW(CODE := BITS);                                        13405000
          << >>                                                         13410000
  FREE:   IF NOT TESTALIVE(PIN) THEN GOTO ILLX;                         13415000
          GOTO FIN;                                                     13420000
            << >>                                                       13425000
  OUT:    IF NOT TESTALIVE(PIN) THEN GOTO ILLX;                         13430000
          GOTO FIN;                                                     13435000
            << >>                                                       13440000
  IN:     IF PIN=0 AND NOT TESTALIVE(PIN) THEN GOTO ILLX;               13445000
          TOS := GETMAILINFO(PCBNUM);                                   13450000
          DEL;                                                          13455000
          COUNT := TOS;                                                 13460000
          GOTO FIN;                                                     13465000
          << >>                                                         13470000
  BLOK:   BITS := 4;                                                    13475000
          GOTO FIN;                                                     13480000
          << >>                                                         13485000
  ILLX:   CCERR := CCG;                                                 13490000
          BITS := 3;                                                    13495000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,3);                              13500000
  FINX:   STATUS.CCFLD := CCERR;                                        13505000
          MAIL := BITS;                                                 13510000
          RESETCRITICAL(CRIT);                                          13515000
          ERROREXIT(ERREX,0,0);                                         13520000
  END;                                                                  13525000
                                                                        13530000
                                                                        13535000
            << >>                                                       13540000
<<********************************************************>>            13545000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            13550000
<<********************************************************>>            13555000
            <<PREPARE AND SEND THE MAIL.                                13560000
               STATUS IS RETURNED TO INDICATE COMPLETION OR             13565000
               OTHERWISE. ANY PREVIOUS MAIL WHICH WAS SENT              13570000
               BUT NOT COLLECTED,IS EITHER AUTO OVERWRITTEN             13575000
               WITH THE NEW MAIL OR ALLOWED TO BE COLLECTED             13580000
               BEFORE CONTINUING THE REQUEST,DEPENDING ON THE           13585000
               VALUE OF WAITFLAG. THE MAILBOX MAY ALSO BE               13590000
               EXPLICITELY CLEARED. A BLOCKED CONDITION CAUSES          13595000
               AN EXPLICIT "WAIT" UNTIL READY                           13600000
                                                                        13605000
               PIN   =0 FATHER                                          13610000
                     <>0 SON                                            13615000
               LENGTH = LENGTH OF TRANSFER                              13620000
               LOCATION = ADDRESS OF MAIL                               13625000
               WAITFLAG =TRUE WAIT UNTIL PREVIOUS MAIL SENT             13630000
                        =FALSE OVERWRITE PREVIOUS MAIL                  13635000
                                                                        13640000
               SENDMAIL  :=  0 - OK SEND COMPLETED                      13645000
                          1 - OK OVERWRITE OR CLEAR                     13650000
                          2 - INCOMING                                  13655000
                          3 - ERROR                                     13660000
                          4 - NOWAIT                                    13665000
                          5 - MAXDATA                                   13670000
                          6 - RESOURCE                                  13675000
                                                                        13680000
               CODE: CC=0 OK.                                           13685000
                     CC>0 NO.  - ILLEGAL PIN(3)                         13690000
                               - ILLEGAL 0>LENGTH>SYS MAX(5)            13695000
                               - STORAGE RESOURCE UNAVAILABLE(6)        13700000
                     CC<0 NO.  - BOUNDS FAILURE(3)                      13705000
                               - BOTH PROCESSES WAITING TO SEND(4) >>   13710000
<<********************************************************>>            13715000
            << >>                                                       13720000
LOGICAL PROCEDURE SENDMAIL(PIN,LENGTH,LOCATION,WAITFLAG);               13725000
  VALUE   PIN,LENGTH,WAITFLAG;                                          13730000
  LOGICAL WAITFLAG;                                                     13735000
  INTEGER PIN,LENGTH;                                                   13740000
  ARRAY   LOCATION;                                                     13745000
  OPTION  PRIVILEGED;                                                   13750000
  BEGIN                                                                 13755000
          EQUATE ERRN=107, CAP1=1, EXITN=4;                             13760000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               13765000
          EQUATE BOUND=-EXITN-4;                                        13770000
          EQUATE CCE=2,                                                 13775000
                 CCG=0,                                                 13780000
                 CCL=1;                                                 13785000
          EQUATE MAXDSEG = %1111;                              <<06644>>13790000
          DEFINE     CCFLD=(6:2)#;                                      13795000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                13800000
          DOUBLE DD;                                                    13805000
          INTEGER COUNT=DD;                                             13810000
          LOGICAL DSTX=DD+1;                                            13815000
          INTEGER LOC=Q-5;                                              13820000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             13825000
          SWITCH SW := FREE,OUT,IN,WAIT;                                13830000
            << >>                                                       13835000
          ERRORON;                                                      13840000
          CHEK(ERREX,%104,%40D,DOUBLE(CAP1));                           13845000
          CRIT := SETCRITICAL;                                          13850000
          IF LENGTH<0 OR LENGTH>ABSOLUTE(MAXDSEG) THEN                  13855000
               BEGIN CCERR := CCG;                                      13860000
                     BITS := 5;                                         13865000
                     GOTO FINX;                                         13870000
               END;                                                     13875000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        13880000
  ILL:         BEGIN CCERR := CCG;                                      13885000
                     BITS := 3;                                         13890000
                     GOTO FINX;                                         13895000
               END;                                                     13900000
  AGAIN:  BITS := GETMAILSTATUS(PIN,0);                                 13905000
          GOTO SW(CODE := BITS);                                        13910000
            << >>                                                       13915000
  FREE:   IF NOT TESTALIVE(PIN) THEN                                    13920000
               BEGIN CCERR := CCG;                                      13925000
                     BITS := 3;                                         13930000
                     GOTO FIN;                                          13935000
               END;                                                     13940000
          IF LENGTH=0 THEN GOTO FIN;                                    13945000
          IF LENGTH=1 THEN                                              13950000
               BEGIN DSTX := LOCATION;                                  13955000
                     GOTO FINY;                                         13960000
               END;                                                     13965000
          COUNT := (LENGTH+3)&LSR(2)&LSL(2);                            13970000
          IF (DSTX := GETDATASEG(COUNT,0))=0 THEN                       13975000
               BEGIN CCERR := CCG;                                      13980000
                     BITS := 6;                                         13985000
                     GOTO FIN;                                          13990000
               END;                                                     13995000
          TOS := DMOVE(DSTX,0,LENGTH,LOC,FALSE,BOUND);                  14000000
          IF TOS<>CCE THEN                                              14005000
               BEGIN RELDATASEG(DSTX);                                  14010000
                     CCERR := CCL;                                      14015000
                     BITS := 3;                                         14020000
                     GOTO FIN;                                          14025000
               END;                                                     14030000
  FINY:   COUNT := LENGTH;                                              14035000
          SETMAILINFO(DD,PCBNUM);                                       14040000
          CODE := 1;                                                    14045000
          GOTO FIN;                                                     14050000
            << >>                                                       14055000
  OUT:    IF WAITFLAG THEN GOTO WAIT;                                   14060000
          ABORTMAILINFO(PCBNUM);                                        14065000
          IF LENGTH<>0 THEN GOTO FREE;                                  14070000
          CODE := 0;                                                    14075000
          GOTO FIN;                                                     14080000
            << >>                                                       14085000
  IN:     IF LENGTH <> 0 THEN  GO FIN;                                  14090000
          ABORTMAILINFO(PCBNUM);                                        14095000
          CODE := 0;                                                    14100000
          SETMAILSTATUS(PIN,CODE,FALSE,1);                              14105000
          BITS := 1;                                                    14110000
          GO  FINX;                                                     14115000
            << >>                                                       14120000
  WAIT:   IF NOT SETMAILSTATUS(PIN,CODE,TRUE,0) THEN                    14125000
               BEGIN CCERR := CCL;                                      14130000
                     BITS := 4;                                         14135000
                     GOTO FINX;                                         14140000
               END;                                                     14145000
          GOTO AGAIN;                                                   14150000
            << >>                                                       14155000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,0);                              14160000
  FINX:   STATUS.CCFLD := CCERR;                                        14165000
          SENDMAIL := BITS;                                             14170000
          RESETCRITICAL(CRIT);                                          14175000
          ERROREXIT(ERREX,0,0);                                         14180000
  END;                                                                  14185000
                                                                        14190000
                                                                        14195000
            << >>                                                       14200000
<<********************************************************>>            14205000
<<******  CALLABLE - CAPABILITY 1 -  P - P COM    ********>>            14210000
<<********************************************************>>            14215000
            << RECEIVE THE INCOMING MAIL.                               14220000
               STATUS IS RETURNED TO INDICATE RECEIPT OR                14225000
               OTHERWISE.THE PARAMETER WAITFLAG DETERMINES THE          14230000
               ACTION TAKEN IF THE MAILBOX IS EMPTY - WAIT              14235000
               OR RETURN.A BLOCKED CONDITION CAUSES AN                  14240000
               EXPLICIT "WAIT" UNTIL READY.                             14245000
                                                                        14250000
               PIN   = 0 FATHER                                         14255000
                     <>0 SON                                            14260000
               LOCATION = RECEIVER'S BUFFER ADDRESS                     14265000
               WAITFLAG =TRUE  WAIT FOR MAIL                            14270000
                        =FALSE RETURN                                   14275000
                                                                        14280000
               RECEIVEMAIL  :=  0 - NULL                                14285000
                             1 - OUTGOING                               14290000
                             2 - OK MAIL RECEIVED                       14295000
                             3 - ERROR                                  14300000
                             4 - NOWAIT                                 14305000
                                                                        14310000
               CODE: CC=0 OK.                                           14315000
                     CC>0 NO.  - ILLEGAL PIN(3)                         14320000
                     CC<0 NO.  - BOUNDS FAILURE(3)                      14325000
                               - BOTH WAITING TO RECEIVE(4)  >>         14330000
<<********************************************************>>            14335000
            << >>                                                       14340000
LOGICAL PROCEDURE RECEIVEMAIL(PIN,LOCATION,WAITFLAG);                   14345000
  VALUE   PIN,WAITFLAG;                                                 14350000
  LOGICAL WAITFLAG;                                                     14355000
  INTEGER PIN;                                                          14360000
  ARRAY   LOCATION;                                                     14365000
  OPTION  PRIVILEGED;                                                   14370000
  BEGIN                                                                 14375000
          EQUATE ERRN=108, CAP1=1, EXITN=3;                             14380000
          EQUATE ERREX=[10/ERRN,6/EXITN];                               14385000
          EQUATE BOUND=-EXITN-4;                                        14390000
          EQUATE CCE=2,                                                 14395000
                 CCG=0,                                                 14400000
                 CCL=1;                                                 14405000
          DEFINE     CCFLD=(6:2)#;                                      14410000
          LOGICAL PCBNUM,BITS,CODE,CRIT;                                14415000
          DOUBLE DD;                                                    14420000
          INTEGER COUNT=DD;                                             14425000
          LOGICAL DSTX=DD+1;                                            14430000
          INTEGER LOC=Q-5;                                              14435000
          LOGICAL CCERR := CCE, STATUS=Q-1;                             14440000
          SWITCH SW := FREE,OUT,IN,WAIT;                                14445000
            << >>                                                       14450000
          ERRORON;                                                      14455000
          CHEK(ERREX,%103,%10D,DOUBLE(CAP1));                           14460000
          CRIT := SETCRITICAL;                                          14465000
          IF (PCBNUM := CHEKMAILPCB(PIN))=0 THEN                        14470000
  ILL:         BEGIN CCERR := CCG;                                      14475000
                     BITS := 3;                                         14480000
                     GOTO FINX;                                         14485000
               END;                                                     14490000
  AGAIN:  BITS := GETMAILSTATUS(PIN,1);                                 14495000
          GOTO SW(CODE := BITS);                                        14500000
            << >>                                                       14505000
  FREE:   IF NOT WAITFLAG THEN  GO FIN;                                 14510000
          IF NOT TESTALIVE(PIN) THEN                                    14515000
             BEGIN                                                      14520000
             CCERR := CCG;                                              14525000
             BITS := 3;                                                 14530000
             GO FIN;                                                    14535000
             END;                                                       14540000
          GO WAIT;                                                      14545000
            << >>                                                       14550000
  OUT:    GOTO FIN;                                                     14555000
            << >>                                                       14560000
  IN:     IF PIN=0 AND NOT TESTALIVE(PIN) THEN                          14565000
               BEGIN CCERR := CCG;                                      14570000
                     BITS := 3;                                         14575000
                     GOTO FIN;                                          14580000
               END;                                                     14585000
          DD := GETMAILINFO(PCBNUM);                                    14590000
          IF COUNT=1 THEN                                               14595000
               BEGIN LOCATION := DSTX;                                  14600000
                     GOTO FINY;                                         14605000
               END;                                                     14610000
          TOS := DMOVE(DSTX,0,COUNT,LOC,TRUE,BOUND);                    14615000
          IF TOS<>CCE THEN                                              14620000
               BEGIN CCERR := CCL;                                      14625000
                     BITS := 3;                                         14630000
                     GOTO FIN;                                          14635000
               END;                                                     14640000
  FINY:   ABORTMAILINFO(PCBNUM);                                        14645000
          CODE := 0;                                                    14650000
          GOTO FIN;                                                     14655000
            << >>                                                       14660000
  WAIT:   IF NOT SETMAILSTATUS(PIN,CODE,TRUE,1) THEN                    14665000
               BEGIN CCERR := CCL;                                      14670000
                     BITS := 4;                                         14675000
                     GOTO FINX;                                         14680000
               END;                                                     14685000
          GOTO AGAIN;                                                   14690000
            << >>                                                       14695000
  FIN:    SETMAILSTATUS(PIN,CODE,FALSE,1);                              14700000
  FINX:   STATUS.CCFLD := CCERR;                                        14705000
          RECEIVEMAIL := BITS;                                          14710000
          RESETCRITICAL(CRIT);                                          14715000
          ERROREXIT(ERREX,0,0);                                         14720000
          HELP; << DUMMY CALL TO LINK BREAKPOINTS >>                    14725000
  END;                                                                  14730000
                                                                        14735000
                                                                        14740000
                                                                        14745000
                                                                        14750000
$CONTROL SEGMENT=MAIN                                                   14755000
SHOWMQ;                                                        <<01549>>14760000
END.  << PROCSEG >>                                            <<00652>>14765000
