$CONTROL MAP,CODE,USLINIT                                               00010000
<< CHECKER -- MODULE 69 >>                                              00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL SEGMENT=CHECKER                                                00028000
$THIRTY                                                                 00030000
                                                                        00032000
                                                                        00034000
BEGIN                                                                   00036000
                                                                        00038000
                                                                        00040000
POINTER PCB=3;                                                 <<IMAGE>>00042000
                                                               <<IMAGE>>00044000
DEFINE IQPTR=(8:8)#,                                           <<IMAGE>>00046000
       F=ABSOLUTE#,                                            <<IMAGE>>00048000
       MYPINNUMBER=((F(CPCB)-F(PCBB))/PCBSIZE)#;               <<IMAGE>>00050000
                                                               <<IMAGE>>00052000
EQUATE PCBSIZE=16,                                             <<IMAGE>>00054000
       CPCB   =4,                                              <<IMAGE>>00056000
       PCBB   =3;                                              <<IMAGE>>00058000
                                                               <<IMAGE>>00060000
                                                               <<IMAGE>>00062000
DEFINE SYSSEGFLAG=(6:1)#;                                      <<01549>>00064000
DOUBLE POINTER MEASBUF=DB+%17;                                 <<01549>>00066000
                                                                        00068000
$INCLUDE INCLPCB                                               <<04488>>00070000
PROCEDURE WAIT(WF,JPCNTX);VALUE WF,JPCNTX;INTEGER WF,JPCNTX;            00072000
OPTION EXTERNAL;                                                        00074000
                                                                        00076000
<<------------------------------------------------------------------->> 00078000
INTEGER PROCEDURE SYSPROC(LP);VALUE LP;INTEGER LP;OPTION EXTERNAL;      00080000
                                                                        00082000
<<------------------------------------------------------------------->> 00084000
LOGICAL PROCEDURE SETCRITICAL; OPTION EXTERNAL;                         00086000
                                                                        00088000
<<------------------------------------------------------------------->> 00090000
LOGICAL PROCEDURE EXCHANGEDB(A);VALUE A;LOGICAL A;OPTION EXTERNAL;      00092000
                                                                        00094000
<<------------------------------------------------------------------->> 00096000
PROCEDURE RESETCRITICAL(A);VALUE A;LOGICAL A;OPTION EXTERNAL;           00098000
                                                                        00100000
<<------------------------------------------------------------------->> 00102000
LOGICAL PROCEDURE GETSIR(A);VALUE A;LOGICAL A;OPTION EXTERNAL;          00104000
                                                                        00106000
<<------------------------------------------------------------------->> 00108000
PROCEDURE RELSIR(A,B);VALUE A,B;LOGICAL A,B;OPTION EXTERNAL;            00110000
                                                                        00112000
<<------------------------------------------------------------------->> 00114000
LOGICAL PROCEDURE SETSYSDB; OPTION EXTERNAL;                            00116000
                                                                        00118000
<<------------------------------------------------------------------->> 00120000
PROCEDURE RESETDB(A);VALUE A;LOGICAL A;OPTION EXTERNAL;                 00122000
                                                                        00124000
<<------------------------------------------------------------------->> 00126000
PROCEDURE  AWAKE(P,N,W);  VALUE P,N,W;  INTEGER P,N,W;                  00128000
OPTION EXTERNAL;                                                        00130000
                                                                        00132000
<<------------------------------------------------------------------->> 00134000
PROCEDURE ABORT(A,B,C);VALUE A,B,C;LOGICAL A,B,C;OPTION EXTERNAL;       00136000
                                                                        00138000
<<------------------------------------------------------------------->> 00140000
PROCEDURE SUDDENDEATH(A); VALUE A; INTEGER A; OPTION EXTERNAL;          00142000
                                                                        00144000
<<------------------------------------------------------------------->> 00146000
PROCEDURE HELP; OPTION EXTERNAL;                                        00148000
                                                                        00150000
<<------------------------------------------------------------------->> 00152000
                                                                        00154000
PROCEDURE IMPAIRED(A,B,C); VALUE A,B,C; INTEGER A,B; LOGICAL C;<<IMAGE>>00156000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<IMAGE>>00158000
PROCEDURE UNIMPEDE(A); VALUE A; INTEGER A;                     <<IMAGE>>00160000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<IMAGE>>00162000
PROCEDURE IMPEDE(P); VALUE P; INTEGER P;                       <<00085>>00164000
OPTION EXTERNAL;                                               <<00085>>00166000
                                                               <<IMAGE>>00168000
                                                                        00170000
DOUBLE PROCEDURE TIMER;                                        <<01549>>00172000
OPTION EXTERNAL;                                               <<01549>>00174000
                                                                        00176000
                                                                        00178000
                                                                        00180000
DOUBLE PROCEDURE PROCTIME;                                              00182000
OPTION PRIVILEGED;                                                      00184000
                                                                        00186000
                                                                        00188000
COMMENT: RETURNS A DOUBLE WORD WHICH IS THE RUNNING TIME                00190000
         OF THE CALLER PROCESS IN MILLISECONDS.                         00192000
      ;                                                                 00194000
                                                                        00196000
                                                                        00198000
BEGIN                                                                   00200000
      EQUATE PTIMEX=24;                                                 00202000
                                                                        00204000
      ARRAY PCBX(*)=Q+0;                                                00206000
      INTEGER X=X;                                                      00208000
                                                                        00210000
                                                                        00212000
      PUSH(Q,DL);                                                       00214000
      ASSEMBLE(XCH,SUB;DUP,STAX;DECX,DECX);                             00216000
      TOS:=-PCBX(X);                                                    00218000
      ASSEMBLE(ADD);                                                    00220000
      X:=TOS+PTIMEX;                                                    00222000
      ASSEMBLE(SED 0);                                                  00224000
      TOS:=PCBX(X);                                                     00226000
      TOS:=PCBX(X:=X+1);                                                00228000
      TOS := 0;                                                         00230000
      ASSEMBLE( RCLK; DADD );                                           00232000
      PROCTIME := TOS;                                                  00234000
                                                                        00236000
                                                                        00238000
END;  << P R O C T I M E  >>                                            00240000
                                                                        00242000
                                                                        00244000
<<------------------------------------------------------------------->> 00246000
                                                                        00248000
                                                                        00250000
                                                                        00252000
                                                                        00254000
                                                                        00256000
                                                                        00258000
          << >>                                                         00260000
          <<RUN TIME (ABORT) ERRORS.                                    00262000
               - INCREMENT ERROR LEVEL                                  00264000
               - CLEAR ERROR WORD      >>                               00266000
          << >>                                                         00268000
PROCEDURE ERRORON;                                                      00270000
  OPTION  PRIVILEGED,UNCALLABLE;                                        00272000
  BEGIN                                                                 00274000
          EQUATE     PXERROR=35;                                        00276000
          EQUATE     CPCB=4,                                            00278000
                     SYXL=9,                                            00280000
                     SYSL=3;                                            00282000
          DEFINE     SYSF=(11:1)#;                                      00284000
          DEFINE     SYXF=(6:1)#;                                       00286000
          DEFINE     TRAPFLD=(2:1)#;                                    00288000
          ARRAY STACK(*)=Q+0;                                           00290000
          LOGICAL STATUS=Q-1;                                           00292000
          INTEGER X=X;                                                  00294000
          << >>                                                         00296000
          STATUS.TRAPFLD:=0;        <<TURN OFF TRAPS>>                  00298000
          PUSH(STATUS); TOS.(2:1) := 0; SET(STATUS);                    00300000
          IF ABSOLUTE(ABSOLUTE(CPCB)+SYXL).SYXF THEN RETURN;            00302000
          PUSH(Q,DL);                                                   00304000
          ASSEMBLE(XCH,SUB; DUP,STAX);                                  00306000
          TOS:=STACK(X:=X-2)-PXERROR;                                   00308000
          X:=TOS-TOS;                                                   00310000
          TOS:=STACK(X);                                                00312000
          IF = THEN                                                     00314000
               BEGIN TOS:=X;                                            00316000
                     ABSOLUTE(ABSOLUTE(CPCB)+SYSL).SYSF:=1;             00318000
                     X:=TOS;                                            00320000
               END;                                                     00322000
          TOS:=TOS+1;                                                   00324000
          ASSEMBLE(DUP,DUP);                                            00326000
          STACK(X):=TOS;                                                00328000
          X:=TOS+X;                                                     00330000
          TOS:=TOS-6;                                                   00332000
          IF > THEN RETURN;                                             00334000
          IF < THEN                                                     00336000
               BEGIN STACK(X):=0;                                       00338000
                     X:=X+1;                                            00340000
               END;                                                     00342000
          STACK(X):=0;                                                  00344000
  END;                                                                  00346000
                                                                        00348000
                                                                        00350000
<<------------------------------------------------------------------->> 00352000
                                                                        00354000
                                                                        00356000
                                                                        00358000
                                                                        00360000
                                                                        00362000
                                                                        00364000
          << >>                                                         00366000
          <<RUN TIME (ABORT) ERRORS.                                    00368000
               - GET ERROR WORD FROM RELATIVE LEVEL                     00370000
               - 0 IF INVALID LEVEL OR INDEX   >>                       00372000
          << >>                                                         00374000
