$CONTROL USLINIT,MAP,CODE,SOURCE                                        00010000
<< JOBTABLE - MODULE 74 >>                                     <<00745>>00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$CONTROL SEGMENT=JOBTABLE                                               00060000
$CONTROL PRIVILEGED                                                     00065000
BEGIN                                                                   00070000
$PAGE "***   GENERAL/GLOBAL EQUIVALENCES   ***"                         00075000
INTEGER                                                                 00080000
         DB0   = DB+0  ,                                                00085000
         S0    = S-0   ,                                                00090000
         S3    = S-3   ,                                                00095000
         S5    = S-5   ,                                                00100000
         X     = X     ,                                                00105000
         XREG  = X     ;                                                00110000
INTEGER POINTER                                                         00115000
         PS0   = S-0   ,                                                00120000
         PS1   = S-1   ;                                                00125000
BYTE POINTER                                                            00130000
         BPS0  = S-0   ,                                                00135000
         BPS1  = S-1   ;                                                00140000
                                                                        00145000
                                                                        00150000
   << SYSTEM GLOBAL / POINTER >>                                        00155000
POINTER                                                                 00160000
         SYS'DST   = 2    ;                                             00165000
   << JOB DIRECTORY TABLE DECLARATIONS >>                      <<U.RAO>>00170000
INTEGER JDTBASE = DB+0,  <<SEGMENT SIZES>>                     <<U.RAO>>00175000
        JDSDADR = JDTBASE+1,  <<ADDRESS OF JDT DSD>>           <<U.RAO>>00180000
        JTFDADR = JDSDADR+1,  <<ADDRESS OF JOB TEMP FILE DIR>> <<U.RAO>>00185000
        JFEQADR = JTFDADR+1,  <<ADDRESS OF FILE EQ TABLE>>     <<U.RAO>>00190000
        JLEQADR = JFEQADR+1,  <<ADDRESS OF LINE EQ TABLE>>     <<U.RAO>>00195000
        JJCWADR = JLEQADR+1,  <<ADDRESS OF JCW TABLE>>         <<U.RAO>>00200000
        JFREESPCADR = JJCWADR+1,  <<ADDRESS OF FREE SPACE>>    <<U.RAO>>00205000
        JDTWORKSPCBASE = JFREESPCADR+1,  <<JDT WORK SPACE>>    <<U.RAO>>00210000
        JDSJNUM = JDTWORKSPCBASE+15,  <<JOB NUMBER>>           <<U.RAO>>00215000
        JESMPN  = JDSJNUM+1;   <<MAIN PIN NUMBER>>             <<U.RAO>>00220000
INTEGER POINTER                                                <<U.RAO>>00225000
        JDSDPTR = JDSDADR,                                     <<U.RAO>>00230000
        JTFDPTR = JTFDADR,                                     <<U.RAO>>00235000
        JFEQPTR = JFEQADR,                                     <<U.RAO>>00240000
        JLEQPTR = JLEQADR,                                     <<U.RAO>>00245000
        JJCWPTR = JJCWADR,                                     <<U.RAO>>00250000
        JFREESPCPTR = JFREESPCADR;                             <<U.RAO>>00255000
INTEGER ARRAY                                                  <<U.RAO>>00260000
        JDTWORKSPC(*) = JDTWORKSPCBASE,                        <<U.RAO>>00265000
        JDTARR(*) = JDTBASE;                                   <<U.RAO>>00270000
EQUATE NUMJDTPTRS = 6;  <<NUMBER OF POINTERS IN TABLE>>        <<U.RAO>>00275000
DEFINE                                                         <<U.RAO>>00280000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>00285000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>00290000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>00295000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>00300000
      BEGIN                                                    <<U.RAO>>00305000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>00310000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>00315000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>00320000
      END #,                                                   <<U.RAO>>00325000
                                                               <<U.RAO>>00330000
   DEF'MOVETODSEG =                                            <<U.RAO>>00335000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                    <<U.RAO>>00340000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                       <<U.RAO>>00345000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                     <<U.RAO>>00350000
      BEGIN                                                    <<U.RAO>>00355000
         X := TOS;                                             <<U.RAO>>00360000
         ASSEMBLE(MTDS 0);                                     <<U.RAO>>00365000
         TOS := X;                                             <<U.RAO>>00370000
      END #;                                                   <<U.RAO>>00375000
                                                               <<U.RAO>>00380000
$SET X8=OFF                                                    <<06596>>00385000
$INCLUDE INCLJMAT                                              <<06596>>00390000
$INCLUDE INCLPXG                                               <<06595>>00395000
$PAGE "***   JOBTABLE   ***"                                            00400000
INTEGER PROCEDURE ALTDSEGSIZE(IX,SIZE);                                 00405000
   VALUE IX,SIZE;                                                       00410000
   INTEGER IX,SIZE;                                                     00415000
   OPTION EXTERNAL;                                                     00420000
                                                                        00425000
INTEGER PROCEDURE GETSIR(SIR);                                          00430000
   VALUE SIR;                                                           00435000
   INTEGER SIR;                                                         00440000
   OPTION EXTERNAL;                                                     00445000
                                                                        00450000
PROCEDURE RELSIR(SIR,FL);                                               00455000
   VALUE SIR,FL;                                                        00460000
   INTEGER SIR,FL;                                                      00465000
   OPTION EXTERNAL;                                                     00470000
                                                                        00475000
LOGICAL PROCEDURE EXCHANGEDB (DSTX);                                    00480000
   VALUE DSTX;                                                          00485000
   LOGICAL DSTX;                                                        00490000
   OPTION EXTERNAL;                                                     00495000
                                                                        00500000
INTEGER PROCEDURE LOCKJIR;                                              00505000
   OPTION EXTERNAL;                                                     00510000
                                                               << 8147>>00515000
PROCEDURE TRANSJCWEQUATE(EQ,JCW,ERRNUM,ERRPTR);                << 8147>>00520000
BYTE ARRAY EQ;                                                 << 8147>>00525000
INTEGER JCW,ERRNUM,ERRPTR;                                     << 8147>>00530000
OPTION EXTERNAL;                                               << 8147>>00535000
                                                               << 8147>>00540000
                                                                        00545000
PROCEDURE UNLOCKJIR(B);                                                 00550000
   VALUE   B;                                                           00555000
   LOGICAL B;                                                           00560000
   OPTION EXTERNAL;                                                     00565000
                                                                        00570000
PROCEDURE SUDDENDEATH(A);                                               00575000
   VALUE A;                                                             00580000
   INTEGER A;                                                           00585000
   OPTION EXTERNAL;                                                     00590000
                                                                        00595000
PROCEDURE HELP;                                                         00600000
   OPTION EXTERNAL;                                                     00605000
                                                                        00610000
INTRINSIC BINARY,MYCOMMAND,DBINARY;                            <<04696>>00615000
                                                                        00620000
PROCEDURE ERROREXIT (I,E,P);                                   <<U.RAO>>00625000
   VALUE   I,E,P;                                              <<U.RAO>>00630000
   LOGICAL I,E,P;                                              <<U.RAO>>00635000
   OPTION EXTERNAL;                                            <<U.RAO>>00640000
                                                               <<U.RAO>>00645000
PROCEDURE ERRORON;                                             <<U.RAO>>00650000
   OPTION EXTERNAL;                                            <<U.RAO>>00655000
                                                               <<U.RAO>>00660000
   DOUBLE PROCEDURE CHEK(INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK); <<U.RAO>>00665000
   VALUE INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK;                  <<U.RAO>>00670000
   LOGICAL INTRIN,FLAGS,OPTVMASK;                              <<U.RAO>>00675000
   DOUBLE PARMS,CAPMASK;                                       <<U.RAO>>00680000
   OPTION VARIABLE,EXTERNAL;                                   <<U.RAO>>00685000
                                                               <<U.RAO>>00690000
                                                                        00695000
                                                                        00700000
PROCEDURE PACKANDPOINT (FILEREF, LEN, GPNTR, APNTR);                    00705000
   BYTE ARRAY FILEREF;                                                  00710000
   INTEGER LEN;                                                         00715000
   LOGICAL GPNTR, APNTR;                                                00720000
   OPTION UNCALLABLE;                                                   00725000
<< THIS PROCEDURE ANALYZES <FILEREF> AND ENSURES THAT IT IS IN A        00730000
   LEGITIMATE FILE REFERENCE FORMAT.                                    00735000
   RETURNS:                                                             00740000
      CCL- INVALID NAME.                                                00745000
      CCE- OKAY:                                                        00750000
      <GPNTR> IS BYTE POINTER TO GROUP NAME, OR 0.                      00755000
      <APNTR> IS BYTE POINTER TO ACCOUNT NAME, OR 0.                    00760000
   >>                                                                   00765000
BEGIN                                                                   00770000
   INTEGER FLAG := -1;                                                  00775000
   LOGICAL STATUS = Q-1;                                                00780000
   EQUATE  CCE = 2 ,                                                    00785000
           CCG = 0 ,                                                    00790000
           CCL = 1 ;                                                    00795000
   DEFINE  CC = STATUS.(6:2) #;                                         00800000
                                                                        00805000
LOGICAL SUBROUTINE DONAME (NAME);                                       00810000
   VALUE NAME;                                                          00815000
   LOGICAL NAME;                                                        00820000
<< SCANS <NAME> TO ENSURE THAT IT IS LEGITIMATE;                        00825000
   IF <NAME> EXACTLY SATISFIES <LEN>, THEN CCE RETURN TO PACKANDPOINT   00830000
      CALLER.                                                           00835000
   ALLOWS FOR LOCKWORD FOLLOWING FIRST NAME;                            00840000
   IF STILL CHARACTERS LEFT AND DELIMITER IS ".", THEN                  00845000
      RETURNS BYTE POINTER TO NEXT NAME.>>                              00850000
 BEGIN                                                                  00855000
   IF BPS1 <> ALPHA THEN GOTO ERROR;                                    00860000
   TOS := NAME;                                                         00865000
   ASSEMBLE (DUP, DUP);                                                 00870000
   MOVE * := * WHILE ANS, 0;                                            00875000
   ASSEMBLE (CAB, SUB);                                                 00880000
   IF = THEN GOTO ERROR;                                                00885000
   IF TOS > 8 THEN GOTO ERROR;                                          00890000
   IF (S0 -@FILEREF) = LEN THEN                                         00895000
      BEGIN                                                             00900000
      TOS := CCE;                                                       00905000
      GOTO EXIT;                                                        00910000
      END;                                                              00915000
   IF > THEN GOTO ERROR;                                                00920000
   FLAG := FLAG +1;                                                     00925000
   IF = AND BPS0 = "/" THEN                                             00930000
      BEGIN                                                             00935000
      ASSEMBLE (DUP, INCA);                                             00940000
      TOS := DONAME (*);                                                00945000
      END                                                               00950000
   ELSE                                                                 00955000
      BEGIN                                                             00960000
      IF BPS0 <> "." THEN GOTO ERROR;                                   00965000
      TOS := TOS +1;                                                    00970000
      END;                                                              00975000
   S3 := TOS;                                                           00980000
   END    <<SUBROUTINE DONAME>>;                                        00985000
                                                                        00990000
   GPNTR := 0;                                                          00995000
   APNTR := 0;                                                          01000000
   DONAME (APNTR := DONAME (GPNTR := DONAME (@FILEREF)));               01005000
ERROR:                                                                  01010000
   TOS := CCL;                                                          01015000
EXIT:                                                          <<U.RAO>>01020000
   CC := TOS;                                                  <<U.RAO>>01025000
   END    <<PACKANDPOINT>>;                                    <<U.RAO>>01030000
