$CONTROL MAP,CODE,USLINIT                                               00010000
<<RINS - MODULE 73>>                                                    00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$CONTROL SEGMENT=RINS                                                   00055000
$THIRTY                                                                 00060000
<<  R I N   I N T R I N S I C S    F I L E S >>                         00065000
                                                                        00070000
                                                                        00075000
BEGIN                                                                   00080000
DEFINE DISABLE=ASSEMBLE(SED 0)#,ENABLE=ASSEMBLE(SED 1)#;                00085000
DEFINE TRAPSOFF = PUSH(STATUS); TOS.(2:1):=0; SET(STATUS)#;    <<00804>>00090000
DEFINE FORCESTKO = ASSEMBLE (ADDS 128; SUBS 128)#;             <<00804>>00095000
INTEGER S0=S-0;                                                <<06266>>00100000
$INCLUDE INCLPCB5                                              <<06649>>00105000
ARRAY QARRAY(*) = Q+0;                                         <<*7763>>00110000
$INCLUDE INCLPXDL                                              <<*7763>>00115000
$INCLUDE INCLPXFT                                              <<*7763>>00120000
$INCLUDE INCLRINS                                              <<06265>>00125000
$INCLUDE INCLPXGT                                              <<*7763>>00130000
$INCLUDE INCLMEAS                                              <<01814>>00135000
$INCLUDE INCLJIT                                               <<06267>>00140000
$INCLUDE INCLMIFT                                              <<04541>>00145000
$PAGE "  "                                                     <<01622>>00150000
<<------------------------------------------------------------------->> 00155000
DOUBLE PROCEDURE CHEK(INT,FL,PARM,CAPM,OVM);                            00160000
VALUE INT,FL,PARM,CAPM,OVM;                                             00165000
LOGICAL INT,FL,OVM; DOUBLE PARM,CAPM;                                   00170000
OPTION EXTERNAL,VARIABLE;                                               00175000
<<------------------------------------------------------------------->> 00180000
PROCEDURE WAIT(WF,JPCNTX);VALUE WF,JPCNTX;INTEGER WF,JPCNTX;            00185000
OPTION EXTERNAL;                                                        00190000
<<------------------------------------------------------------------->> 00195000
PROCEDURE AWAKE(PCBPT,N,W);VALUE PCBPT,N,W;INTEGER PCBPT,N,W;           00200000
OPTION EXTERNAL;                                                        00205000
<<------------------------------------------------------------------->> 00210000
LOGICAL PROCEDURE EXCHANGEDB(N);VALUE N;LOGICAL N;OPTION EXTERNAL;      00215000
<<------------------------------------------------------------------->> 00220000
LOGICAL PROCEDURE GETSIR(N);VALUE N;INTEGER N;OPTION EXTERNAL;          00225000
<<------------------------------------------------------------------->> 00230000
PROCEDURE RELSIR(N,S);VALUE N,S;INTEGER N;LOGICAL S;OPTION EXTERNAL;    00235000
<<------------------------------------------------------------------->> 00240000
PROCEDURE ERROREXIT(INT,ERB,PAR);VALUE INT,ERB,PAR;                     00245000
LOGICAL INT,ERB,PAR;OPTION EXTERNAL;                                    00250000
<<------------------------------------------------------------------->> 00255000
PROCEDURE ERRORON;OPTION EXTERNAL;                                      00260000
<<------------------------------------------------------------------->> 00265000
PROCEDURE SUDDENDEATH(N);VALUE N;INTEGER N;OPTION EXTERNAL;             00270000
<<------------------------------------------------------------------->> 00275000
PROCEDURE HELP; OPTION EXTERNAL;                                        00280000
<<------------------------------------------------------------------->> 00285000
INTEGER PROCEDURE FATHER;   OPTION EXTERNAL;                   <<00452>>00290000
<<------------------------------------------------------------------->> 00295000
PROCEDURE WRITEDSEG (DSTENTRYNUMBER);                          <<04642>>00300000
VALUE DSTENTRYNUMBER;                                          <<04642>>00305000
INTEGER DSTENTRYNUMBER;                                        <<04642>>00310000
OPTION EXTERNAL;                                               <<04642>>00315000
<<----------------------------------------------------------->><<04642>>00320000
                                                                        00325000
                                                                        00330000
                                                                        00335000
                                                                        00340000
LOGICAL PROCEDURE MRCAPOK (SIT, RINX);                         <<01603>>00345000
  VALUE SIT, RINX;   LOGICAL SIT;                              <<01603>>00350000
  INTEGER RINX;                                                <<01603>>00355000
  OPTION UNCALLABLE, PRIVILEGED, VARIABLE;                     <<00560>>00360000
                                                                        00365000
COMMENT:                                                                00370000
      1  CHECKS CALLER'S MULTIPLE RIN CAPABILITY. IF MR THEN            00375000
        RETURNS, AND MRCAPOK=TRUE                                       00380000
      2  IF SIT=TRUE THEN TEST GLOBAL RIN FLAG AND SETS IT. IF          00385000
         ALREADY SET THEN RETURNS FALSE OTHERWISE TRUE.                 00390000
         3  IF SET=FALSE THEN RESETS GLOBAL RIN FLAG IN PXFIXED<<06667>>00395000
      ;                                                                 00400000
<< PARAMETER RIN ADDED TO ALLOW MRCAPOK TO RETURN TRUE    >>   <<00560>>00405000
<< WHEN PROCESS WITHOUT MR CAPABILITY TRIES TO LOCK RIN   >>   <<00560>>00410000
<< THAT IT ALREADY HAS LOCKED.                            >>   <<00560>>00415000
                                                                        00420000