LOGICAL PROCEDURE ERRORGET(L);                                          00376000
  VALUE   L;                                                            00378000
  INTEGER L;                                                            00380000
  OPTION  PRIVILEGED,UNCALLABLE;                                        00382000
  BEGIN                                                                 00384000
          EQUATE     PXERROR=35;                                        00386000
          EQUATE     CPCB=4,                                            00388000
                     SYXL=9;                                            00390000
          DEFINE     SYXF=(6:1)#;                                       00392000
          ARRAY STACK(*)=Q+0;                                           00394000
          INTEGER X=X;                                                  00396000
          << >>                                                         00398000
          IF ABSOLUTE(ABSOLUTE(CPCB)+SYXL).SYXF THEN RETURN;   <<01631>>00400000
          IF L<0 THEN                                                   00402000
               BEGIN TOS:=0;                                            00404000
                     GOTO FIN;                                          00406000
               END;                                                     00408000
          PUSH(Q,DL);                                                   00410000
          ASSEMBLE(XCH,SUB; DUP,STAX);                                  00412000
          TOS:=STACK(X:=X-2)-PXERROR;                                   00414000
          X:=TOS-TOS;                                                   00416000
          TOS:=STACK(X)+LOGICAL(L);                                     00418000
          ASSEMBLE(DUP);                                                00420000
          IF TOS>6 THEN                                                 00422000
               BEGIN TOS:=0;                                            00424000
                     GOTO FIN;                                          00426000
               END;                                                     00428000
          X:=TOS+X;                                                     00430000
          TOS:=STACK(X);                                                00432000
  FIN:    ERRORGET:=TOS;                                                00434000
  END;                                                                  00436000
                                                                        00438000
                                                                        00440000
<<------------------------------------------------------------------->> 00442000
                                                                        00444000
                                                                        00446000
                                                                        00448000
                                                                        00450000
                                                                        00452000
                                                                        00454000
          << >>                                                         00456000
          <<RUN TIME (ABORT) ERRORS.                                    00458000
               - PUT ERROR WORD INTO REL LEVEL   >>                     00460000
          << >>                                                         00462000
PROCEDURE ERRORPUT(ERRWORD,L);                                          00464000
  VALUE   ERRWORD,L;                                                    00466000
  INTEGER ERRWORD,L;                                                    00468000
  OPTION  PRIVILEGED,UNCALLABLE;                                        00470000
  BEGIN                                                                 00472000
          EQUATE     PXERROR=35;                                        00474000
          EQUATE     CPCB=4,                                            00476000
                     SYXL=9;                                            00478000
          DEFINE     SYXF=(6:1)#;                                       00480000
          ARRAY STACK(*)=Q+0;                                           00482000
          INTEGER X=X;                                                  00484000
          << >>                                                         00486000
          IF ABSOLUTE(ABSOLUTE(CPCB)+SYXL).SYXF THEN RETURN;            00488000
          IF L<0 THEN RETURN;                                           00490000
          PUSH(Q,DL);                                                   00492000
          ASSEMBLE(XCH,SUB; DUP,STAX);                                  00494000
          TOS:=STACK(X:=X-2)-PXERROR;                                   00496000
          X:=TOS-TOS;                                                   00498000
          TOS:=STACK(X)+LOGICAL(L);                                     00500000
          ASSEMBLE(DUP);                                                00502000
          IF TOS>6 THEN RETURN;                                         00504000
          X:=TOS+X;                                                     00506000
          STACK(X):=ERRWORD;                                            00508000
  END;                                                                  00510000
                                                                        00512000
<<------------------------------------------------------------------->> 00514000
                                                                        00516000
                                                                        00518000
                                                                        00520000
                                                                        00522000
                                                                        00524000
                                                                        00526000
          << >>                                                         00528000
          <<RUN TIME (ABORT) ERRORS.                                    00530000
               IF STOV FLAG SET THEN ABORT                              00532000
                     IF ERROR LEVEL<=1                                  00534000
               IF INTRINSIC # = 99 THEN IGNORE CARRY AND NO ABORT       00536000
               IF ERRWORD <>0 THEN (ERROR)                              00538000
                     -INSERT ERROR WORD                                 00540000
                     -IF INTRINSIC # =0 DO NOT ABORT                    00542000
                     -IF ERROR LEVEL <=1 THEN ABORT                     00544000
               RESET Q:=Q-DELTAQ                                        00546000
               CARRY BIT IN  STATUS:= 1 IF ERROR                        00548000
                                   := 0 IF NO ERROR                     00550000
               DECREMENT ERROR LEVEL                                    00552000
               EXIT THROUGH THIS PREVIOUS STACK MARKER                  00554000
                 USING PARAMETER COUNT(N)                               00556000
                                                                        00558000
               INTRINEXIT.(0:10)   = INTRINSIC ERROR #                  00560000
                         .(10:6)   = PARAMETER COUNT (N)                00562000
               ERRWORD .(0:8)      = PARAMETER                          00564000
                       .(8:8)      = ERROR BYTE                         00566000
               PARAM = ADDITIONAL INFO IF ABORT OCCURS     >>           00568000
          << >>                                                         00570000
PROCEDURE ERROREXIT(INTRINEXIT,ERRWORD,PARAM);                          00572000
  VALUE   INTRINEXIT,ERRWORD,PARAM;                                     00574000
  LOGICAL INTRINEXIT,ERRWORD,PARAM;                                     00576000
  OPTION  PRIVILEGED,UNCALLABLE;                                        00578000
  BEGIN                                                                 00580000
          EQUATE TYPE=1, MARK=2, MODE=[8/MARK,8/TYPE];                  00582000
          EQUATE SOTYPE=0, SOCODE=20, SOMODE=[8/MARK,8/SOTYPE];         00584000
          EQUATE     PXERROR=35;                                        00586000
          EQUATE     CPCB=4,                                            00588000
                     SYSL=3,                                            00590000
                     SYXL=9,                                            00592000
                     STOVL=9;                                           00594000
          DEFINE     STOVF=(5:1)#;                                      00596000
          DEFINE     SYXF=(6:1)#;                                       00598000
          DEFINE     SYSF=(11:1)#;                                      00600000
          DEFINE     IFLD= (0:10)#,                                     00602000
                     NFLD =(10:6)#,                                     00604000
                     CFLD =(5:1)#;                                      00606000
          ARRAY STACK(*)=Q+0;                                           00608000
          INTEGER KARRY:=0;                                             00610000
          LOGICAL DELTAQ=Q+0, STATUS=Q-1;                               00612000
          INTEGER X=X;                                                  00614000
          << >>                                                         00616000
          IF ABSOLUTE(ABSOLUTE(CPCB)+SYXL).SYXF THEN GOTO CONT;         00618000
          PUSH(Q,DL);                                                   00620000
          ASSEMBLE(XCH,SUB; DUP,STAX);                                  00622000
          TOS:=STACK(X:=X-2)-PXERROR;                                   00624000
          X:=TOS-TOS;                                                   00626000
          TOS:=STACK(X);            <<DECR ERROR LEVEL>>                00628000
          IF <= THEN                                                    00630000
               BEGIN TOS:=TOS+1;                                        00632000
                     STACK(X:=X+1):=0;                                  00634000
                     STACK(X:=X+1):=0;                                  00636000
                     X:=X-2;                                            00638000
               END;                                                     00640000
          TOS:=TOS-1;                                                   00642000
          ASSEMBLE(DUP,DUP);                                            00644000
          STACK(X):=TOS;                                                00646000
          ASSEMBLE(TEST);                                               00648000
          IF > THEN GOTO CONTX;    <<STACK OVFLW CHECK>>                00650000
          TOS:=X;                                                       00652000
          ABSOLUTE(ABSOLUTE(CPCB)+SYSL).SYSF:=0;                        00654000
          IF ABSOLUTE(ABSOLUTE(CPCB)+PROCSTATEWORDNUM).        <<04488>>00658000
             STOVFLAG = 1                                      <<04488>>00660000
          THEN                                                 <<04488>>00662000
             BEGIN                                             <<04488>>00664000
             COMMENT: LET KERNEL ROUTINES KNOW PROCESS IS      <<04488>>00666000
                ABORTING.  NOTE THAT ERROREXIT DOESN'T CHECK   <<04488>>00668000
                STOVABORT BIT SINCE CURRENTLY STOV->ABORT->DEBU<<04488>>00670000
                ->ERROREXIT MUST RESULT IN ANOTHER CALL TO     <<04488>>00672000
                ABORT. STOVABORT BIT IS LEFT ON TO ALLOW YOU   <<04488>>00674000
                TO GET INTO DEBUG. WE COUNT ON LAST CALL TO    <<04488>>00676000
                ERROREXIT TO CATCH STOV. AND GO BACK TO ABORT; <<04488>>00678000
             ABSOLUTE(ABSOLUTE(CPCB)+RESABORTINFOWORDNUM)      <<04488>>00680000
                .STOVABORTFLAG := 1;                           <<04488>>00682000
             ABORT(SOMODE,SOCODE,0);                           <<04488>>00684000
             END;                                              <<04488>>00686000
          X:=TOS;                                                       00688000
  CONTX:  TOS:=ERRWORD;             <<ERROR WORD>>                      00690000
          IF = THEN GOTO CONT;     <<NO ERROR>>                         00692000
          KARRY:=1;                                                     00694000
          ASSEMBLE(XCH,DUP);                                            00696000
          IF TOS>=6 THEN                                                00698000
               BEGIN DEL;                                               00700000
                     TOS:=5;                                            00702000
               END;                                                     00704000
          X:=TOS+X+1;                                                   00706000
          STACK(X):=TOS;            <<PUT ERROR WORD>>                  00708000
          ASSEMBLE(TEST);                                               00710000
          IF > THEN GOTO CONT;     <<NESTED ERROR >>                    00712000
          IF INTRINEXIT.IFLD=0 THEN GOTO CONT;                          00714000
          ABORT(MODE,INTRINEXIT,PARAM);                                 00716000
  CONT:   TOS:=%031400;             <<EXIT INSTRUCTION>>                00718000
          TOS:=TOS LOR INTRINEXIT.NFLD;                                 00720000
          TOS:=KARRY;                                                   00722000
          TOS := INTRINEXIT.IFLD;                                       00724000
          ASSEMBLE( SED 0 );                                            00726000
          PUSH(Q);                                                      00728000
          TOS:=DELTAQ;                                                  00730000
          TOS:=TOS-TOS;                                                 00732000
          SET(Q);                                                       00734000
          IF  TOS = 99  THEN  DEL  ELSE  STATUS.CFLD := TOS;            00736000
          ASSEMBLE(XEQ 0);         << E X I T  N >>                     00738000
          HELP;   << DEBUG LINKING CALL >>                              00740000
  END;                                                                  00742000
                                                                        00744000