LOGICAL PROCEDURE PARSEJOBID(JOBID, RESULT);                   <<U.RAO>>01035000
BYTE ARRAY JOBID;                                              <<U.RAO>>01040000
INTEGER ARRAY RESULT;                                          <<U.RAO>>01045000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>01050000
<<FUNCTION:  PARSE A JOBID FOR CXTELL, CONSTELL, CONSWARN.>>   <<U.RAO>>01055000
<<INPUT:                                                    >> <<U.RAO>>01060000
<<   JOBID - Byte pointer to job id.  Can have any of the   >> <<U.RAO>>01065000
<<        following forms.                                  >> <<U.RAO>>01070000
<<                                                          >> <<U.RAO>>01075000
<<        [#]{S/J}nnn                                       >> <<U.RAO>>01080000
<<        [[jsname],]username.acctname                      >> <<U.RAO>>01085000
<<        @                                                 >> <<U.RAO>>01090000
<<        @S                                                >> <<U.RAO>>01095000
<<        @J                                                >> <<U.RAO>>01100000
<<                                                          >> <<U.RAO>>01105000
<<   OUTPUT:                                                >> <<U.RAO>>01110000
<<                                                          >> <<U.RAO>>01115000
<<        RESULT is a 17 word array to which is returned the>> <<U.RAO>>01120000
<<           output of the parse as follows.                >> <<U.RAO>>01125000
<<           RESULT(13) identifies the type of jobid parsed.>> <<U.RAO>>01130000
<<                                                          >> <<U.RAO>>01135000
<<              0 => job number                             >> <<U.RAO>>01140000
<<              1 => jsname, user.acct                      >> <<U.RAO>>01145000
<<              2 => user.acct                              >> <<U.RAO>>01150000
<<              3 => @.acct                                 >> <<U.RAO>>01155000
<<              4 => @S                                     >> <<U.RAO>>01160000
<<              5 => @J                                     >> <<U.RAO>>01165000
<<              6 => @                                      >> <<U.RAO>>01170000
<<                                                          >> <<U.RAO>>01175000
<<           If 0, the job number will be in the JMAT       >> <<U.RAO>>01180000
<<              format in RESULT(0).                        >> <<U.RAO>>01185000
<<           If 1, RESULT(1) = user name                    >> <<U.RAO>>01190000
<<                 RESULT(5) = acct name                    >> <<U.RAO>>01195000
<<                 RESULT(9) = job name                     >> <<U.RAO>>01200000
<<           If 2, RESULT(1) = user name                    >> <<U.RAO>>01205000
<<                 RESULT(5) = acct name                    >> <<U.RAO>>01210000
<<           If 3, RESULT(5) = acct name                    >> <<U.RAO>>01215000
<<           If 4,5,6 then RESULT(0) - RESULT(12) garbage   >> <<U.RAO>>01220000
<<           RESULT(14) = byte pointer to first character   >> <<U.RAO>>01225000
<<              following character in RESULT(15).          >> <<U.RAO>>01230000
<<           RESULT(15) = first non-blank character         >> <<U.RAO>>01235000
<<              following jobid.                            >> <<U.RAO>>01240000
<<                                                          >> <<U.RAO>>01245000
<<        If an error occurred in parse, PARSEJOBID will    >> <<U.RAO>>01250000
<<           return FALSE  (else true).                     >> <<U.RAO>>01255000
<<           RESULT(14) will be a byte pointer to the place >> <<U.RAO>>01260000
<<              in jobid where the error was found.         >> <<U.RAO>>01265000
<<           RESULT(15) will be the internal error number   >> <<U.RAO>>01270000
<<           RESULT(16) will be the ordinal of the parameter>> <<U.RAO>>01275000
<<              in error.                                   >> <<U.RAO>>01280000
<<                                                          >> <<U.RAO>>01285000
<<                                                          >> <<U.RAO>>01290000
BEGIN                                                          <<U.RAO>>01295000
INTEGER TOKENLEN;  <<LENGTH OF CURRENT PART OF JOBID>>         <<U.RAO>>01300000
BYTE POINTER TOKENPTR;  <<CURRENT PLACE IN JOBID>>             <<U.RAO>>01305000
   <<ALSO WHEN ERROR ENCOUNTERED, POINTS TO ERROR LOCATION>>   <<U.RAO>>01310000
BYTE POINTER IDPTR;  <<POINTS TO NEXT PLACE IN JOBID>>         <<U.RAO>>01315000
BYTE POINTER DELIM;  <<POINTS OT CURRENT DELIMITER>>           <<U.RAO>>01320000
DEFINE JOBFIELD = (0:2)#;                                      <<U.RAO>>01325000
EQUATE JOBFLAG = 2,                                            <<U.RAO>>01330000
       SESSIONFLAG = 1;                                        <<U.RAO>>01335000
BYTE ARRAY BRESULT(*) = RESULT;                                <<U.RAO>>01340000
INTEGER ERRNUM := 0;                                           <<U.RAO>>01345000
EQUATE JOBNUM = 0,                                             <<U.RAO>>01350000
       FULLNAME = 1,                                           <<U.RAO>>01355000
       USERID = 2,                                             <<U.RAO>>01360000
       ALLOFACCT = 3,                                          <<U.RAO>>01365000
       ALLSESSIONS = 4,                                        <<U.RAO>>01370000
       ALLJOBS = 5,                                            <<U.RAO>>01375000
       ALL = 6;                                                <<U.RAO>>01380000
EQUATE INVJOBNUMBER = 1,                                       <<U.RAO>>01385000
       INVSESSIONNUM = 2,                                      <<U.RAO>>01390000
       XPCTJORS = 3,                                           <<U.RAO>>01395000
       XPCTJSORAT = 4,                                         <<U.RAO>>01400000
       JOBXPCTJUSTAT = 5,                                      <<U.RAO>>01405000
       JOBNAMETOOLONG = 6,                                     <<U.RAO>>01410000
       JOBXPCTALPHA = 7,                                       <<U.RAO>>01415000
       USERNAMEMISSING = 8,                                    <<U.RAO>>01420000
       USERNAMETOOLONG = 9,                                    <<U.RAO>>01425000
       USERXPCTALPHA = 10,                                     <<U.RAO>>01430000
       XPCTPERIODDELIM = 11,                                   <<U.RAO>>01435000
       ACCTNAMEMISSING = 12,                                   <<U.RAO>>01440000
       ACCTXPCTNAMNTAT = 13,                                   <<U.RAO>>01445000
       ACCTNAMETOOLONG = 14,                                   <<U.RAO>>01450000
       ACCTXPCTALPHA = 15,                                     <<U.RAO>>01455000
       JOBIDMISSING = 16;                                      <<U.RAO>>01460000
LOGICAL SUBROUTINE GETNEXT;                                    <<U.RAO>>01465000
<<GETS NEXT TOKEN FROM JOBID>>                                 <<U.RAO>>01470000
BEGIN                                                          <<U.RAO>>01475000
TOKENLEN := 0;                                                 <<U.RAO>>01480000
SCAN IDPTR WHILE %6440, 1;  <<SKIP LEADING BLANKS>>            <<U.RAO>>01485000
@TOKENPTR := TOS;                                              <<U.RAO>>01490000
IF CARRY THEN   <<NO MORE NON-BLANK CHARACTERS>>               <<U.RAO>>01495000
   GETNEXT := FALSE                                            <<U.RAO>>01500000
ELSE                                                           <<U.RAO>>01505000
   BEGIN  <<LOOK FOR "@" SIGN>>                                <<U.RAO>>01510000
   GETNEXT := TRUE;                                            <<U.RAO>>01515000
   IF TOKENPTR <> "@" THEN                                     <<U.RAO>>01520000
      BEGIN                                                    <<U.RAO>>01525000
      IF TOKENPTR="#" THEN   <<SKIP PAST IT>>                  <<U.RAO>>01530000
         TOS := @TOKENPTR+1                                    <<U.RAO>>01535000
      ELSE                                                     <<U.RAO>>01540000
         TOS := @TOKENPTR;                                     <<U.RAO>>01545000
      ASSEMBLE(DUP);                                           <<U.RAO>>01550000
      MOVE * := * WHILE ANS,1;                                 <<U.RAO>>01555000
      TOKENLEN := S0-@TOKENPTR;                                <<U.RAO>>01560000
      SCAN * WHILE %6440, 1;  <<SKIP BLANKS TO NEXT DELIM>>    <<U.RAO>>01565000
      @DELIM := S0;  <<POINTER TO DELIMITER>>                  <<U.RAO>>01570000
      @IDPTR := TOS+1;                                         <<U.RAO>>01575000
      END                                                      <<U.RAO>>01580000
   ELSE IF TOKENPTR(1) <> " " AND TOKENPTR(1) <> %15 THEN      <<U.RAO>>01585000
      BEGIN                                                    <<U.RAO>>01590000
      @IDPTR := @TOKENPTR+1;  <<SKIP "@">>                     <<U.RAO>>01595000
      GETNEXT;                                                 <<U.RAO>>01600000
      @TOKENPTR := @TOKENPTR-1;                                <<U.RAO>>01605000
      TOKENLEN := TOKENLEN+1;                                  <<U.RAO>>01610000
      END                                                      <<U.RAO>>01615000
   ELSE   <<HAS TRAILING BLANK(S)>>                            <<U.RAO>>01620000
      BEGIN                                                    <<U.RAO>>01625000
      TOKENLEN := 1;  <<FOR "@">>                              <<U.RAO>>01630000
      SCAN TOKENPTR(1) WHILE %6440,1;  <<FIND FIRST NON-BLANK>><<U.RAO>>01635000
      @DELIM := TOS;  <<FIRST NON-BLANK AFTER "@">>            <<U.RAO>>01640000
      @IDPTR := @DELIM+1;                                      <<U.RAO>>01645000
      END;                                                     <<U.RAO>>01650000
   END;                                                        <<U.RAO>>01655000
END;                                                           <<U.RAO>>01660000
SUBROUTINE PARSEJSNUMBER;                                      <<U.RAO>>01665000
BEGIN                                                          <<U.RAO>>01670000
<<On entrance, the entity believed to be a job or session numbe<<U.RAO>>01675000
<<has been tokenized and any leading "#" has been stripped.  >><<U.RAO>>01680000
<<This subroutine converts the ID into a format compatible with<<U.RAO>>01685000
<<the JMAT format for job numbers.  If any errors, the return>><<U.RAO>>01690000
<<values are completely set up inside PARSEJSNUMBER.>>         <<U.RAO>>01695000
RESULT(13) := JOBNUM;  <<TYPE OF PARSED ID>>                   <<U.RAO>>01700000
RESULT(15) := 0;  <<ERROR CODE>>                               <<U.RAO>>01705000
IF TOKENPTR = "J" THEN   <<JOB>>                               <<U.RAO>>01710000
   BEGIN                                                       <<U.RAO>>01715000
   RESULT := BINARY(TOKENPTR(1), TOKENLEN-1);                  <<U.RAO>>01720000
   IF <> OR NOT(1<=RESULT<=16383) THEN  <<INVALID NUMBER>>     <<U.RAO>>01725000
      BEGIN                                                    <<U.RAO>>01730000
      RESULT(14) := @TOKENPTR(1);                              <<U.RAO>>01735000
      RESULT(15) := INVJOBNUMBER;                              <<U.RAO>>01740000
      END                                                      <<U.RAO>>01745000
   ELSE  <<GOOD JOB NUMBER, COMPLETE FORMATTING>>              <<U.RAO>>01750000
      RESULT.JOBFIELD := JOBFLAG;                              <<U.RAO>>01755000
   END                                                         <<U.RAO>>01760000
ELSE IF TOKENPTR="S" THEN   <<SESSION>>                        <<U.RAO>>01765000
   BEGIN                                                       <<U.RAO>>01770000
   RESULT := BINARY(TOKENPTR(1), TOKENLEN-1);                  <<U.RAO>>01775000
   IF <> OR NOT(1<=RESULT<=16383) THEN                         <<U.RAO>>01780000
      BEGIN                                                    <<U.RAO>>01785000
      RESULT(14) := @TOKENPTR(1);                              <<U.RAO>>01790000
      RESULT(15) := INVSESSIONNUM;                             <<U.RAO>>01795000
      END                                                      <<U.RAO>>01800000
   ELSE  <<GOOD SESSION NUMBER>>                               <<U.RAO>>01805000
      RESULT.JOBFIELD := SESSIONFLAG;                          <<U.RAO>>01810000
   END                                                         <<U.RAO>>01815000
ELSE   <<NOT J OR S, WHAT IS IT?>>                             <<U.RAO>>01820000
   BEGIN                                                       <<U.RAO>>01825000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>01830000
   RESULT(15) := XPCTJORS;                                     <<U.RAO>>01835000
   END;                                                        <<U.RAO>>01840000
IF RESULT(15)=0 THEN   <<GOOD PARSE - FINISH UP>>              <<U.RAO>>01845000
   BEGIN                                                       <<U.RAO>>01850000
   PARSEJOBID := TRUE;                                         <<U.RAO>>01855000
   RESULT(14) := @IDPTR;                                       <<U.RAO>>01860000
   RESULT(15) := DELIM;                                        <<U.RAO>>01865000
   END;                                                        <<U.RAO>>01870000
END;   <<SUBROUTINE PARSEJSNUMBER>>                            <<U.RAO>>01875000
SUBROUTINE PARSEJSNAME;                                        <<U.RAO>>01880000
BEGIN                                                          <<U.RAO>>01885000
<<On entrance, the first name has been tokenized by GETNEXT,>> <<U.RAO>>01890000
<<the return values to the procedure have been initialized to>><<U.RAO>>01895000
<<Syntax Error and we are sure that the jobid is not a >>      <<U.RAO>>01900000
<<j/s number.  We do not know if anything else weird is present<<U.RAO>>01905000
<<On return, either an error has been detected, in which case>><<U.RAO>>01910000
<<the return values are properly set, or no error was detected,<<U.RAO>>01915000
<<in which case RESULT is properly set.>>                      <<U.RAO>>01920000
RESULT(1) := "  ";                                             <<U.RAO>>01925000
MOVE RESULT(2) := RESULT(1), (11);  <<INIT RETURN>>            <<U.RAO>>01930000
RESULT(13) := USERID;  <<DEFAULT TYPE OF JOBID>>               <<U.RAO>>01935000
RESULT(16) := 0;  <<CURRENT PARAMETER NUMBER>>                 <<U.RAO>>01940000
IF DELIM = "," THEN   <<JOB NAME PART PRESENT>>                <<U.RAO>>01945000
   BEGIN                                                       <<U.RAO>>01950000
   RESULT(16) := 1; <<FIRST TOKEN>>                            <<U.RAO>>01955000
   IF TOKENLEN = 0 THEN                                        <<U.RAO>>01960000
      <<IGNORE - SAME AS NOT SPECIFIED>>                       <<U.RAO>>01965000
      IF NOT GETNEXT THEN   <<NO MORE TOKENS AVAILABLE>>       <<U.RAO>>01970000
         ERRNUM := USERNAMEMISSING                             <<U.RAO>>01975000
      ELSE  <<REALLY IGNORE>>                                  <<U.RAO>>01980000
   ELSE IF TOKENPTR = "@" AND TOKENLEN>1 THEN                  <<U.RAO>>01985000
      BEGIN                                                    <<U.RAO>>01990000
      @TOKENPTR := @TOKENPTR+1;                                <<U.RAO>>01995000
      ERRNUM := JOBXPCTJUSTAT                                  <<U.RAO>>02000000
      END                                                      <<U.RAO>>02005000
   ELSE IF TOKENLEN>8 THEN                                     <<U.RAO>>02010000
      ERRNUM := JOBNAMETOOLONG                                 <<U.RAO>>02015000
   ELSE IF TOKENPTR<>ALPHA AND TOKENPTR<>"@" THEN              <<U.RAO>>02020000
      ERRNUM := JOBXPCTALPHA                                   <<U.RAO>>02025000
   ELSE   <<LOOKS OK>>                                         <<U.RAO>>02030000
      BEGIN  <<PUT UPSHIFTED COPY IN RESULT>>                  <<U.RAO>>02035000
      MOVE BRESULT(18) := TOKENPTR WHILE ANS;                  <<U.RAO>>02040000
      RESULT(13) := FULLNAME;  <<JOBID PARSED TYPE>>           <<U.RAO>>02045000
      IF NOT GETNEXT THEN                                      <<U.RAO>>02050000
         ERRNUM := USERNAMEMISSING;                            <<U.RAO>>02055000
      END;                                                     <<U.RAO>>02060000
   END;                                                        <<U.RAO>>02065000
IF ERRNUM = 0 THEN   <<NO ERRORS YET - CONTINUE PARSE>>        <<U.RAO>>02070000
   BEGIN <<DO user.acct PART>>                                 <<U.RAO>>02075000
   RESULT(16) := RESULT(16)+1;                                 <<U.RAO>>02080000
   IF TOKENLEN = 0 THEN                                        <<U.RAO>>02085000
      ERRNUM := USERNAMEMISSING                                <<U.RAO>>02090000
   ELSE IF TOKENPTR="@" THEN                                   <<U.RAO>>02095000
      IF TOKENLEN=1 THEN  <<COULD BE "@" OR "@.acct">>         <<U.RAO>>02100000
         IF DELIM<>"." THEN  <<JUST PLAIN "@">>                <<U.RAO>>02105000
            RESULT(13) := ALL  <<EVERY JOB OR SESSION>>        <<U.RAO>>02110000
         ELSE   <<@.acct>>                                     <<U.RAO>>02115000
            RESULT(13) := ALLOFACCT  <<ALL OF PARTICULAR ACCT>><<U.RAO>>02120000
      ELSE IF TOKENLEN=2 THEN  <<COULD BE @S OR @J>>           <<U.RAO>>02125000
         IF TOKENPTR(1) = "S" THEN                             <<U.RAO>>02130000
            RESULT(13) := ALLSESSIONS                          <<U.RAO>>02135000
         ELSE IF TOKENPTR(1) = "J" THEN                        <<U.RAO>>02140000
            RESULT(13) := ALLJOBS                              <<U.RAO>>02145000
         ELSE   <<DON'T RECOGNIZE FIRST CHARACTER>>            <<U.RAO>>02150000
            BEGIN                                              <<U.RAO>>02155000
            @TOKENPTR := @TOKENPTR+1;                          <<U.RAO>>02160000
            ERRNUM := XPCTJORS                                 <<U.RAO>>02165000
            END                                                <<U.RAO>>02170000
      ELSE                                                     <<U.RAO>>02175000
         ERRNUM := XPCTJSORAT                                  <<U.RAO>>02180000
   ELSE IF TOKENLEN>8 THEN                                     <<U.RAO>>02185000
      ERRNUM := USERNAMETOOLONG                                <<U.RAO>>02190000
   ELSE IF TOKENPTR <> ALPHA THEN                              <<U.RAO>>02195000
      ERRNUM := USERXPCTALPHA                                  <<U.RAO>>02200000
   ELSE IF DELIM <> "." THEN                                   <<U.RAO>>02205000
      BEGIN                                                    <<U.RAO>>02210000
      @TOKENPTR := @DELIM;                                     <<U.RAO>>02215000
      ERRNUM := XPCTPERIODDELIM                                <<U.RAO>>02220000
      END                                                      <<U.RAO>>02225000
   ELSE                                                        <<U.RAO>>02230000
      MOVE BRESULT(2) := TOKENPTR WHILE ANS;                   <<U.RAO>>02235000
   <<PRETTY MUCH FINISHED NOW.  JUST PARSE ACCT NAME, IF ANY>> <<U.RAO>>02240000
   IF ERRNUM = 0 AND RESULT(13) < ALLSESSIONS THEN             <<U.RAO>>02245000
      BEGIN   <<EXPECTING ACCT NAME>>                          <<U.RAO>>02250000
      RESULT(16) := RESULT(16)+1;                              <<U.RAO>>02255000
      IF NOT GETNEXT OR TOKENLEN=0 THEN                        <<U.RAO>>02260000
         ERRNUM := ACCTNAMEMISSING                             <<U.RAO>>02265000
      ELSE IF TOKENPTR="@" THEN                                <<U.RAO>>02270000
         ERRNUM := ACCTXPCTNAMNTAT                             <<U.RAO>>02275000
      ELSE IF TOKENLEN>8 THEN                                  <<U.RAO>>02280000
         ERRNUM := ACCTNAMETOOLONG                             <<U.RAO>>02285000
      ELSE IF TOKENPTR<>ALPHA THEN                             <<U.RAO>>02290000
         ERRNUM := ACCTXPCTALPHA                               <<U.RAO>>02295000
      ELSE  <<ACCT NAME PARSED - NOW FINISH UP>>               <<U.RAO>>02300000
         MOVE BRESULT(10) := TOKENPTR WHILE ANS;               <<U.RAO>>02305000
      END                                                      <<U.RAO>>02310000
   END;                                                        <<U.RAO>>02315000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>02320000
   BEGIN                                                       <<U.RAO>>02325000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>02330000
   RESULT(15) := ERRNUM;                                       <<U.RAO>>02335000
   END                                                         <<U.RAO>>02340000
ELSE                                                           <<U.RAO>>02345000
   BEGIN                                                       <<U.RAO>>02350000
   PARSEJOBID := TRUE;                                         <<U.RAO>>02355000
   RESULT(15) := DELIM;                                        <<U.RAO>>02360000
   RESULT(14) := @IDPTR;                                       <<U.RAO>>02365000
   END;                                                        <<U.RAO>>02370000
END;   <<SUBROUTINE PARSEJSNAME>>                              <<U.RAO>>02375000
<<             OUTER BLOCK OF PROCEDURE               >>       <<U.RAO>>02380000
<<FIRST STEP IS MISC INITIALIZATION>>                          <<U.RAO>>02385000
@IDPTR := @TOKENPTR := @JOBID;                                 <<U.RAO>>02390000
RESULT(16) := 1;                                               <<U.RAO>>02395000
<<ERRNUM INITIALIZED TO 0 IN DECLARATIONS>>                    <<U.RAO>>02400000
<<PARSEJOBID ASSUMED INITIALIZED TO FALSE>>                    <<U.RAO>>02405000
<<  GET FIRST TOKEN TO CHOOSE BETWEEN JOB NAME OR NUMBER>>     <<U.RAO>>02410000
IF NOT GETNEXT THEN    <<JOBID MISSING>>                       <<U.RAO>>02415000
   BEGIN                                                       <<U.RAO>>02420000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>02425000
   RESULT(15) := JOBIDMISSING;                                 <<U.RAO>>02430000
   END                                                         <<U.RAO>>02435000
ELSE IF TOKENPTR = "#" THEN                                    <<U.RAO>>02440000
   BEGIN  <<ASSUME J/S NUMBER>>                                <<U.RAO>>02445000
   @TOKENPTR := @TOKENPTR+1;  <<SKIP "#">>                     <<U.RAO>>02450000
   TOKENLEN := TOKENLEN-1;                                     <<U.RAO>>02455000
   PARSEJSNUMBER;                                              <<U.RAO>>02460000
   END                                                         <<U.RAO>>02465000
ELSE IF DELIM <> "." AND DELIM <> "," AND                      <<U.RAO>>02470000
   (TOKENPTR="J" OR TOKENPTR="S") THEN                         <<U.RAO>>02475000
      PARSEJSNUMBER                                            <<U.RAO>>02480000
ELSE   <<ASSUME ACTUAL [JSNAME,]USER.ACCT>>                    <<U.RAO>>02485000
   PARSEJSNAME;                                                <<U.RAO>>02490000
END;   <<PARSEJOBID>>                                          <<U.RAO>>02495000
LOGICAL PROCEDURE SCANJMAT(NEXTINDEX, JOBID, RESULT);          <<U.RAO>>02500000
INTEGER NEXTINDEX;                                             <<U.RAO>>02505000
INTEGER ARRAY JOBID;                                           <<U.RAO>>02510000
INTEGER ARRAY RESULT;                                          <<U.RAO>>02515000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>02520000
<<FUNCTION:  Finds next qualified entry in JMAT based on     >><<U.RAO>>02525000
<<           NEXTINDEX and the information in JOBID.         >><<U.RAO>>02530000
<<INPUT:                                                     >><<U.RAO>>02535000
<<       NEXTINDEX - JMAT index of JMAT entry at which scan  >><<U.RAO>>02540000
<<          will be started.  This typically will be the     >><<U.RAO>>02545000
<<          value returned from the last call to SCANJMAT.   >><<U.RAO>>02550000
<<          Note that the first legal index in the JMAT is 1.>><<U.RAO>>02555000
<<       JOBID - A formatted array containing the qualifying >><<U.RAO>>02560000
<<          information.                                     >><<U.RAO>>02565000
<<             JOBID(13) = 0 => job number                   >><<U.RAO>>02570000
<<                         1 => job name, user.acct          >><<U.RAO>>02575000
<<                         2 => user.acct                    >><<U.RAO>>02580000
<<                         3 => @.acct                       >><<U.RAO>>02585000
<<                         4 => @S                           >><<U.RAO>>02590000
<<                         5 => @J                           >><<U.RAO>>02595000
<<                         6 => @   (all jobs and sessions)  >><<U.RAO>>02600000
<<             If JOBID(12) = 0, the job number is formatted >><<U.RAO>>02605000
<<                in JOBID(0).                               >><<U.RAO>>02610000
<<             If JOBID(12) >= 4, the rest of JOBID can be   >><<U.RAO>>02615000
<<                ignored.                                   >><<U.RAO>>02620000
<<             Otherwise, JOBID has the job, user and account>><<U.RAO>>02625000
<<                names in the form required by the JMAT,    >><<U.RAO>>02630000
<<                starting at JOBID(1).                      >><<U.RAO>>02635000
<<OUTPUT:                                                    >><<U.RAO>>02640000
<<         SCANJMAT - TRUE if scan found candidate,          >><<U.RAO>>02645000
<<            FALSE if end of JMAT encountered first.        >><<U.RAO>>02650000
<<                                                           >><<U.RAO>>02655000
<<         NEXTINDEX -   JMAT index of this candidate, plus 1>><<U.RAO>>02660000
<<                                                           >><<U.RAO>>02665000
<<         RESULT(0) -   JMAT entry element 0.               >><<U.RAO>>02670000
<<         RESULT(1) -   $STDLIST ldev.                      >><<U.RAO>>02675000
<<         RESULT(2) -   Funny terminal (APL) bits.          >><<U.RAO>>02680000
<<                                                           >><<U.RAO>>02685000
<<         JOBID(0) -    Job type and number for this candidate<<U.RAO>>02690000
<<         JOBID(1-4) -  User name.                          >><<U.RAO>>02695000
<<         JOBID(5-8) -  Account name.                       >><<U.RAO>>02700000
<<         JOBID(9-12) - Job name, if any, or blanks.        >><<U.RAO>>02705000
<<                                                           >><<U.RAO>>02710000
<<                                                           >><<U.RAO>>02715000
BEGIN                                                          <<U.RAO>>02720000
<< ....................................................... >>  <<06596>>02725000
<<       Declarations for referencing the JMAT             >>  <<06596>>02730000
<<   JMATARR -- A local array which holds a JMAT entry     >>  <<06596>>02735000
<<   JMATINX -- The index used in the include file defs.   >>  <<06596>>02740000
<<              to reference each entry.  This will be 0   >>  <<06596>>02745000
<<              in this case since JMATARR is local and    >>  <<06596>>02750000
<<              pointing directly to the entry.            >>  <<06596>>02755000
<< ....................................................... >>  <<06596>>02760000
INTEGER ARRAY JMATARR(0:JMATENTRYSIZE-1);  << JMAT entry >>    <<06596>>02765000
BYTE ARRAY BJMATARR(*) = JMATARR;                              <<06596>>02770000
INTEGER    JMATINX;  << Index into the JMATARR >>              <<06596>>02775000
BYTE ARRAY BJOBID(*) = JOBID;                                  <<U.RAO>>02780000
INTEGER COMPARELEN;   <<LENGTH OF BYTE COMPARE WHEN NEEDED.>>  <<U.RAO>>02785000
INTEGER TCOMPAREOFFSET;  <<BYTE OFFSET FROM JMATENTRY(0)   >>  <<U.RAO>>02790000
INTEGER SCOMPAREOFFSET;  <<BYTE OFFSET FROM JOBID(0)       >>  <<U.RAO>>02795000
INTEGER OLDSIR;  <<HOLDS RETURN FROM GETSIR>>                  <<U.RAO>>02800000
LOGICAL FOUNDENTRY;   <<FLAG TO SHOW FOUND CANDIDATE.      >>  <<U.RAO>>02805000
INTEGER JSTYPE; << either JOB, SESSION, or everything >>       <<06596>>02810000
INTEGER LASTJMATINDEX; << end of table >>                      <<06596>>02815000
EQUATE TBLQUANTUM = 128; << Quantum of sizes in JMAT >>        <<06596>>02820000
EQUATE ALLSESSIONS = 4;                                        <<U.RAO>>02825000
EQUATE JOBTYPESESSION = 1,                                     <<06596>>02830000
       JOBTYPEJOB = 2;                                         <<06596>>02835000
                                                               <<06596>>02840000
<< ........................................................ >> <<06596>>02845000
LOGICAL SUBROUTINE GETJMATENTRY;                               <<U.RAO>>02850000
BEGIN                                                          <<U.RAO>>02855000
<<This subroutine whirls through the JMAT looking for the>>    <<U.RAO>>02860000
<<next non-garbage entry.  If one is found before the end>>    <<U.RAO>>02865000
<<of the JMAT the subroutine returns true and the entry>>      <<U.RAO>>02870000
<<will reside in JMATARR.>>                                    <<06596>>02875000
IF NEXTINDEX <= LASTJMATINDEX THEN                             <<U.RAO>>02880000
   BEGIN                                                       <<00745>>02885000
   DO   <<LOOP THROUGH JMAT>>                                  <<U.RAO>>02890000
      BEGIN                                                    <<U.RAO>>02895000
      TOS := @JMATARR;                                         <<06596>>02900000
      TOS := JMATDST;                                          <<U.RAO>>02905000
      TOS := NEXTINDEX*JMATENTRYSIZE;                          <<U.RAO>>02910000
      TOS := JMATENTRYSIZE;                                    <<U.RAO>>02915000
      ASSEMBLE(MFDS);                                          <<U.RAO>>02920000
      NEXTINDEX := NEXTINDEX+1;                                <<U.RAO>>02925000
      END                                                      <<U.RAO>>02930000
   UNTIL (JMATJOBSTATE <> 0) OR (NEXTINDEX > LASTJMATINDEX);   <<06596>>02935000
   IF JMATJOBSTATE <> 0 THEN GETJMATENTRY := TRUE;             <<06596>>02940000
   END;                                                        <<00745>>02945000
END;   <<SUBROUTINE GETJMATENTRY>>                             <<U.RAO>>02950000
                                                               <<06596>>02955000
<< ........................................................ >> <<06596>>02960000
                                                               <<06596>>02965000
<<  **** Initialization and MAIN portion of SCANJMAT ****  >>  <<06596>>02970000
                                                               <<06596>>02975000
JMATINX := 0; << JMATARR is local  >>                          <<06596>>02980000
OLDSIR := GETSIR(JMATSIR);                                     <<U.RAO>>02985000
TOS := @JMATARR;                                               <<06596>>02990000
TOS := JMATDST;                                                <<U.RAO>>02995000
TOS := 0;                                                      <<U.RAO>>03000000
TOS := JMATENTRYSIZE;                                          <<06596>>03005000
ASSEMBLE(MFDS);  <<GET JMAT GLOBAL DATA>>                      <<U.RAO>>03010000
<< The last index is the current size (which is stored in the ><<06596>>03015000
<< JMAT header after being multiplied by TBLQUANTUM) divided  ><<06596>>03020000
<< by the size of an entry -- minus one:                      ><<06596>>03025000
LASTJMATINDEX := (JMATCURSIZE*TBLQUANTUM) / JMATENTRYSIZE  - 1;<<06596>>03030000
IF JOBID(13) < ALLSESSIONS THEN   <<COMPARE IS NECESSARY>>     <<U.RAO>>03035000
   BEGIN                                                       <<U.RAO>>03040000
   <<SET PARAMETERS FOR COMPARE>>                              <<U.RAO>>03045000
   CASE JOBID(13) OF                                           <<U.RAO>>03050000
      BEGIN                                                    <<U.RAO>>03055000
                                                               <<U.RAO>>03060000
         BEGIN   <<JOB/SESSION NUMBER>>                        <<U.RAO>>03065000
         COMPARELEN := 2;                                      <<U.RAO>>03070000
         TCOMPAREOFFSET := JMATJSNOOFF*2;<< Off. to J/S no. >> <<06596>>03075000
         SCOMPAREOFFSET := 0;  <<BYTES FROM START OF JOBID>>   <<U.RAO>>03080000
         END;                                                  <<U.RAO>>03085000
                                                               <<U.RAO>>03090000
         BEGIN   <<FULLY QUALIFIED JOB ID>>                    <<U.RAO>>03095000
         COMPARELEN := (JMATNAMELEN*3)*2;  << Bytes >>         <<06596>>03100000
         TCOMPAREOFFSET := JMATUSERNAMEOFF*2;                  <<06596>>03105000
         SCOMPAREOFFSET := 2;                                  <<U.RAO>>03110000
         END;                                                  <<U.RAO>>03115000
                                                               <<U.RAO>>03120000
         BEGIN   <<USER.ACCT>>                                 <<U.RAO>>03125000
         COMPARELEN := (JMATNAMELEN*2)*2;                      <<06596>>03130000
         TCOMPAREOFFSET := JMATUSERNAMEOFF*2;                  <<06596>>03135000
         SCOMPAREOFFSET := 2;                                  <<U.RAO>>03140000
         END;                                                  <<U.RAO>>03145000
                                                               <<U.RAO>>03150000
         BEGIN   <<@.ACCT>>                                    <<U.RAO>>03155000
         COMPARELEN := JMATNAMELEN*2;                          <<06596>>03160000
         TCOMPAREOFFSET := JMATACCTNAMEOFF*2;                  <<06596>>03165000
         SCOMPAREOFFSET := 10;                                 <<U.RAO>>03170000
         END;                                                  <<U.RAO>>03175000
      END;   <<CASE STATEMENT>>                                <<U.RAO>>03180000
                                                               <<06596>>03185000
<< At this point we are ready to start scanning through the >> <<06596>>03190000
<< JMAT entries until a qualifying one is found.            >> <<06596>>03195000
<< SCOMPAREOFFSET and TCOMPAREOFFSET, as set above,         >> <<06596>>03200000
<< determine the qualifications necessary in the test below.>> <<06596>>03205000
                                                               <<06596>>03210000
   DO                                                          <<U.RAO>>03215000
      FOUNDENTRY := GETJMATENTRY                               <<U.RAO>>03220000
      UNTIL NOT FOUNDENTRY <<NO MORE IN JMAT>>   OR            <<U.RAO>>03225000
         (BJOBID(SCOMPAREOFFSET) = BJMATARR(TCOMPAREOFFSET),   <<06596>>03230000
            (COMPARELEN));  <<HAVE MATCH>>                     <<U.RAO>>03235000
   END                                                         <<U.RAO>>03240000
ELSE   <<@, @S, @J - FIND NEXT QUALIFYING JOB TYPE>>           <<U.RAO>>03245000
   BEGIN                                                       <<U.RAO>>03250000
   CASE JOBID(13) - ALLSESSIONS OF                             <<U.RAO>>03255000
      BEGIN                                                    <<U.RAO>>03260000
      JSTYPE := JOBTYPESESSION;   <<ALL SESSIONS>>             <<06596>>03265000
      JSTYPE := JOBTYPEJOB;       <<ALL JOBS>>                 <<06596>>03270000
      JSTYPE := -1;   <<EVERYTHING>>                           <<06596>>03275000
      END;   <<MASK IS NOW SET UP>>                            <<U.RAO>>03280000
   DO                                                          <<U.RAO>>03285000
      FOUNDENTRY := GETJMATENTRY   <<SCAN FOR ENTRY>>          <<U.RAO>>03290000
      UNTIL NOT FOUNDENTRY  <<JMAT EXHAUSTED>>                 <<U.RAO>>03295000
        OR ((JMATJSTYPE = JSTYPE)  OR  (JSTYPE = -1));         <<06596>>03300000
   END;                                                        <<U.RAO>>03305000
<<NOW RETURN SCAN RESULTS>>                                    <<U.RAO>>03310000
IF FOUNDENTRY THEN   <<HAVE A WINNER>>                         <<U.RAO>>03315000
   BEGIN                                                       <<U.RAO>>03320000
   RESULT := JMATARR;                                          <<06596>>03325000
   RESULT(1) := JMATJLISTDEV;                                  <<06596>>03330000
   RESULT(2) := JMATFTBITS;                                    <<06596>>03335000
   JOBID(0)   := JMATARR(JMATJSNOOFF); << js number and type>> <<06596>>03340000
   MOVE JOBID(1) := JMATARR(JMATUSERNAMEOFF),                  <<06596>>03345000
                 (JMATNAMELEN * 3); << move all three names >> <<06596>>03350000
   SCANJMAT := TRUE;                                           <<U.RAO>>03355000
   END;                                                        <<U.RAO>>03360000
RELSIR(JMATSIR, OLDSIR);                                       <<U.RAO>>03365000
END;   <<PROCEDURE SCANJMAT>>                                  <<U.RAO>>03370000
                                                                        03375000
                                                                        03380000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                                 03385000
    INTEGER NWORDS;                                                     03390000
    INTEGER ARRAY DEST;                                                 03395000
    BYTE ARRAY N1,N2,N3;                                                03400000
   OPTION PRIVILEGED, UNCALLABLE;                                       03405000
         <<PROCEDURE TO PUT ENTRY NAMES INTO STANDARD FORM.           >>03410000
         <<HIGH ORDER BIT OF FIRST BYTE OF EACH NAME PART IS TURNED ON>>03415000
         <<EACH NAME PART MUST BE TERMINATED BY A NON-ALPHANUMERIC.   >>03420000
         <<N1,N2,N3 - NAME PARTS TO BE CONCATENATED TO FORM ENTRY NAME>>03425000
         <<DEST - ARRAY WHERE ENTRY NAME IS TO BE STORED.             >>03430000
         <<NWORDS:= SIZE OF ENTRY NAME IN WORDS (OUTPUT)              >>03435000
         <<NOTE: DB MUST BE POINTING TO THE STACK                     >>03440000
         <<      ARRAY "DEST" MUST BE AT LEAST 25 BYTES LONG          >>03445000
   BEGIN                                                                03450000
    INTEGER ARRAY                                                       03455000
         ISRC(0:14)=Q                                                   03460000
        ,IDEST(0:12) = Q                                                03465000
   ;BYTE ARRAY                                                          03470000
         BSRC(*) = ISRC                                                 03475000
        ,BDEST(*) = IDEST                                               03480000
   ;BYTE POINTER                                                        03485000
         BP                                                             03490000
   ;INTEGER I   <<USED AS A LOOP VARIABLE>>                    <<U.RAO>>03495000
   ;                                                                    03500000
   I := -1;                                                             03505000
   WHILE (I:=I+1)<8 DO                                                  03510000
      BEGIN   <<COMBINE SOURCES INTO LOCAL ARRAY>>                      03515000
      BSRC(I) := N1(I);                                                 03520000
      BSRC(I+10) := N2(I);                                              03525000
      BSRC(I+20) := N3(I);                                              03530000
      END;                                                              03535000
   TOS := @BDEST;                                                       03540000
   ASSEMBLE(DUP);                                                       03545000
   I := -10;                                                            03550000
   WHILE (I:=I+10)<21 DO                                                03555000
      BEGIN                                                             03560000
      BSRC(I+8) := " ";   <<TO INSURE TERMINATION>>                     03565000
      ASSEMBLE(DUP);                                                    03570000
      @BP := TOS;                                                       03575000
      MOVE * := BSRC(I) WHILE AN,1;                                     03580000
      BP := LOGICAL(BP) LOR %200;   <<TURN ON HIGH BIT OF FIRST BYTE>>  03585000
      END;                                                              03590000
   BPS0 := " ";   <<IN CASE STRING ENDS NOT ON WORD BOUNDARY>>          03595000
   ASSEMBLE(XCH; LSUB; INCA; LSR 1);                                    03600000
   NWORDS := TOS;                                                       03605000
   TOS := @DEST;   <<TARGET>>                                           03610000
   TOS := @IDEST;   <<SOURCE>>                                          03615000
   TOS := NWORDS;   <<WORD COUNT>>                                      03620000
   ASSEMBLE(MOVE 3);   <<MOVE TO CALLER ARRAY>>                         03625000
   END;   <<CRUNCH>>                                                    03630000
$PAGE                                                          << 8498>>03635000
<<***********************************************************>><< 8498>>03640000
<<                                                           >><< 8498>>03645000
<< Procedure UNCRUNCH                                        >><< 8498>>03650000
<<                                                           >><< 8498>>03655000
<< Purpose:  To take as input, a byte array in the form of a >><< 8498>>03660000
<<           byte array output from CRUNCH, and uncrunch it  >><< 8498>>03665000
<<           into the file, group, and account names.        >><< 8498>>03670000
<<                                                           >><< 8498>>03675000
<<***********************************************************>><< 8498>>03680000
                                                               << 8498>>03685000
PROCEDURE UNCRUNCH( FNAME, FNAME'SIZE, FILE, GROUP, ACCT );    << 8498>>03690000
  VALUE FNAME'SIZE;                                            << 8498>>03695000
  INTEGER FNAME'SIZE;                                          << 8498>>03700000
  BYTE ARRAY FNAME, FILE, GROUP, ACCT;                         << 8498>>03705000
  OPTION PRIVILEGED, UNCALLABLE;                               << 8498>>03710000
                                                               << 8498>>03715000
BEGIN                                                          << 8498>>03720000
INTEGER I := 0,                                                << 8498>>03725000
        J := -1,                                               << 8498>>03730000
        M := 0;                                                << 8498>>03735000
                                                               << 8498>>03740000
WHILE ( I < FNAME'SIZE ) DO                                    << 8498>>03745000
  BEGIN                                                        << 8498>>03750000
  IF FNAME( I ) >= %200                                        << 8498>>03755000
    THEN BEGIN                                                 << 8498>>03760000
         FNAME( I ) := FNAME( I ) - %200;                      << 8498>>03765000
         J := J + 1;                                           << 8498>>03770000
         M := 0;                                               << 8498>>03775000
         END;                                                  << 8498>>03780000
                                                               << 8498>>03785000
  CASE J OF                                                    << 8498>>03790000
       BEGIN                                                   << 8498>>03795000
                                                               << 8498>>03800000
       << 0 >> << FILE NAME  >>                                << 8498>>03805000
       FILE( M ) := FNAME( I );                                << 8498>>03810000
                                                               << 8498>>03815000
       << 1 >> << GROUP NAME >>                                << 8498>>03820000
       GROUP( M ) := FNAME( I );                               << 8498>>03825000
                                                               << 8498>>03830000
       << 2 >> << ACCT NAME  >>                                << 8498>>03835000
       ACCT( M ) := FNAME( I );                                << 8498>>03840000
                                                               << 8498>>03845000
       END; << CASE >>                                         << 8498>>03850000
                                                               << 8498>>03855000
  M := M + 1;                                                  << 8498>>03860000
  I := I + 1;                                                  << 8498>>03865000
                                                               << 8498>>03870000
  END;  << WHILE >>                                            << 8498>>03875000
                                                               << 8498>>03880000
END;  << Procedure UNCRUNCH >>                                 << 8498>>03885000
$PAGE                                                          << 8498>>03890000
<<***********************************************************>><< 8498>>03895000
<<                                                           >><< 8498>>03900000
<< Procedure GET'ORDERED'INDEX                               >><< 8498>>03905000
<<                                                           >><< 8498>>03910000
<< Purpose:  To return a JDT relative index to where a new   >><< 8498>>03915000
<<           entry should be placed in a candidate table.    >><< 8498>>03920000
<<           The new entries will be placed in order in the  >><< 8498>>03925000
<<           table by the caller at the index.               >><< 8498>>03930000
<<           Order will be defined to be alphabetic first by >><< 8498>>03935000
<<           account, then group and then the file name      >><< 8498>>03940000
<<                                                           >><< 8498>>03945000
<<***********************************************************>><< 8498>>03950000
                                                               << 8498>>03955000
INTEGER PROCEDURE GET'ORDERED'INDEX( FILE, GROUP, ACCT,        << 8498>>03960000
                                            TABLE, PXGJDT );   << 8498>>03965000
    VALUE TABLE, PXGJDT;                                       << 8498>>03970000
    INTEGER TABLE, PXGJDT;                                     << 8498>>03975000
    BYTE ARRAY FILE, GROUP, ACCT;                              << 8498>>03980000
    OPTION PRIVILEGED, UNCALLABLE;                             << 8498>>03985000
                                                               << 8498>>03990000
BEGIN                                                          << 8498>>03995000
<< This procedure is called in split-stack mode.  DB is      >><< 8498>>04000000
<< pointing at the JDT in question.  The algorithm is as     >><< 8498>>04005000
<< follows:  1.  Get the head pointer to TABLE table         >><< 8498>>04010000
<<           2.  Get an entry                                >><< 8498>>04015000
<<           3.  Uncrunch the formal file name in the entry  >><< 8498>>04020000
<<           4.  If FILE, GROUP, and ACCT are less than this >><< 8498>>04025000
<<               uncrunched formal file name, go to 2.       >><< 8498>>04030000
<<           5.  If FILE, GROUP, and ACCT are greater than   >><< 8498>>04035000
<<               this entry, return this entry's JDT         >><< 8498>>04040000
<<               index.                                      >><< 8498>>04045000
<< Assumes that the candidate entry does not exist in table! >><< 8498>>04050000
                                                               << 8498>>04055000
LOGICAL ARRAY QARRAY( 0:36 )  = Q;                             << 8498>>04060000
BYTE    ARRAY QARRAY'B(*)     = QARRAY;                        << 8498>>04065000
                                                               << 8498>>04070000
LOGICAL ARRAY DESIGNATOR'L(*) = QARRAY( 0 ); << 13 WORDS >>    << 8498>>04075000
BYTE    ARRAY DESIGNATOR(*)   = DESIGNATOR'L;                  << 8498>>04080000
                                                               << 8498>>04085000
BYTE    ARRAY U'FILE(*)       = QARRAY( 13 );   << 4 WORDS >>  << 8498>>04090000
BYTE    ARRAY U'GROUP(*)      = QARRAY( 17 );   << 4 WORDS >>  << 8498>>04095000
BYTE    ARRAY U'ACCT(*)       = QARRAY( 21 );   << 4 WORDS >>  << 8498>>04100000
                                                               << 8498>>04105000
BYTE    ARRAY F'FILE(*)       = QARRAY( 25 );   << 4 WORDS >>  << 8498>>04110000
BYTE    ARRAY F'GROUP(*)      = QARRAY( 29 );   << 4 WORDS >>  << 8498>>04115000
BYTE    ARRAY F'ACCT(*)       = QARRAY( 33 );   << 4 WORDS >>  << 8498>>04120000
                                                               << 8498>>04125000
LOGICAL FIRST'TIME := TRUE;                                    << 8498>>04130000
                                                               << 8498>>04135000
                                                               << 8498>>04140000
INTEGER POINTER TABLE'HEAD,                                    << 8498>>04145000
                TABLE'TAIL,                                    << 8498>>04150000
                ENTRY'I,                                       << 8498>>04155000
                SAVE'ENTRY;                                    << 8498>>04160000
                                                               << 8498>>04165000
INTEGER ENTRY'SIZE,                                            << 8498>>04170000
        I,                                                     << 8498>>04175000
        DESIGNATOR'SIZE,                                       << 8498>>04180000
        R'VALUE;                                               << 8498>>04185000
                                                                        04190000
                                                               << 8498>>04195000
<<***********************************************************>><< 8498>>04200000
<<                                                           >><< 8498>>04205000
<< Subroutine DETERMINE                                      >><< 8498>>04210000
<<                                                           >><< 8498>>04215000
<< Purpose: To determine if the formal designator is the     >><< 8498>>04220000
<<          is at an entry index where that index will used  >><< 8498>>04225000
<<          as the index for a new entry.                    >><< 8498>>04230000
<<                                                           >><< 8498>>04235000
<<***********************************************************>><< 8498>>04240000
<< ACCT, GROUP, FILE are the input arrays to GET'ODERED'INDEX>><< 8498>>04245000
<< U'ACCT, U'GROUP, U'FILE are created by UNCRUNCH           >><< 8498>>04250000
                                                               << 8498>>04255000
SUBROUTINE DETERMINE( R'VAL );                                 << 8498>>04260000
   INTEGER R'VAL;                                              << 8498>>04265000
                                                               << 8498>>04270000
BEGIN                                                          << 8498>>04275000
R'VAL := 0;                                                    << 8498>>04280000
IF F'ACCT < U'ACCT,( 8 )                                       << 8498>>04285000
   THEN                                                        << 8498>>04290000
   R'VAL := @SAVE'ENTRY                                        << 8498>>04295000
   ELSE                                                        << 8498>>04300000
    IF F'ACCT = U'ACCT,( 8 )                                   << 8498>>04305000
       THEN                                                    << 8498>>04310000
        IF F'GROUP < U'GROUP ,( 8 )                            << 8498>>04315000
           THEN                                                << 8498>>04320000
            R'VAL := @SAVE'ENTRY                               << 8498>>04325000
           ELSE                                                << 8498>>04330000
            IF F'GROUP = U'GROUP, ( 8 )                        << 8498>>04335000
               THEN                                            << 8498>>04340000
                IF F'FILE < U'FILE, ( 8 )                      << 8498>>04345000
                   THEN                                        << 8498>>04350000
                    R'VAL := @SAVE'ENTRY                       << 8498>>04355000
                   ELSE << 1.  F'FILE <> U'FILE (assumption) >><< 8498>>04360000
                        << 2.  F'FILE > U'FILE drop out and  >><< 8498>>04365000
                        <<     to get a new entry          >>  << 8498>>04370000
                                                               << 8498>>04375000
               ELSE << 1.  F'GROUP > U'GROUP - drop out and >> << 8498>>04380000
                    <<     to get a new entry             >>   << 8498>>04385000
                                                               << 8498>>04390000
       ELSE;  << 1.  F'ACCT > U'ACCT - drop out >>             << 8498>>04395000
              <<     to get a new entry       >>               << 8498>>04400000
                                                               << 8498>>04405000
END;  << Subroutine DETERMINE >>                               << 8498>>04410000
@TABLE'HEAD := JDTARR( TABLE );    << Addr start of table    >><< 8498>>04415000
@TABLE'TAIL := JDTARR( TABLE + 1 ); << Addr start of table+1 >><< 8498>>04420000
                                                               << 8498>>04425000
R'VALUE := 0;                                                  << 8498>>04430000
                                                               << 8498>>04435000
IF @TABLE'HEAD = @TABLE'TAIL                                   << 8498>>04440000
   THEN R'VALUE := @TABLE'TAIL                                 << 8498>>04445000
   ELSE BEGIN                                                  << 8498>>04450000
        << Whirl through candidate table looking for  >>       << 8498>>04455000
        << MR. GOODENTRY                              >>       << 8498>>04460000
        @ENTRY'I := @TABLE'HEAD;                               << 8498>>04465000
        WHILE (( @ENTRY'I < @TABLE'TAIL )                      << 8498>>04470000
                        LAND                                   << 8498>>04475000
               (     R'VALUE = 0      )) DO                    << 8498>>04480000
          BEGIN                                                << 8498>>04485000
          @SAVE'ENTRY := @ENTRY'I;                             << 8498>>04490000
                                                               << 8498>>04495000
          << Get entry size in words >>                        << 8498>>04500000
          ENTRY'SIZE := ENTRY'I.(0:8);                         << 8498>>04505000
                                                               << 8498>>04510000
          << Get formal file name size words >>                << 8498>>04515000
          DESIGNATOR'SIZE := ENTRY'I.(8:8);                    << 8498>>04520000
                                                               << 8498>>04525000
          << Set ENTRY to formal designator and set up the >>  << 8498>>04530000
          << byte array DESIGNATOR                         >>  << 8498>>04535000
                                                               << 8498>>04540000
          @ENTRY'I := @ENTRY'I + 1;                            << 8498>>04545000
          EXCHANGEDB( 0 );                                     << 8498>>04550000
          << Need to exchange to DB to play with Q relative >> << 8498>>04555000
          << arrays.                                        >> << 8498>>04560000
          MOVE DESIGNATOR(0) := "                          ";  << 8498>>04565000
                                                               << 8498>>04570000
          << Load up the DESIGNATOR'L WITH designator name  >> << 8498>>04575000
                                                               << 8498>>04580000
          TOS := @DESIGNATOR'L;                                << 8498>>04585000
          TOS := PXGJDT;                                       << 8498>>04590000
          TOS := @ENTRY'I;                                     << 8498>>04595000
          TOS := DESIGNATOR'SIZE;                              << 8498>>04600000
          ASSEMBLE( MFDS  4 );                                 << 8498>>04605000
          << Set up and call UNCRUNCH >>                       << 8498>>04610000
          MOVE U'FILE  := "        ";                          << 8498>>04615000
          MOVE U'GROUP := "        ";                          << 8498>>04620000
          MOVE U'ACCT  := "        ";                          << 8498>>04625000
                                                               << 8498>>04630000
          DESIGNATOR'SIZE := DESIGNATOR'SIZE * 2; << BYTES >>  << 8498>>04635000
                                                               << 8498>>04640000
          UNCRUNCH( DESIGNATOR, DESIGNATOR'SIZE, U'FILE,       << 8498>>04645000
                    U'GROUP   , U'ACCT );                      << 8498>>04650000
                                                               << 8498>>04655000
          IF FIRST'TIME = TRUE                                 << 8498>>04660000
             THEN BEGIN                                        << 8498>>04665000
                                                               << 8498>>04670000
                  I := 0;                                      << 8498>>04675000
                  WHILE I < 8 DO                               << 8498>>04680000
                     BEGIN                                     << 8498>>04685000
                     F'FILE( I )  := FILE( I );                << 8498>>04690000
                     F'GROUP( I ) := GROUP( I );               << 8498>>04695000
                     F'ACCT( I )  := ACCT( I );                << 8498>>04700000
                     I := I + 1;                               << 8498>>04705000
                     END;  << WHILE >>                         << 8498>>04710000
                  FIRST'TIME := FALSE;                         << 8498>>04715000
                  END; << BEGIN >>                             << 8498>>04720000
                                                               << 8498>>04725000
                                                               << 8498>>04730000
          << Now we check to see if this entry is the entry >> << 8498>>04735000
          << that we want.                                  >> << 8498>>04740000
                                                               << 8498>>04745000
          DETERMINE( R'VALUE );                                << 8498>>04750000
                                                               << 8498>>04755000
          EXCHANGEDB( PXGJDT );                                << 8498>>04760000
                                                               << 8498>>04765000
          @ENTRY'I := @SAVE'ENTRY + ENTRY'SIZE;                << 8498>>04770000
          END; << While >>                                     << 8498>>04775000
                                                               << 8498>>04780000
          IF R'VALUE = 0                                       << 8498>>04785000
             THEN R'VALUE := @TABLE'TAIL;                      << 8498>>04790000
                                                               << 8498>>04795000
        END; << ELSE BEGIN >>                                  << 8498>>04800000
                                                               << 8498>>04805000
GET'ORDERED'INDEX := R'VALUE;                                  << 8498>>04810000
                                                               << 8498>>04815000
END;    << Procedure GET'ORDERED'INDEX >>                      << 8498>>04820000
                                                                        04825000
INTEGER PROCEDURE FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                   04830000
    VALUE TNO;                                                          04835000
    INTEGER TNO,PXGJDT;                                                 04840000
    BYTE ARRAY N1,N2,N3;                                                04845000
    LOGICAL A;                                                          04850000
    OPTION UNCALLABLE,PRIVILEGED;                                       04855000
         <<PROCEDURE TO FIND AN ENTRY IN THE JOB TABLE                >>04860000
         <<N1,N2,N3 = NAMES TO BE CONCATENATED AND SEARCHED (INPUT)   >>04865000
         <<TNO = TABLE # (1,2 OR 3) (INPUT)                           >>04870000
         <<TNO = 0- EXCHANGEDB,GETSIR,PASS BACK PXGJSIR,A,PXGJDT      >>04875000
         <<         BUT DO NO MORE                                    >>04880000
         <<A := LOCKJIR RETURN VALUE                                   >04885000
         <<PXGJDT:= JOB TABLE DST# (OUTPUT)                           >>04890000
         <<FINDJTENTRY:= SEG.REL.ADR.OF ENTRY (:=0 IF NOT FOUND)      >>04895000
         <<UPON ENTRY, DB MUST BE POINTING AT THE STACK               >>04900000
         <<UPON EXIT, DB WILL BE POINTING AT THE JOB TABLE            >>04905000
        << TNO = 1 - Data Segment Table                      >><< 8498>>04910000
        << TNO = 2 - Temporary File Table                    >><< 8498>>04915000
        << TNO = 3 File Equation Table                       >><< 8498>>04920000
   BEGIN                                                                04925000
    ARRAY QARRAY(*) = Q + 0;                                   <<06595>>04930000
    INTEGER PCBGLOBLOC;                                        <<06595>>04935000
    INTEGER                                                             04940000
         I                                                              04945000
        ,NAMSIZE   <<#WORDS IN CONCATENATED ENTRY NAME>>                04950000
        ,IDNO = Q-10   <<INDEX OF ENTRY WORD 0 (SEG.REL.ADR.)>>         04955000
   ;INTEGER ARRAY                                                       04960000
         CRUNCHED(0:12) = Q   <<Q-REL.ARRAY FOR NAME>>                  04965000
   ;INTEGER POINTER                                                     04970000
         PXPNTR                                                         04975000
   ;                                                                    04980000
<< get the JDT DST number from the PXGLOBAL area >>            <<06288>>04985000
                                                               <<06288>>04990000
   PXGLOBAL;                                                   <<06595>>04995000
   PXGJDT := PXG'JDTDST;                                       <<06595>>05000000
   IF TNO>0 THEN                                                        05005000
      << Crunch file, group, and acct to formal desg format >> << 8498>>05010000
      CRUNCH(N1,N2,N3,CRUNCHED,NAMSIZE);                                05015000
   A := LOCKJIR;                                                        05020000
<< exchange DB to the JDT DST  >>                              <<06288>>05025000
   EXCHANGEDB(PXGJDT);                                                  05030000
   IF TNO = 0 THEN RETURN;   <<DUMMY CALL>>                             05035000
   JDTWORKSPC := NAMSIZE;   <<WORK AREA>>                      <<U.RAO>>05040000
   I := -1;                                                             05045000
   WHILE (I:=I+1) < NAMSIZE DO                                          05050000
      BEGIN   <<MOVE CRUNCHED NAME INTO WORK AREA>>                     05055000
      JDTWORKSPC(I+1) := CRUNCHED(I);                          <<U.RAO>>05060000
      END;                                                              05065000
   I := JDTARR(TNO);   <<STARTING INDEX OF PROPER TABLE>>      <<U.RAO>>05070000
   WHILE I < JDTARR(TNO+1) DO                                  <<U.RAO>>05075000
      BEGIN   <<SEARCH UNTIL FOUND OR INDEX=START OF NEXT TABLE>>       05080000
      TOS := (@JDTARR(I)&LSL(1))+1;   <<CURRENT ENTRY>>        <<U.RAO>>05085000
      TOS := @JDTWORKSPC&LSL(1)+1;  <<GOAL NAME>>              <<U.RAO>>05090000
      TOS := (NAMSIZE&LSL(1))+1;   <<#CHAR>>                            05095000
      ASSEMBLE(CMPB 3);                                                 05100000
      IF = THEN                                                         05105000
         BEGIN                                                          05110000
         IDNO := I;   <<INDEX OF ENTRY>>                                05115000
         RETURN;                                                        05120000
         END;                                                           05125000
      I := I + JDTARR(I).(0:8);   <<INC.TO NEXT ENTRY>>        <<U.RAO>>05130000
      END;                                                              05135000
   IDNO := 0;                                                           05140000
   END;   <<FINDJTENTRY>>                                               05145000
                                                                        05150000
                                                                        05155000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);                      05160000
    INTEGER SIZE;                                                       05165000
    INTEGER ARRAY INFO;                                                 05170000
    BYTE ARRAY N1,N2,N3;                                                05175000
   OPTION PRIVILEGED, UNCALLABLE;                                       05180000
         <<TRACE POINTERS ORIGINATING FROM GIVEN ENTRY AND RETURN     >>05185000
         <<INFO FOUND IN FINAL ENTRY. SEARCH IS DONE IN TABLE #3      >>05190000
         <<INPUT:.....................................................>>05195000
         <<N1,N2,N3 - NAME OF ENTRY WHOSE POINTERS ARE TO BE TRACED   >>05200000
         <<OUTPUT:....................................................>>05205000
         <<SIZE     - #WORDS OF INFO RETURNED TO CALLER               >>05210000
         <<INFO     - INFORMATION FOUND IN FINAL ENTRY                >>05215000
         <<XRETJTENTRY                                                >>05220000
         <<      =0 - OK                                              >>05225000
         <<      =1 - ENTRY GIVEN CANNOT BE FOUND                     >>05230000
         <<      =2 - ENTRY POINTING TO NON-EXISTENT ENTRY            >>05235000
   BEGIN                                                                05240000
    LOGICAL                                                             05245000
         A   <<REDUNDANT LOCKJIR RETURN VALUE>>                         05250000
        ,B   <<LOCKJIR RETURN VALUE>>                                   05255000
   ;INTEGER ARRAY                                                       05260000
        IN1(0:17) = Q   <<LOCAL ARRAY FOR UNPACKING NAMES>>    <<U.RAO>>05265000
   ;BYTE ARRAY                                                          05270000
         BN1(*) = IN1                                                   05275000
        ;INTEGER                                                        05280000
         I,J,K                                                          05285000
        ,PXGJDT   <<JOB TABLE DST#>>                                    05290000
        ,SAVEDL                                                         05295000
        ,ADRIN1   <<DB-REL.ADR.OF IN1(*)>>                              05300000
        ,BN2,BN3                                                        05305000
   ;                                                                    05310000
   PUSH(DL);                                                            05315000
   SAVEDL := TOS;                                                       05320000
   ADRIN1 := @IN1;                                                      05325000
<< return an index into the JDT for the given table >>         <<06288>>05330000
   I := FINDJTENTRY(N1,N2,N3,3,B,PXGJDT);                               05335000
<< ******* Caution: DB  is at the JDT DST now  >>              <<06288>>05340000
   IF I=0 THEN                                                          05345000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 05350000
      XRETJTENTRY := 1;                                                 05355000
EXIT: EXCHANGEDB(0);                                                    05360000
      UNLOCKJIR(B);                                                     05365000
      RETURN;                                                           05370000
      END;                                                              05375000
NEXT:                                                                   05380000
<< the INFO string begins at the word following the formal>>   <<06288>>05385000
<< name designator at the beginning of each entry in a    >>   <<06288>>05390000
<< table.                                                 >>   <<06288>>05395000
<<     K is at the 2nd word of the PMASK                  >>   <<06288>>05400000
                                                               <<06288>>05405000
   K := I + JDTARR(I).(8:8) + 2;   <<INDEX OF 2ND WORD OF INFO><<U.RAO>>05410000
<< check the PMASK (word 2) for pointers to the file equ. >>   <<06288>>05415000
   IF JDTARR(K).(6:1) = 0 THEN GO ENDOFLINE;   <<NO MORE POINTE<<U.RAO>>05420000
   J := JDTARR(K+1).(0:8);   <<SIZE OF NAME IN INFO (BYTES)>>  <<U.RAO>>05425000
   TOS := ADRIN1 - SAVEDL;   <<DL-REL.TARGET>>                          05430000
<< address of beginning of name-actual designator is put  >>   <<06288>>05435000
<< on TOS.                                                >>   <<06288>>05440000
                                                               <<06288>>05445000
   TOS := K+2;   <<DB-REL.SOURCE>>                                      05450000
   TOS := (J+1)&LSR(1);   <<WORD COUNT>>                                05455000
   ASSEMBLE(MVBL 3);   <<MOVE INFO NAME INTO LOCAL ARRAY>>              05460000
   EXCHANGEDB(0);                                                       05465000
   PACKANDPOINT(BN1,J,BN2,BN3);                                         05470000
   BN1 (J) := " ";                                                      05475000
   I := FINDJTENTRY(BN1,BN2,BN3,3,A,PXGJDT);                            05480000
<< DB is at JDT DST here  >>                                   <<06288>>05485000
   IF I=0 THEN                                                          05490000
      BEGIN   <<POINTING TO NON-EXISTENT ENTRY>>                        05495000
      XRETJTENTRY := 2;                                                 05500000
      GO EXIT;                                                          05505000
      END;                                                              05510000
   EXCHANGEDB(PXGJDT);                                                  05515000
   GO NEXT;                                                             05520000
ENDOFLINE:                                                              05525000
   J := JDTARR(I).(0:8);   <<ENTRY SIZE>>                      <<U.RAO>>05530000
   TOS := @INFO-SAVEDL;   <<DL-REL.TARGET>>                             05535000
   TOS := I;   <<DB-REL.SOURCE>>                                        05540000
   TOS := J;   <<WORD COUNT>>                                           05545000
   ASSEMBLE(MVBL 3);                                                    05550000
   EXCHANGEDB(0);                                                       05555000
   SIZE := J;                                                           05560000
   GO EXIT;                                                             05565000
END;   <<PROCEDURE XRETJTENTRY>>                                        05570000
                                                                        05575000
                                                                        05580000
INTEGER PROCEDURE RETJTENTRY(N1,N2,N3,SIZE,INFO);                       05585000
    INTEGER SIZE;                                                       05590000
    INTEGER ARRAY INFO;                                                 05595000
    BYTE ARRAY N1,N2,N3;                                                05600000
OPTION PRIVILEGED, UNCALLABLE;                                          05605000
         <<RETURN JOB TABLE ENTRY INFORMATION                         >>05610000
         <<N1,N2,N3 = NAMES TO BE CONCATENATED AND SEARCHED (INPUT)   >>05615000
         <<SIZE = 1,2 OR 3 INDICATING WHICH TABLE TO SEARCH (INPUT)   >>05620000
         <<SIZE:= #WORDS OF INFORMATION PUT IN "INFO" (OUTPUT)        >>05625000
         <<INFO:= INFORMATION PORTION OF TABLE ENTRY (OUTPUT)         >>05630000
         <<RETJTENTRY:= 0 IF OK, 1 IF ENTRY CANNOT BE FOUND (OUTPUT)  >>05635000
   BEGIN                                                                05640000
    INTEGER                                                             05645000
         PXGJDT   <<JOB TABLE DST#>>                                    05650000
        ,I,J,K                                                          05655000
        ,QSIZE   <<SIZE OF INFO (WORDS)>>                               05660000
        ,SAVEDL                                                         05665000
   ;LOGICAL                                                             05670000
         A   <<LOCKJIR RETURN VALUE>>                                   05675000
   ;                                                                    05680000
   PUSH(DL);                                                            05685000
   SAVEDL := TOS;                                                       05690000
   I := FINDJTENTRY(N1,N2,N3,SIZE,A,PXGJDT);                            05695000
<< DB is at JDT DST here  >>                                   <<06288>>05700000
   IF I = 0 THEN                                                        05705000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 05710000
      RETJTENTRY := 1;                                                  05715000
      EXCHANGEDB(0);                                                    05720000
      UNLOCKJIR(A);                                            <<U.RAO>>05725000
      RETURN;                                                           05730000
      HELP;                                                             05735000
      END;                                                              05740000
<< the INFO string begins at the word following the formal >>  <<06288>>05745000
<< name designator at the beginning of each entry in table >>  <<06288>>05750000
                                                               <<06288>>05755000
   K := JDTARR(I);   <<ENTRY SIZE / NAME SIZE>>                <<U.RAO>>05760000
   J := K.(8:8) + I + 1;   <<INFO STARTING INDEX>>                      05765000
   QSIZE := K.(0:8) + I - J;   <<#WORDS OF INFO>>                       05770000
   TOS := @INFO - SAVEDL;   <<DL-REL.>>                                 05775000
<< start at INFO string; put address on TOS.               >>  <<06288>>05780000
   TOS := @JDTARR(J);   <<DB-REL.>>                            <<U.RAO>>05785000
   TOS := QSIZE;   <<WORD COUNT>>                                       05790000
   ASSEMBLE(MVBL 3);                                                    05795000
   EXCHANGEDB(0);                                                       05800000
   SIZE := QSIZE;                                                       05805000
   UNLOCKJIR(A);                                               <<U.RAO>>05810000
   END;   <<RETJTENTRY>>                                                05815000
                                                                        05820000
                                                                        05825000
INTEGER PROCEDURE REMJTENTRY(N1,N2,N3,TNO,ADR);                         05830000
    VALUE TNO,ADR;                                                      05835000
    INTEGER TNO,ADR;                                                    05840000
    BYTE ARRAY N1,N2,N3;                                                05845000
   OPTION PRIVILEGED, UNCALLABLE;                                       05850000
         <<PROCEDURE TO REMOVE AN ENTRY FROM THE JOB TABLE            >>05855000
         <<N1,N2,N3 - NAME PARTS OF ENTRY TO BE REMOVED (INPUT)       >>05860000
         <<TNO - TABLE # (1,2 OR 3) FROM WHICH TO REMOVE ENTRY (INPUT)>>05865000
         <<ADR = 0 - USE N1,N2,N3 TO FIND ENTRY                       >>05870000
         <<ADR > 0 - ENTRY TO BE REMOVED STARTS AT THIS ADDRESS       >>05875000
         <<REMJTENTRY.(8:8) = 0 - OK, ENTRY DELETED          >><<04573>>05880000
         <<                 = 1 - NO SUCH ENTRY              >><<04573>>05885000
         <<REMJTENTRY.(0:8) = OLD FILE REFERENCE COUNT. THIS >><<04573>>05890000
         <<                   IS RETURNED TO PRESERVE THIS   >><<04573>>05895000
         <<                   VALUE WHEN ADDING NEW FILE     >><<04573>>05900000
         <<                   EQUATIONS OF THE SAME NAME THAT>><<04573>>05905000
         <<                   IS BEING DELETED.              >><<04573>>05910000
         <<NOTE: DB MUST BE POINTING TO THE STACK                     >>05915000
        << TNO = 1 - Data Segment Table                      >><< 8498>>05920000
        << TNO = 2 - Temporary File Table                    >><< 8498>>05925000
        << TNO = 3 File Equation Table                       >><< 8498>>05930000
OPTION PRIVILEGED, UNCALLABLE;                                          05935000
   BEGIN                                                                05940000
    INTEGER                                                             05945000
        I,J                                                             05950000
        ,PXGJDT   <<JOB TABLE DST#>>                                    05955000
        ,SEGSIZE   <<CURRENT ACTUAL SIZE OF JOB TABLE SEGMENT>>         05960000
         ,ACTLNAMEWORD  <<INDEX TO ACTUAL NAME/DEV LEN.>>      <<04573>>05965000
         ,REFCOUNT := 0 <<REFERENCE COUNT VALUE        >>      <<04573>>05970000
         ,Z             <<WORD LENGTH OF NAME/DEV      >>      <<04573>>05975000
         ,REFCNTINDEX   <<INDEX TO REF. COUNT WORD     >>      <<04573>>05980000
         ;                                                     <<04573>>05985000
   LOGICAL                                                     <<04573>>05990000
         A   <<LOCKJIR RETURN VALUE>>                                   05995000
   ;                                                                    06000000
   IF ADR = 0 THEN                                                      06005000
      I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT)                           06010000
   ELSE                                                                 06015000
      BEGIN                                                             06020000
      I := ADR;                                                         06025000
       <<DUMMY CALL-EXCH.DB,LOCKJIR,PASS BACK A,PXGJDT>>                06030000
      FINDJTENTRY(J,J,J,0,A,PXGJDT);                                    06035000
      END;                                                              06040000
   IF I=0 THEN                                                          06045000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 06050000
      REMJTENTRY := 1;                                                  06055000
EXIT: REMJTENTRY.(0:8) := REFCOUNT;                            <<04573>>06060000
      EXCHANGEDB(0);                                           <<04573>>06065000
      UNLOCKJIR(A);                                                     06070000
      RETURN;                                                           06075000
      END;                                                              06080000
    <<COMPRESS DATA TO ELIMINATE ENTRY>>                                06085000
<< Find out if the reference count is greater than zero. >>    <<04573>>06090000
<< This value will be returned as the upper 8 bits of the>>    <<04573>>06095000
<< REMJTENTRY integer value returned.                    >>    <<04573>>06100000
<<                                                       >>    <<04573>>06105000
IF TNO = 3 THEN                                                <<04906>>06110000
BEGIN                                                          <<04906>>06115000
ACTLNAMEWORD := I + JDTARR(I).(8:8) + 3;                       <<04573>>06120000
Z := (JDTARR(ACTLNAMEWORD).(0:8) + 1)&LSR(1)                   <<04573>>06125000
   + (JDTARR(ACTLNAMEWORD).(8:8) + 1)&LSR(1);                  <<04573>>06130000
   REFCNTINDEX := (ACTLNAMEWORD + Z + 10 );<<REFCNT. WORD>>    <<04573>>06135000
   REFCOUNT := (JDTARR(REFCNTINDEX)).(0:6);                    <<04573>>06140000
END;                                                           <<04906>>06145000
<< remove the entry by writing from the end of the entry   >>  <<06288>>06150000
<< (next entry) to the beginning of the freespace over the >>  <<06288>>06155000
<< entry being removed ie. move the table up in the JDT.   >>  <<06288>>06160000
                                                               <<06288>>06165000
   TOS := I;   <<TARGET>>                                               06170000
<< put  address of entrysize + index into JDT on TOS.      >>  <<06288>>06175000
   TOS := JDTARR(I).(0:8)+I;   <<SOURCE>>                      <<U.RAO>>06180000
   ASSEMBLE(DUP);                                                       06185000
   J := TOS;                                                            06190000
   TOS _ JFREESPCADR-J;   <<WORD COUNT (POSITIVE)>>            <<U.RAO>>06195000
   I := JDTARR(I).(0:8);                                       <<U.RAO>>06200000
   ASSEMBLE(MOVE 3);                                                    06205000
   J := TNO;                                                            06210000
<< update the starting addresses of subsequent tables by   >>  <<06288>>06215000
<< subtracting out the size of entry being removed  (I).   >>  <<06288>>06220000
   WHILE (J:=J+1) <= NUMJDTPTRS DO                             <<U.RAO>>06225000
      BEGIN   <<REDUCE STARTING ADDRESSES OF SUBSEQUENT TABLES>>        06230000
      JDTARR(J) := JDTARR(J)-I;                                <<U.RAO>>06235000
      END;                                                              06240000
   SEGSIZE := (SYS'DST(PXGJDT&LSL(2)).(3:13))&LSL(2)-1;                 06245000
   J _ JFREESPCADR-SEGSIZE;                                    <<U.RAO>>06250000
   ALTDSEGSIZE(PXGJDT,J);                                               06255000
   IF  <>  THEN  SUDDENDEATH(500);  << FATAL ERROR >>                   06260000
   GO EXIT;                                                             06265000
END;   <<REMJTENTRY>>                                                   06270000
                                                                        06275000
                                                                        06280000
PROCEDURE DELJTENTRIES(KEYNAME,KEYNAMESIZE,TNO,PXGJDT,SAVEDL);          06285000
    VALUE TNO,PXGJDT,SAVEDL,KEYNAMESIZE;                                06290000
    INTEGER TNO,PXGJDT,SAVEDL,KEYNAMESIZE;                              06295000
    BYTE ARRAY KEYNAME;                                                 06300000
    OPTION INTERNAL,PRIVILEGED,UNCALLABLE;                              06305000
         <<DELETE ALL ENTRIES POINTING TO ENTRY "KEYNAME"             >>06310000
         <<DB MUST BE POINTING AT THE STACK                           >>06315000
         <<KEYNAME = NAME OF ENTRY IN STANDARD FORM                   >>06320000
         <<KEYNAMESIZE = SIZE OF KEYNAME IN WORDS                     >>06325000
         <<TNO = TABLE #                                              >>06330000
         <<PXGJDT = DST# OF JOB TABLE                                 >>06335000
         <<SAVEDL = VALUE OF DL                                       >>06340000
        << TNO = 1 - Data Segment Table                      >><< 8498>>06345000
        << TNO = 2 - Temporary File Table                    >><< 8498>>06350000
        << TNO = 3 File Equation Table                       >><< 8498>>06355000
   BEGIN                                                                06360000
    INTEGER ARRAY                                                       06365000
         IRAWTESTNAME(0:17)                                             06370000
        ,IENTRYNAME(0:14)                                               06375000
        ,ITESTNAME(0:14)                                                06380000
   ;BYTE ARRAY                                                          06385000
         TESTNAME(*) = ITESTNAME   <<NAME FROM INFO.-STD.FORM>>         06390000
        ,ENTRYNAME(*) = IENTRYNAME   <<NAME OF ENTRY FROM WHICH         06395000
                                       "TESTNAME" CAME (STD.FORM)>>     06400000
        ,RAWTESTNAME(*) = IRAWTESTNAME   <<INFO.NAME (RAW FORM)>>       06405000
   ;INTEGER                                                             06410000
         RAWTESTNAMESIZE   <<BYTES>>                                    06415000
        ,TESTNAMESIZE   <<WORDS>>                                       06420000
        ,I,J,K                                                          06425000
        ,ENTRYNAMESIZE   <<WORDS>>                                      06430000
        ,ENTRYSIZE   <<WORDS>>                                          06435000
        ,ADRIENTRYNAME   <<DB-REL.ADR OF IENTRYNAME>>                   06440000
        ,ADRIRAWTESTNAME   <<DB-REL.ADR OF IRAWTESTNAME>>               06445000
   ;                                                                    06450000
   ADRIENTRYNAME := @IENTRYNAME;                                        06455000
   ADRIRAWTESTNAME := @IRAWTESTNAME;                                    06460000
START:                                                                  06465000
   EXCHANGEDB(PXGJDT);                                                  06470000
   I := JDTARR(TNO);   <<STARTING INDEX OF PROPER TABLE>>      <<U.RAO>>06475000
   WHILE I < JDTARR(TNO+1) DO                                  <<U.RAO>>06480000
      BEGIN   <<CYCLE ON ENTRY>>                                        06485000
       <<MOVE ENTRY NAME TO LOCAL ARRAY>>                               06490000
      ENTRYSIZE := JDTARR(I).(0:8);                            <<U.RAO>>06495000
      TOS := ADRIENTRYNAME - SAVEDL;   <<DL-REL.TARGET>>                06500000
      TOS := I+1;   <<DB-REL.SOURCE>>                                   06505000
      TOS := JDTARR(I).(8:8);   <<WORD COUNT>>                 <<U.RAO>>06510000
      ASSEMBLE(DUP; STOR ENTRYNAMESIZE;);                               06515000
      ASSEMBLE(MVBL 3);   <<MOVE DB TO DL>>                             06520000
      K := JDTARR(I+ENTRYNAMESIZE+2);<<SAVE 2ND WORD OF PMASK>><<00272>>06525000
       <<MOVE INFO NAME TO LOCAL ARRAY>>                                06530000
      J := I+ENTRYNAMESIZE+4;   <<ADR.OF INFO.NAME>>                    06535000
      TOS := ADRIRAWTESTNAME - SAVEDL;   <<DL-REL.TARGET>>              06540000
      TOS := J;   <<DB-REL.SOURCE>>                                     06545000
      RAWTESTNAMESIZE := JDTARR(J-1).(0:8);                    <<U.RAO>>06550000
      TOS := (RAWTESTNAMESIZE+1)&LSR(1);   <<WORD COUNT>>               06555000
      ASSEMBLE(MVBL 3);   <<DB TO DL MOVE>>                             06560000
      EXCHANGEDB(0);                                                    06565000
   <<IF NOT A BACK REFERENCE OR NO ACTUAL NAME THEN SKIP TEST>><<00272>>06570000
      IF K.(6:1)=0 OR RAWTESTNAMESIZE=0 THEN GO INC;           <<00272>>06575000
       <<PUT INFO.NAME IN STANDARD FORM>>                               06580000
      PACKANDPOINT(RAWTESTNAME,RAWTESTNAMESIZE,J,K);                    06585000
   RAWTESTNAME (RAWTESTNAMESIZE) := " ";                                06590000
   << NOTE: J AND K ARE STACKED BECAUSE CRUNCH EXPECTS BYTE >> <<00271>>06595000
   << ARRAYS AS PARAMETERS AND J AND K ARE DECLARED AS      >> <<00271>>06600000
   << INTEGERS IN THIS ROUTINE.  TYPE MIXING IS DANGEROUS!! >> <<00271>>06605000
      TOS := @RAWTESTNAME;                                     <<00271>>06610000
      TOS := J;                                                <<00271>>06615000
      TOS := K;                                                <<00271>>06620000
      CRUNCH(*,*,*,ITESTNAME,TESTNAMESIZE);                    <<00271>>06625000
      IF TESTNAMESIZE = KEYNAMESIZE THEN                                06630000
         BEGIN   <<SEE IF TESTNAME SAME AS KEYNAME>>                    06635000
         TOS := @KEYNAME;   <<TARGET>>                                  06640000
         TOS := @TESTNAME;   <<SOURCE>>                                 06645000
         TOS := KEYNAMESIZE & LSL(1);   <<BYTE COUNT>>                  06650000
         ASSEMBLE(CMPB 3);                                              06655000
         IF = THEN                                                      06660000
            BEGIN   <<DELETE ENTRY AND ALL ENTRIES POINTING AT IT>>     06665000
            REMJTENTRY(J,J,J,TNO,I);                                    06670000
            DELJTENTRIES(ENTRYNAME,ENTRYNAMESIZE,TNO,PXGJDT,SAVEDL);    06675000
            GO START;   <<START SEARCH OVER AGAIN>>                     06680000
            END;                                                        06685000
         END;                                                           06690000
INC:                                                                    06695000
      I := I+ENTRYSIZE;                                                 06700000
      EXCHANGEDB(PXGJDT);                                               06705000
      END;                                                              06710000
   EXCHANGEDB(0);                                                       06715000
   END;   <<DELJTENTRIES>>                                              06720000
                                                                        06725000
                                                                        06730000
INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,TNO);                            06735000
    VALUE TNO;                                                          06740000
    INTEGER TNO;                                                        06745000
    BYTE ARRAY N1,N2,N3;                                                06750000
OPTION PRIVILEGED, UNCALLABLE;                                          06755000
   BEGIN                                                                06760000
         <<PROCEDURE TO REMOVE FROM THE JOB TABLE AN ENTRY (N1,N2,N3) >>06765000
         <<AND ALL OTHER ENTRIES DIRECTLY OR INDIRECTLY POINTING AT   >>06770000
         <<IT. ALSO, IF THE ENTRY (N1,N2,N3) POINTS TO ANOTHER ENTRY, >>06775000
         <<DECREMENT THE REF.COUNT FOR THAT ENTRY. IF THIS REF.COUNT  >>06780000
         <<GOES TO ZERO, DELETE THE ENTRY.                            >>06785000
         <<N1,N2,N3 - NAME OF ENTRY TO BE DELETED.                    >>06790000
         <<TNO - TABLE#(1,2 OR 3) FROM WHICH ENTRY IS TO BE DELETED. >> 06795000
         <<XREMJTENTRY:= 0 - OK,ENTRY DELETED.                        >>06800000
         <<           := 1 - NO SUCH ENTRY.                           >>06805000
         <<           := 2 - N1,N2,N3 POINTING TO NON-EXISTENT ENTRY. >>06810000
         <<           := 3 - REF.COUNT ALREADY ZERO IN ENTRY POINTED  >>06815000
         <<                  TO BY ENTRY N1,N2,N3.                    >>06820000
         <<NOTE: DB MUST BE POINTING TO THE STACK.                    >>06825000
        << TNO = 1 - Data Segment Table                      >><< 8498>>06830000
        << TNO = 2 - Temporary File Table                    >><< 8498>>06835000
        << TNO = 3 File Equation Table                       >><< 8498>>06840000
    LOGICAL                                                             06845000
         A   <<LOCKJIR RETURN VALUE (NOT USED)>>                        06850000
        ,B   <<LOCKJIR RETURN VALUE>>                                   06855000
   ;INTEGER                                                             06860000
         PXGJDT   <<JOB TABLE DST#>>                                    06865000
        ,I,J,K,L      <<MISCELLANEOUS DUMMIES>>                <<U.RAO>>06870000
        ,SAVEDL                                                         06875000
        ,ADRIN1   <<DB-REL.ADR OF IN1>>                                 06880000
        ,KEYADR   <<ADR.OF ENTRY N1,N2,N3>>                             06885000
   ;INTEGER ARRAY                                                       06890000
        IN1(0:17) = Q                                          <<U.RAO>>06895000
   ;BYTE ARRAY                                                          06900000
         BN1(*) = IN1                                                   06905000
   ;LOGICAL                                                             06910000
         BN2                                                            06915000
        ,BN3                                                            06920000
   ;BYTE POINTER                                               <<00069>>06925000
         CN2                                                   <<00069>>06930000
        ,CN3                                                   <<00069>>06935000
   ;                                                                    06940000
   PUSH(DL);                                                            06945000
   SAVEDL := TOS;                                                       06950000
   B := LOCKJIR;                                                        06955000
   ADRIN1 := @IN1;                                                      06960000
   KEYADR := I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                   06965000
   IF I=0 THEN                                                          06970000
      BEGIN   <<NO SUCH ENTRY>>                                         06975000
      XREMJTENTRY := 1;                                                 06980000
EXIT1:                                                                  06985000
      EXCHANGEDB(0);                                                    06990000
EXIT2:                                                                  06995000
      UNLOCKJIR(B);                                                     07000000
      RETURN;                                                           07005000
      END;                                                              07010000
<< I = index into JDT of entry                             >>  <<06288>>07015000
<< K = 2nd word of INFO string; INFO is the rest of the    >>  <<06288>>07020000
<<     entry following the FORMAL Designator name          >>  <<06288>>07025000
   K := I+JDTARR(I).(8:8)+2;   <<INDEX OF 2ND WORD IN INFO>>   <<U.RAO>>07030000
   IF JDTARR(K).(6:1) = 1 THEN                                 <<U.RAO>>07035000
      BEGIN   <<DECREMENT REF.COUNT IN ENTRY POINTED AT>>               07040000
      J := JDTARR(K+1).(0:8);   <<SIZE OF NAME IN INFO(BYTES)>><<U.RAO>>07045000
      TOS := ADRIN1 - SAVEDL;   <<DL-REL.TARGET>>                       07050000
      TOS := K+2;   <<DB-REL.SOURCE>>                                   07055000
      TOS := (J+1)&LSR(1);   <<WORD COUNT>>                             07060000
      ASSEMBLE(MVBL 3);   <<MOVE INFO.NAME TO LOCAL ARRAY>>             07065000
      EXCHANGEDB(0);                                                    07070000
      PACKANDPOINT(BN1,J,BN2,BN3);                                      07075000
      BN1 (J) := " ";                                                   07080000
      @CN2:=BN2;                                               <<00069>>07085000
      @CN3:=BN3;                                               <<00069>>07090000
      I := FINDJTENTRY(BN1,CN2,CN3,TNO,A,PXGJDT);              <<00069>>07095000
      IF I=0 THEN                                                       07100000
         BEGIN   <<N1,N2,N3 POINTING AT NON-EXISTENT ENTRY>>            07105000
         XREMJTENTRY := 2;                                              07110000
         GO EXIT1;                                                      07115000
         END;                                                           07120000
      K := I+JDTARR(I).(8:8)+2;   <<INDEX OF SECOND WORD IN INF<<U.RAO>>07125000
     K:=K+1;                                                   <<FORMS>>07130000
<< L = name-actual designator length + dev length in words.>>  <<06288>>07135000
     L:=(JDTARR(K).(0:8)+1)&LSR(1)                                      07140000
     +(JDTARR(K).(8:8)+1)&LSR(1);                                       07145000
<< K = index to the reference cound word in JFEQ table     >>  <<06288>>07150000
     K:=(K+L+10);                                              <<FORMS>>07155000
      L := JDTARR(K).(0:6);   <<REF.COUNT>>                    <<U.RAO>>07160000
      IF L=0 THEN                                                       07165000
         BEGIN   <<REF.COUNT ALREADY ZERO>>                             07170000
         XREMJTENTRY := 3;                                              07175000
         GO EXIT1;                                                      07180000
         END;                                                           07185000
      JDTARR(K).(0:6) := L-1;   <<DECREMENT REF.COUNT>>        <<U.RAO>>07190000
      END;                                                              07195000
   EXCHANGEDB(0);                                                       07200000
   REMJTENTRY(J,J,J,TNO,KEYADR);                                        07205000
   CRUNCH(N1,N2,N3,BN1,I);                                              07210000
   DELJTENTRIES(BN1,I,TNO,PXGJDT,SAVEDL);                               07215000
   GO EXIT2;                                                            07220000
   END;   <<XREMJTENTRY>>                                               07225000
                                                                        07230000
                                                                        07235000
INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                   07240000
    VALUE SIZE,TNO;                                                     07245000
    INTEGER SIZE,TNO;                                                   07250000
    INTEGER ARRAY INFO;                                                 07255000
    BYTE ARRAY N1,N2,N3;                                                07260000
OPTION PRIVILEGED, UNCALLABLE;                                          07265000
   BEGIN                                                                07270000
         <<PROCEDURE TO ADD ENTRY TO THE JOB TABLE.                   >>07275000
         <<N1,N2,N3 - NAME OF ENTRY BEING ADDED.                      >>07280000
         <<TNO = 1,2 OR 3 - TABLE# TO WHICH ENTRY IS TO BE ADDED.     >>07285000
         <<    = -1,-2 OR -3 - USE -TNO AS THE TABLE# AND DO NOT ISSUE>>07290000
         <<                    AN ERROR #2. IN CASE OF DUPLICATE, THE >>07295000
         <<                    OLD ENTRY IS DELETED AND THE NEW ADDED.>>07300000
         <<    = 0 - SPECIAL CALL TO ADD AN ENTRY TO TABLE #1. NAME   >>07305000
         <<          LENGTH IS ALWAYS 1 WORD (NOT PUT IN STD.FORM);   >>07310000
         <<          INFO IS 2 WORDS (4 WORD ENTRY). NO CHECK IS MADE >>07315000
         <<          FOR DUPLICATE NAMES.                             >>07320000
         <<SIZE - LENGTH OF "INFO" IN WORDS.                          >>07325000
         <<INFO - INFORMATION TO BE PUT IN TABLE ENTRY.               >>07330000
         <<ADDJTENTRY:= 0 - ENTRY ADDED.                              >>07335000
         <<          := 1 - NO ROOM FOR NEW ENTRY.                    >>07340000
         <<          := 2 - DUPLICATE NAME.                           >>07345000
         <<NOTE: DB MUST BE POINTING TO THE STACK.                    >>07350000
        << TNO = 1 - Data Segment Table                      >><< 8498>>07355000
        << TNO = 2 - Temporary File Table                    >><< 8498>>07360000
        << TNO = 3 File Equation Table                       >><< 8498>>07365000
   INTEGER POINTER SAVETOS; <<PMASK1 WORD TARGET ADDR >>       <<04573>>07370000
    INTEGER                                                             07375000
        I,J                                                    <<U.RAO>>07380000
        ,ENTRY'I << Index from DETERMINE >>                    << 8498>>07385000
        ,SAVEDL   <<STACK REL.ADR.OF DL>>                               07390000
        ,PXGJDT   <<JOB TABLE DST#>>                                    07395000
        ,SEGSIZE   <<CURRENT ACTUAL SIZE OF JOB TABLE SEGMENT>>         07400000
        ,REFCOUNT := 0   <<FILE REFERENCE COUNT         >>     <<04573>>07405000
        ,RESULT := 0     <<RETURN VALUE FOR REMJTENTRY  >>     <<04573>>07410000
        ,ACTUALDEVLEN    <<FROM INFO STRING NAME/DEV LEN>>     <<04573>>07415000
        ,INFOREFINDEX    <<REF CNT INDEX FOR INFO STRING>>     <<04573>>07420000
        ,UPPERINFO       << BITS (0:8) OF INFO STRING WORD 2>> <<04573>>07425000
        ,LOWERINFO       << BITS (8:8) OF INFO STRING WORD 2>> <<04573>>07430000
   ;LOGICAL                                                             07435000
         A   <<LOCKJIR RETURN VALUE>>                                   07440000
        ,SPECALL := FALSE  <<TNO<0, NO ERROR #2 TO BE ISSUED (IF TRUE)>>07445000
   ;                                                                    07450000
   PUSH(DL);                                                            07455000
   SAVEDL := TOS;                                                       07460000
   IF TNO < 0 THEN                                                      07465000
      BEGIN                                                             07470000
      TNO := -TNO;                                                      07475000
      SPECALL := TRUE;                                                  07480000
      END;                                                              07485000
   J.(0:8) := N1;   <<SAVE ID FOR TABLE#1 (SPECIAL CALL)>>              07490000
   J.(8:8) := N1(1);                                                    07495000
FIX:                                                                    07500000
   I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                             07505000
       << AM NOW OPERATING IN SPLIT STACK MODE WITH THE >>     <<04573>>07510000
       << STACK POINTING TO THE JDT DST.  FINDJTENTRTY  >>     <<04573>>07515000
       << PUTS THE CALLER INTO SPLIT STACK MODE.        >>     <<04573>>07520000
   IF TNO = 0 THEN                                                      07525000
      BEGIN   <<SPECIAL ADD TO TABLE #1>>                               07530000
      JDTWORKSPC := %2001;   <<ENTRY SIZE=4, NAME SIZE=1>>     <<U.RAO>>07535000
      JDTWORKSPC(1) := J;   <<ENTRY NAME>>                     <<U.RAO>>07540000
      SIZE := 2;   <<INFO SIZE>>                                        07545000
      I := 4;   <<ENTRY SIZE>>                                          07550000
      GO SEG;                                                           07555000
      END;                                                              07560000
   IF I <> 0 THEN                                                       07565000
      IF NOT SPECALL THEN                                               07570000
         BEGIN   <<DUPLICATE NAME>>                                     07575000
         ADDJTENTRY := 2;                                               07580000
EXIT:    EXCHANGEDB(0);                                                 07585000
         UNLOCKJIR(A);                                                  07590000
         RETURN;                                                        07595000
         END                                                            07600000
      ELSE                                                              07605000
         BEGIN   <<DELETE OLD ENTRY>>                                   07610000
         EXCHANGEDB(0);                                                 07615000
         RESULT := REMJTENTRY(N1,N2,N3,TNO,0);                 <<04573>>07620000
 <<                                                      >>    <<04573>>07625000
 << REMJTENTRY returns an integer value. Bits (8:8) are  >>    <<04573>>07630000
 << the return value of REMJTENTRY  and are 0 or 1. Bits >>    <<04573>>07635000
 << (0:8) are the reference count from the removed file. >>    <<04573>>07640000
 << Ths is done to preserve this value so that the file  >>    <<04573>>07645000
 << being replaced with a FILE equation with the same    >>    <<04573>>07650000
 << name will not lose track of any pointer files point- >>    <<04573>>07655000
 << ing to the file being replaced.                      >>    <<04573>>07660000
                                                               <<04573>>07665000
         REFCOUNT := RESULT.(0:8);                             <<04573>>07670000
         UNLOCKJIR(A);  GO FIX;  << WRONG NAME IN WORK AREA >>          07675000
         END;                                                           07680000
       << AM IN SPLIT STACK MODE WITH STACK AT JDT DST  >>     <<04573>>07685000
   <<                                                       >> << 8498>>07690000
   << This is where we add the new entry to the table.  By  >> << 8498>>07695000
   << now, we have the new entry's size in the JDT work     >> << 8498>>07700000
   << area and we have the size of the packed formal        >> << 8498>>07705000
   << formal designator in the JDT work area.  SIZE is the  >> << 8498>>07710000
   << length (in words) of the information (INFO) that will    << 8498>>07715000
   << be stored in the new entry.                           >> << 8498>>07720000
   <<                                                       >> << 8498>>07725000
   I := JDTWORKSPC.(8:8);   <<NAME SIZE>>                      <<U.RAO>>07730000
   I := SIZE + I + 1;   <<NEW ENTRY SIZE>>                              07735000
   JDTWORKSPC.(0:8) := I;   <<STORE ENTRY SIZE IN WORK AREA>>  <<U.RAO>>07740000
SEG:                                                                    07745000
   << Now determine if we can expand the JDT by the newly   >> << 8498>>07750000
   << computed length of the new entry (I).                 >> << 8498>>07755000
   << SEGSIZE is gotten from the DST table.                 >> << 8498>>07760000
   << The JDT free space area is at the tail of the JDT.  J >> << 8498>>07765000
   << is the number of extra words needed to fit the new    >> << 8498>>07770000
   << entry after the number of words in the free space area>> << 8498>>07775000
   << is computed (SEGSIZE - JFREESPCADR).  If there is no  >> << 8498>>07780000
   << room, exit the procedure with ADDJTENTRY=1.           >> << 8498>>07785000
   SEGSIZE := (SYS'DST(PXGJDT&LSL(2)).(3:13))&LSL(2)-1;                 07790000
   J := I - (SEGSIZE-JFREESPCADR);   <<#EXTRA WORDS NEEDED>>   <<U.RAO>>07795000
   IF (SEGSIZE+J) > JDTARR THEN                                <<U.RAO>>07800000
      BEGIN   <<NO MORE ROOM>>                                          07805000
NMR:                                                                    07810000
      ADDJTENTRY := 1;                                                  07815000
      GO EXIT;                                                          07820000
      END;                                                              07825000
   IF J > 0 THEN                                                        07830000
      BEGIN   <<INCREASE SEG.SIZE>>                                     07835000
      ALTDSEGSIZE(PXGJDT,J);                                            07840000
      IF <> THEN                                                        07845000
         GO NMR;   <<NO MORE ROOM>>                                     07850000
      END;                                                              07855000
                                                               << 8498>>07860000
   << If TNo = 2, then the Temporary file table is being     >><< 8498>>07865000
   << updated.  We want to put it into the table in order    >><< 8498>>07870000
   << Find entry index where new entry should be placed      >><< 8498>>07875000
   << We attempt to place the entries in sorted order.  The  >><< 8498>>07880000
   << procedure DETERMINE returns a JDT relative index of    >><< 8498>>07885000
   << where the new entry should be placed in the table.  The>><< 8498>>07890000
   << order is first by account, then by group and then by   >><< 8498>>07895000
   << file name.  There will be no collisions since any      >><< 8498>>07900000
   << dupilcates would be been removed by now (depending upon>><< 8498>>07905000
   << if ADDJTENTRY was called from XADDJTENTRY or not).     >><< 8498>>07910000
                                                               << 8498>>07915000
   IF TNO <> 2                                                 << 8498>>07920000
      THEN ENTRY'I := JDTARR( TNO + 1 )                        << 8498>>07925000
      ELSE ENTRY'I := GET'ORDERED'INDEX( N1, N2, N3, TNO,      << 8498>>07930000
                                                 PXGJDT   );   << 8498>>07935000
                                                               << 8498>>07940000
   << Now we move an entire part of the JDT, from the index  >><< 8498>>07945000
   << ENTRY'I to the end of the last table in the JDT (the   >><< 8498>>07950000
   << last word before the start of the freespace area), down>><< 8498>>07955000
   << I words.                                               >><< 8498>>07960000
                                                               << 8498>>07965000
    <<MOVE PART OF DATA  DOWN TO FIT NEW ENTRY>>                        07970000
   TOS := JFREESPCADR + I - 1;   <<TARGET>>                    <<U.RAO>>07975000
   TOS := JFREESPCADR - 1;   <<SOURCE>>                        <<U.RAO>>07980000
   TOS := ENTRY'I-JFREESPCADR;  << Will be a negative value >> << 8498>>07985000
   ASSEMBLE(MOVE 3);                                                    07990000
                                                               << 8498>>07995000
   << Now we move the new entry from the JDT work area to   >> << 8498>>08000000
   << its new index ENTRY'I.  It will fit since we just made>> << 8498>>08005000
   << room for its I words of length.                       >> << 8498>>08010000
                                                               << 8498>>08015000
    <<MOVE ENTRY SIZE, NAME SIZE & NAME INTO NEW ENTRY>>                08020000
   TOS := ENTRY'I; << Target where new entry will be placed >> << 8498>>08025000
   TOS := @JDTWORKSPC;                                         <<U.RAO>>08030000
   TOS := JDTWORKSPC.(8:8) + 1;   <<#WORDS (NAME SIZE+1 FOR "SI<<U.RAO>>08035000
   ASSEMBLE(MOVE 2);                                                    08040000
                                                               << 8498>>08045000
   << Now move the INFO into the new entry (in TOS)        >>  << 8498>>08050000
                                                               << 8498>>08055000
   @SAVETOS := TOS;  <<SAVE TARGET ADDRESS, BEGINNING OF >>    <<04573>>08060000
                     <<INFO STRING                       >>    <<04573>>08065000
   TOS := @SAVETOS;  <<PUT TARGET BACK, MOVE INFO IN     >>    <<04573>>08070000
   TOS := @INFO - SAVEDL;   <<DL-REL.SOURCE ADR.>>                      08075000
   TOS := SIZE;   <<WORD COUNT (POSITIVE)>>                             08080000
   ASSEMBLE(MVLB 3);   <<DL+ TO DB+ MOVE>>                              08085000
                                                               << 8498>>08090000
   << If the entry was added to the File Equation Table    >>  << 8498>>08095000
   << update its reference count.  It was saved earlier in >>  << 8498>>08100000
   << case the new entry was a duplicate of a previous one >>  << 8498>>08105000
                                                               << 8498>>08110000
   IF TNO = 3 THEN  << Reference count only in JFEQ. >>        <<04906>>08115000
   BEGIN                                                       <<04906>>08120000
      UPPERINFO := SAVETOS(2).(0:8); <<ACTUAL DESIG. LENGTH >> <<04906>>08125000
      LOWERINFO := SAVETOS(2).(8:8); <<DEVICE LENGTH        >> <<04906>>08130000
      ACTUALDEVLEN := (UPPERINFO + LOWERINFO + 1)&LSR(1);      <<04906>>08135000
      INFOREFINDEX := 12 + ACTUALDEVLEN; <<REF COUNT INDEX>>   <<04906>>08140000
      SAVETOS(INFOREFINDEX).(0:6) := REFCOUNT.(10:6);          <<04906>>08145000
   END;                                                        <<04906>>08150000
                                                               << 8498>>08155000
   << Now Whirl through the pointers to the tables and     >>  << 8498>>08160000
   << adjust their pointers by I words.  (only if their    >>  << 8498>>08165000
   << pointers are below ENTRY'I, the spot where the new   >>  << 8498>>08170000
   << entry was added.                                     >>  << 8498>>08175000
                                                               << 8498>>08180000
   J := IF TNO=0 THEN 1 ELSE TNO;                                       08185000
   WHILE (J:=J+1) <= NUMJDTPTRS DO                             <<U.RAO>>08190000
      BEGIN   <<INCREASE STARTING ADDRESSES OF SUBSEQUENT TABLES>>      08195000
      JDTARR(J) := JDTARR(J)+I;                                <<U.RAO>>08200000
      END;                                                              08205000
   GO EXIT;                                                             08210000
END;   <<ADDJTENTRY>>                                                   08215000
                                                                        08220000
                                                                        08225000
INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO,                   08230000
                                           XN1,XN2,XN3);                08235000
    VALUE SIZE,TNO;                                                     08240000
    INTEGER SIZE,TNO;                                                   08245000
    BYTE ARRAY N1,N2,N3,XN1,XN2,XN3;                                    08250000
    INTEGER ARRAY INFO;                                                 08255000
OPTION PRIVILEGED, UNCALLABLE;                                          08260000
         <<ADD ENTRY N1,N2,N3 TO JOB-TABLE                            >>08265000
         <<INCREMENT REFERENCE COUNT IN EXISTING ENTRY XN1,XN2,XN3    >>08270000
         <<TNO = TABLE # (1,2 OR 3) (INPUT)                           >>08275000
         <<SIZE = #WORDS OF INFO (INPUT)                              >>08280000
         <<INFO = ARRAY OF INFORMATION (INPUT)                        >>08285000
         <<XADDJTENTRY:= 0 - EVERYTHING OK                            >>08290000
         <<           := 1 - NO ROOM FOR NEW ENTRY N1,N2,N3           >>08295000
         <<           := 2 - DUPLICATE NAME N1,N2,N3                  >>08300000
         <<           := 3 - NO SUCH ENTRY XN1,XN2,XN3                >>08305000
         <<           := 4 - REFERENCE COUNT OVERFLOW                 >>08310000
         <<           := 5 - CIRCULAR LIST                  >> <<00834>>08315000
        << TNO = 1 - Data Segment Table                      >><< 8498>>08320000
        << TNO = 2 - Temporary File Table                    >><< 8498>>08325000
        << TNO = 3 File Equation Table                       >><< 8498>>08330000
   BEGIN                                                                08335000
   INTEGER ARRAY                                               <<U.RAO>>08340000
         IN1(0:17)=Q                                                    08345000
        ,LHS(0:12)   <<CRUNCHED LHS>>                                   08350000
        ,CHAINEL(0:12)   <<CRUNCHED RHS CHAIN ELEMENT>>                 08355000
   ;BYTE ARRAY                                                          08360000
         BN1(*) = IN1                                                   08365000
        ,BLHS(*) = LHS                                                  08370000
        ,BCHAINEL(*) = CHAINEL                                          08375000
   ;INTEGER                                                             08380000
         K                                                              08385000
        ,ABSTNO   <<ABS(TNO)>>                                          08390000
        ,RHSADR   <<ADR.OF RHS(XN1,XN2,XN3) IN TABLE>>                  08395000
        ,ADRIN1   <<ADR OF IN1(*)>>                                     08400000
        ,SAVEDL                                                         08405000
        ,BN2,BN3                                                        08410000
        ,NWDS   <<FOR COMPARE>>                                         08415000
   ;INTEGER                                                             08420000
        I,J                                                             08425000
        ,PXGJDT   <<TABLE DST #>>                                       08430000
   ;LOGICAL                                                             08435000
         A   <<LOCKJIR RETURN VALUE (NOT USED)>>                        08440000
        ,ERROR := FALSE                                                 08445000
        ,B   <<LOCKJIR RETURN VALUE>>                                   08450000
   ;                                                                    08455000
   ADRIN1 := @IN1;                                                      08460000
   PUSH(DL);                                                            08465000
   SAVEDL := TOS;                                                       08470000
   ABSTNO := IF TNO>0 THEN TNO ELSE -TNO;                               08475000
   B := LOCKJIR;                                                        08480000
<< look for existing entry name tghat has been referenced  >>  <<06288>>08485000
<< to by entry being added.                                >>  <<06288>>08490000
<< FINDJTENTRY leaves DB at JDT DST.                       >>  <<06288>>08495000
                                                               <<06288>>08500000
   RHSADR := I := FINDJTENTRY(XN1,XN2,XN3,ABSTNO,A,PXGJDT);             08505000
   IF I=0 THEN                                                          08510000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 08515000
      XADDJTENTRY := 3;   <<NO SUCH ENTRY>>                             08520000
EXIT1:                                                                  08525000
      EXCHANGEDB(0);                                                    08530000
EXIT: UNLOCKJIR(B);                                                     08535000
      IF ERROR THEN REMJTENTRY(N1,N2,N3,ABSTNO,0);                      08540000
      RETURN;                                                           08545000
      END;                                                              08550000
   EXCHANGEDB(0);                                                       08555000
   CRUNCH(N1,N2,N3,LHS,NWDS);   <<CRUNCH LHS>>                          08560000
   J := FINDJTENTRY(N1,N2,N3,ABSTNO,A,PXGJDT);                          08565000
   IF J=0 THEN GO RHSOK;                                                08570000
   IF I=J THEN                                                          08575000
      BEGIN   <<ERROR, N POINTING AT XN>>                               08580000
      XADDJTENTRY := 3;                                                 08585000
      GO EXIT1;                                                         08590000
      END;                                                              08595000
NEXT:                                                                   08600000
   K := I+JDTARR(I).(8:8)+2;   <<INDEX OF 2ND WORD OF INFO>>   <<U.RAO>>08605000
   IF JDTARR(K).(6:1) = 0 THEN GO RHSOK;   <<NO MORE POINTERS>><<U.RAO>>08610000
   J := JDTARR(K+1).(0:8);   <<SIZE (BYTES) OF NAME IN INFO>>  <<U.RAO>>08615000
   TOS := ADRIN1 - SAVEDL;   <<DL-REL TARGET>>                          08620000
   TOS := K+2;   <<DL-REL SOURCE>>                                      08625000
   TOS := (J+1)&LSR(1);   <<WORD COUNT>>                                08630000
   ASSEMBLE (MVBL 3);   <<MOVE INFO NAME TO LOCAL ARRAY>>               08635000
   EXCHANGEDB(0);                                                       08640000
   PACKANDPOINT(BN1,J,BN2,BN3);                                         08645000
   BN1 (J) := " ";                                                      08650000
   CRUNCH(BN1,BN2,BN3,CHAINEL,NWDS);   <<CRUNCH RHS CHAIN ELEMENT>>     08655000
   TOS := @BLHS;   <<TARGET>>                                           08660000
   TOS := @BCHAINEL;   <<SOURCE>>                                       08665000
   TOS := NWDS&LSL(1);   <<BYTE COUNT>>                                 08670000
   ASSEMBLE(CMPB 3);                                                    08675000
   IF = THEN                                                            08680000
      BEGIN   <<ERROR, CIRCULAR LINK LIST>>                             08685000
      XADDJTENTRY := 5;                                        <<00834>>08690000
      GO EXIT;                                                          08695000
      END;                                                              08700000
   I := FINDJTENTRY(BN1,BN2,BN3,ABSTNO,A,PXGJDT);                       08705000
   IF I=0 THEN SUDDENDEATH(501);   <<POINTER TO NON-EXISTENT ENTRY>>    08710000
   GO NEXT;                                                             08715000
RHSOK:   <<NO LOOPS, RHS ENTRY EXISTS>>                                 08720000
   EXCHANGEDB(0);                                                       08725000
   I := ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                             08730000
   IF I<>0 THEN                                                         08735000
      BEGIN   <<ERROR>>                                                 08740000
      XADDJTENTRY := I;                                                 08745000
      ERROR := TRUE;                                                    08750000
      GO EXIT;                                                          08755000
      END;                                                              08760000
   J := FINDJTENTRY(XN1,XN2,XN3,ABSTNO,A,PXGJDT);                       08765000
<< J = index of entry in JDT.                              >>  <<06288>>08770000
<< DB is at JDT DST.                                       >>  <<06288>>08775000
<< I = index to second word of INFO string.                >>  <<06288>>08780000
   I := J + JDTARR(J).(8:8) + 2;                               <<U.RAO>>08785000
<< make I index to name-actual designator.                 >>  <<06288>>08790000
<< J := name lengtrh + device name length                  >>  <<06288>>08795000
     I:=I+1;                                                   <<FORMS>>08800000
     J:=(JDTARR(I).(0:8)+1)&LSR(1)                                      08805000
     +(JDTARR(I).(8:8)+1)&LSR(1);                                       08810000
<< I = index to reference count word.                      >>  <<06288>>08815000
     I:=(I+J+10);                                              <<FORMS>>08820000
   IF (J:=JDTARR(I).(0:6)) = 63 THEN                           <<U.RAO>>08825000
      BEGIN   <<REFERENCE COUNT OVERFLOW>>                              08830000
      XADDJTENTRY := 4;                                                 08835000
      ERROR := TRUE;                                                    08840000
      GO EXIT1;                                                         08845000
      END;                                                              08850000
   JDTARR(I).(0:6) := J+1;   <<INC.REF.COUNT>>                 <<U.RAO>>08855000
   GO EXIT1;                                                            08860000
   END;   <<XADDJTENTRY>>                                               08865000
                                                                        08870000
                                                                        08875000
INTEGER PROCEDURE XJDT(FUNC,ID,DSTNO);                                  08880000
    VALUE FUNC,ID,DSTNO;                                                08885000
    INTEGER FUNC,ID,DSTNO;                                              08890000
   OPTION PRIVILEGED, UNCALLABLE;                                       08895000
         <<PROCEDURE TO MAINTAIN TABLE #1 OF JOB TABLES.              >>08900000
         <<ID - NAME OF ENTRY (1 WORD, NOT IN STANDARD FORM).         >>08905000
         <<DSTNO - DATA SEGMENT TABLE # ASSOCIATED WITH "ID" IN TABLE.>>08910000
         <<FUNC = 0 - SEARCH: USE ID TO FIND ENTRY (DSTNO NOT USED).  >>08915000
         <<           IF ENTRY EXISTS, RETURN XJDT=DST#(3RD WORD),    >>08920000
         <<           INCREMENT REF (4TH WORD). IF ENTRY DOES NOT     >>08925000
         <<           EXIST, RETURN XJDT=0.                           >>08930000
         <<FUNC = 1 - PUT: USE ID TO FIND ENTRY. IF ENTRY EXISTS,     >>08935000
         <<           RETURN XJDT=DST# (3RD WORD), INCREMENT REF (4TH >>08940000
         <<           WORD). IF ENTRY DOES NOT EXIST, ADD NEW ENTRY   >>08945000
         <<           (ID,DSTNO,REF=1), RETURN XJDT=0. IF INSUFFICIENT>>08950000
         <<           ROOM FOR NEW ENTRY, RETURN XJDT=-1.             >>08955000
         <<FUNC = 2 - RELEASE: IF ID<>0, THEN USE ID TO FIND ENTRY. IF>>08960000
         <<           ID=0, THEN USE DSTNO TO FIND ENTRY. IF ENTRY    >>08965000
         <<           CANNOT BE FOUND, THEN RETURN XJDT=0. IF ENTRY IS>>08970000
         <<           FOUND AND 3RD WORD (DST#) = DSTNO THEN DECREMENT>>08975000
         <<           REFERENCE COUNT, RETURN XJDT=ORIGINAL REF. IF   >>08980000
         <<           REF GOES TO ZERO, THEN DELETE ENTRY.            >>08985000
         <<FUNC = 3 - DESTROY: RETURN XJDT=0 IF TABLE IS EMPTY.       >>08990000
         <<           OTHERWISE FIND LAST ENTRY IN TABLE,             >>08995000
         <<           SET XJDT=DST# (3RD WORD) AND DELETE THE ENTRY.  >>09000000
         <<FUNC = 4 - RELEASE: SAME AS FUNC=2, EXCEPT DON'T>>  <<00428>>09005000
         <<           DELETE ENTRY IF REF GOES TO 0.       >>  <<00428>>09010000
         <<NOTE: UPON ENTRY, DB MUST BE POINTING TO THE STACK.        >>09015000
   BEGIN                                                                09020000
    INTEGER ARRAY                                                       09025000
        DUMMY(0:2)=Q   <<ID,DSTNO,REF>>                        <<U.RAO>>09030000
   ;BYTE ARRAY                                                          09035000
         BDUMMY(*) = DUMMY                                              09040000
   ;INTEGER                                                             09045000
         PXGJDT     <<JDT DST#>>                               <<U.RAO>>09050000
        ,I,J,K,L                                                        09055000
   ;LOGICAL                                                             09060000
         A   <<GETSIR RETURN VALUE (NOT USED)>>                         09065000
        ,B   <<LOCKJIR RETURN VALUE>>                                   09070000
   ;                                                                    09075000
   XJDT := 0;                                                           09080000
   B := LOCKJIR;                                                        09085000
   FINDJTENTRY(J,J,J,0,A,PXGJDT);   <<DUMMY CALL>>                      09090000
   I := JDSDADR;   <<STARTING ADR.OF TABLE #1>>                <<U.RAO>>09095000
   J := JTFDADR;   <<STARTING ADR.OF TABLE #2>>                <<U.RAO>>09100000
   IF FUNC = 3 THEN                                                     09105000
      BEGIN   <<DESTROY>>                                               09110000
      IF I=J THEN                                                       09115000
         BEGIN   <<NO ENTRIES LEFT>>                                    09120000
         XJDT := 0;                                                     09125000
EXIT1:   EXCHANGEDB(0);                                                 09130000
EXIT2:   UNLOCKJIR(B);                                                  09135000
         RETURN;                                                        09140000
         END;                                                           09145000
       <<DELETE LAST ENTRY & RETURN DST# (3RD WORD)>>                   09150000
      J := J-4;                                                         09155000
      XJDT := JDTARR(J+2);   <<DST #>>                         <<U.RAO>>09160000
      EXCHANGEDB(0);                                                    09165000
      REMJTENTRY(J,J,J,1,J);                                            09170000
      GO EXIT2;                                                         09175000
      END;                                                              09180000
   IF (FUNC=2 OR FUNC=4) AND ID=0 THEN                         <<00428>>09185000
      BEGIN   <<SEARCH ON DSTNO>>                                       09190000
      K := 2;                                                           09195000
      L := DSTNO;                                                       09200000
      END                                                               09205000
   ELSE                                                                 09210000
      BEGIN   <<SEARCH ON ID>>                                          09215000
      K := 1;                                                           09220000
      L := ID;                                                          09225000
      END;                                                              09230000
   I := I+K;                                                            09235000
   WHILE I<J DO                                                         09240000
      BEGIN   <<CYCLE ON ENTRY>>                                        09245000
      IF JDTARR(I) = L THEN                                    <<U.RAO>>09250000
         BEGIN                                                          09255000
         I := I-K;   <<POINT TO 1ST WORD>>                              09260000
         GO FOUND;                                                      09265000
         END;                                                           09270000
      I := I+4;                                                         09275000
      END;                                                              09280000
    <<ENTRY CANNOT BE FOUND>>                                           09285000
   IF FUNC <> 1 THEN                                                    09290000
      GO EXIT1;                                                         09295000
    <<ADD ENTRY>>                                                       09300000
   EXCHANGEDB(0);                                                       09305000
   DUMMY := ID;                                                         09310000
   DUMMY(1) := DSTNO;                                                   09315000
   DUMMY(2) := 1;   <<REF.COUNT>>                                       09320000
   I := ADDJTENTRY(BDUMMY,J,J,0,2,DUMMY(1));   <<SPECIAL CALL>>         09325000
   IF I=1 THEN                                                          09330000
      XJDT := -1;   <<NO ROOM>>                                         09335000
   GO EXIT2;                                                            09340000
FOUND:                                                                  09345000
    <<NOTE: I=INDEX OF 1ST WORD OF ENTRY>>                              09350000
   IF FUNC < 2 THEN                                                     09355000
      BEGIN   <<"SEARCH" OR "PUT">>                                     09360000
      XJDT := JDTARR(I+2);   <<DST #>>                         <<U.RAO>>09365000
      JDTARR(I+3) := JDTARR(I+3)+1;   <<INC.REF.COUNT>>        <<U.RAO>>09370000
      GO EXIT1;                                                         09375000
      END;                                                              09380000
    <<FUNC=2 OR 4 - "RELEASE">>                                <<00428>>09385000
   IF DSTNO = JDTARR(I+2) THEN                                 <<U.RAO>>09390000
      BEGIN                                                             09395000
      XJDT := J := JDTARR(I+3);   <<ORIGINAL REF.COUNT>>       <<U.RAO>>09400000
      << DECREMENT REF COUNT IN JDT AND REMOVE ENTRY FROM >>   <<00428>>09405000
      << JDT ONLY IF COUNT = 0 AND FUNC = 2.              >>   <<00428>>09410000
      IF (JDTARR(I+3) := J-1) = 0 AND FUNC = 2 THEN            <<00428>>09415000
         BEGIN   <<REMOVE ENTRY>>                                       09420000
         EXCHANGEDB(0);                                                 09425000
         REMJTENTRY(J,J,J,1,I);                                         09430000
         GO EXIT2;                                                      09435000
         END;                                                           09440000
      END;                                                              09445000
   GO EXIT1;                                                            09450000
   END;   <<PROCEDURE XJDT>>                                            09455000
                                                                        09460000
                                                                        09465000
INTEGER PROCEDURE CSJTENTRYLOC(LINEGROUP,ENTRYSIZE,TNO,DSTNO,           09470000
    JIR);                                                               09475000
    VALUE TNO;                                                          09480000
    BYTE ARRAY LINEGROUP;                                               09485000
    INTEGER ENTRYSIZE,TNO,DSTNO;                                        09490000
    LOGICAL JIR;                                                        09495000
   OPTION PRIVILEGED,UNCALLABLE;                                        09500000
         <<PROCEDURE TO DETERMINE IF CS ENTRIES EXIST                 >>09505000
         <<LINEGROUP - NAME OF LINE OR GROUP                          >>09510000
         <<ENTRYSIZE - SIZE OF ENTRY (WORDS), IF FOUND                >>09515000
         <<TNO - TABLE NUMBER: 4 = LINE TABLE, 5 = GROUP TABLE        >>09520000
         <<DSTNO - DATA SEGMENT TABLE NUMBER OF JDT                   >>09525000
   BEGIN                                                                09530000
    LOGICAL                                                             09535000
         A   <<REDUNDANT LOCKJIR RETURN VALUE>>                         09540000
        ,B   <<LOCKJIR RETURN VALUE>>                                   09545000
    ;INTEGER ARRAY                                                      09550000
        IN1(0:3) = Q   <<LOCAL ARRAY FOR STORING NAMES>>       <<U.RAO>>09555000
    ;INTEGER                                                            09560000
         I,K                                                            09565000
        ,SAVEDL                                                         09570000
        ,ADRIN1   <<DL - REL. ADDR. OF IN1(*)>>                         09575000
    ;                                                                   09580000
    BYTE ARRAY N2(0:1),N3(*)=N2,BN1(*)=IN1;                             09585000
    PUSH(DL);                                                           09590000
    SAVEDL _ TOS;                                                       09595000
    ADRIN1 _ @IN1;                                                      09600000
    N2 _ " ";                                                           09605000
    I _ FINDJTENTRY(LINEGROUP,N2,N3,TNO,B,DSTNO);                       09610000
<< DB is at the JDT DST now >>                                 <<06288>>09615000
    WHILE I<>0                                                 <<U.RAO>>09620000
<< look at reference count bit from the PMASK word 2.      >>  <<06288>>09625000
      AND LOGICAL(JDTARR(K:=I+JDTARR(I).(8:8)+2).(6:1)) DO     <<U.RAO>>09630000
       BEGIN                                                            09635000
       TOS _ ADRIN1 - SAVEDL;                                           09640000
       TOS _ K+2;                                                       09645000
       TOS _ 4;   <<SIZE OF NAME (WORDS)>>                              09650000
       ASSEMBLE(MVBL);                                                  09655000
       EXCHANGEDB(0);                                                   09660000
       I _ FINDJTENTRY(BN1,N2,N3,TNO,A,DSTNO);                          09665000
<< DB is at the JDT DST now >>                                 <<06288>>09670000
       END;                                                             09675000
    IF (CSJTENTRYLOC _ I) <> 0 THEN                                     09680000
       BEGIN                                                            09685000
       I := JDTARR(I)&LSR(8);                                  <<U.RAO>>09690000
       K _ B;                                                           09695000
       END ELSE UNLOCKJIR(B);                                           09700000
    EXCHANGEDB(0);                                                      09705000
    ENTRYSIZE _ I;                                                      09710000
    JIR _ K;                                                            09715000
END <<CSJTENTRYLOC>>;                                                   09720000
INTEGER PROCEDURE RETPMASK(N1,N2,N3,PMASKHI,PMASKLO);                   09725000
LOGICAL PMASKHI,PMASKLO;                                                09730000
BYTE ARRAY N1,N2,N3;                                                    09735000
OPTION PRIVILEGED,UNCALLABLE;                                           09740000
<<                                                   >>                 09745000
<<  PROCEDURE TO OBTAIN INFORMATION CONCERNING WHICH >>                 09750000
<<  PARAMETERS A USER HAS SPECIFIED IN A FILE        >>                 09755000
<<  EQUATION                                         >>                 09760000
<<                                                   >>                 09765000
<<  INPUT: N1,N2,N3  FILE NAME IN STANDARD FORMAT    >>                 09770000
<<                                                   >>                 09775000
<<  OUTPUT: PMASKHI = FIRST WORD OF PMASK PARAMETER  >>                 09780000
<<                    IN FILE EQUATION TABLE ENTRY   >>                 09785000
<<          PMASKLO = REMAINING BITS OF PMASK        >>                 09790000
<<                                                   >>                 09795000
<<          RETPMASK= 0 OK                           >>                 09800000
<<                  = 1 ENTRY NOT FOUND              >>                 09805000
<<                                                   >>                 09810000
<<                                                   >>                 09815000
<<  FORMAT OF PMASKHI :                              >>                 09820000
<<       BIT 0    BLOCKFACTOR                        >>                 09825000
<<           1    RECSIZE                            >>                 09830000
<<           2    DISPOSITION                        >>                 09835000
<<           3    NUMBUFFERS                         >>                 09840000
<<           4    INHIBIT BUFFERING                  >>                 09845000
<<           5    EXCLUSIVE                          >>                 09850000
<<           6    MULTI-RECORD                       >>                 09855000
<<           7    ACCESS TYPE                        >>                 09860000
<<           8    COPY/NOCOPY                        >>        <<02557>>09865000
<<           9    CARRIAGE CONTROL                   >>                 09870000
<<          10    RECORD FORMAT                      >>                 09875000
<<          11    DEFAULT DESIGNATION                >>                 09880000
<<          12    ASCII/BINARY                       >>                 09885000
<<          13    DOMAIN                             >>                 09890000
<<          14    DEVICE                             >>                 09895000
<<          15    NAME                               >>                 09900000
<<                                                   >>                 09905000
<<  FORMAT OF PMASKLO:                               >>                 09910000
<<       BIT   0   FILE TYPE                         >>        <<02557>>09915000
<<             1   LABELLED TAPE                     >>        <<02557>>09920000
<<             2   FORMS MESSAGE                     >>                 09925000
<<             3   USER LABELS                       >>                 09930000
<<             4   RESERVED FOR NATIVE LANGUAGE      >>        << 8498>>09935000
<<             5   RESERVED FOR ADVANCED NET (VTERM) >>        << 8498>>09940000
<<             6   THIS IS A BACK REFERENCE ENTRY    >>                 09945000
<<             7   DYNAMIC LOCKING                   >>                 09950000
<<             8   WAIT/NOWAIT                       >>                 09955000
<<             9   MULTI-ACCESS                      >>                 09960000
<<            10   NUMCOP                            >>                 09965000
<<            11   OUTPRI                            >>                 09970000
<<            12   FILECODE                          >>                 09975000
<<            13   FILESIZE                          >>                 09980000
<<            14   NUMEXTS                           >>                 09985000
<<            15   INIT ALLOC                        >>                 09990000
<<                                                   >>                 09995000
<< IF BIT = 1, THEN USER SPECIFIED THE PARAMETER IN  >>                 10000000
<<            IN A FILE EQUATION                     >>                 10005000
<<                                                   >>                 10010000
<<            USED BY IMAGE/3000                     >>                 10015000
<<                                                   >>                 10020000
<<                                                   >>                 10025000
                                                                        10030000
BEGIN                                                                   10035000
INTEGER SIZE;                                                           10040000
INTEGER ARRAY INFO(0:255);                                              10045000
                                                                        10050000
SIZE := 3;                                                              10055000
IF (RETPMASK := RETJTENTRY(N1,N2,N3,SIZE,INFO))  = 0      THEN          10060000
  BEGIN                                                                 10065000
  PMASKHI := INFO;                                                      10070000
  PMASKLO := INFO(1);                                                   10075000
  END;                                                                  10080000
END;                                                                    10085000
INTEGER PROCEDURE XRETPMASK(N1,N2,N3,PMASKHI,PMASKLO);         <<02557>>10090000
   LOGICAL PMASKHI,PMASKLO;                                    <<02557>>10095000
   BYTE ARRAY N1,N2,N3;                                        <<02557>>10100000
   OPTION PRIVILEGED,UNCALLABLE;                               <<02557>>10105000
                                                               <<02557>>10110000
COMMENT                                                        <<02557>>10115000
                                                               <<02557>>10120000
   Procedure to obtain information concerning which parameters <<02557>>10125000
a user has specified in a file equation.  Unlike RETPMASK, it  <<02557>>10130000
traces down the pointer file equations until it reaches the end<<02557>>10135000
of the chain.                                                  <<02557>>10140000
                                                               <<02557>>10145000
INPUT:  N1,N2,N3 -- File name in standard format               <<02557>>10150000
                                                               <<02557>>10155000
OUTPUT: PMASKHI  -- First word of PMASK parameter in file      <<02557>>10160000
                    equation table entry.                      <<02557>>10165000
        PMASKLO  -- Remaining bits of PMASK.                   <<02557>>10170000
                                                               <<02557>>10175000
        RETPMASK  = 0, OK                                      <<02557>>10180000
                  = 1, Entry not found                         <<02557>>10185000
                  = 2, An entry points to a non-existent entry <<02557>>10190000
                                                               <<02557>>10195000
The PMASK bit definitions are the same as those listed in      <<02557>>10200000
the header comment for RETPMASK.                               <<02557>>10205000
                                                               <<02557>>10210000
;   << end of comment >>                                       <<02557>>10215000
                                                               <<02557>>10220000
BEGIN                                                          <<02557>>10225000
INTEGER                                                        <<02557>>10230000
   NAMESIZE,   << Length of formal name in words >>            <<02557>>10235000
   SIZE;       << Return from XRETJTENTRY >>                   <<02557>>10240000
INTEGER ARRAY                                                  <<02557>>10245000
   INFO(0:255);  << File equation entry returned >>            <<02557>>10250000
                                                               <<02557>>10255000
   IF (XRETPMASK := XRETJTENTRY(N1,N2,N3,SIZE,INFO)) = 0 THEN  <<02557>>10260000
      BEGIN                                                    <<02557>>10265000
      NAMESIZE := INFO.(8:8);                                  <<02557>>10270000
      PMASKHI := INFO(NAMESIZE + 1);                           <<02557>>10275000
      PMASKLO := INFO(X + 1);                                  <<02557>>10280000
      END;                                                     <<02557>>10285000
                                                               <<02557>>10290000
END;   << of XRETJTENTRY >>                                    <<02557>>10295000
LOGICAL PROCEDURE SEARCHJCW(GOAL, JCWADR, JCWVALUE);           <<U.RAO>>10300000
BYTE ARRAY GOAL;                                               <<U.RAO>>10305000
INTEGER JCWADR,JCWVALUE;                                       <<U.RAO>>10310000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>10315000
BEGIN                                                          <<U.RAO>>10320000
<<THIS PROCEDURE SEARCHES THE JCW TABLE IN THE JDT FOR  >>     <<U.RAO>>10325000
<<THE ID "GOAL".                                        >>     <<U.RAO>>10330000
<<INPUT:  GOAL - A BYTE ARRAY CONTAINING THE NAME OF THE>>     <<U.RAO>>10335000
<<      DESIRED JCW, WITH BYTE 0 BEING THE LENGTH.      >>     <<U.RAO>>10340000
<<      OF THE NAME.                                    >>     <<U.RAO>>10345000
<<OUTPUT: SEARCHJCW - TRUE IF FOUND IN TABLE ELSE FALSE >>     <<U.RAO>>10350000
<<   JCWADR - IF SEARCH WAS SUCCESSFUL, WORD OFFSET TO  >>     <<U.RAO>>10355000
<<            START OF ENTRY FROM START OF JDT.         >>     <<U.RAO>>10360000
<<   JCWVALUE - IF SEARCH WAS SUCCESSFUL, ACTUAL VALUE  >>     <<U.RAO>>10365000
<<            OF JCW.                                   >>     <<U.RAO>>10370000
<<METHOD IS A STRAIGHTFORWARD LOOP THROUGH THE TABLE.   >>     <<U.RAO>>10375000
INTEGER JDTDST;   <<HOLDS JDT DST NUMBER>>                     <<U.RAO>>10380000
DOUBLE JCWTABLIMITS;  <<BOUNDS ON JCW PART OF JDT>>            <<U.RAO>>10385000
INTEGER NEXTJCWADR = JCWTABLIMITS;  <<ADDRESS OF NEXT ENTRY>>  <<U.RAO>>10390000
INTEGER JCWTABEND = JCWTABLIMITS+1; <<ADDRESS OF END OF TABLE>><<U.RAO>>10395000
INTEGER ARRAY CANDIDATEW(0:128);  <<LOCAL COPY FOR SEARCH>>    <<U.RAO>>10400000
BYTE ARRAY CANDIDATE(*) = CANDIDATEW;                          <<U.RAO>>10405000
ARRAY QARRAY(*) = Q + 0;                                       <<06595>>10410000
INTEGER PCBGLOBLOC;                                            <<06595>>10415000
SEARCHJCW := FALSE;                                            <<U.RAO>>10420000
PXGLOBAL;                                                      <<06595>>10425000
JDTDST := PXG'JDTDST;                                          <<06595>>10430000
<<FIRST GET BOUNDS ON JCW TABLE>>                              <<U.RAO>>10435000
TOS := @JCWTABLIMITS;                                          <<U.RAO>>10440000
TOS := JDTDST;                                                 <<U.RAO>>10445000
TOS := @JJCWADR;                                               <<U.RAO>>10450000
TOS := 2;                                                      <<U.RAO>>10455000
ASSEMBLE(MFDS);                                                <<U.RAO>>10460000
<<NEXT DO LOOP THROUGH JCW TABLE>>                             <<U.RAO>>10465000
WHILE NEXTJCWADR < JCWTABEND DO                                <<U.RAO>>10470000
   BEGIN                                                       <<U.RAO>>10475000
   <<STRATEGY IS 1) MAKE LOCAL COPY FROM TABLE, >>             <<U.RAO>>10480000
   << 2) COMPARE CANDIDATE WITH GOAL, >>                       <<U.RAO>>10485000
   << 3) IF HIT, RETURN VALUES ELSE UPDATE NEXTJCWADR>>        <<U.RAO>>10490000
   TOS := @CANDIDATEW;                                         <<U.RAO>>10495000
   TOS := JDTDST;                                              <<U.RAO>>10500000
   TOS := NEXTJCWADR;  <<SOURCE ADDRESS IN JDT>>               <<U.RAO>>10505000
   <<NEXT WE STACK TRANSFER COUNT.  IT IS THE MIN OF>>         <<U.RAO>>10510000
   <<THE SPACE LEFT IN THE TABLE OR 129>>                      <<U.RAO>>10515000
   IF JCWTABEND-NEXTJCWADR > 129 THEN                          <<U.RAO>>10520000
      TOS := 129  <<MAX POSSIBLE ENTRY SIZE>>                  <<U.RAO>>10525000
   ELSE                                                        <<U.RAO>>10530000
      TOS := JCWTABEND - NEXTJCWADR;                           <<U.RAO>>10535000
   ASSEMBLE(MFDS);                                             <<U.RAO>>10540000
   <<NOW WE HAVE THE LOCAL COPY OF THE ENTRY.  DO COMPARE>>    <<U.RAO>>10545000
   IF GOAL = CANDIDATE, (GOAL+1) THEN  <<A HIT>>               <<U.RAO>>10550000
      BEGIN   <<RETURN VALUES, KILL SEARCH>>                   <<U.RAO>>10555000
      JCWADR := NEXTJCWADR;                                    <<U.RAO>>10560000
      SEARCHJCW := TRUE;                                       <<U.RAO>>10565000
      JCWVALUE := CANDIDATEW(CANDIDATE&LSR(1)+1);              <<U.RAO>>10570000
      NEXTJCWADR := JCWTABEND;  <<KILLS WHILE LOOP>>           <<U.RAO>>10575000
      END                                                      <<U.RAO>>10580000
   ELSE   <<POINT TO NEXT ENTRY FOR NEXT LOOP>>                <<U.RAO>>10585000
      NEXTJCWADR := NEXTJCWADR+INTEGER(CANDIDATE)&LSR(1)+2;    <<U.RAO>>10590000
   END;   << OF WHILE LOOP>>                                   <<U.RAO>>10595000
END;   <<PROCEDURE SEARCHJCW>>                                 <<U.RAO>>10600000
PROCEDURE FINDJCW(JCWNAME, JCWVALUE, ERROR);                   <<U.RAO>>10605000
BYTE ARRAY JCWNAME;                                            <<U.RAO>>10610000
LOGICAL JCWVALUE;                                              <<U.RAO>>10615000
INTEGER ERROR;                                                 <<U.RAO>>10620000
OPTION PRIVILEGED;   <<CALLABLE INTRINSIC>>                    <<U.RAO>>10625000
BEGIN                                                          <<U.RAO>>10630000
<<THIS INTRINSIC SEARCHES THE JDT JCW TABLE FOR JCWNAME.>>     <<U.RAO>>10635000
<<THE WORK IS ACTUALLY DONE BY SEARCHJCW.  THIS PROCEDURE>>    <<U.RAO>>10640000
<<PRIMARILY CHECKS THE PARAMETERS.>>                           <<U.RAO>>10645000
EQUATE FINDJCWNUM = 86,   <<INTRINSIC NUMBER>>                 <<U.RAO>>10650000
       FINDJCWPARMS = 3,  <<NUMBER OF PARAMETERS>>             <<U.RAO>>10655000
       FINDJCWMODE = [10/FINDJCWNUM, 6/FINDJCWPARMS];          <<U.RAO>>10660000
INTEGER NAMELEN;   <<HOLDS LENGTH OF NAME IN BYTES>>           <<U.RAO>>10665000
BYTE ARRAY COPY(0:255);  <<HOLDS LOCAL COPY OF JCWNAME>>       <<U.RAO>>10670000
INTEGER DUMMY;   <<UNUSED PARAMETER TO SEARCHJCW>>             <<U.RAO>>10675000
EQUATE   <<POSSIBLE ERROR RETURNS>>                            <<U.RAO>>10680000
   NAMETOOBIG = 1,  <<NAME > 255 CHARACTERS LONG>>             <<U.RAO>>10685000
   NOLEADINGALPHA = 2,  <<NAME DOES NOT START WITH ALPHA>>     <<U.RAO>>10690000
   JCWNOTFOUND = 3;   <<THIS ID NOT FOUND IN JCW TABLE>>       <<U.RAO>>10695000
LOGICAL SAVEJIR;  <<HOLDS RETURN FROM LOCKJIR>>                <<U.RAO>>10700000
ERRORON;                                                       <<U.RAO>>10705000
CHEK(FINDJCWMODE, 3, [2/2, 2/2, 2/3]D);                        <<U.RAO>>10710000
ERROR := 0;                                                    <<U.RAO>>10715000
MOVE JCWNAME := JCWNAME WHILE AN,1;                            <<U.RAO>>10720000
NAMELEN := TOS-@JCWNAME;                                       <<U.RAO>>10725000
IF NAMELEN > 255 THEN                                          <<U.RAO>>10730000
   ERROR := NAMETOOBIG                                         <<U.RAO>>10735000
ELSE IF JCWNAME <> ALPHA THEN                                  <<U.RAO>>10740000
   ERROR := NOLEADINGALPHA                                     <<U.RAO>>10745000
ELSE  <<NO APPARENT ERRORS, TRY FOR VALUE>>                    <<U.RAO>>10750000
   BEGIN                                                       <<U.RAO>>10755000
   COPY := NAMELEN;                                            <<U.RAO>>10760000
   MOVE COPY(1) := JCWNAME WHILE ANS;  <<UPSHIFT>>             <<U.RAO>>10765000
   SAVEJIR := LOCKJIR;                                         <<U.RAO>>10770000
  ERROR := 0;                                                  << 8147>>10775000
   IF NOT SEARCHJCW(COPY, DUMMY, JCWVALUE)                     << 8147>>10780000
     THEN TRANSJCWEQUATE(JCWNAME,JCWVALUE,ERROR,DUMMY); << KJ  << 8147>>10785000
   IF ERROR <> 0 THEN                                          << 8147>>10790000
            ERROR := JCWNOTFOUND;                              << 8147>>10795000
   UNLOCKJIR(SAVEJIR);                                         <<U.RAO>>10800000
   END;                                                        <<U.RAO>>10805000
ERROREXIT(FINDJCWMODE, 0, 0);                                  <<U.RAO>>10810000
END;                                                           <<U.RAO>>10815000
PROCEDURE PUTJCW(JCWNAME, JCWVALUE, ERROR);                    <<U.RAO>>10820000
BYTE ARRAY JCWNAME;                                            <<U.RAO>>10825000
LOGICAL JCWVALUE;                                              <<U.RAO>>10830000
INTEGER ERROR;                                                 <<U.RAO>>10835000
OPTION PRIVILEGED;                                             <<U.RAO>>10840000
BEGIN                                                          <<U.RAO>>10845000
<<THIS INTRINSIC UPDATES THE VALUE OF A JCW IN THE JDT.>>      <<U.RAO>>10850000
<<IF AN ENTRY FOR JCWNAME DOES NOT EXIST, PUTJCW ALSO  >>      <<U.RAO>>10855000
<<CREATES A NEW ENTRY.                                 >>      <<U.RAO>>10860000
<<INPUT: JCWNAME IS A BYTE ARRAY HOLDING THE NAME OF   >>      <<U.RAO>>10865000
<<       THE DESIRED JCW.  THE NAME MUST START WITH AN >>      <<U.RAO>>10870000
<<       ALPHA CHARACTER, BE LESS THAN 256 CHARACTERS  >>      <<U.RAO>>10875000
<<       LONG, AND BE TERMINATED WITH A NON-ALPHANUMERIC>>     <<U.RAO>>10880000
<<       CHARACTER.  IT MAY ALSO BE "@", IN WHICH      >>      <<04.RO>>10885000
<<       CASE IT RESULTS IN ALL EXISTING JCW'S BEING   >>      <<04.RO>>10890000
<<       SET TO JCWVALUE.                              >>      <<04.RO>>10895000
<<       JCWVALUE IS THE VALUE TO WHICH JCW JCWNAME IS >>      <<U.RAO>>10900000
<<       TO BE SET.                                    >>      <<U.RAO>>10905000
<<OUTPUT: ERROR - 0 IF NO ERRORS OCCURRED              >>      <<U.RAO>>10910000
<<                1 IF NAME > 255 CHARACTERS LONG      >>      <<U.RAO>>10915000
<<                2 IF NAME DOES NOT START WITH AN ALPHA>>     <<U.RAO>>10920000
<<                3 IF UNABLE TO COMPLETE DUE TO LACK  >>      <<U.RAO>>10925000
<<                  OF SPACE IN JDT.                   >>      <<U.RAO>>10930000
<<                4 NAME HAS A SPECIAL JCW MEANING     >>      <<04696>>10935000
                                                               <<U.RAO>>10940000
INTEGER NAMELEN;  <<# BYTES IN NAME>>                          <<U.RAO>>10945000
BYTE NAMELENB = NAMELEN;  <<FOR LOOKING AT ENTRIES>>           <<04.RO>>10950000
ARRAY COPYW(0:128);  <<CONTAINS PROTOTYPE ENTRY>>              <<U.RAO>>10955000
BYTE ARRAY COPY(*) = COPYW;                                    <<U.RAO>>10960000
LOGICAL SAVEJIR;  <<HOLD RETURN FROM LOCKJIR>>                 <<U.RAO>>10965000
INTEGER JDTDST;  <<HOLDS DST # FOR JDT FROM PXGLOB>>           <<U.RAO>>10970000
INTEGER OLDVALUE;  <<DUMMY FOR SEARCHJCW CALL - UNUSED>>       <<U.RAO>>10975000
INTEGER JCWADR;  <<IF VALID, ENTRY POINTER FROM SEARCHJCW>>    <<U.RAO>>10980000
INTEGER ENTRYSIZE;  <<LENGTH OF WHOLE ENTRY IN WORDS>>         <<U.RAO>>10985000
DOUBLE DBEQV; << HOLDS THE VALUE FROM INTRINSIC DBINARY >>     <<04696>>10990000
INTEGER SEGSIZE;  <<CURRENT LENGTH OF JDT>>                    <<U.RAO>>10995000
INTEGER ARRAY LOCALJDT(0:NUMJDTPTRS)=Q;  <<COPY OF JDT PTR ARRA<<U.RAO>>11000000
INTEGER LOCALFSPCADR = LOCALJDT+NUMJDTPTRS;                    <<U.RAO>>11005000
INTEGER LOCALJJCW = LOCALJDT+5;  <<JCW TABLE ADDRESS>>         <<04.RO>>11010000
ARRAY QARRAY(*) = Q + 0;                                       <<06595>>11015000
INTEGER PCBGLOBLOC;                                            <<06595>>11020000
EQUATE NAMETOOBIG = 1,                                         <<U.RAO>>11025000
       NOLEADINGALPHA = 2,                                     <<U.RAO>>11030000
       OUTOFSPACE = 3,                                         <<04696>>11035000
       NAMEISRESERVED = 4;                                     <<04696>>11040000
EQUATE PUTJCWNUM = 85,                                         <<U.RAO>>11045000
       PUTJCWPARMS = 3,                                        <<U.RAO>>11050000
       PUTJCWMODE = [10/PUTJCWNUM, 6/PUTJCWPARMS];             <<U.RAO>>11055000
                                                               <<04696>>11060000
LOGICAL SUBROUTINE ILLEGALNAME;                                <<04696>>11065000
<< THIS SUBROUTINE CHECKS TO SEE IF THE JCWNAME IS A VALID>>   <<04696>>11070000
<< JCWVALUE.  IF SO THEN ILLEGALNAME BECOMES TRUE >>           <<04696>>11075000
<< The last 6 JCW's dealing with date and time are being >>    << 8147>>11080000
<< added for T-MIT.  If any more System JCW's are added, >>    << 8147>>11085000
<< an array should be set up with each of the names and  >>    << 8147>>11090000
<< the search intrinsic should be used.                  >>    << 8147>>11095000
    BEGIN                                                      <<04696>>11100000
      ILLEGALNAME := FALSE;                                    <<04696>>11105000
      DBEQV := -1D;                                            <<04696>>11110000
      IF JCWNAME ="OK" AND NAMELEN >= 2 THEN                   <<04696>>11115000
         BEGIN                                                 <<04696>>11120000
           IF NAMELEN = 2                                      <<04696>>11125000
              THEN ILLEGALNAME := TRUE                         <<04696>>11130000
              ELSE BEGIN                                       <<04696>>11135000
                     DBEQV := DBINARY(JCWNAME(2),NAMELEN-2);   <<04696>>11140000
                     IF = AND (DBEQV >=0D) AND (DBEQV <=65535D)<<04696>>11145000
                        THEN ILLEGALNAME := TRUE;              <<04696>>11150000
                   END;                                        <<04696>>11155000
         END                                                   <<04696>>11160000
      ELSE IF JCWNAME ="WARN" AND NAMELEN >= 4 THEN            <<04696>>11165000
              BEGIN                                            <<04696>>11170000
                IF NAMELEN = 4                                 <<04696>>11175000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>11180000
                   BEGIN                                       <<04696>>11185000
                     DBEQV := DBINARY(JCWNAME(4),NAMELEN-4);   <<04696>>11190000
                     IF = AND(DBEQV >=0D) AND (DBEQV <=49151D) <<04696>>11195000
                         THEN ILLEGALNAME := TRUE;             <<04696>>11200000
                   END;                                        <<04696>>11205000
         END                                                   <<04696>>11210000
      ELSE IF JCWNAME ="FATAL" AND NAMELEN >= 5 THEN           <<04696>>11215000
              BEGIN                                            <<04696>>11220000
                IF NAMELEN = 5                                 <<04696>>11225000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>11230000
                   BEGIN                                       <<04696>>11235000
                     DBEQV := DBINARY(JCWNAME(5),NAMELEN-5);   <<04696>>11240000
                     IF = AND(DBEQV >=0D) AND (DBEQV <=32767D) <<04696>>11245000
                        THEN ILLEGALNAME := TRUE;              <<04696>>11250000
                    END;                                       <<04696>>11255000
         END                                                   <<04696>>11260000
      ELSE IF JCWNAME ="SYSTEM" AND NAMELEN >= 6 THEN          <<04696>>11265000
              BEGIN                                            <<04696>>11270000
                IF NAMELEN = 6                                 <<04696>>11275000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>11280000
                   BEGIN                                       <<04696>>11285000
                     DBEQV := DBINARY(JCWNAME(6),NAMELEN-6);   <<04696>>11290000
                     IF = AND(DBEQV >=0D) AND (DBEQV <= 16383D)<<04696>>11295000
                        THEN ILLEGALNAME := TRUE;              <<04696>>11300000
                   END;                                        <<04696>>11305000
         END                                                   << 8147>>11310000
      ELSE IF JCWNAME="HPDAY" AND NAMELEN = 5                 <<< 8147>>11315000
              THEN ILLEGALNAME := TRUE                         << 8147>>11320000
      ELSE IF JCWNAME="HPDATE" AND NAMELEN = 6                <<< 8147>>11325000
              THEN ILLEGALNAME := TRUE                         << 8147>>11330000
      ELSE IF JCWNAME="HPMONTH" AND NAMELEN = 7               <<< 8147>>11335000
              THEN ILLEGALNAME := TRUE                         << 8147>>11340000
      ELSE IF JCWNAME="HPYEAR" AND NAMELEN = 6                <<< 8147>>11345000
              THEN ILLEGALNAME := TRUE                         << 8147>>11350000
      ELSE IF JCWNAME="HPHOUR" AND NAMELEN = 6                <<< 8147>>11355000
              THEN ILLEGALNAME := TRUE                         << 8147>>11360000
      ELSE IF JCWNAME="HPMINUTE" AND NAMELEN = 8              <<< 8147>>11365000
              THEN ILLEGALNAME := TRUE;                        << 8147>>11370000
       END;  << ILLEGALNAME >>                                 <<04696>>11375000
                                                               <<04696>>11380000
ERRORON;                                                       <<U.RAO>>11385000
CHEK(PUTJCWMODE, 3, [2/2, 2/2, 2/3]D);                         <<U.RAO>>11390000
ERROR := 0;  <<ASSUME NO ERRORS>>                              <<U.RAO>>11395000
MOVE JCWNAME := JCWNAME WHILE AN,1;  <<SCAN FOR END OF NAME>>  <<U.RAO>>11400000
NAMELEN := TOS-@JCWNAME;  <<LENGTH IN BYTES>>                  <<U.RAO>>11405000
IF NAMELEN>255 THEN                                            <<U.RAO>>11410000
   ERROR := NAMETOOBIG                                         <<04.RO>>11415000
ELSE IF JCWNAME = "@" THEN                                     <<04.RO>>11420000
   BEGIN  <<DO ALL EXISTING JCW'S>>                            <<04.RO>>11425000
   <<INVOLVES SCANNING TABLE FOR ALL ENTRIES>>                 <<04.RO>>11430000
   SAVEJIR := LOCKJIR;  << LOCK DOWN JDT>>                     <<04.RO>>11435000
   PXGLOBAL;                                                   <<06595>>11440000
   JDTDST := PXG'JDTDST;                                       <<06595>>11445000
   <<NEXT GET BOUNDS ON JCW ARRAY FROM JDT POINTERS>>          <<04.RO>>11450000
   TOS := @LOCALJJCW;                                          <<04.RO>>11455000
   TOS := JDTDST;                                              <<04.RO>>11460000
   TOS := @JJCWADR;                                            <<04.RO>>11465000
   TOS := 2;                                                   <<04.RO>>11470000
   ASSEMBLE(MFDS);                                             <<04.RO>>11475000
   <<NEXT DO LOOP THROUGH JCW ARRAY, MODIFYING VALUES>>        <<04.RO>>11480000
   WHILE LOCALJJCW < LOCALFSPCADR DO                           <<04.RO>>11485000
      BEGIN                                                    <<04.RO>>11490000
      TOS := @NAMELEN;  <<FIRST GET NAME LENGTH>>              <<04.RO>>11495000
      TOS := JDTDST;                                           <<04.RO>>11500000
      TOS := LOCALJJCW;                                        <<04.RO>>11505000
      TOS := 1;                                                <<04.RO>>11510000
      ASSEMBLE(MFDS);                                          <<04.RO>>11515000
      LOCALJJCW := LOCALJJCW+INTEGER(NAMELENB+2)&LSR(1);       <<04.RO>>11520000
      <<NOW WRITE NEW VALUE INTO TABLE>>                       <<04.RO>>11525000
      TOS := JDTDST;                                           <<04.RO>>11530000
      TOS := LOCALJJCW;                                        <<04.RO>>11535000
      TOS := @JCWVALUE;                                        <<04.RO>>11540000
      TOS := 1;                                                <<04.RO>>11545000
      ASSEMBLE(MTDS);                                          <<04.RO>>11550000
      LOCALJJCW := LOCALJJCW+1;                                <<04.RO>>11555000
      END;                                                     <<04.RO>>11560000
   UNLOCKJIR(SAVEJIR);                                         <<04.RO>>11565000
   END <<OF "@" CASE>>                                         <<04.RO>>11570000
ELSE IF JCWNAME <> ALPHA THEN                                  <<U.RAO>>11575000
   ERROR := NOLEADINGALPHA                                     <<U.RAO>>11580000
ELSE IF ILLEGALNAME THEN                                       <<04696>>11585000
   BEGIN                                                       << 8147>>11590000
   IF JCWNAME = "HP"  << MUST BE SYS RES. JCW >>               << 8147>>11595000
      THEN ERROR := 5                                          << 8147>>11600000
      ELSE ERROR := NAMEISRESERVED;                            << 8147>>11605000
   END                                                         << 8147>>11610000
ELSE                                                           <<04696>>11615000
   BEGIN  <<NO APPARENT ERRORS - SET VALUE>>                   <<U.RAO>>11620000
   COPY := NAMELEN;  <<MUST PUT ON WORD BDY, PACK>>            <<U.RAO>>11625000
   MOVE COPY(1) := JCWNAME WHILE ANS;  <<UPSHIFT LOCAL COPY>>  <<U.RAO>>11630000
   SAVEJIR := LOCKJIR;  <<LOCK DOWN JDT>>                      <<U.RAO>>11635000
   PXGLOBAL;                                                   <<06595>>11640000
   JDTDST := PXG'JDTDST;                                       <<06595>>11645000
   IF SEARCHJCW(COPY, JCWADR, OLDVALUE) THEN                   <<U.RAO>>11650000
      BEGIN  <<NAME EXISTS, JUST REPLACE VALUE>>               <<U.RAO>>11655000
      TOS := JDTDST;                                           <<U.RAO>>11660000
      TOS := JCWADR+NAMELEN&LSR(1)+1;  <<OFFSET TO JCWVALUE>>  <<U.RAO>>11665000
      TOS := @JCWVALUE;  <<SOURCE>>                            <<U.RAO>>11670000
      TOS := 1;  <<JUST TRANSFER VALUE>>                       <<U.RAO>>11675000
      ASSEMBLE(MTDS);                                          <<U.RAO>>11680000
      END                                                      <<U.RAO>>11685000
   ELSE   <<NAME DOES NOT EXIST.  MUST ADD NAME TO TABLE>>     <<U.RAO>>11690000
      BEGIN                                                    <<U.RAO>>11695000
      <<PROBLEM IS TO ALLOCATE SPACE TO HOLD NEW VALUE>>       <<U.RAO>>11700000
      <<FIRST CHECK TO SEE IF SPACE EXISTS IN JDT>>            <<U.RAO>>11705000
      ENTRYSIZE := NAMELEN&LSR(1)+2;                           <<U.RAO>>11710000
      SEGSIZE := (SYS'DST(JDTDST&LSL(2)).(3:13))&LSL(2)-1;     <<U.RAO>>11715000
      <<GET COPY OF JDT POINTERS>>                             <<U.RAO>>11720000
      TOS := @LOCALJDT;                                        <<U.RAO>>11725000
      TOS := JDTDST;                                           <<U.RAO>>11730000
      TOS := @JDTBASE;                                         <<U.RAO>>11735000
      TOS := NUMJDTPTRS+1;                                     <<U.RAO>>11740000
      ASSEMBLE(MFDS);                                          <<U.RAO>>11745000
      IF ENTRYSIZE+LOCALFSPCADR > LOCALJDT THEN                <<U.RAO>>11750000
         ERROR := OUTOFSPACE                                   <<U.RAO>>11755000
      ELSE   <<SHOULD BE POSSIBLE TO FIT IN EXPANDED JDT>>     <<U.RAO>>11760000
         BEGIN                                                 <<U.RAO>>11765000
         IF SEGSIZE < ENTRYSIZE+LOCALFSPCADR THEN              <<U.RAO>>11770000
            BEGIN   <<NEED TO ENLARGE SEGMENT>>                <<U.RAO>>11775000
            ALTDSEGSIZE(JDTDST,ENTRYSIZE+LOCALFSPCADR-SEGSIZE);<<U.RAO>>11780000
            IF <> THEN    <<REAL PROBLEM HERE, PERHAPS>>       <<U.RAO>>11785000
               BEGIN                                           <<U.RAO>>11790000
               ERROR := OUTOFSPACE;                            <<U.RAO>>11795000
               UNLOCKJIR(SAVEJIR);                             <<U.RAO>>11800000
               ERROREXIT(PUTJCWMODE, 0, 0);                    <<U.RAO>>11805000
               RETURN                                          <<U.RAO>>11810000
               END;                                            <<U.RAO>>11815000
            END;                                               <<U.RAO>>11820000
         <<AT THIS POINT WE KNOW WE HAVE ENOUGH SPACE IN>>     <<U.RAO>>11825000
         <<THE JDT FOR THE ENTRY.  NOW MOVE DATA IN>>          <<U.RAO>>11830000
         COPYW(ENTRYSIZE-1) := JCWVALUE;  <<FINALIZE ENTRY>>   <<U.RAO>>11835000
         TOS := JDTDST;                                        <<U.RAO>>11840000
         TOS := LOCALFSPCADR;                                  <<U.RAO>>11845000
         TOS := @COPYW;                                        <<U.RAO>>11850000
         TOS := ENTRYSIZE;                                     <<U.RAO>>11855000
         ASSEMBLE(MTDS);                                       <<U.RAO>>11860000
         <<FINALLY UPDATE THE FREESPACE POINTER IN THE JDT>>   <<U.RAO>>11865000
         LOCALFSPCADR := LOCALFSPCADR+ENTRYSIZE;               <<U.RAO>>11870000
         TOS := JDTDST;                                        <<U.RAO>>11875000
         TOS := @JFREESPCADR;                                  <<U.RAO>>11880000
         TOS := @LOCALFSPCADR;                                 <<U.RAO>>11885000
         TOS := 1;  <<JUST FIXUP FREE SPACE POINTER>>          <<U.RAO>>11890000
         ASSEMBLE(MTDS);                                       <<U.RAO>>11895000
         END;                                                  <<U.RAO>>11900000
      END;                                                     <<U.RAO>>11905000
   UNLOCKJIR(SAVEJIR);                                         <<U.RAO>>11910000
   END;                                                        <<U.RAO>>11915000
ERROREXIT(PUTJCWMODE, 0, 0);                                   <<U.RAO>>11920000
END;                                                           <<U.RAO>>11925000
LOGICAL PROCEDURE GETJCW;                                      <<U.RAO>>11930000
OPTION PRIVILEGED;                                             <<U.RAO>>11935000
<<This callable intrinsic returns the current value of the>>   <<U.RAO>>11940000
<<specific jcw "JCW" to the user.>>                            <<U.RAO>>11945000
BEGIN                                                          <<U.RAO>>11950000
EQUATE GETJCWERRMODE = [10/73,6/0];                            <<U.RAO>>11955000
INTEGER RESULT = GETJCW;  <<AVOIDS SPL LLBL>>                  <<U.RAO>>11960000
DOUBLE NAME := "JCW ";                                         <<U.RAO>>11965000
INTEGER ERRORRTN;  <<A DUMMY SINCE SHOULD NOT FAIL>>           <<U.RAO>>11970000
ERRORON;                                                       <<U.RAO>>11975000
FINDJCW(NAME, RESULT, ERRORRTN);                               <<U.RAO>>11980000
ERROREXIT(GETJCWERRMODE, 0, 0);                                <<U.RAO>>11985000
END;                                                           <<U.RAO>>11990000
PROCEDURE SETJCW(NEWJCW);                                      <<U.RAO>>11995000
VALUE NEWJCW;                                                  <<U.RAO>>12000000
INTEGER NEWJCW;                                                <<U.RAO>>12005000
<<This callable intrinsic updates jcw "JCW" in the JDT >>      <<U.RAO>>12010000
<<to the value NEWJCW through the intrinsic PUTJCW.>>          <<U.RAO>>12015000
BEGIN                                                          <<U.RAO>>12020000
EQUATE SETJCWERRMODE = [10/72, 6/1];                           <<U.RAO>>12025000
DOUBLE NAME := "JCW ";                                         <<U.RAO>>12030000
INTEGER ERRORRTN;  <<A DUMMY>>                                 <<U.RAO>>12035000
ERRORON;                                                       <<U.RAO>>12040000
PUTJCW(NAME, NEWJCW, ERRORRTN);                                <<U.RAO>>12045000
ERROREXIT(SETJCWERRMODE, 0, 0);                                <<U.RAO>>12050000
END;                                                           <<U.RAO>>12055000
$CONTROL SEGMENT=MAIN                                          <<U.RAO>>12060000
END.                                                           <<U.RAO>>12065000