BEGIN                                                                   00425000
      EQUATE ACCX=5;                                                    00430000
                                                                        00435000
      DEFINE PINOFLOCKER = (8:8)#;                             <<00560>>00440000
      INTEGER OVMASK = Q-4;                                    <<00560>>00445000
      DEFINE RINTHERE = OVMASK.(15:1) = 1#;                    <<06667>>00450000
      INTEGER DB, SIRCOND, RIN'ENTRY, PIN;                     <<00560>>00455000
      LOGICAL ARRAY QARRAY(*)=Q+0;                             <<06268>>00460000
      LOGICAL PXFIXEDLOC;                                      <<06268>>00465000
      INTEGER X=X;                                                      00470000
      INTEGER RINPTR;                                          <<01603>>00475000
                                                                        00480000
                                                                        00485000
      PXFIXED;                                                 <<06268>>00490000
      IF PXFXCAP.(12:1)  THEN              <<TEST FOR MR CAP>> <<06667>>00495000
      BEGIN                            <<MR CAP>>                       00500000
         MRCAPOK:=TRUE;                                                 00505000
         RETURN;                                                        00510000
      END;                                                              00515000
                                                                        00520000
      SIRCOND := GETSIR (RIN'SIR);                             <<06265>>00525000
                                                                        00530000
      IF SIT THEN                      <<TEST AND SET BIT>>             00535000
      BEGIN                                                             00540000
         PXFXGLBRINFLG:=1;             <<TEST GLOB RIN FLAG>>  <<06667>>00545000
         IF <> THEN                    <<NOT 0 = AN ERROR?>>   <<00560>>00550000
         BEGIN                                                 <<00560>>00555000
           IF RINTHERE THEN                                    <<06667>>00560000
             BEGIN                                             <<00560>>00565000
               PIN := (CURPRC)/PCBSIZE;                        <<06649>>00570000
               RINPTR:=RINX*RIN'LENGTH;                        <<06667>>00575000
               DB := EXCHANGEDB (RIN'DST);                     <<06265>>00580000
                IF RIN'E'HOLDER = PIN THEN                     <<01603>>00585000
                  MRCAPOK := TRUE;                             <<06667>>00590000
               EXCHANGEDB (DB);                                <<00560>>00595000
             END                                               <<06667>>00600000
             ELSE MRCAPOK:=FALSE;                              <<07056>>00605000
         END                                                   <<00560>>00610000
         ELSE MRCAPOK:=TRUE;                                   <<06667>>00615000
      END                                                      <<06667>>00620000
      ELSE                                                     <<06667>>00625000
        BEGIN                                                  <<06667>>00630000
          MRCAPOK:=TRUE;                                       <<06667>>00635000
          PXFXGLBRINFLG:=0;                                    <<06667>>00640000
        END;                                                   <<06667>>00645000
                                                               <<00560>>00650000
      RELSIR (RIN'SIR, SIRCOND);                               <<06265>>00655000
                                                                        00660000
END;     <<  M R C A P O K  >>                                          00665000
<<------------------------------------------------------------------->> 00670000
                                                                        00675000
                                                                        00680000
                                                                        00685000
                                                                        00690000
PROCEDURE RLOCK(RINX,UNCOND);                                  <<01603>>00695000
VALUE RINX,UNCOND;                                             <<01603>>00700000
INTEGER RINX;                                                  <<01603>>00705000
LOGICAL UNCOND;                                                         00710000
OPTION UNCALLABLE,PRIVILEGED;                                           00715000
                                                                        00720000
                                                                        00725000
COMMENT: LOCKS THE SPECIFIED RIN.                                       00730000
         IF UNCOND=TRUE THEN UNCONDITIONALLY                            00735000
         IF UNCOND=FALSE THEN ONLY IF NOT LOCKED                        00740000
                                                                        00745000
      RETURNS                                                           00750000
         CCE   GRANTED                                                  00755000
         CCG   GRANTED BUT THE PROCESS ALREADY HAD IT                   00760000
         CCL   (ONLY IF UNCOND=FALSE) NOT GRANTED BECAUSE LOCKED        00765000
         CCX   NOT ALLOCATED                                            00770000
                                                                        00775000
      IF BIT 0 OF "RINX" IS 1 THEN DB IS AREADY POINTING TO RIN TABLE   00780000
      ;                                                                 00785000
                                                                        00790000
                                                                        00795000
                                                                        00800000
BEGIN                                                                   00805000
      EQUATE CCG=0,CCL=1,CCE=2,CCX=3;                                   00810000
      INTEGER POINTER  PCB = 3;                                         00815000
                                                                        00820000
      ARRAY RINSEG(*)=DB+0;                                             00825000
      INTEGER X=X,PIN,DB,SIRF,CC,PINX;                                  00830000
      LOGICAL DBF:=FALSE;                                               00835000
      INTEGER STATUS=Q-1,WAITF;                                         00840000
      INTEGER RINPTR;                                          <<01603>>00845000
                                                                        00850000
                                                                        00855000
                                                                        00860000
      PIN := (PINX := (CURPRC))/PCBSIZE;                       <<06649>>00865000
                                                                        00870000
      IF RINX<0 THEN RINX.(0:1) := 0 ELSE                      <<01603>>00875000
      BEGIN                                                             00880000
         DBF:=TRUE;                                                     00885000
         DB:=EXCHANGEDB(RIN'DST); <<DB POINTS TO RIN TABLE>>   <<06265>>00890000
      END;                                                              00895000
                                                                        00900000
      SIRF:=GETSIR(RIN'SIR);            <<LOCK RIN>>           <<06265>>00905000
                                                                        00910000
      RINPTR := RINX*RIN'LENGTH;                               <<01603>>00915000
      IF RIN'E'TYPE = 0 THEN                                   <<01603>>00920000
      BEGIN                               << NOT ALLOCATED >>  <<01603>>00925000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>00930000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>00935000
        STATUS.(6:2) := CCX;                                   <<01603>>00940000
        RETURN;                                                <<01603>>00945000
      END;                                                     <<01603>>00950000
      IF RIN'E'TYPE = 1 THEN WAITF := %1000                    <<01603>>00955000
      ELSE WAITF := %2000;                                     <<01603>>00960000
      IF RIN'E'HOLDER = PIN THEN                               <<01603>>00965000
      BEGIN              << THE PROCESS ALREADY HAS IT >>      <<01603>>00970000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>00975000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>00980000
        STATUS.(6:2) := CCG;                                   <<01603>>00985000
        RETURN;                                                <<01603>>00990000
      END;                                                     <<01603>>00995000
      IF RIN'E'HOLDER = 0 THEN                                 <<01603>>01000000
      BEGIN  << RIN FREE >>                                    <<01603>>01005000
        RIN'E'HOLDER := PIN;                                   <<01603>>01010000
        RELSIR(RIN'SIR,SIRF);  << UNBLOCK RIN >>               <<06265>>01015000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>01020000
        STATUS.(6:2) := CCE;                                   <<01603>>01025000
        RETURN;                                                <<01603>>01030000
      END;                                                     <<01603>>01035000
                                                                        01040000
      <<AT THIS POINT THE RIN IS LOCKED BY ANOTHER PROCESS>>            01045000
                                                                        01050000
      IF NOT(UNCOND) THEN              <<THE RIN ASKED CONDITIONALLY>>  01055000
      BEGIN                                                             01060000
          RELSIR(RIN'SIR,SIRF);                                <<06265>>01065000
          IF DBF THEN EXCHANGEDB(DB);                          <<01603>>01070000
          STATUS.(6:2) := CCL;                                 <<01603>>01075000
          RETURN;                                              <<01603>>01080000
      END;                                                              01085000
                                                                        01090000
      PCB(PINX+NIMPPINWORDNUM) := 0;                           <<06649>>01095000
      IF RIN'E'HEADQ = 0 THEN  << NO PROCESS WAITING >>        <<01603>>01100000
        RIN'E'HEADQ := PIN                                     <<01603>>01105000
      ELSE  << PUT AT END OF LIST >>                           <<01603>>01110000
      BEGIN                                                             01115000
          TOS := RIN'E'HEADQ;                                  <<01603>>01120000
         WHILE PCB(TOS*PCBSIZE+NIMPPINWORDNUM) <> 0 DO         <<06649>>01125000
            TOS := PCB(X)/PCBSIZE;                             <<06649>>01130000
         PCB(X) := PIN * PCBSIZE;                              <<06649>>01135000
      END;                                                              01140000
                                                                        01145000
      <<PROCESS GOES TO WAIT>>                                          01150000
      ASSEMBLE( PSDB );                                                 01155000
      RELSIR(RIN'SIR,SIRF.(15:1));      <<RELEASE RIN SIR>>    <<06265>>01160000
      IF GCLASSENABLEDMASK.CLASS15 THEN                        <<01814>>01165000
         BEGIN <<PROCESS LEVEL RIN WAIT>>                      <<01814>>01170000
         TOS:=MEASPROCXDSBANK;                                 <<01814>>01175000
         TOS:=MEASPROCXDSBASE+LOGICAL(PIN)*CLASS15'SUB0SIZE+   <<01814>>01180000
              CP'STOPRIN;                                      <<01814>>01185000
         ASSEMBLE(LSEA;INCA;SSEA;DDEL);                        <<01814>>01190000
         END;                                                  <<01814>>01195000
      WAIT(WAITF,0);                                                    01200000
                                                                        01205000
                                                                        01210000
      IF DBF THEN EXCHANGEDB(DB);                              <<01603>>01215000
      STATUS.(6:2) := CCE;                                     <<01603>>01220000
                                                                        01225000
END;  << R L O C K  >>                                                  01230000
                                                                        01235000
<<------------------------------------------------------------------->> 01240000
                                                                        01245000
                                                                        01250000
                                                                        01255000
                                                                        01260000
                                                                        01265000
                                                                        01270000
PROCEDURE RUNLOCK(RINX);                                       <<01603>>01275000
VALUE RINX;                                                    <<01603>>01280000
INTEGER RINX;                                                  <<01603>>01285000
OPTION UNCALLABLE,PRIVILEGED;                                           01290000
                                                                        01295000
COMMENT: UNLOCKS THE SPECIFIED RIN.                                     01300000
         IF RINX.(0:1)=1 THEN DB ALREADY POINTING TO RIN TABLE.<<01603>>01305000
                                                                        01310000
      RETURNS                                                           01315000
         CCE   GRANTED                                                  01320000
         CCG   IF PROCESS HAD NOT THE RIN                               01325000
         CCL   IF RIN NOT ALLOCATED                                     01330000
                                                                        01335000
      ;                                                                 01340000
                                                                        01345000
BEGIN                                                                   01350000
      EQUATE CCG=0,CCL=1,CCE=2;                                         01355000
      EQUATE RIN'DST=22,RIN'SIR=38;                            <<06265>>01360000
      INTEGER POINTER PCB = 3;                                 <<06649>>01365000
                                                                        01370000
                                                                        01375000
      INTEGER X=X,PCBT,CC,PIN,NEXT:=0,STATUS=Q-1,SIRF,D;                01380000
      INTEGER DB;                                                       01385000
      LOGICAL DBF:=FALSE,AF:=FALSE,GR:=FALSE,LR:=FALSE,SR:=FALSE;       01390000
      INTEGER AWF;                                                      01395000
      INTEGER RINPTR;                                          <<01603>>01400000
ENTRY GRUNLOCK,LRUNLOCK;                                                01405000
      SR:=TRUE;                                                         01410000
      GO ALL;                                                           01415000
GRUNLOCK:  GR:=TRUE;                                                    01420000
           GO ALL;                                                      01425000
LRUNLOCK:  LR:=TRUE;                                                    01430000
ALL:                                                                    01435000
      PIN := (CURPRC)/PCBSIZE;                                 <<06649>>01440000
                                                                        01445000
      IF RINX<0 THEN RINX.(0:1):=0 ELSE                        <<01603>>01450000
      BEGIN                                                             01455000
         DBF:=TRUE;                                                     01460000
         DB:=EXCHANGEDB(RIN'DST);                              <<06265>>01465000
      END;                                                              01470000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>01475000
      RINPTR := RINX*RIN'LENGTH;                               <<01603>>01480000
      IF NOT SR THEN                                           <<01603>>01485000
      BEGIN                                                    <<01603>>01490000
        IF RIN'TOTALNUM/RIN'LENGTH < RINX THEN                 <<01603>>01495000
        BEGIN               << INVALID RIN # >>                <<01603>>01500000
          RELSIR(RIN'SIR,SIRF);                                <<06265>>01505000
          IF DBF THEN EXCHANGEDB(DB);                          <<01603>>01510000
          STATUS.(6:2) := CCL;                                 <<01603>>01515000
          RETURN;                                              <<01603>>01520000
        END;                                                   <<01603>>01525000
        IF GR AND RIN'E'TYPE <> 2 OR                           <<01603>>01530000
           LR AND RIN'E'TYPE <> 1 THEN                         <<01603>>01535000
        BEGIN                                                  <<01603>>01540000
          RELSIR(RIN'SIR,SIRF);                                <<06265>>01545000
          IF DBF THEN EXCHANGEDB(DB);                          <<01603>>01550000
          STATUS.(6:2) := CCL;                                 <<01603>>01555000
          RETURN;                                              <<01603>>01560000
        END;                                                   <<01603>>01565000
      END;                                                     <<01603>>01570000
      IF RIN'E'TYPE = 1 THEN AWF := %1000                      <<01603>>01575000
      ELSE AWF := %2000;                                       <<01603>>01580000
      IF RIN'E'HOLDER = PIN THEN                               <<01603>>01585000
      BEGIN                   << THE PROCESS HAS THE RIN >>    <<01603>>01590000
        NEXT := RIN'E'HEADQ;                                   <<01603>>01595000
        RIN'E'HOLDER := RIN'E'HEADQ;                           <<01603>>01600000
        IF RIN'E'HEADQ <> 0 THEN RIN'E'HEADQ :=                <<01603>>01605000
           PCB(RIN'E'HEADQ*PCBSIZE+NIMPPINWORDNUM)/            <<06649>>01610000
           PCBSIZE;                                            <<06649>>01615000
        CC := CCE                                              <<01603>>01620000
      END                                                      <<01603>>01625000
      ELSE              << CALLER DOES NOT HAVE THE RIN >>     <<01603>>01630000
        IF RIN'E'TYPE = 0 THEN CC := CCL                       <<01603>>01635000
        ELSE CC := CCG;                                        <<01603>>01640000
      RELSIR(RIN'SIR,SIRF);                                    <<06265>>01645000
      IF NEXT <> 0 THEN AWAKE(NEXT*PCBSIZE,AWF,0);             <<01603>>01650000
      IF DBF THEN EXCHANGEDB(DB);                              <<01603>>01655000
      STATUS.(6:2) := CC;            <<SET CC >>               <<01603>>01660000
                                                                        01665000
END;  << R U N L O C K  >>                                              01670000
                                                               <<04642>>01675000
<<------------------------------------------------------------------->> 01680000
                                                                        01685000
                                                                        01690000
                                                                        01695000
                                                                        01700000
                                                                        01705000
                                                                        01710000
INTEGER PROCEDURE ALLORIN(RCODE,USNAM,PASSW);                           01715000
VALUE RCODE;                                                            01720000
INTEGER RCODE;                                                          01725000
ARRAY USNAM,PASSW;                                                      01730000
OPTION UNCALLABLE,PRIVILEGED,VARIABLE;                                  01735000
                                                                        01740000
                                                                        01745000
COMMENT: ALLOCATES A RIN ENTRY                                          01750000
         RCODE DEFINES THE RIN TYPE                                     01755000
            1  LOCAL RIN                                                01760000
            2  GLOBAL RIN                                               01765000
            3  FILE RIN                                                 01770000
                                                                        01775000
         RETURNS THE GLOBAL RIN NUMBER TO CALLER(0 IF NONE AVAILABLE)   01780000
                                                                        01785000
         IF RCODE.(0:1)=1 THEN DB IS ALREADY POINTING TO RIN TABLE      01790000
               ( FOR LOCAL AND FILE RIN ONLY )                          01795000
                                                                        01800000
      ;                                                                 01805000
                                                                        01810000
BEGIN                                                                   01815000
                                                                        01820000
                                                                        01825000
      INTEGER D;                                                        01830000
      LOGICAL VAR=Q-4;                                                  01835000
      ARRAY USER(0:8)=Q;                                                01840000
      ARRAY RPASS(0:4)=Q;                                               01845000
      INTEGER R;                                                        01850000
      LOGICAL DBF:=FALSE;                                               01855000
      INTEGER X=X,DB,CX,SIRF,I;                                         01860000
      INTEGER RINPTR,                                          <<01603>>01865000
              RIN'PASSUSERINX;                                 <<01603>>01870000
                                                                        01875000
                                                                        01880000
      IF VAR&LSR(1) THEN               <<USNAM PARAMETER PRESENT>>      01885000
      BEGIN                            <<COPY USNAM LOCALLY>>           01890000
         CX:=-1;                                                        01895000
         WHILE (CX:=CX+1)<8  DO USER(CX):=USNAM(CX);                    01900000
      END;                                                              01905000
                                                                        01910000
      IF VAR THEN                      <<PASSW PARAMETER PRESENT>>      01915000
      BEGIN                                                             01920000
         CX:=-1;                                                        01925000
         WHILE (CX:=CX+1)<4 DO RPASS(CX):=PASSW(CX);                    01930000
      END;                                                              01935000
                                                                        01940000
      IF RCODE<0 THEN RCODE.(0:1):=0 ELSE                               01945000
      BEGIN                                                             01950000
         DBF:=TRUE;                                                     01955000
         DB:=EXCHANGEDB(RIN'DST);                              <<06265>>01960000
      END;                                                              01965000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>01970000
                                                                        01975000
      IF RIN'FIRSTFREE = 0 THEN                                <<01603>>01980000
      BEGIN                   << NO AVAILABLE RIN >>           <<01603>>01985000
        ALLORIN := 0;                                          <<01603>>01990000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>01995000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>02000000
        RETURN;                                                <<01603>>02005000
      END;                                                     <<01603>>02010000
      IF RCODE = 2 AND RIN'FREEPTR = 0 THEN                    <<01603>>02015000
      BEGIN << NO PASS ENTRY AVAILABLE FOR GLOBAL RINS >>      <<01603>>02020000
        ALLORIN := 0;                                          <<01603>>02025000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>02030000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>02035000
        RETURN;                                                <<01603>>02040000
      END;                                                     <<01603>>02045000
      RINPTR := RIN'FIRSTFREE;                                 <<01603>>02050000
      ALLORIN := RIN'FIRSTFREE/RIN'LENGTH;                     <<01603>>02055000
      RIN'FIRSTFREE := RIN'E'INDEX;    << RELINK >>            <<01603>>02060000
      RIN'E'TYPE := RCODE;                                     <<01603>>02065000
      RIN'E'INDEX := 0;                                        <<01603>>02070000
      IF RIN'E'TYPE = 2 THEN                                   <<01603>>02075000
      BEGIN                         << GLOBAL RIN >>           <<01603>>02080000
        RIN'E'INDEX := RIN'FREEPTR;                            <<01603>>02085000
        RIN'FREEPTR := RIN'E'NEXTFREE;                         <<01603>>02090000
        IF VAR THEN                << PASSWORD PRESENT >>      <<01603>>02095000
        BEGIN                                                  <<01603>>02100000
          RIN'PASSUSERINX := 0;                                <<01603>>02105000
          WHILE RIN'PASSUSERINX < 4 DO                         <<01603>>02110000
          BEGIN                                                <<01603>>02115000
            RIN'E'PASSWORD := RPASS(RIN'PASSUSERINX);          <<01603>>02120000
            RIN'PASSUSERINX := RIN'PASSUSERINX+1;              <<01603>>02125000
          END;                                                 <<01603>>02130000
        END                                                    <<01603>>02135000
        ELSE                                                   <<01603>>02140000
        BEGIN                                                  <<01603>>02145000
          RIN'PASSUSERINX := 0;                                <<01603>>02150000
          RIN'E'PASSWORD := 0;                                 <<01603>>02155000
        END;                                                   <<01603>>02160000
        RIN'PASSUSERINX := 0;                                  <<01603>>02165000
        WHILE RIN'PASSUSERINX < 8 DO                           <<01603>>02170000
        BEGIN                                                  <<01603>>02175000
          RIN'E'USERNAME := USER(RIN'PASSUSERINX);             <<01603>>02180000
          RIN'PASSUSERINX := RIN'PASSUSERINX+1;                <<01603>>02185000
        END;                                                   <<01603>>02190000
        RIN'FREENTRIES := RIN'FREENTRIES-1;                    <<01603>>02195000
               << DECREMENT FREE ENTRY COUNT >>                <<01603>>02200000
      END;                                                     <<01603>>02205000
      RIN'E'HEADQ := 0;                                        <<01603>>02210000
      RIN'E'HOLDER := 0;                                       <<01603>>02215000
      IF DBF THEN EXCHANGEDB(DB);                              <<01603>>02220000
<< IF GLOBAL RIN MAKE THE MODIFIED RIN TABLE PERMANENT>>       <<04642>>02225000
IF RCODE = 2 THEN WRITEDSEG(RIN'DST);                          <<06265>>02230000
RELSIR(RIN'SIR,SIRF);                                          <<06265>>02235000
                                                                        02240000
END;  << A L L O R I N  >>                                              02245000
<<------------------------------------------------------------------->> 02250000
                                                                        02255000
                                                                        02260000
                                                                        02265000
                                                                        02270000
                                                                        02275000
                                                                        02280000
PROCEDURE DEALLORIN(RINX,USNAM);                               <<01603>>02285000
VALUE RINX;                                                    <<01603>>02290000
INTEGER RINX;                                                  <<01603>>02295000
ARRAY USNAM;                                                            02300000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                                  02305000
                                                                        02310000
                                                                        02315000
COMMENT: DEALLOCATES THE SPECIFIED RIN.                                 02320000
                                                                        02325000
      RETURNS                                                           02330000
                                                                        02335000
         CCE   OK                                                       02340000
         CCG   IF RIN IS CURRENTLY USED                                 02345000
         CCL   IF RIN WAS NOT ALLOCATED TO THIS USER(GLOBAL RIN)        02350000
               OR RIN > # OF CONFIGURED RINS                   <<00859>>02355000
                                                                        02360000
      "USNAM" OMITTED IF NOT A GLOBAL RIN.                              02365000
                                                                        02370000
       IF RINX.(0:1)=1 DB IS ALREADY POINTING TO RIN TABLE     <<01603>>02375000
         ( FOR LOCAL AND FILE RINS ONLY )                               02380000
      ;                                                                 02385000
                                                                        02390000
                                                                        02395000
BEGIN                                                                   02400000
      EQUATE CCG=0,CCL=1,CCE=2;                                         02405000
                                                                        02410000
      INTEGER X=X,CX,DB,SIRF,CC,I,D;                                    02415000
      INTEGER STATUS=Q-1;                                               02420000
      INTEGER RINPTR,                                          <<01603>>02425000
              RIN'PASSUSERINX;                                 <<01603>>02430000
      LOGICAL VAR=Q-4;                                         <<04769>>02435000
      LOGICAL DBF:=FALSE;                                      <<04769>>02440000
      LOGICAL GLOBALRIN:=FALSE;                                <<04769>>02445000
      ARRAY USER(0:8)=Q;                                                02450000
                                                                        02455000
                                                                        02460000
      IF VAR THEN                                                       02465000
      BEGIN                                                             02470000
         CX:=-1;                                                        02475000
         WHILE (CX:=CX+1)<8 DO USER(CX):=USNAM(CX);                     02480000
      END;                                                              02485000
                                                                        02490000
      IF RINX<0 THEN RINX.(0:1):= 0 ELSE                       <<01603>>02495000
      BEGIN                                                             02500000
         DBF:=TRUE;                                                     02505000
         DB:=EXCHANGEDB(RIN'DST);                              <<06265>>02510000
      END;                                                              02515000
                                                                        02520000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>02525000
                                                                        02530000
      RINPTR := RINX*RIN'LENGTH;                               <<01603>>02535000
      IF RINX > (RIN'TOTALNUM/RIN'LENGTH)-1 THEN               <<01603>>02540000
      BEGIN               << THE RIN IS BEYOND RINTABLE >>     <<01603>>02545000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>02550000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>02555000
        STATUS.(6:2) := CCL;                                   <<01603>>02560000
        RETURN;                                                <<01603>>02565000
      END;                                                     <<01603>>02570000
      IF RIN'E'HOLDER <> 0 THEN                                <<01603>>02575000
      BEGIN               << THE RIN IS CURRENTLY LOCKED >>    <<01603>>02580000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>02585000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>02590000
        STATUS.(6:2) := CCG;                                   <<01603>>02595000
        RETURN;                                                <<01603>>02600000
      END;                                                     <<01603>>02605000
      IF RIN'E'TYPE = 0 THEN                                   <<01603>>02610000
      BEGIN               << NOT ALLOCATED >>                  <<01603>>02615000
        RELSIR(RIN'SIR,SIRF);                                  <<06265>>02620000
        IF DBF THEN EXCHANGEDB(DB);                            <<01603>>02625000
        STATUS.(6:2) := CCL;                                   <<01603>>02630000
        RETURN;                                                <<01603>>02635000
      END;                                                     <<01603>>02640000
      IF RIN'E'TYPE = 2 THEN                                   <<01603>>02645000
      BEGIN               << GLOBAL RIN >>                     <<01603>>02650000
        GLOBALRIN:=TRUE;                                       <<04642>>02655000
        RIN'PASSUSERINX := 0;                                  <<01603>>02660000
        WHILE RIN'PASSUSERINX < 8 DO                           <<01603>>02665000
        BEGIN                                                  <<01603>>02670000
          IF LOGICAL(RIN'E'USERNAME) <> USER(RIN'PASSUSERINX)  <<01603>>02675000
          THEN                     << NOT GRANTED >>           <<01603>>02680000
          BEGIN                                                <<01603>>02685000
            RELSIR(RIN'SIR,SIRF);                              <<06265>>02690000
            IF DBF THEN EXCHANGEDB(DB);                        <<01603>>02695000
            STATUS.(6:2) := CCL;                               <<01603>>02700000
            RETURN;                                            <<01603>>02705000
          END;                                                 <<01603>>02710000
          RIN'PASSUSERINX := RIN'PASSUSERINX+1;                <<01603>>02715000
        END;                                                   <<01603>>02720000
        RIN'E'LINK := RIN'FREEPTR;  << RELINK >>               <<01603>>02725000
        RIN'FREEPTR := RIN'E'INDEX;                            <<01603>>02730000
        RIN'FREENTRIES := RIN'FREENTRIES+1;                    <<01603>>02735000
      END                                                      <<01603>>02740000
      ELSE                                                     <<01603>>02745000
       IF VAR THEN                                             <<01603>>02750000
        BEGIN                                                  <<01603>>02755000
         RELSIR(RIN'SIR,SIRF);                                 <<06265>>02760000
         IF DBF THEN EXCHANGEDB(DB);                           <<01603>>02765000
         STATUS.(6:2) := CCL;                                  <<01603>>02770000
         RETURN;                                               <<01603>>02775000
        END;                                                   <<01603>>02780000
      RIN'E'TYPE := 0;                                         <<01603>>02785000
      RIN'E'INDEX := RIN'FIRSTFREE;                            <<01603>>02790000
      RIN'E'HEADQ := 0;                                        <<01603>>02795000
      RIN'E'HOLDER := 0;                                       <<01603>>02800000
      RIN'FIRSTFREE := RINPTR;                                 <<01603>>02805000
      IF DBF THEN EXCHANGEDB(DB);                              <<01603>>02810000
      IF GLOBALRIN THEN WRITEDSEG(RIN'DST); <<RIN DST TO DISC>><<06265>>02815000
      RELSIR(RIN'SIR,SIRF);                                    <<06265>>02820000
      STATUS.(6:2) := CCE;                                     <<01603>>02825000
                                                                        02830000
END;  << D E A L L O R I N  >>                                          02835000
<<------------------------------------------------------------------->> 02840000
                                                                        02845000
                                                                        02850000
                                                                        02855000
                                                                        02860000
                                                                        02865000
PROCEDURE LOCKGLORIN(RINX,UNCOND,RINPASSW);                    <<01603>>02870000
VALUE RINX;                                                    <<01603>>02875000
INTEGER RINX;                                                  <<01603>>02880000
LOGICAL UNCOND;                                                         02885000
BYTE ARRAY RINPASSW;                                                    02890000
OPTION PRIVILEGED;                                                      02895000
                                                                        02900000
                                                                        02905000
COMMENT: LOCKS THE GLOBAL RIN SPECIFIED.                                02910000
                                                                        02915000
         RETURNS (IF UNCOND=TRUE)                                       02920000
            CCE   GRANTED(UNCOND CHANGED TO FALSE IF RIN FREE)          02925000
            CCG   (NULL)                                                02930000
            CCL   INVALID RIN (NOT ALLOCATED, NOT A GLOBAL     <<00452>>02935000
                               RIN, EXCEEDS RIN TABLE, OR      <<00452>>02940000
                               INCORRECT PASSWORD)             <<00452>>02945000
                                                                        02950000
         RETURNS (IF UNCOND=FALSE)                                      02955000
            CCE   GRANTED:UNCOND CHANGED TO TRUE IF RIN LOCKED BY CALLER02960000
            CCG   RIN WAS LOCKED BY ANOTHER PROCESS                     02965000
            CCL   (SAME AS ABOVE)                                       02970000
                                                                        02975000
         ERRORS                                                         02980000
           21  UNDER CLASS 0 OR 1 ONLY ONE RIN CAN BE LOCKED            02985000
               AT ANY ONE TIME                                          02990000
                                                                        02995000
      ;                                                                 03000000
                                                                        03005000
BEGIN                                                                   03010000
      EQUATE RIN'DST=22,RIN'SIR=38;                            <<06265>>03015000
      EQUATE CCG=0,CCL=1,CCE=2;                                         03020000
      EQUATE ACCX=5;                                                    03025000
                                                                        03030000
      INTEGER INT,ERR:=0;                                               03035000
      INTEGER X=X;                                                      03040000
      INTEGER STATUS=Q-1;                                               03045000
      INTEGER ARRAY PCBX(*)=Q+0;                                        03050000
      BYTE ARRAY JPCNT(*)=DB+0;                                         03055000
      BYTE ARRAY RPASS(0:8)=Q;                                          03060000
      ARRAY WRPASS(*)=RPASS;                                            03065000
      INTEGER JPCNTX,DB,SIRF,CX,I,CC,CC';                               03070000
      INTEGER ARRAY JGLOF(*)=DB+0;                                      03075000
      INTEGER RINPTR,                                          <<01603>>03080000
              RIN'PASSUSERINX;                                 <<01603>>03085000
                                                                        03090000
                                                                        03095000
      ERRORON;                                                          03100000
      RINPTR := RINX*RIN'LENGTH;                               <<01603>>03105000
      INT:=34&LSL(6)+3;                                                 03110000
      CHEK(INT,3,%70D);                                        <<00099>>03115000
      << Get password and check its length: >>                 <<01928>>03120000
      MOVE RPASS := RINPASSW, (8);                             <<01928>>03125000
      RPASS(8):=" "; << STOP CHARACTER >>                      <<01928>>03130000
      MOVE RPASS := RPASS WHILE ANS, 1; << SCAN FOR LENGTH >>  <<01928>>03135000
      I := TOS - @RPASS;  << STORE LENGTH IN I >>              <<01928>>03140000
     IF I=8 AND (RINPASSW(8)=ALPHA OR RINPASSW(8)=NUMERIC) THEN<<01928>>03145000
                                                               <<01942>>03150000
         BEGIN                                                 <<01928>>03155000
         STATUS.(6:2) := CCL;                                  <<01928>>03160000
         ERROREXIT (INT,ERR,0);                                <<01928>>03165000
         RETURN;                                               <<01928>>03170000
         END;                                                  <<01928>>03175000
      RPASS (I) := " ";  << BLANK OUT REST OF ARRAY: >>        <<01928>>03180000
      IF I < 7 THEN                                            <<01928>>03185000
         MOVE RPASS(I+1):=RPASS(I),(7-I);                      <<01928>>03190000
                                                                        03195000
      IF NOT MRCAPOK (TRUE, RINX) THEN    << ERROR >>          <<01603>>03200000
      BEGIN                                                             03205000
         ERR:=21;                      <<ERROR ABORT #21>>              03210000
         ERROREXIT(INT,ERR,0);                                 <<01603>>03215000
         RETURN;                                               <<01603>>03220000
      END;                                                              03225000
                                                                        03230000
      DB:=EXCHANGEDB(RIN'DST);          <<DB TO RIN TABLE>>    <<06265>>03235000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>03240000
      IF RINX > RIN'TOTALNUM THEN                              <<01603>>03245000
      BEGIN  << RIN EXCEEDS THE TABLE SIZE >>                  <<01603>>03250000
        MRCAPOK (FALSE);                                       <<01603>>03255000
        STATUS.(6:2) := CCL;                                   <<01603>>03260000
        RELSIR(RIN'SIR,SIRF);  <<RELEASE RIN >>                <<06265>>03265000
        EXCHANGEDB(DB);                                        <<01603>>03270000
        ERROREXIT(INT,ERR,0);                                  <<01603>>03275000
        RETURN;                                                <<01603>>03280000
      END;                                                     <<01603>>03285000
      IF RIN'E'TYPE <> 2 THEN                                  <<01603>>03290000
      BEGIN  << NOT A GLOBAL RIN >>                            <<01603>>03295000
        MRCAPOK (FALSE);                                       <<01603>>03300000
        STATUS.(6:2) := CCL;                                   <<01603>>03305000
        RELSIR(RIN'SIR,SIRF);  <<RELEASE RIN >>                <<06265>>03310000
        EXCHANGEDB(DB);                                        <<01603>>03315000
        ERROREXIT(INT,ERR,0);                                  <<01603>>03320000
        RETURN;                                                <<01603>>03325000
      END;                                                     <<01603>>03330000
      RIN'PASSUSERINX := -1;                                   <<01928>>03335000
      WHILE (RIN'PASSUSERINX:=RIN'PASSUSERINX+1)<=3 DO         <<01928>>03340000
        IF LOGICAL(RIN'E'PASSWORD) <> WRPASS(RIN'PASSUSERINX)  <<01603>>03345000
        THEN                                                   <<01603>>03350000
        BEGIN  << INCORRECT RIN PASSWORD >>                    <<01603>>03355000
          MRCAPOK (FALSE);                                     <<01603>>03360000
          STATUS.(6:2) := CCL;                                 <<01603>>03365000
          RELSIR(RIN'SIR,SIRF);  <<RELEASE RIN >>              <<06265>>03370000
          EXCHANGEDB(DB);                                      <<01603>>03375000
          ERROREXIT(INT,ERR,0);                                <<01603>>03380000
          RETURN;                                              <<01603>>03385000
        END;                                                   <<01603>>03390000
        EXCHANGEDB(DB);  << TO STACK >>                        <<01603>>03395000
        RLOCK(RINX,UNCOND);  << LOCKS THE RIN >>               <<01603>>03400000
          PUSH(STATUS);                                        <<01603>>03405000
          CC' := TOS.(6:2);                                    <<01603>>03410000
          CASE CC' OF                                          <<01603>>03415000
      BEGIN                                                             03420000
         BEGIN CC:=CCE;UNCOND:=FALSE;END;                               03425000
         BEGIN MRCAPOK(FALSE);CC:=CCG;END;                              03430000
         BEGIN CC:=CCE;UNCOND:=TRUE;END;                                03435000
         BEGIN CC:=CCL; END;                                   <<00452>>03440000
      END;                                                              03445000
                                                                        03450000
      IF CC = CCL THEN MRCAPOK (FALSE);                        <<01603>>03455000
      STATUS.(6:2) := CC;                                      <<00452>>03460000
      RELSIR (RIN'SIR, SIRF);                                  <<06265>>03465000
      EXCHANGEDB(DB);                                                   03470000
      ERROREXIT(INT,ERR,0);                                    <<01603>>03475000
                                                                        03480000
END;  << L O C K G L O R I N  >>                                        03485000
<<------------------------------------------------------------------->> 03490000
                                                                        03495000
                                                                        03500000
                                                                        03505000
                                                                        03510000
                                                                        03515000
                                                                        03520000
PROCEDURE UNLOCKGLORIN(RINX);                                  <<01603>>03525000
VALUE RINX;                                                    <<01603>>03530000
INTEGER RINX;                                                  <<01603>>03535000
OPTION PRIVILEGED;                                                      03540000
                                                                        03545000
                                                                        03550000
COMMENT: UNLOCKS THE SPECIFIED RIN.                                     03555000
                                                                        03560000
         RETURNS                                                        03565000
            CCE   OK                                                    03570000
            CCG   IF PROCESS DOES NOT HAVE THE RIN LOCKED FOR ITSELF    03575000
            CCL   IF THE RIN IS NOT ALLOCATED                           03580000
                                                                        03585000
      ;                                                                 03590000
                                                                        03595000
                                                                        03600000
BEGIN                                                                   03605000
      EQUATE CCG=0,CCL=1,CCE=2;                                         03610000
                                                                        03615000
      INTEGER JPCNTX;                                                   03620000
      ARRAY JGLOF(*)=DB+0;                                              03625000
      INTEGER ARRAY JPCNT(*)=DB+0;                                      03630000
      INTEGER ARRAY PCBX(*)=Q+0;                                        03635000
      INTEGER DB,SIRF,CC,STATUS=Q-1;                                    03640000
      INTEGER X=X;                                                      03645000
                                                                        03650000
                                                                        03655000
      ERRORON;                                                          03660000
      IF RINX < 0 THEN                                         <<01603>>03665000
      BEGIN                                                             03670000
        STATUS.(6:2):=CCL;                                              03675000
        GO BEND;                                                        03680000
      END;                                                              03685000
      SIRF:=GETSIR(RIN'SIR);            <<BLOCKS RIN>>         <<06265>>03690000
                                                                        03695000
      GRUNLOCK(RINX);                                          <<01603>>03700000
                                                                        03705000
      IF = THEN                                                         03710000
      BEGIN                            <<OK>>                           03715000
         MRCAPOK(FALSE);               <<RESET GLOBAL RIN FLAG>>        03720000
         CC:=CCE;                                                       03725000
      END ELSE BEGIN PUSH(STATUS);CC:=TOS.(6:2);END;                    03730000
                                                                        03735000
      RELSIR(RIN'SIR,SIRF);                                    <<06265>>03740000
      STATUS.(6:2):=CC;                                                 03745000
BEND:                                                                   03750000
      ERROREXIT(1,0,0);                                                 03755000
                                                                        03760000
                                                                        03765000
END;  << U N L O C K G L O R I N  >>                                    03770000
                                                                        03775000
<<------------------------------------------------------------------->> 03780000
                                                                        03785000
                                                                        03790000
                                                                        03795000
                                                                        03800000
                                                                        03805000
PROCEDURE FREELOCRIN;                                                   03810000
OPTION PRIVILEGED;                                                      03815000
                                                                        03820000
                                                                        03825000
COMMENT: DEALLOCATES ALL THE RINS ALLOCATED TO A JOB THROUGH            03830000
            GETLOCRIN.                                                  03835000
                                                                        03840000
         RETURNS                                                        03845000
            CCE   OK                                                    03850000
            CCG   NO LOCAL RIN ALLOCATED                                03855000
            CCL   AT LEAST ONE RIN CURRENTLY LOCKED(NOT GRANTED)        03860000
                                                                        03865000
      ;                                                                 03870000
                                                                        03875000
                                                                        03880000
BEGIN                                                                   03885000
      EQUATE RIN'SIR=38,RIN'DST=22,JITX=6,FIR=43;              <<06265>>03890000
      EQUATE CCG=0,CCL=1,CCE=2;                                         03895000
                                                                        03900000
      INTEGER X=X;                                                      03905000
      INTEGER V;                                                        03910000
      INTEGER DB,JIT,FIRST,CC,CX,SIRF;                                  03915000
      INTEGER STATUS=Q-1;                                               03920000
                                                               <<01603>>03925000
      INTEGER ARRAY PCBX(*)=Q+0;                                        03930000
      ARRAY QARRAY(*)=Q+0;                                     <<06266>>03935000
      INTEGER PCBGLOBLOC;                                      <<06266>>03940000
      INTEGER ARRAY JITARR(*) = DB + 0;                        <<06267>>03945000
      INTEGER RINPTR;                                          <<01603>>03950000
                                                                        03955000
      ERRORON;                                                          03960000
      <<GET THE JIT FROM PCBX>>                                         03965000
      PXGLOBAL;                                                <<06266>>03970000
      JIT:=PXG'JITDST;                                         <<06266>>03975000
      DB:=EXCHANGEDB(JIT);                                              03980000
      SIRF:=GETSIR(RIN'SIR);            <<BLOCKS RINS>>        <<06265>>03985000
                                                                        03990000
      TOS:=JITLOCALRINPTR;                <<FIRST RIN>>        <<06267>>03995000
      IF = THEN                                                         04000000
      BEGIN                            <<JOB HAS NO RIN ALLOCATED>>     04005000
         CC:=CCG;                                                       04010000
         GOTO FIN;                                                      04015000
      END;                                                              04020000
      ASSEMBLE(DUP);                                                    04025000
      FIRST:=TOS;                                                       04030000
      JITLOCALRINPTR:=0;     <<RESET FIRST RIN TO ZERO>>       <<06267>>04035000
                                                                        04040000
      <<TEST TO FIND OUT IF NO RINS ARE STIIL LOCKED>>                  04045000
      CC := CCE; <<DEFAULT>>                                   <<01928>>04050000
      EXCHANGEDB(RIN'DST);              <<DB TO RIN TABLE>>    <<06265>>04055000
      RINPTR := FIRST*RIN'LENGTH;                              <<01603>>04060000
      WHILE RINPTR <> 0 DO                                     <<01603>>04065000
      BEGIN                                                    <<01603>>04070000
        IF RIN'E'HOLDER <> 0 THEN  << TEST FOR >>              <<01603>>04075000
        BEGIN   << SOMETHING AND TEST FOR LOCKED  >>           <<01603>>04080000
          EXCHANGEDB(JIT);            << DB TO JIT >>          <<01603>>04085000
          JITLOCALRINPTR := FIRST;  << RESTORE FIRST RIN >>    <<06267>>04090000
          CC := CCL;                                           <<01928>>04095000
          GOTO FIN;                                            <<01928>>04100000
        END;                                                   <<01603>>04105000
        RINPTR := RIN'E'INDEX*RIN'LENGTH;<< NEXT POINTER >>    <<01603>>04110000
      END;                                                     <<01603>>04115000
      RINPTR := FIRST*RIN'LENGTH;                              <<01603>>04120000
      WHILE RINPTR <> 0 DO                                     <<01603>>04125000
      BEGIN                                                    <<01603>>04130000
        V := RIN'E'INDEX;                                      <<01603>>04135000
        RINPTR := RINPTR/RIN'LENGTH;                           <<01603>>04140000
        RINPTR.(0:1) := 1;  << DB ALREADY POINTING TO RIN T>>  <<01603>>04145000
        DEALLORIN(RINPTR);                                     <<01603>>04150000
        IF < THEN SUDDENDEATH(303);                            <<01603>>04155000
        RINPTR := V*RIN'LENGTH;                                <<01603>>04160000
      END;                                                     <<01603>>04165000
FIN:  RELSIR(RIN'SIR,SIRF);                                    <<06265>>04170000
      EXCHANGEDB(DB);                                          <<01603>>04175000
      STATUS.(6:2) := CC;                                      <<01928>>04180000
      ERROREXIT(0,0,0);                                        <<01603>>04185000
END;  << F R E E L O C R I N  >>                                        04190000
                                                                        04195000
<<------------------------------------------------------------------->> 04200000
                                                                        04205000
                                                                        04210000
                                                                        04215000
                                                                        04220000
                                                                        04225000
                                                                        04230000
                                                                        04235000
                                                                        04240000
PROCEDURE GETLOCRIN(N);                                                 04245000
VALUE N;                                                                04250000
LOGICAL N;                                                              04255000
OPTION PRIVILEGED;                                                      04260000
                                                                        04265000
                                                                        04270000
COMMENT: ALLOCATES N GLOBAL RINS AND LINKS THEM.                        04275000
         THE FIRST IS KEPT IN JIT (CELL 43).                            04280000
                                                                        04285000
         RETURNS                                                        04290000
            CCE   ALL N RINS HAVE BEEN ALLOCATED                        04295000
            CCG   THE JOB HAS ALREADY LOCAL RINS ALLOCATED(NOT GRANTED) 04300000
            CCL   NOT ENOUGH RINS AVAILABLE:NO RIN ALLOCATED.           04305000
      ;                                                                 04310000
                                                                        04315000
                                                                        04320000
BEGIN                                                                   04325000
      EQUATE CCG=0,CCL=1,CCE=2;                                         04330000
      EQUATE JITX=6,FIR=43,RCODE=%100001;                      <<06265>>04335000
                                                                        04340000
      INTEGER X=X,SIRF,DB,CC,CX,PREVIOUS,V,FIRST,STATUS=Q-1;            04345000
      LOGICAL ARRAY QARRAY(*)=Q+0;                             <<06266>>04350000
      INTEGER PCBGLOBLOC;                                      <<06266>>04355000
      INTEGER ARRAY JITARR(*) = DB + 0;                        <<06267>>04360000
      INTEGER JIT;                     <<JIT DST #>>                    04365000
      INTEGER RINPTR;                                          <<01603>>04370000
                                                                        04375000
      ERRORON;                                                          04380000
      DB:=EXCHANGEDB(RIN'DST);                                 <<06265>>04385000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>04390000
                                                                        04395000
      CC:=CCE;                                                          04400000
      CX := 0;                                                 <<01603>>04405000
      WHILE LOGICAL ((CX := CX+1)) <= N DO                     <<01603>>04410000
      BEGIN                                                    <<01603>>04415000
        RINPTR := ALLORIN(RCODE)*RIN'LENGTH; << RIN INDEX >>   <<01603>>04420000
        IF RINPTR <> 0 THEN << TEST FOR RETURNED VALE >>       <<01603>>04425000
        BEGIN               << SUCESSFUL              >>       <<01603>>04430000
          IF CX = 1 THEN    << TEST FOR START OF CHAIN>>       <<01603>>04435000
          BEGIN                                                <<01603>>04440000
            PXGLOBAL;                                          <<06266>>04445000
            JIT := PXG'JITDST;                                 <<06266>>04450000
            EXCHANGEDB(JIT);                    <<DB TO JIT>>  <<06266>>04455000
            V := JITLOCALRINPTR;                 << FIRST RIN>><<06267>>04460000
            IF V <> 0 THEN     <<LOCAL RINS ALREADY ALLOCATED>><<01603>>04465000
            BEGIN                                              <<01603>>04470000
              EXCHANGEDB(RIN'DST);  << DB BACK TO RINTABLE >>  <<06265>>04475000
              RIN'E'INDEX := RIN'FIRSTFREE;                    <<01603>>04480000
              RIN'FIRSTFREE := RINPTR;  << DELINK >>           <<01603>>04485000
              RIN'E'TYPE:=0;                                   <<01916>>04490000
              RELSIR(RIN'SIR,SIRF);                            <<06265>>04495000
              EXCHANGEDB(DB);                                  <<01603>>04500000
              STATUS.(6:2) := CCG;                             <<01603>>04505000
              ERROREXIT(1,0,0);                                <<01603>>04510000
              RETURN;                                          <<01603>>04515000
            END;                                               <<01603>>04520000
            << THER ARE NO LOCAL RINS ALLOCATED >>             <<01603>>04525000
            <<STORE FIRST RIN>>                                <<06267>>04530000
            JITLOCALRINPTR := RINPTR/RIN'LENGTH;               <<06267>>04535000
            EXCHANGEDB(RIN'DST);                               <<06265>>04540000
            PREVIOUS := RINPTR;                                <<01603>>04545000
            FIRST := RINPTR;                                   <<01603>>04550000
          END                                                  <<01603>>04555000
          ELSE                                                 <<01603>>04560000
          BEGIN                   << NOT SUCCESSFUL >>         <<01603>>04565000
            V := RINPTR;                                       <<01603>>04570000
            RINPTR := PREVIOUS;                                <<01603>>04575000
            RIN'E'INDEX := V/RIN'LENGTH;                       <<01603>>04580000
            PREVIOUS := V;                                     <<01603>>04585000
            RINPTR := V;                                       <<01603>>04590000
          END                                                  <<01603>>04595000
        END                                                    <<01603>>04600000
        ELSE                                                   <<01603>>04605000
        BEGIN                                                  <<01603>>04610000
          IF CX = 1 THEN                                       <<01603>>04615000
          BEGIN RELSIR(RIN'SIR,SIRF);                          <<06265>>04620000
            EXCHANGEDB(DB);                                    <<01603>>04625000
            STATUS.(6:2) := CCL;                               <<01603>>04630000
            ERROREXIT(1,0,0);                                  <<01603>>04635000
            RETURN;                                            <<01603>>04640000
          END;                                                 <<01916>>04645000
          RINPTR := FIRST;                                     <<01928>>04650000
          WHILE RINPTR <> 0 DO                                 <<01916>>04655000
          BEGIN                                                <<01916>>04660000
            V := RIN'E'INDEX;                                  <<01916>>04665000
            RINPTR := RINPTR/RIN'LENGTH;                       <<01916>>04670000
            RINPTR.(0:1) := 1;  << DB ALREADY POINTING TO RIN T<<01916>>04675000
            DEALLORIN(RINPTR);                                 <<01916>>04680000
            IF < THEN SUDDENDEATH(303);                        <<01916>>04685000
            RINPTR := V*RIN'LENGTH;                            <<01916>>04690000
          END;                                                 <<01916>>04695000
          EXCHANGEDB(JIT); JITLOCALRINPTR := 0;                <<06267>>04700000
                            << RESET FIRST >>                  <<01603>>04705000
          RELSIR(RIN'SIR,SIRF);                                <<06265>>04710000
          EXCHANGEDB(DB);                                      <<01603>>04715000
          STATUS.(6:2) := CCL;                                 <<01603>>04720000
          ERROREXIT(1,0,0);                                    <<01603>>04725000
          RETURN;                                              <<01603>>04730000
        END;                                                   <<01603>>04735000
     END;                                                      <<01603>>04740000
     RELSIR(RIN'SIR,SIRF);                                     <<06265>>04745000
     EXCHANGEDB(DB);                                           <<01603>>04750000
     STATUS.(6:2) := CCE;                                      <<01603>>04755000
     ERROREXIT(1,0,0);                                         <<01603>>04760000
                                                                        04765000
END;  << G E T L O C R I N  >>                                          04770000
                                                                        04775000
<<------------------------------------------------------------------->> 04780000
                                                                        04785000
                                                                        04790000
                                                                        04795000
                                                                        04800000
                                                                        04805000
                                                                        04810000
                                                                        04815000
INTEGER PROCEDURE LOCKUNLOCKLOCRIN(L,Y,UNCOND);                         04820000
VALUE L,Y,UNCOND;                                                       04825000
INTEGER Y;                                                              04830000
LOGICAL L,UNCOND;                                                       04835000
OPTION PRIVILEGED,UNCALLABLE;                                           04840000
                                                                        04845000
                                                                        04850000
COMMENT: LOCKS OR UNLOCKS A LOCAL RIN(ACCORDING TO L VALUE)             04855000
                                                                        04860000
         RETURNS                                                        04865000
            0,1,2   :CONDITION CODE FROM RLOCK OR RUNLOCK               04870000
            3       IF Y IS OUTSIDE THE SET OF RINS THAT ARE ALLOCATED  04875000
      ;                                                                 04880000
                                                                        04885000
BEGIN                                                                   04890000
EQUATE JITX=6,FIR=43;                                          <<06265>>04895000
                                                                        04900000
      INTEGER DB,SIRF;                                                  04905000
      INTEGER ARRAY PCBX(*)=Q+0;                                        04910000
      ARRAY JITARR(*) = DB + 0;                                <<06267>>04915000
      ARRAY QARRAY(*) =Q+0;                                    <<06266>>04920000
      INTEGER PCBGLOBLOC;                                      <<06266>>04925000
      INTEGER JIT;                                             <<06266>>04930000
      INTEGER RINPTR;                                          <<01603>>04935000
      INTEGER STATUS=Q-1,FIRST,CX,CC;                                   04940000
      INTEGER X=X;                                                      04945000
                                                                        04950000
                                                                        04955000
      IF Y=0 THEN                                                       04960000
      BEGIN                            <<INVALID>>                      04965000
         LOCKUNLOCKLOCRIN:=3;                                           04970000
         RETURN;                                                        04975000
      END;                                                              04980000
                                                                        04985000
      <<GET JIT FROM PCBX>>                                             04990000
      PXGLOBAL;                                                <<06266>>04995000
      JIT:=PXG'JITDST;                                         <<06266>>05000000
      DB:=EXCHANGEDB(JIT);               <<DB TO JIT>>         <<06266>>05005000
      SIRF:=GETSIR(RIN'SIR);                                   <<06265>>05010000
      RINPTR := JITLOCALRINPTR*RIN'LENGTH;                     <<06267>>05015000
      IF RINPTR = 0 THEN                                       <<01603>>05020000
      BEGIN                                                    <<01603>>05025000
        LOCKUNLOCKLOCRIN := 3;                                 <<01603>>05030000
        RELSIR(RIN'SIR,SIRF);            <<RELEASE RIN >>      <<06265>>05035000
        EXCHANGEDB(DB);                                        <<01603>>05040000
        RETURN;                                                <<01603>>05045000
      END;                                                     <<01603>>05050000
      EXCHANGEDB(RIN'DST);            << TO RINTABLE >>        <<06265>>05055000
      CX := 0;                                                 <<01603>>05060000
      WHILE (CX:=CX+1) < Y DO                                  <<01603>>05065000
      BEGIN                                                    <<01603>>05070000
        RINPTR := RIN'E'INDEX*RIN'LENGTH;                      <<01603>>05075000
        IF RINPTR = 0 THEN                                     <<01603>>05080000
        BEGIN                 << CHAIN SOTPS >>                <<01603>>05085000
          LOCKUNLOCKLOCRIN := 3;                               <<01603>>05090000
          RELSIR(RIN'SIR,SIRF);  <<RELEASE RIN >>              <<06265>>05095000
          EXCHANGEDB(DB);                                      <<01603>>05100000
          RETURN;                                              <<01603>>05105000
        END;                                                   <<01603>>05110000
      END;                                                     <<01603>>05115000
      EXCHANGEDB(DB);                                          <<01603>>05120000
      IF L THEN RLOCK(RINPTR/RIN'LENGTH,UNCOND)                <<01603>>05125000
           ELSE LRUNLOCK(RINPTR/RIN'LENGTH);                   <<01603>>05130000
      PUSH(STATUS);                                            <<01603>>05135000
      LOCKUNLOCKLOCRIN := TOS.(6:2);                           <<01603>>05140000
                                                               <<01603>>05145000
      RELSIR(RIN'SIR,SIRF);  <<RELEASE RIN >>                  <<06265>>05150000
      EXCHANGEDB(DB);                                                   05155000
                                                                        05160000
                                                                        05165000
END;  << L O C K U N L O C K L O C R I N  >>                            05170000
                                                                        05175000
<<------------------------------------------------------------------->> 05180000
                                                                        05185000
                                                                        05190000
                                                                        05195000
                                                                        05200000
                                                                        05205000
                                                                        05210000
                                                                        05215000
PROCEDURE LOCKLOCRIN(Y,UNCOND);                                         05220000
VALUE Y;                                                                05225000
INTEGER Y;                                                              05230000
LOGICAL UNCOND;                                                         05235000
OPTION PRIVILEGED;                                                      05240000
                                                                        05245000
                                                                        05250000
COMMENT: CALLABLE PROCEDURE TO OCK A LOCAL RIN.                         05255000
                                                                        05260000
         RETURNS                                                        05265000
            CCE   GRANTED                                               05270000
               UNCOND=FALSE IF PROCESS DIDN'T HAVE IT                   05275000
               UNCOND=TRUE IF PROCESS ALREADY HAD IT                    05280000
            CCG   NOT GRANTED(LOCKED BY ANOTHER PROCESS) UNCOND=TRUE    05285000
            CCL   INVALID RIN(TOO BIG,NO LOCAL RIN ALLOCATED,OR Y=0)    05290000
      ;                                                                 05295000
                                                                        05300000
                                                                        05305000
BEGIN                                                                   05310000
      EQUATE CCG=0,CCL=1,CCE=2;                                         05315000
      INTEGER CC,STATUS=Q-1;                                            05320000
                                                                        05325000
      ERRORON;                                                          05330000
                                                               <<01928>>05335000
      IF Y<0 THEN                                              <<01928>>05340000
         BEGIN                                                 <<01928>>05345000
         CC := CCL;                                            <<01928>>05350000
         GOTO BEND;                                            <<01928>>05355000
         END;                                                  <<01928>>05360000
                                                               <<01928>>05365000
      CASE LOCKUNLOCKLOCRIN(1,Y,UNCOND) OF                              05370000
                                                                        05375000
      BEGIN                                                             05380000
         BEGIN UNCOND:=TRUE;CC:=CCE;END;                                05385000
         CC:=CCG;                                                       05390000
         BEGIN UNCOND:=FALSE;CC:=CCE;END;                               05395000
         CC:=CCL;                                                       05400000
      END;                                                              05405000
                                                                        05410000
  BEND:                                                        <<01928>>05415000
      STATUS.(6:2):=CC;                                                 05420000
      ERROREXIT(2,0,0);                                                 05425000
                                                                        05430000
END;  << L O C K L O C R I N  >>                                        05435000
                                                                        05440000
<<------------------------------------------------------------------->> 05445000
                                                                        05450000
                                                                        05455000
                                                                        05460000
                                                                        05465000
                                                                        05470000
                                                                        05475000
PROCEDURE UNLOCKLOCRIN(Y);                                              05480000
VALUE Y;                                                                05485000
INTEGER Y;                                                              05490000
OPTION PRIVILEGED;                                                      05495000
                                                                        05500000
COMMENT: CALLABLE PROCEDURE TO UNLOCK A LOCAL RIN.                      05505000
                                                                        05510000
         RETURN                                                         05515000
            CCE   OK                                                    05520000
            CCG   THE RIN IS LEGAL BUT NOT LOCKED BY CALLER(NOT GRANTED)05525000
            CCL   INVALID RIN(NOT ALLOCATED,TOO BIG OR Y=0)             05530000
      ;                                                                 05535000
                                                                        05540000
BEGIN                                                                   05545000
      INTEGER STATUS=Q-1;                                               05550000
      EQUATE CCG=0,CCL=1,CCE=2;                                         05555000
      ERRORON;                                                          05560000
      IF Y < 0 THEN                                                     05565000
      BEGIN                                                             05570000
        STATUS.(6:2):=CCL;                                              05575000
        GO BEND;                                                        05580000
      END;                                                              05585000
      TOS:=LOCKUNLOCKLOCRIN(0,Y,0);                                     05590000
      ASSEMBLE(DUP,DUP);                                                05595000
      IF TOS AND TOS&LSR(1) THEN TOS:=1;                                05600000
                                                                        05605000
      STATUS.(6:2):=TOS;                                                05610000
BEND:                                                                   05615000
      ERROREXIT(1,0,0);                                                 05620000
END;  << U N L O C K L O C R I N  >>                                    05625000
$PAGE                                                                   05630000
<<------------------------------------------------------------------->> 05635000
                                                                        05640000
                                                                        05645000
                                                                        05650000
                                                                        05655000
                                                                        05660000
INTEGER PROCEDURE LOCRINOWNER (RINX);                          <<01603>>05665000
  VALUE RINX;   INTEGER RINX;                                  <<01603>>05670000
  OPTION PRIVILEGED;                                           <<00452>>05675000
  <<********************************************************>> <<00452>>05680000
  <<                                                        >> <<00452>>05685000
  << PROCEDURE TO DETERMINE PIN OF PROCESS WHICH HAS A      >> <<00452>>05690000
  << PARTICULAR LOCAL RIN LOCKED.  IF FATHER HAS IT LOCKED  >> <<00452>>05695000
  << RETURN 0 OTHERWISE RETURN PIN (EVEN IF THIS PROCESS    >> <<00452>>05700000
  << HAS IT LOCKED).                                        >> <<00452>>05705000
  <<                                                        >> <<00452>>05710000
  <<    CONDITION CODE : CCE - REQUEST GRANTED              >> <<00452>>05715000
  <<                     CCG - RIN NOT CURRENTLY LOCKED     >> <<00452>>05720000
  <<                     CCL - REQUEST DENIED BECAUSE RIN   >> <<00452>>05725000
  <<                           WAS INVALID (WAS <= 0 OR     >> <<00452>>05730000
  <<                           RIN EXCEEDED # OF LOCAL      >> <<00452>>05735000
  <<                           RINS CURRENTLY ALLOCATED)    >> <<00452>>05740000
  <<                                                        >> <<00452>>05745000
  <<********************************************************>> <<00452>>05750000
                                                               <<00452>>05755000
  BEGIN                                                        <<00452>>05760000
    EQUATE INTNUM = 36,  NUMPARMS = 1;                         <<00804>>05765000
    EQUATE ERREX = [10/INTNUM, 6/NUMPARMS];                    <<00804>>05770000
    EQUATE RSLT = %101;                                        <<00804>>05775000
   EQUATE   FIR = 43;                                          <<07259>>05780000
    EQUATE CCG = 0,   CCL = 1,   CCE = 2;                      <<00452>>05785000
    INTEGER I, RINPTR, PIN, CC, DB, STATUS = Q-1;              <<01622>>05790000
    LOGICAL SIRCOND;                                           <<00452>>05795000
    LOGICAL ARRAY JITARR(*) = DB+0;                            <<06267>>05800000
    INTEGER PCBGLOBLOC;                                        <<06266>>05805000
    LOGICAL ARRAY QARRAY(*) = Q+ 0;                            <<06266>>05810000
                                                               <<00452>>05815000
                                                               <<00452>>05820000
    SUBROUTINE GETRINPTR;                                      <<01622>>05825000
                                                               <<01622>>05830000
      COMMENT : SUBROUTINE TO GET POINTER TO LOCAL RINS        <<01622>>05835000
                CURRENTLY ALLOCATED TO THE CALLING PROCESS     <<01622>>05840000
                FROM THE JIT.  JIT DST IS IN PCBX;             <<01622>>05845000
      BEGIN                                                    <<00452>>05850000
        PXGLOBAL;                                              <<07259>>05855000
        TOS := @RINPTR;                                        <<07259>>05860000
        TOS := PXG'JITDST;     << JIT dst # >>                 <<07259>>05865000
        TOS := FIR;            << Offset to RINS ptr >>        <<07259>>05870000
        TOS := 1;                                              <<07259>>05875000
        ASSEMBLE (MFDS);       << Get the Rin ptr >>           <<07259>>05880000
        RINPTR := RINPTR * RIN'LENGTH;                         <<01622>>05885000
      END <<GETRINPTR>>;                                       <<00452>>05890000
                                                               <<00452>>05895000
                                                               <<00452>>05900000
    << LOCRINOWNER >>                                          <<00452>>05905000
    FORCESTKO;                                                 <<00804>>05910000
    ERRORON;                                                   <<00804>>05915000
    CHEK (ERREX, RSLT);                                        <<00804>>05920000
    TRAPSOFF;                                                  <<00804>>05925000
    LOCRINOWNER := 0;   CC := CCE;                             <<00452>>05930000
                                                               <<01622>>05935000
    IF RINX <= 0 THEN CC := CCL                                <<01603>>05940000
    ELSE                                                       <<00452>>05945000
      BEGIN                                                    <<00452>>05950000
        GETRINPTR;                                             <<01622>>05955000
        DB := EXCHANGEDB (RIN'DST);                            <<06265>>05960000
        SIRCOND := GETSIR (RIN'SIR);                           <<06265>>05965000
        I := 1;                                                <<00452>>05970000
                                                               <<01622>>05975000
        WHILE I < RINX AND RINPTR <> 0 DO                      <<01603>>05980000
          BEGIN                                                <<00452>>05985000
            RINPTR := RIN'E'INDEX * RIN'LENGTH;                <<01622>>05990000
            I := I + 1;                                        <<00452>>05995000
          END;                                                 <<00452>>06000000
                                                               <<01622>>06005000
        IF RINPTR = 0 THEN CC := CCL                           <<00452>>06010000
        ELSE                                                   <<00452>>06015000
          BEGIN                                                <<00452>>06020000
            PIN := RIN'E'HOLDER;                               <<01622>>06025000
            IF PIN = 0 THEN CC := CCG                          <<00452>>06030000
            ELSE IF PIN <> FATHER THEN LOCRINOWNER := PIN;     <<00452>>06035000
          END;                                                 <<00452>>06040000
        RELSIR (RIN'SIR, SIRCOND);                             <<06265>>06045000
        EXCHANGEDB (DB);                                       <<00452>>06050000
      END;                                                     <<00452>>06055000
                                                               <<01622>>06060000
    STATUS.(6:2) := CC;                                        <<00452>>06065000
    ERROREXIT (ERREX, 0, 0);                                   <<00804>>06070000
  END << LOCRINOWNER >>;                                       <<00452>>06075000
                                                                        06080000
<<------------------------------------------------------------------->> 06085000
                                                                        06090000
$CONTROL SEGMENT=MAIN                                                   06095000
                                                                        06100000
                                                                        06105000
                                                                        06110000
                                                                        06115000
END ; <<O F    R I N    I N T R I N S I C     F I L E   >>              06120000