<<------------------------------------------------------------------->> 00746000
                                                                        00748000
                                                                        00750000
                                                                        00752000
                                                                        00754000
                                                                        00756000
                                                                        00758000
DOUBLE PROCEDURE CHEK (INTRINSIC, FLAGS, PARMS, CAPMASK, OPTVMASK);     00760000
                                                                        00762000
   VALUE INTRINSIC, FLAGS, PARMS, CAPMASK, OPTVMASK;                    00764000
   LOGICAL INTRINSIC, FLAGS, OPTVMASK;                                  00766000
   DOUBLE PARMS, CAPMASK;                                               00768000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             00770000
BEGIN                                                                   00772000
<< PARAMETER EQUIVALENCES >>                                            00774000
   LOGICAL PMASK = Q-4;                                                 00776000
   DEFINE                                                               00778000
      WDSOFPARMS        = INTEGER (INTRINSIC.(10:6))#,                  00780000
      ANYDB        = FLAGS & CSL(1) #,                                  00782000
      WDSOFTYPE         = INTEGER (FLAGS.(8:2)) #,                      00784000
      CAPORCHECK   = FLAGS & LSR(5) #,                                  00786000
      NUMPARMS          = INTEGER (FLAGS.(11:5)) #;                     00788000
   LOGICAL                                                              00790000
      CAP1              = CAPMASK,                                      00792000
      CAP2              = CAP1+1;                                       00794000
<< HANG CODES >>                                                        00796000
   EQUATE                                                               00798000
      ILLDB             = 1,       <<ILLEGAL DB>>                       00800000
      ILLCAP            = 2,       <<ILLEGAL CAPABILITY>>               00802000
      OMITTEDPARM       = 3,       <<OMITTED PARAMETER>>                00804000
      ILLCALL           = 4,       <<INCORRECT S-REGISTER>>             00806000
      BOUNDSVIOL        = 5;       <<PARAMETER ADDRESS VIOLATION>>      00808000
<< MISC & SYSTEM STUFF >>                                               00810000
   INTEGER XREG = X;                                                    00812000
   INTEGER DELTAQ = Q;                                                  00814000
   INTEGER                                                              00816000
      S0 = S-0,                                                         00818000
      S1 = S-1,                                                         00820000
      S2 = S-2;                                                         00822000
   LOGICAL                                                              00824000
      LS0 = S-0;                                                        00826000
   LOGICAL ARRAY                                                        00828000
      LQ0ARR (*) = Q-0,                                                 00830000
      LQ1ARR (*) = Q-1,                                                 00832000
      LQ3ARR (*) = Q-3,                                                 00834000
      LQ4ARR (*) = Q-4;                                                 00836000
   INTEGER ARRAY                                                        00838000
      DBARR (*) = DB+0,                                                 00840000
      Q1ARR (*) = Q-1,                                                  00842000
      Q2ARR (*) = Q-2;                                                  00844000
   INTEGER POINTER                                                      00846000
      DST = 2,                                                          00848000
      CST = 1;                                                          00850000
   DEFINE GETSYSSEG = & LSR (4)  #;                                     00852000
   EQUATE CPCB = 4;                                                     00854000
   EQUATE QI = 5;                                                       00856000
   EQUATE                                                               00858000
      PXGWATTRIBUTE     = 2,                                            00860000
      PXFWRESOURCE      = 5;                                            00862000
   DEFINE                                                               00864000
      DISABLEI          = ASSEMBLE (SED 0) #,                           00866000
      ENABLEI           = ASSEMBLE (SED 1) #;                           00868000
   EQUATE CHEKSA = 6;                                                   00870000
   LOGICAL STATUS = Q-1;                                                00872000
   DEFINE CARRYCC = STATUS.(5:3) #;                                     00874000
   EQUATE CCG = 0,   CCL = 1,   CCE = 2;                       <<01200>>00876000
<< RANDOM VARIABLES >>                                                  00878000
   INTEGER PCNT := 1;                                                   00880000
   LOGICAL DBSTACK := TRUE;                                             00882000
   INTEGER PARMP;                                                       00884000
   LOGICAL NO'ABORT;          << FLAG FOR SPECIAL ENTRY PT >>  <<01200>>00886000
   DOUBLE LIMS = Q-13;    <<CHEK RETURN>>                               00888000
   INTEGER                                                              00890000
      LOWLIM = LIMS,                                                    00892000
      UPLIM = LIMS+1;                                                   00894000
   SWITCH PARMSWITCH :=                                                 00896000
      SKIP1, SKIP2, WORDADDR, BYTEADDR;                                 00898000
                                                               <<01200>>00900000
   ENTRY CHEK'NOABORT;          << CHEK WITH MINIMAL ABORTS >> <<01200>>00902000
   LABEL START;                 << COMMON CODE FOR ENTRY PTS >><<01200>>00904000
                                                                        00906000
                                                                        00908000
<< >>                                                                   00910000
   NO'ABORT := FALSE;           << NORMAL ENTRY PT >>          <<01200>>00912000
   GOTO START;                                                 <<01200>>00914000
                                                               <<01200>>00916000
<< CHEK'NOABORT IS AN ENTRY POINT WHICH WILL NOT ABORT THE   >><<01200>>00918000
<< CALLING PROCESS AS OFTEN AS CHEK DOES.  CHEK'NOABORT WILL >><<01200>>00920000
<< ONLY ABORT THE CALLING PROCESS IF IT IS IN SPLIT STACK    >><<01200>>00922000
<< MODE OR IF THE ADDRESS OF THE 'ERROR' PARAMETER IS BAD OR >><<01200>>00924000
<< IF THE 'ERROR' PARAMETER IS OMITTED.  NOTE THAT IT IS     >><<01200>>00926000
<< ASSUMED THAT THE 'ERROR' PARAMETER IS THE 1ST PARAMTER IN >><<01200>>00928000
<< THE CALLING SEQUENCE OF THE INTRINSIC CALLING             >><<01200>>00930000
<< CHEK'NOABORT.  CCE INDICATES ALL PARAMETERS CHECKED OUT   >><<01200>>00932000
<< OK.  CCL INDICATES AN ERROR CONDITION.  THE EXACT ERROR   >><<01200>>00934000
<< IS REPORTED IN THE INTRINSIC ERROR REPORTING AREA OF THE  >><<01200>>00936000
<< PXFIXED AREA OF THE PCBX.  THE ERROR CODES ARE THE SAME   >><<01200>>00938000
<< AS THOSE USED TO ABORT THE PROCESS (E.G. 2 = INCORRECT    >><<01200>>00940000
<< CAPABILITY, ETC.  SEE PREVIOUS PAGE).                     >><<01200>>00942000
CHEK'NOABORT:                                                  <<01200>>00944000
   NO'ABORT := TRUE;                                           <<01200>>00946000
                                                               <<01200>>00948000
START:                                                         <<01200>>00950000
<< SET UP 'USER = SYSTEM SEGMENT' CHECK >>                              00952000
   TOS := LQ1ARR(-DELTAQ).(8:8);                                        00954000
   IF  S0 > %300  THEN  S0 := 0                                         00956000
   ELSE TOS:=CST(TOS&LSL(2)+1).SYSSEGFLAG;                     <<01549>>00958000
   XREG := ABSOLUTE (ABSOLUTE (CPCB) +2).(1:10) & ASL(2);   <<0 IF STK>>00960000
   TOS := DST (XREG);                                                   00962000
<< SET UP 'DB = STACK' CHECK >>                                         00964000
   XREG := ABSOLUTE (QI)-4;                                             00966000
   DISABLEI;                                                            00968000
   PUSH( SBANK,DB);                                                     00970000
   TOS := ABSOLUTE (XREG);                                              00972000
   ENABLEI;                                                             00974000
   PARMP := - (DELTAQ+WDSOFPARMS+WDSOFTYPE+4); << -(Q DISPL OF USER S)>>00976000
<< S-5 = SYS SEGMENT BIT,                                               00978000
   S-4 = DSTENTRY (0)  (OR GARBAGE IF AT STACK),                        00980000
   S-2 = ACTUAL DB,                                                     00982000
   S-0 = STACK DB.    >>                                                00984000
<< PERFORM DB CHECK; SET LIMITS & CARRY; & LEAVE IF 'USER' = SYSTEM >>  00986000
   ASSEMBLE( DCMP );                                                    00988000
   IF  <>  THEN                                                         00990000
      BEGIN    <<DB NOT AT STACK>>                                      00992000
      << NOTE: DB MUST BE AT LOGICAL DATA SEGMENT, HOWEVER. >>          00994000
      IF NOT(ANYDB) THEN                                                00996000
         BEGIN                                                          00998000
         TOS := ILLDB;                                                  01000000
         NO'ABORT := FALSE;     << FORCE THE ABORT FOR ILLDB >><<01200>>01002000
         GOTO HANGIT0;                                                  01004000
         END;                                                           01006000
      TOS := TOS.(3:13) & ASL(2)-1;    <<XTRA DATA SEGMENT LENGTH>>     01008000
      ASSEMBLE (DZRO);                                                  01010000
      DBSTACK := TOS;                                                   01012000
      XREG := 4;                                                        01014000
      END                                                               01016000
   ELSE                                                                 01018000
      BEGIN    <<DB AT STACK>>                                          01020000
      ASSEMBLE (DEL);                                                   01022000
      TOS := @LQ0ARR + PARMP;                                           01024000
      PUSH (DL);                                                        01026000
      XREG := 0;                                                        01028000
      END;                                                              01030000
   LOWLIM := TOS;                                                       01032000
   UPLIM := TOS;                                                        01034000
   IF TOS THEN                                                          01036000
      BEGIN                                                             01038000
      CARRYCC := XREG+CCG;                                              01040000
      RETURN;                                                           01042000
      END;                                                              01044000
   CARRYCC := XREG+CCE;                                                 01046000
<< CHECK CAPABILITY >>                                                  01048000
   IF PMASK & LSR(1) THEN                                               01050000
      BEGIN                                                             01052000
      PUSH (Q, DL);                                                     01054000
      ASSEMBLE (SUB, NEG);                                              01056000
      XREG := S0-Q1ARR(S0).(4:12)+PXGWATTRIBUTE;                        01058000
      TOS := LQ0ARR(XREG) LAND CAP1;                                    01060000
      XREG := S1-Q2ARR(S1)+PXFWRESOURCE;                                01062000
      TOS := LQ0ARR(XREG) LAND CAP2;                                    01064000
      IF CAPORCHECK THEN                                                01066000
         BEGIN    <<"OR" CHECK: 1 MUST BE ON >>                         01068000
         ASSEMBLE (DTST, DDEL);                                         01070000
         IF = THEN                                                      01072000
ILLHANG:    BEGIN                                                       01074000
            TOS := ILLCAP;                                              01076000
            GOTO HANGIT0;                                               01078000
            END;                                                        01080000
         END                                                            01082000
      ELSE    <<"AND" CHECK: ALL REQUIRED MUST BE ON>>                  01084000
         IF TOS <> CAPMASK THEN GOTO ILLHANG;                           01086000
      END;                                                              01088000
<< CHECK OPTION VARIABLE >>                                             01090000
   IF PMASK THEN                                                        01092000
      IF (LQ4ARR(-DELTAQ) LOR OPTVMASK) <> NOT ((-1) & LSL(NUMPARMS))   01094000
      THEN                                                              01096000
         BEGIN                                                          01098000
         TOS := OMITTEDPARM;                                            01100000
         TOS :=(NOT (LQ4ARR (-DELTAQ) LOR OPTVMASK))& LSL (16-NUMPARMS);01102000
         ASSEMBLE (                                                     01104000
            SCAN 0;                                                     01106000
            XAX, INCA);                                                 01108000
         << FORCE ABORT IF 1ST PARAMETER WAS OMITTED >>        <<01200>>01110000
         IF S0 = 1 THEN NO'ABORT := FALSE;                     <<01200>>01112000
         GOTO HANGIT;                                                   01114000
         END;                                                           01116000
<< VALID CALL?    (I.E. USER S >= DL+3) >>                              01118000
   PUSH (Q, DL);                                                        01120000
   ASSEMBLE (SUB, NEG);    << -(Q DISPL. OF DL) >>                      01122000
   IF TOS+3 > PARMP THEN                                                01124000
      BEGIN                                                             01126000
      TOS := ILLCALL;                                                   01128000
      GOTO HANGIT0;                                                     01130000
      END;                                                              01132000
<< CHECK PARAMETER BOUNDS >>                                            01134000
   IF NOT (PMASK & LSR(2)) THEN GOTO EXIT;                              01136000
   TOS := PARMS;                                                        01138000
   IF = THEN GOTO EXIT;                                                 01140000
   PARMP := PARMP+WDSOFTYPE+1;                                          01142000
   DO BEGIN                                                             01144000
      TOS := LS0 LAND 3;                                                01146000
      IF PMASK AND NOT (LQ4ARR(-DELTAQ) & LSR (NUMPARMS-PCNT)) THEN     01148000
         BEGIN                                                          01150000
         IF TOS <> 1 THEN GOTO SKIP1;                                   01152000
         GOTO SKIP2;                                                    01154000
         END;                                                           01156000
      GOTO * PARMSWITCH (TOS);                                          01158000
      WORDADDR:                                                         01160000
         XREG :=LQ0ARR (PARMP);                                         01162000
         GOTO CHECKPARM;                                                01164000
      BYTEADDR:                                                         01166000
         TOS := LQ0ARR(PARMP) & LSR(1);                                 01168000
         IF DBSTACK AND S0 > UPLIM THEN ASSEMBLE (TSBC 0);              01170000
         XREG := TOS;                                                   01172000
      CHECKPARM:                                                        01174000
         TOS := LIMS;                                                   01176000
         ASSEMBLE (CPRB SKIP1);                                         01178000
            BEGIN                                                       01180000
            TOS := BOUNDSVIOL;                                          01182000
            TOS := PCNT;                                                01184000
            << FORCE ABORT IF 1ST PARAMETER OUT OF BOUNDS >>   <<01200>>01186000
            IF S0 = 1 THEN NO'ABORT := FALSE;                  <<01200>>01188000
            GOTO HANGIT;                                                01190000
            END;                                                        01192000
      SKIP2:                                                            01194000
         PARMP := PARMP+1;                                              01196000
      SKIP1:                                                            01198000
         PARMP := PARMP+1;                                              01200000
         PCNT := PCNT+1;                                                01202000
         TOS := TOS & DLSR(2);                                          01204000
      END                                                               01206000
   UNTIL =;                                                             01208000
EXIT:                                                                   01210000
   RETURN;                                                              01212000
<< GO HANG >>                                                           01214000
HANGIT0:                                                                01216000
   TOS := 0;                                                            01218000
HANGIT:                                                                 01220000
   TOS := INTRINSIC;                                                    01222000
   ASSEMBLE (CAB, CAB);                                                 01224000
   TOS:=TOS&LSL(8);                                                     01226000
   TOS:=TOS LOR TOS;                                                    01228000
   TOS:=0;                                                              01230000
   IF NO'ABORT THEN                                            <<01200>>01232000
      BEGIN  << DO NOT ABORT CALLING PROCESS >>                <<01200>>01234000
      ERRORON;   << SO ERROREXIT WON'T ABORT >>                <<01200>>01236000
      CARRYCC := CCL;                                          <<01200>>01238000
      END                                                      <<01200>>01240000
   ELSE                                                        <<01200>>01242000
      BEGIN  << ABORT CALLING PROCESS >>                       <<01200>>01244000
      << CUT BACK 1 STACK MARKER TO EFFECT RETURN TO USER >>   <<01200>>01246000
      PUSH (Q);                                                <<01200>>01248000
      TOS := TOS - DELTAQ;                                     <<01200>>01250000
      SET (Q);                                                 <<01200>>01252000
      END;                                                     <<01200>>01254000
   << EITHER ABORT CALLER OR RETURN TO INTRINSIC WITH ERROR  >><<01200>>01256000
   << REPORTED IN THE PXFIXED AREA OF PCBX.                  >><<01200>>01258000
   ERROREXIT(*,*,*);                                                    01260000
   END    <<CHEK>>;                                                     01262000
                                                                        01264000
<<------------------------------------------------------------------->> 01266000
                                                                        01268000
                                                                        01270000
                                                                        01272000
                                                                        01274000
                                                                        01276000
                                                                        01278000
                                                                        01280000
PROCEDURE REQUCOP(REQUEST,PIN,UWAIT);                                   01282000
VALUE REQUEST,PIN,UWAIT; LOGICAL REQUEST,PIN,UWAIT;                     01284000
OPTION PRIVILEGED,UNCALLABLE;                                           01286000
                                                                        01288000
COMMENT: SETS A REQUEST FOR UCOP.                                       01290000
         UWAIT MEANS THAT THE REQUESTOR GOES IN WAIT MODE UNTIL         01292000
         THE REQUEST HAS BEEN EXECUTED.                                 01294000
         DOES NOT SET CRITICAL BIT.                                     01296000
         ;                                                              01298000
                                                                        01300000
BEGIN                                                                   01302000
      EQUATE URLDSN=9;                                                  01304000
                                                                        01306000
DEFINE ENABLE=ASSEMBLE(SED 1)#,DISABLE=ASSEMBLE(SED 0)#;                01308000
      LOGICAL DB;                                                       01310000
      INTEGER P1,P2,X=X;                                                01312000
      DOUBLE ARRAY UR(*)=DB+0;                                          01314000
      INTEGER ARRAY URL(*)=DB+0;                                        01316000
                                                                        01318000
      TOS:=REQUEST;                                                     01320000
      TOS:=PIN;                                                         01322000
      DB:=EXCHANGEDB(URLDSN);                                           01324000
                                                                        01326000
      <<TEST FOR URL OVERLOAD:>>                                        01328000
      DISABLE;                                                          01330000
      P1:=URL(1);                                                       01332000
      P2:=URL(2);                                                       01334000
      IF (P2-P1)=1 OR P1-P2=URL(0)+2 THEN                               01336000
      BEGIN         <<OVERLOAD>>                                        01338000
         SUDDENDEATH(1);                                                01340000
      END ELSE                                                          01342000
      BEGIN                                                             01344000
         X:=P1;                                                         01346000
         UR(X):=TOS;           <<SET REQUEST>>                          01348000
         URL(1):=IF URL(1)=URL(0)+2 THEN 2 ELSE URL(1)+1;               01350000
         AWAKE( SYSPROC(2),%20,IF UWAIT THEN %40 ELSE 0 );              01352000
         IF < AND UWAIT THEN WAIT(%40,0);                               01354000
         ENABLE;                                                        01356000
         EXCHANGEDB(DB);                                                01358000
      END;                                                              01360000
END;  <<REQUCOP>>                                                       01362000
<<------------------------------------------------------------------->> 01364000
                                                                        01366000
                                                                        01368000
                                                                        01370000
                                                                        01372000
                                                                        01374000
                                                                        01376000
                                                                        01378000
                                                                        01380000
                                                                        01382000
PROCEDURE GETPRIVMODE;                                                  01384000
OPTION PRIVILEGED;                                                      01386000
                                                                        01388000
COMMENT: GET PRIVILEGED MODE FOR THE CODE TO BE RIN BY THE CALLER,      01390000
         BY MEANS OF CHANGING THE PRIVILEGED MODE BIT IN THE            01392000
         STATUS.                                                        01394000
                                                                        01396000
         RETURNS                                                        01398000
            CCE   IF OK                                                 01400000
            CCG   IF ALREADY IN PRIVILEGED MODE.                        01402000
                                                                        01404000
         ERROR CODE: 200.                                               01406000
      ;                                                                 01408000
                                                                        01410000
                                                                        01412000
                                                                        01414000
BEGIN                                                                   01416000
      EQUATE CCE=2,CCG=0,CSTB=0,CSTXB=1;                                01418000
      EQUATE ERRN=200, EXITN=0;                                         01420000
      EQUATE ERREX=[10/ERRN,6/EXITN];                                   01422000
      INTEGER X=X,STATUS=Q-1,CSTX,CC;                                   01424000
      ERRORON;                                                          01426000
                                                                        01428000
      CSTX:=LOGICAL(STATUS) LAND %377; <<EXTRACT CURRENT CST>>          01430000
      X := CSTB;                                                        01432000
      IF  CSTX > %300  THEN                                             01434000
         BEGIN                                                          01436000
         CSTX := CSTX-%300;                                             01438000
         X := CSTXB;                                                    01440000
         END;                                                           01442000
      TOS:=ABSOLUTE(ABSOLUTE(X)+CSTX&LSL(2));                           01444000
      TOS:=TOS&CSL(2);                 <<PRIVILEGED MODE BIT>>          01446000
      IF TOS THEN GOTO PM1;            <<ALREADY IN PRIV MODE>>         01448000
      CHEK(ERREX,%100040,,DOUBLE(%100));                                01450000
PM1:  TOS:=STATUS;                                                      01452000
      ASSEMBLE(DUP);                                                    01454000
      IF TOS<0 THEN CC:=CCG ELSE                                        01456000
      BEGIN                                                             01458000
         CC:=CCE;                                                       01460000
         TOS.(0:1):=1;                 <<PRIVILEGED MODE ON>>           01462000
      END;                                                              01464000
      TOS.(6:2):=CC;                   <<STORE OF COND CODE>>           01466000
      STATUS:=TOS;                                                      01468000
      ERROREXIT(ERREX,0,0);                                             01470000
                                                                        01472000
END;  << G E T P R I V M O D E  >>                                      01474000
                                                                        01476000
<<------------------------------------------------------------------->> 01478000
                                                                        01480000
                                                                        01482000
                                                                        01484000
                                                                        01486000
PROCEDURE GETUSERMODE;                                                  01488000
OPTION PRIVILEGED;                                                      01490000
                                                                        01492000
COMMENT: GET USER MODE IN STATUS (PRIVILEGED MODE TURNED OFF)           01494000
         RETURNS                                                        01496000
         CCE   IF OK                                                    01498000
         CCG   IF ALREADY IN USER MODE.                                 01500000
                                                                        01502000
         ERROR CODE: 201.                                               01504000
      ;                                                                 01506000
                                                                        01508000
                                                                        01510000
BEGIN                                                                   01512000
     EQUATE CCG=0, CCE=2;                                               01514000
      EQUATE QI=3, CPCB=4;                                     <<00423>>01516000
      EQUATE DELTAQ=0, PLOC=-2;                                <<00423>>01518000
      EQUATE ERRN=201, EXITN=0;                                         01520000
      EQUATE ERREX=[10/ERRN,6/EXITN];                                   01522000
      ARRAY PCBX(*)=Q+0;                                       <<00423>>01524000
      INTEGER CC;                                                       01526000
      INTEGER INITQ; <<HEIGHT OF STACK BEFORE 1ST MARKER>>     <<00423>>01528000
      INTEGER X=X;                                             <<00423>>01530000
      INTEGER S0=S-0;                                          <<00423>>01532000
      LOGICAL STATUS=Q-1;                                      <<00423>>01534000
      LOGICAL P=Q-2;                                           <<00423>>01536000
      POINTER STACKMARKER;                                     <<00423>>01538000
      POINTER CST = 1;                                         <<00423>>01540000
      DEFINE SYSBIT = (6:1)#;                                  <<04487>>01542000
      DEFINE PSIM = (0:3)#;                                    <<00423>>01544000
      <<PXFIXED: SET X TO Q REL INDEX OF PXFIXED AREA>>        <<00423>>01546000
      DEFINE PXFIXED =    PUSH(Q,DL);ASSEMBLE(XCH;SUB);        <<00423>>01548000
                          X:=TOS-PCBX(S0-2)#;                  <<00423>>01550000
      DEFINE NOT'SYSSEG = (NOT STATUS.(8:8) < %300  OR  NOT    <<00423>>01552000
                       CST(STATUS.(8:8)&LSL(2)+1).SYSSEGFLAG)#;<<04588>>01554000
      DEFINE PENDCTLY =  ABSOLUTE(ABSOLUTE(CPCB)+8).PSIM=5#;   <<04588>>01556000
                                                                        01558000
      ERRORON;                                                          01560000
      TOS:=STATUS;                                                      01562000
      CC:= IF < THEN CCE ELSE CCG;                                      01564000
      TOS.(0:1):=0;                    <<TURN OFF THE PRIV MODE BIT>>   01566000
      TOS.(6:2):=CC;                   <<STORE COND CODE>>              01568000
      STATUS:=TOS;                                                      01570000
      IF PENDCTLY AND NOT'SYSSEG THEN                          <<00423>>01572000
         BEGIN                                                 <<00423>>01574000
         COMMENT:                                              <<00423>>01576000
            EXECUTE PENDING CONTROLY WHEN EXIT THIS            <<00423>>01578000
            PROCEDURE.;                                        <<00423>>01580000
         PXFIXED;                                              <<00423>>01582000
         INITQ:=PCBX(X+QI);                                    <<00423>>01584000
         PUSH(Q);                                              <<00423>>01586000
         @STACKMARKER:=TOS;                                    <<00423>>01588000
                                                               <<00423>>01590000
         <<FIND PENDING CLTY MARKER>>                          <<00423>>01592000
         WHILE STACKMARKER(PLOC).(0:2) <> 2  AND               <<00423>>01594000
               @STACKMARKER > INITQ DO                         <<00423>>01596000
            BEGIN                                              <<00423>>01598000
            IF INTEGER(STACKMARKER(DELTAQ)) >= 4 THEN                   01600000
               @STACKMARKER:=@STACKMARKER-                     <<00423>>01602000
                             INTEGER(STACKMARKER(DELTAQ))      <<00423>>01604000
            ELSE <<BAD STACKMARKER--STOP SEARCH>>              <<00423>>01606000
               @STACKMARKER:=INITQ;                            <<00423>>01608000
            END;                                               <<00423>>01610000
         IF @STACKMARKER > INITQ THEN                          <<00423>>01612000
            BEGIN <<FOUND PEND CTLY MARKER>>                   <<00423>>01614000
            STACKMARKER(PLOC).(0:2):=0; <<CLEAR OLD MARKER>>   <<00423>>01616000
            P.(0:2):=2; <<SET FLAG IN TOP MARKER>>             <<00423>>01618000
            END;                                               <<00423>>01620000
         END;                                                  <<00423>>01622000
      ERROREXIT(ERREX,0,0);                                             01624000
                                                                        01626000
END;  << G E T U S E R M O D E  >>                                      01628000
                                                                        01630000
<<------------------------------------------------------------------->> 01632000
                                                                        01634000
                                                                        01636000
                                                                        01638000
                                                                        01640000
INTEGER PROCEDURE JPCOUNTX;                                             01642000
OPTION UNCALLABLE,PRIVILEGED;                                           01644000
                                                                        01646000
COMMENT:    GETS THE JPCOUNT INDEX FROM PCBX'S CALLER;                  01648000
                                                                        01650000
BEGIN                                                                   01652000
      EQUATE JPX=4;                                                     01654000
      INTEGER X=X;                                                      01656000
      INTEGER ARRAY PCBX(*)=Q+0;                                        01658000
                                                                        01660000
      PUSH(Q,DL);                                                       01662000
      ASSEMBLE(XCH,SUB;DUP,STAX;DECX);                                  01664000
      TOS:=-PCBX(X);                                                    01666000
      ASSEMBLE(ADD);                                                    01668000
      TOS:=TOS+JPX;                                                     01670000
      ASSEMBLE(STAX);                                                   01672000
      JPCOUNTX:=PCBX(X)&LSR(8);                                         01674000
                                                                        01676000
END;  << J P C O U N T X  >>                                            01678000
                                                                        01680000
                                                                        01682000
<<------------------------------------------------------------------->> 01684000
                                                                        01686000
                                                                        01688000
                                                                        01690000
                                                                        01692000
                                                                        01694000
                                                                        01696000
                                                                        01698000
LOGICAL PROCEDURE LOCKJIR;                                              01700000
OPTION PRIVILEGED,UNCALLABLE;                                           01702000
COMMENT: GETS THE LOCK NUMBER FOR THE JOB AND GET THE SIR;              01704000
BEGIN                                                                   01706000
      LOCKJIR:=GETSIR(JPCOUNTX+38);                            <<WH.43>>01708000
END;                                                                    01710000
<<------------------------------------------------------------------->> 01712000
                                                                        01714000
                                                                        01716000
                                                                        01718000
                                                                        01720000
                                                                        01722000
                                                                        01724000
PROCEDURE UNLOCKJIR(A);                                                 01726000
VALUE A; INTEGER A;                                                     01728000
OPTION PRIVILEGED,UNCALLABLE;                                           01730000
BEGIN                                                                   01732000
      RELSIR(JPCOUNTX+38,A);                                   <<WH.43>>01734000
END;                                                                    01736000
$PAGE                                                          <<IMAGE>>01738000
PROCEDURE QPROC (RESOURCE,PROCNO);                             <<IMAGE>>01740000
VALUE            RESOURCE,PROCNO ;                             <<IMAGE>>01742000
INTEGER POINTER  RESOURCE        ;                             <<IMAGE>>01744000
LOGICAL                   PROCNO ;                             <<IMAGE>>01746000
                                                               <<IMAGE>>01748000
OPTION PRIVILEGED,UNCALLABLE ;                                 <<IMAGE>>01750000
COMMENT                                                        <<IMAGE>>01752000
   ADDS THE PROCESS IDENTIFIED BY PROCNO TO THE QUEUE FOR      <<IMAGE>>01754000
   THE RESOURCE IDENTIFIED BY 'RESOURCE'. THE PROCESS IS       <<IMAGE>>01756000
   ADDED AT THE END OF THE QUEUE, WHICH IS IMPLEMENTED AS      <<IMAGE>>01758000
   A LINKED LIST OF PINS IN EACH WAITING PROCESS'S IMPEDED     <<IMAGE>>01760000
   QUEUE POINTER (PCB08.(8:8)).                                <<IMAGE>>01762000
                                                               <<IMAGE>>01764000
   RESOURCE  A POINTER TO A CALLER-MANAGED DOUBLEWORD WITH     <<IMAGE>>01766000
             THE FOLLOWING LAYOUT:                             <<IMAGE>>01768000
                                                               <<IMAGE>>01770000
             +-------------------------------------------+     <<IMAGE>>01772000
             !   OWNER PIN       !   QUEUE LENGTH        !     <<IMAGE>>01774000
             !-------------------------------------------!     <<IMAGE>>01776000
             !   TAIL POINTER    !   HEAD POINTER        !     <<IMAGE>>01778000
             +-------------------------------------------+     <<IMAGE>>01780000
                                                               <<IMAGE>>01782000
             HEAD POINTER  =  PIN OF FIRST WAITING PROCESS     <<IMAGE>>01784000
             TAIL POINTER  =  PIN OF LAST WAITING PROCESS      <<IMAGE>>01786000
             QUEUE LENGTH  =  NUMBER OF PROCESSES IN THE 'C'   <<IMAGE>>01788000
                              QUEUE WAITING FOR THIS RESOURCE. <<IMAGE>>01790000
                                                               <<IMAGE>>01792000
   PROCNO    THE PIN OF THE PROCESS TO BE QUEUED. MAY BE THE   <<IMAGE>>01794000
             PIN OF THE CALLING PROCESS.                       <<IMAGE>>01796000
;                                                              <<IMAGE>>01798000
BEGIN                                                          <<IMAGE>>01800000
INTEGER IPROC=PROCNO;                                          <<IMAGE>>01802000
DEFINE TAILPOINTER =(0:8)#;                                    <<IMAGE>>01804000
                                                               <<IMAGE>>01806000
@RESOURCE:=@RESOURCE+1;                                        <<IMAGE>>01808000
TOS:=RESOURCE;                                                 <<IMAGE>>01810000
IF = THEN                                                      <<IMAGE>>01812000
                                                               <<IMAGE>>01814000
   <<IF HEAD AND TAIL POINTERS ARE BOTH ZERO THEN >>           <<IMAGE>>01816000
   <<THERE IS NO QUEUE, SO CREATE ONE WITH HEAD   >>           <<IMAGE>>01818000
   <<AND TAIL BOTH POINTING TO THE SAME PIN       >>           <<IMAGE>>01820000
     RESOURCE := PROCNO LOR PROCNO&LSL(8)                      <<IMAGE>>01822000
                                                               <<IMAGE>>01824000
ELSE                                                           <<IMAGE>>01826000
                                                               <<IMAGE>>01828000
   BEGIN                                                       <<IMAGE>>01830000
   <<POINT THE IQPTR OF THE PROCESS WHO WAS PREVIOUSLY>>       <<IMAGE>>01832000
   <<THE LAST IN THE QUEUE TO THE NEW PCB             >>       <<IMAGE>>01834000
   PCB(TOS.TAILPOINTER * PCBSIZE +8).IQPTR := PROCNO;          <<IMAGE>>01836000
                                                               <<IMAGE>>01838000
   <<POINT THE RESOURCE TAIL POINTER TO THE NEW PIN>>          <<IMAGE>>01840000
   RESOURCE.TAILPOINTER:=PROCNO;                               <<IMAGE>>01842000
   END;                                                        <<IMAGE>>01844000
                                                               <<IMAGE>>01846000
<<MAKE THE NEW QUEUER'S IQPTR ZERO>>                           <<IMAGE>>01848000
PCB(IPROC*PCBSIZE+8).IQPTR:=0;                                 <<IMAGE>>01850000
END; <<OF QPROC>>                                              <<IMAGE>>01852000
$PAGE                                                          <<IMAGE>>01854000
INTEGER PROCEDURE DQPROC (RESOURCE);                           <<IMAGE>>01856000
VALUE                     RESOURCE ;                           <<IMAGE>>01858000
INTEGER POINTER           RESOURCE ;                           <<IMAGE>>01860000
                                                               <<IMAGE>>01862000
OPTION PRIVILEGED,UNCALLABLE;                                  <<IMAGE>>01864000
                                                               <<IMAGE>>01866000
COMMENT                                                        <<IMAGE>>01868000
DE-QUEUES A PROCESS FROM THE LIST OF PROCESSES WAITING ON      <<IMAGE>>01870000
THE RESOURCE IDENTIFIED BY 'RESOURCE'. SEE QPROC FOR MORE      <<IMAGE>>01872000
INFO. THE PIN OF THE PROCESS DEQUEUED IS RETURNED IN THE       <<IMAGE>>01874000
NAME. THIS MAY BE ZERO IF THERE WERE NO WAITERS.               <<IMAGE>>01876000
;                                                              <<IMAGE>>01878000
                                                               <<IMAGE>>01880000
BEGIN                                                          <<IMAGE>>01882000
                                                               <<IMAGE>>01884000
INTEGER NEWPIN;                                                <<00085>>01886000
DEFINE HEADPOINTER =(8:8)#;                                    <<IMAGE>>01888000
                                                               <<IMAGE>>01890000
<<IS ANYONE WAITING?>>                                         <<IMAGE>>01892000
@RESOURCE:=@RESOURCE+1;                                        <<IMAGE>>01894000
TOS:=NEWPIN:=DQPROC:=RESOURCE.HEADPOINTER;                     <<00085>>01896000
IF = THEN RETURN;                                              <<IMAGE>>01898000
                                                               <<IMAGE>>01900000
<<DETERMINE PIN OF THE PROCESS WHO WILL BE NEW HEAD OF LIST>>  <<IMAGE>>01902000
TOS:=PCB(TOS*PCBSIZE+8).IQPTR;                                 <<IMAGE>>01904000
                                                               <<IMAGE>>01906000
IF = THEN                                                      <<IMAGE>>01908000
    <<NO MORE WAITERS AFTER THIS ONE. SET HEAD & TAIL TO ZERO>><<IMAGE>>01910000
    RESOURCE:=0                                                <<IMAGE>>01912000
ELSE                                                           <<IMAGE>>01914000
    <<PUT NEW PIN INTO HEAD POINTER>>                          <<IMAGE>>01916000
    RESOURCE.HEADPOINTER:=TOS;                                 <<IMAGE>>01918000
                                                               <<IMAGE>>01920000
<<ZERO THE NEW OWNERS IQPOINTER>>                              <<00085>>01922000
PCB(NEWPIN*PCBSIZE+8).IQPTR:=0;                                <<00085>>01924000
                                                               <<00085>>01926000
END; << OF DQPROC >>                                           <<IMAGE>>01928000
$PAGE "                           'RELEASE'"                   <<IMAGE>>01930000
PROCEDURE  RELEASE(RES,ALTRES,WAKEUP);                         <<IMAGE>>01932000
VALUE              RES,ALTRES,WAKEUP ;                         <<IMAGE>>01934000
LOGICAL                       WAKEUP ;                         <<IMAGE>>01936000
LOGICAL POINTER    RES,ALTRES        ;                         <<IMAGE>>01938000
                                                               <<IMAGE>>01940000
OPTION PRIVILEGED,UNCALLABLE;                                  <<IMAGE>>01942000
<<************************************************************ <<IMAGE>>01944000
<<                                                             <<IMAGE>>01946000
<< RELEASE CONTROL OF THE USER  RESOURCE REPRESENTED BY THE    <<IMAGE>>01948000
<< PARAMETER 'RES'. IF THERE WAS A QUEUE FOR THIS RESOURCE THE <<IMAGE>>01950000
<< ONE OR ALL OF THE WAITERS ARE ACTIVATED DEPENDING ON THE    <<IMAGE>>01952000
<< SETTING OF PARAMETER 'WAKEUP'. IF 'ALTRES' IS ENABLED THEN  <<IMAGE>>01954000
<< ALL PROCESSES THAT WOULD HAVE BEEN ACTIVATED ARE TRANSFERRE <<IMAGE>>01956000
<< TO THE FIFO QUEUE FOR THE RESOURCE REPRESENTED BY 'ALTRES'. <<IMAGE>>01958000
<< THEY ARE TRANSFERRED IN THE SAME ORDER AS THEY QUEUED FOR   <<IMAGE>>01960000
<< 'RES' AND THEY ARE NOT ACTIVATED.                           <<IMAGE>>01962000
<<                                                             <<IMAGE>>01964000
<<PARAMETERS:                                                  <<IMAGE>>01966000
<<-----------                                                  <<IMAGE>>01968000
<<                                                             <<IMAGE>>01970000
<<  RES       POINTER TO THE DOUBLEWORD WAIT FIELD REPRESENTIN <<IMAGE>>01972000
<<            THE RESOURCE TO BE RELEASED. SEE 'OBTAIN'        <<IMAGE>>01974000
<<                                                             <<IMAGE>>01976000
<<  ALTRES    POINTER TO THE DOUBLEWORD WAITFIELD REPRESENTING <<IMAGE>>01978000
<<            THE ALTERNATE RESOURCE TO WHICH WAITERS ARE      <<IMAGE>>01980000
<<            TRANSFERRED. IF THIS FIELD IS < ZERO THEN WAITER <<IMAGE>>01982000
<<            ARE ACTIVATED IMMEDIATELY WITH NO QUEUE TRANSFER <<IMAGE>>01984000
<<            TAKING PLACE.                                    <<IMAGE>>01986000
<<                                                             <<IMAGE>>01988000
<<  WAKEUP    =1 WAKE ONLY THE FIRST WAITER IN THE QUEUE       <<IMAGE>>01990000
<<            =0 WAKE ALL WAITERS IN THE QUEUE.                <<IMAGE>>01992000
<<                                                             <<IMAGE>>01994000
<<CONDITION CODE:                                              <<IMAGE>>01996000
<<---------------                                              <<IMAGE>>01998000
<<                                                             <<IMAGE>>02000000
<<            NOT AFFECTED.                                    <<IMAGE>>02002000
<<                                                             <<IMAGE>>02004000
<<************************************************************ <<IMAGE>>02006000
                                                               <<IMAGE>>02008000
BEGIN                                                          <<IMAGE>>02010000
                                                               <<IMAGE>>02012000
INTEGER X=X;                                                   <<IMAGE>>02014000
                                                               <<IMAGE>>02016000
DEFINE OWNER=(0:8)#;                                           <<IMAGE>>02018000
                                                               <<IMAGE>>02020000
EQUATE WAITFIELD=1,                                            <<IMAGE>>02022000
       IGNORE=-1;                                              <<IMAGE>>02024000
$PAGE                                                          <<IMAGE>>02026000
                                                               <<IMAGE>>02028000
<<RELEASE THE RESOURCE>>                                       <<IMAGE>>02030000
<<-------------------->>                                       <<IMAGE>>02032000
ASSEMBLE(PSDB);                                                <<IMAGE>>02034000
RES.OWNER:=0;                                                  <<IMAGE>>02036000
                                                               <<IMAGE>>02038000
<<ANYONE WAITING? >>                                           <<IMAGE>>02040000
<<---------------->>                                           <<IMAGE>>02042000
IF RES(WAITFIELD) <> 0 THEN   <<YES>>                          <<IMAGE>>02044000
                                                               <<IMAGE>>02046000
DO   BEGIN                                                     <<IMAGE>>02048000
     <<GIVE RESOURCE TO WAITER(S) >>                           <<IMAGE>>02050000
     RES.OWNER := X := DQPROC(RES);                            <<IMAGE>>02052000
     <<TRANSFER HIM TO ALT Q?>>                                <<IMAGE>>02054000
     IF @ALTRES<>IGNORE THEN QPROC(ALTRES,X)                   <<IMAGE>>02056000
                        ELSE UNIMPEDE(X*PCBSIZE);              <<IMAGE>>02058000
     END                                                       <<IMAGE>>02060000
                                                               <<IMAGE>>02062000
UNTIL WAKEUP OR RES(WAITFIELD)=0;                              <<IMAGE>>02064000
ASSEMBLE(PSEB);                                                <<IMAGE>>02066000
END; <<OF RELEASE>>                                            <<IMAGE>>02068000
$PAGE "                        'OBTAIN'"                       <<IMAGE>>02070000
INTEGER PROCEDURE  OBTAIN (RES,ALTRES);                        <<IMAGE>>02072000
VALUE                      RES,ALTRES ;                        <<IMAGE>>02074000
LOGICAL POINTER            RES,ALTRES ;                        <<IMAGE>>02076000
OPTION PRIVILEGED,UNCALLABLE;                                  <<IMAGE>>02078000
<<************************************************************ <<IMAGE>>02080000
<<                                                             <<IMAGE>>02082000
<<  THIS ROUTINE IS USED TO TAKE CONTROL OF THE RESOURCE       <<IMAGE>>02084000
<<  REPRESENTED BY THE PARAMETER 'RES'. IF THIS RESOURCE       <<IMAGE>>02086000
<<  IS IN USE, THE CALLING PROCESS WILL WAIT IN A FIFO         <<IMAGE>>02088000
<<  QUEUE FOR IT. IF A WAIT IS NECESSARY, THE RESOURCE REP-    <<IMAGE>>02090000
<<  RESENTED BY 'ALTRES' WILL BE RELEASED BEFORE THE           <<IMAGE>>02092000
<<  CALLING PROCESS IS SUSPENDED. IT IS GUARANTEED THAT NO     <<IMAGE>>02094000
<<  INTERRUPTS WILL OCCUR BETWEEN GIVING UP ALTRES AND         <<IMAGE>>02096000
<<  SUSPENDING.                                                <<IMAGE>>02098000
<<  THE PROCEDURE ALSO RETURNS THE CALLER'S PIN IN THE NAME.   <<IMAGE>>02100000
<<  THIS IS DONE TO PROVIDE A QUICK, MPE-INDEPENDENT WAY OF    <<IMAGE>>02102000
<<  OBTAINING YOUR PIN WITHOUT COMPUTING IT EACH TIME.         <<IMAGE>>02104000
<<                                                             <<IMAGE>>02106000
<<  PARAMETERS:                                                <<IMAGE>>02108000
<<  -----------                                                <<IMAGE>>02110000
<<                                                             <<IMAGE>>02112000
<<     RES   POINTER TO A DOUBLEWORD 'WAIT FIELD'              <<IMAGE>>02114000
<<           REPRESENTING THE RESOURCE. IT HAS THE FOLLOWING   <<IMAGE>>02116000
<<           LAYOUT:                                           <<IMAGE>>02118000
<<                                                             <<IMAGE>>02120000
<<           .--------------------------------------.          <<IMAGE>>02122000
<<           !   OWNERS PIN     !   QUEUE LENGTH    !          <<IMAGE>>02124000
<<           .--------------------------------------.          <<IMAGE>>02126000
<<           !   Q TAIL PIN     !   Q HEAD PIN      !          <<IMAGE>>02128000
<<           .--------------------------------------.          <<IMAGE>>02130000
<<                                                             <<00085>>02132000
<<  THE OWNERS PIN CAN BE EQUAL TO 1 WHICH IS INTERPRETED      <<00085>>02134000
<<  AS A DUMMY PROCESS AND IS NEVER TREATED AS A REAL PIN.     <<00085>>02136000
<<                                                             <<IMAGE>>02138000
<<   ALTRES  REPRESENTS ALTERNATE RESOURCE AS ABOVE. IF THIS   <<IMAGE>>02140000
<<           PARAMETER HAS A NEGATIVE VALUE THEN NO ALTERNATE  <<IMAGE>>02142000
<<           RESOURCE EXISTS AND WE WILL NOT ATTEMPT TO        <<IMAGE>>02144000
<<           RELEASE IT.                                       <<IMAGE>>02146000
<<                                                             <<IMAGE>>02148000
<<  CONDITION CODE:                                            <<IMAGE>>02150000
<<  ---------------                                            <<IMAGE>>02152000
<<                                                             <<IMAGE>>02154000
<<           NOT AFFECTED                                      <<IMAGE>>02156000
<<                                                             <<IMAGE>>02158000
<<************************************************************ <<IMAGE>>02160000
                                                               <<IMAGE>>02162000
BEGIN                                                          <<IMAGE>>02164000
DEFINE OWNER=(0:8)#;                                           <<IMAGE>>02166000
                                                               <<IMAGE>>02168000
EQUATE IGNORE=-1,                                              <<IMAGE>>02170000
       DUMMYPIN=1,                                             <<00085>>02172000
       ONEWAITER=1;                                            <<IMAGE>>02174000
                                                               <<IMAGE>>02176000
INTEGER PIN=OBTAIN;                                            <<IMAGE>>02178000
DOUBLE SAVETIME;                                               <<01549>>02180000
INTEGER S0=S-0;                                                <<01549>>02182000
LOGICAL LS0=S-0;                                               <<01549>>02184000
$PAGE                                                          <<IMAGE>>02186000
INTEGER X=X;                                                   <<01549>>02188000
PIN:=MYPINNUMBER;                                              <<IMAGE>>02190000
                                                               <<IMAGE>>02192000
<<FIND OUT IF RESOURCE FREE>>                                  <<IMAGE>>02194000
<<------------------------->>                                  <<IMAGE>>02196000
ASSEMBLE(PSDB);                                                <<IMAGE>>02198000
IF RES.OWNER=0 THEN                                            <<IMAGE>>02200000
                                                               <<IMAGE>>02202000
   BEGIN                                                       <<IMAGE>>02204000
   <<YES. I CAN TAKE IT RIGHT NOW>>                            <<IMAGE>>02206000
   <<---------------------------->>                            <<IMAGE>>02208000
   RES:=PIN&LSL(8);                                            <<IMAGE>>02210000
   ASSEMBLE(PSEB);                                             <<IMAGE>>02212000
   RETURN;                                                     <<IMAGE>>02214000
   END                                                         <<IMAGE>>02216000
                                                               <<IMAGE>>02218000
ELSE                                                           <<IMAGE>>02220000
                                                               <<IMAGE>>02222000
   BEGIN                                                       <<IMAGE>>02224000
   <<GOT TO WAIT IN LINE. RELEASE THE ALTERNATE                <<IMAGE>>02226000
<<   RESOURCE IF SO INSTRUCTED IN 'ALTRES'    >>               <<IMAGE>>02228000
   <<----------------------------------------->>               <<IMAGE>>02230000
   IF @ALTRES <> IGNORE THEN RELEASE(ALTRES,IGNORE,ONEWAITER); <<IMAGE>>02232000
   QPROC(RES,MYPINNUMBER); <<PUT ME AT END OF QUEUE>>          <<IMAGE>>02234000
   IF RES.OWNER=DUMMYPIN THEN                                  <<00085>>02236000
      IMPEDE(0) <<DONT IMPAIR COS THIS RAISES IMPEDERS PRI>>   <<00085>>02238000
   ELSE                                                        <<00085>>02240000
      IMPAIRED(RES.OWNER,@RES,FALSE);                          <<00085>>02242000
                                                               <<00085>>02244000
COMMENT                                                        <<00085>>02246000
   'IMPAIRED' IS AN MPE ROUTINE WHICH DEACTIVATES THE CALLING  <<IMAGE>>02248000
   PROCESS. BEFORE IT DOES SO, IT COMPARES THE PRIORITY OF THE <<IMAGE>>02250000
   CALLER WITH THE PRIORITY OF THE CURRENT OWNER OF THE RESOURC<<IMAGE>>02252000
   IT THEN ENSURES THAT THE OWNER RUNS AT THE SAME OR HIGHER   <<IMAGE>>02254000
   PRIORITY THAN THE CALLER. IT IS ASSUMED THAT THE PROCESS HAS<<IMAGE>>02256000
   SET CRITICAL WHILE USING THIS FACILITY. WHEN IT FINALLY CALL<<IMAGE>>02258000
   RESETCRITICAL, THAT ROUTINE CHECKS TO SEE IF THE CALLING    <<IMAGE>>02260000
   PROCESS HAS BEEN RAISED IN PRIORITY IN THIS WAY. IF IT HAS, <<IMAGE>>02262000
   IT IS PUT BACK DOWN TO ITS ORIGINAL PRIORITY.               <<IMAGE>>02264000
                                                               <<IMAGE>>02266000
   WHEN WE WAKE UP AGAIN, WE WILL BE THE NEW OWNER OF THE RESOU<<IMAGE>>02268000
;                                                              <<IMAGE>>02270000
   END;                                                        <<IMAGE>>02272000
END; <<OF OBTAIN>>                                             <<IMAGE>>02274000
$PAGE " INTRINSIC MYPIN "                                      <<IMAGE>>02276000
LOGICAL PROCEDURE MYPIN;                                       <<IMAGE>>02278000
                                                               <<IMAGE>>02280000
OPTION PRIVILEGED,UNCALLABLE;                                  <<IMAGE>>02282000
                                                               <<IMAGE>>02284000
<<*************************************************************<<IMAGE>>02286000
                                                               <<IMAGE>>02288000
<<      RETURNS THE PIN OF THE CALLING PROCESS                 <<IMAGE>>02290000
                                                               <<IMAGE>>02292000
<<*************************************************************<<IMAGE>>02294000
                                                               <<IMAGE>>02296000
BEGIN                                                          <<IMAGE>>02298000
MYPIN:=((F(CPCB)-F(PCBB))/PCBSIZE);                            <<IMAGE>>02300000
END;                                                           <<IMAGE>>02302000
<<------------------------------------------------------------------->> 02304000
$PAGE "   NEXTPROC"                                            <<00085>>02306000
                                                               <<00085>>02308000
INTEGER PROCEDURE NEXTPROC (PIN);                              <<00085>>02310000
VALUE                       PIN ;                              <<00085>>02312000
INTEGER                     PIN ;                              <<00085>>02314000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00085>>02316000
                                                               <<00085>>02318000
<< This procedure is used to determine the successor process in  00085  02320000
   the queue of impeded processes. It does this by locating the  00085  02322000
   PCB for the process PIN and returning the contents of its     00085  02324000
   IQPTR (impeded queue pointer), which is the pin of the next   00085  02326000
   process in the queue.                                         00085  02328000
>>                                                             <<00085>>02330000
                                                               <<00085>>02332000
BEGIN                                                          <<00085>>02334000
                                                               <<00085>>02336000
                                                               <<00085>>02338000
NEXTPROC:=F(F(PCBB)+PIN*PCBSIZE+8).IQPTR;                      <<00085>>02340000
                                                               <<00085>>02342000
END;                                                           <<00085>>02344000
$PAGE "     PINJOBMAP"                                         <<00085>>02346000
                                                               <<00085>>02348000
PROCEDURE PINJOBMAP (PIN,BUFF,JOBNUM);                         <<00085>>02350000
VALUE                PIN             ;                         <<00085>>02352000
BYTE ARRAY               BUFF        ;                         <<00085>>02354000
INTEGER              PIN,     JOBNUM ;                         <<00085>>02356000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00085>>02358000
                                                               <<00085>>02360000
<<Given a process identified by PIN, this procedure returns the  00085  02362000
 job number that corresponds to it. This is returned in BUFF as  00085  02364000
an ascii string of the form #Snnnn or #jnnnn. It is also return  00085  02366000
in jobnum as follows. The high order 2 bits are 1 for a session  00085  02368000
and 2 for a job. The low order 14 bits contain the job/session   00085  02370000
   number in binary.                                             00085  02372000
>>                                                             <<00085>>02374000
                                                               <<00085>>02376000
BEGIN                                                          <<00085>>02378000
ARRAY JOBTAB(*)=DB+0;                                          <<00085>>02380000
INTEGER JNUM;                                                  <<00085>>02382000
BYTE POINTER P;                                                <<00085>>02384000
EQUATE PJXREF=50;                                              <<00085>>02386000
                                                               <<00085>>02388000
INTRINSIC ASCII;                                               <<00085>>02390000
                                                               <<00085>>02392000
LOGICAL PROCEDURE EXCHANGEDB (DST);                            <<00085>>02394000
VALUE                         DST ;                            <<00085>>02396000
LOGICAL                       DST ;                            <<00085>>02398000
OPTION EXTERNAL;                                               <<00085>>02400000
                                                               <<00085>>02402000
<<GO GET THE JOB INFO>>                                        <<00085>>02404000
EXCHANGEDB(PJXREF);                                            <<00085>>02406000
JNUM:=JOBTAB(PIN);                                             <<00085>>02408000
EXCHANGEDB(0);                                                 <<00085>>02410000
                                                               <<00085>>02412000
<<FORM THE ASCII JOBNUM>>                                      <<00085>>02414000
IF JNUM=0 THEN                                                 <<00085>>02416000
   MOVE BUFF:="???"                                            <<00085>>02418000
ELSE                                                           <<00085>>02420000
   BEGIN                                                       <<00085>>02422000
   IF JNUM.(0:2)=1 THEN                                        <<00085>>02424000
      MOVE BUFF:="#S",2                                        <<00085>>02426000
   ELSE                                                        <<00085>>02428000
      MOVE BUFF:="#J",2;                                       <<00085>>02430000
   @P:=TOS;                                                    <<00085>>02432000
   ASCII(JNUM.(2:14),10,P);                                    <<00085>>02434000
   END;                                                        <<00085>>02436000
JOBNUM:=JNUM;                                                  <<00085>>02438000
END;                                                           <<00085>>02440000
                                                                        02442000
                                                                        02444000
$CONTROL SEGMENT=MAIN                                                   02446000
                                                                        02448000
         END;                                                           02450000
