$CONTROL USLINIT,MAP,CODE,SOURCE                                        00010000
<< JOBTABLE - MODULE 74 >>                                     <<00745>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$CONTROL SEGMENT=JOBTABLE                                               00030000
$CONTROL PRIVILEGED                                                     00032000
BEGIN                                                                   00034000
$PAGE "***   GENERAL/GLOBAL EQUIVALENCES   ***"                         00036000
INTEGER                                                                 00038000
         DB0   = DB+0  ,                                                00040000
         S0    = S-0   ,                                                00042000
         S3    = S-3   ,                                                00044000
         S5    = S-5   ,                                                00046000
         X     = X     ,                                                00048000
         XREG  = X     ;                                                00050000
INTEGER POINTER                                                         00052000
         PS0   = S-0   ,                                                00054000
         PS1   = S-1   ;                                                00056000
BYTE POINTER                                                            00058000
         BPS0  = S-0   ,                                                00060000
         BPS1  = S-1   ;                                                00062000
                                                                        00064000
   << SYSTEM CONSTANTS >>                                               00066000
EQUATE                                                                  00068000
         JMATDST   = 25   ,                                             00070000
         JMATSIR   = 15   ;                                             00072000
                                                                        00074000
   << SYSTEM GLOBAL / POINTER >>                                        00076000
POINTER                                                                 00078000
         SYS'DST   = 2    ;                                             00080000
   << JOB DIRECTORY TABLE DECLARATIONS >>                      <<U.RAO>>00082000
INTEGER JDTBASE = DB+0,  <<SEGMENT SIZES>>                     <<U.RAO>>00084000
        JDSDADR = JDTBASE+1,  <<ADDRESS OF JDT DSD>>           <<U.RAO>>00086000
        JTFDADR = JDSDADR+1,  <<ADDRESS OF JOB TEMP FILE DIR>> <<U.RAO>>00088000
        JFEQADR = JTFDADR+1,  <<ADDRESS OF FILE EQ TABLE>>     <<U.RAO>>00090000
        JLEQADR = JFEQADR+1,  <<ADDRESS OF LINE EQ TABLE>>     <<U.RAO>>00092000
        JJCWADR = JLEQADR+1,  <<ADDRESS OF JCW TABLE>>         <<U.RAO>>00094000
        JFREESPCADR = JJCWADR+1,  <<ADDRESS OF FREE SPACE>>    <<U.RAO>>00096000
        JDTWORKSPCBASE = JFREESPCADR+1,  <<JDT WORK SPACE>>    <<U.RAO>>00098000
        JDSJNUM = JDTWORKSPCBASE+15,  <<JOB NUMBER>>           <<U.RAO>>00100000
        JESMPN  = JDSJNUM+1;   <<MAIN PIN NUMBER>>             <<U.RAO>>00102000
INTEGER POINTER                                                <<U.RAO>>00104000
        JDSDPTR = JDSDADR,                                     <<U.RAO>>00106000
        JTFDPTR = JTFDADR,                                     <<U.RAO>>00108000
        JFEQPTR = JFEQADR,                                     <<U.RAO>>00110000
        JLEQPTR = JLEQADR,                                     <<U.RAO>>00112000
        JJCWPTR = JJCWADR,                                     <<U.RAO>>00114000
        JFREESPCPTR = JFREESPCADR;                             <<U.RAO>>00116000
INTEGER ARRAY                                                  <<U.RAO>>00118000
        JDTWORKSPC(*) = JDTWORKSPCBASE,                        <<U.RAO>>00120000
        JDTARR(*) = JDTBASE;                                   <<U.RAO>>00122000
EQUATE NUMJDTPTRS = 6;  <<NUMBER OF POINTERS IN TABLE>>        <<U.RAO>>00124000
ARRAY PXGJDT(*) = DB+5;   <<FOR GETTING TO JDT DST IN PXGLOB>> <<U.RAO>>00126000
DEFINE STACKJDTDST =  <<EXTRACTS AND STACKS JDT DST FROM PXGLOB<<U.RAO>>00128000
   PUSH(DL);                                                   <<U.RAO>>00130000
   XREG := TOS-PS0(-1);  <<DB OFFSET TO PXGLOB>>               <<U.RAO>>00132000
   TOS := PXGJDT(XREG).(6:10)#;                                <<U.RAO>>00134000
DEFINE                                                         <<U.RAO>>00136000
   DEF'MOVEFROMDSEG =                                          <<U.RAO>>00138000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                  <<U.RAO>>00140000
         VALUE TARGET,DSTN,OFFSET,COUNT;                       <<U.RAO>>00142000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                     <<U.RAO>>00144000
      BEGIN                                                    <<U.RAO>>00146000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<U.RAO>>00148000
         ASSEMBLE(MFDS 0);                                     <<U.RAO>>00150000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<U.RAO>>00152000
      END #,                                                   <<U.RAO>>00154000
                                                               <<U.RAO>>00156000
   DEF'MOVETODSEG =                                            <<U.RAO>>00158000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                    <<U.RAO>>00160000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                       <<U.RAO>>00162000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                     <<U.RAO>>00164000
      BEGIN                                                    <<U.RAO>>00166000
         X := TOS;                                             <<U.RAO>>00168000
         ASSEMBLE(MTDS 0);                                     <<U.RAO>>00170000
         TOS := X;                                             <<U.RAO>>00172000
      END #;                                                   <<U.RAO>>00174000
                                                               <<U.RAO>>00176000
$PAGE "***   JOBTABLE   ***"                                            00178000
INTEGER PROCEDURE ALTDSEGSIZE(IX,SIZE);                                 00180000
   VALUE IX,SIZE;                                                       00182000
   INTEGER IX,SIZE;                                                     00184000
   OPTION EXTERNAL;                                                     00186000
                                                                        00188000
INTEGER PROCEDURE GETSIR(SIR);                                          00190000
   VALUE SIR;                                                           00192000
   INTEGER SIR;                                                         00194000
   OPTION EXTERNAL;                                                     00196000
                                                                        00198000
PROCEDURE RELSIR(SIR,FL);                                               00200000
   VALUE SIR,FL;                                                        00202000
   INTEGER SIR,FL;                                                      00204000
   OPTION EXTERNAL;                                                     00206000
                                                                        00208000
LOGICAL PROCEDURE EXCHANGEDB (DSTX);                                    00210000
   VALUE DSTX;                                                          00212000
   LOGICAL DSTX;                                                        00214000
   OPTION EXTERNAL;                                                     00216000
                                                                        00218000
INTEGER PROCEDURE LOCKJIR;                                              00220000
   OPTION EXTERNAL;                                                     00222000
                                                                        00224000
PROCEDURE UNLOCKJIR(B);                                                 00226000
   VALUE   B;                                                           00228000
   LOGICAL B;                                                           00230000
   OPTION EXTERNAL;                                                     00232000
                                                                        00234000
PROCEDURE SUDDENDEATH(A);                                               00236000
   VALUE A;                                                             00238000
   INTEGER A;                                                           00240000
   OPTION EXTERNAL;                                                     00242000
                                                                        00244000
PROCEDURE HELP;                                                         00246000
   OPTION EXTERNAL;                                                     00248000
                                                                        00250000
INTRINSIC BINARY,MYCOMMAND,DBINARY;                            <<04696>>00252000
                                                                        00254000
PROCEDURE ERROREXIT (I,E,P);                                   <<U.RAO>>00256000
   VALUE   I,E,P;                                              <<U.RAO>>00258000
   LOGICAL I,E,P;                                              <<U.RAO>>00260000
   OPTION EXTERNAL;                                            <<U.RAO>>00262000
                                                               <<U.RAO>>00264000
PROCEDURE ERRORON;                                             <<U.RAO>>00266000
   OPTION EXTERNAL;                                            <<U.RAO>>00268000
                                                               <<U.RAO>>00270000
   DOUBLE PROCEDURE CHEK(INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK); <<U.RAO>>00272000
   VALUE INTRIN,FLAGS,PARMS,CAPMASK,OPTVMASK;                  <<U.RAO>>00274000
   LOGICAL INTRIN,FLAGS,OPTVMASK;                              <<U.RAO>>00276000
   DOUBLE PARMS,CAPMASK;                                       <<U.RAO>>00278000
   OPTION VARIABLE,EXTERNAL;                                   <<U.RAO>>00280000
                                                               <<U.RAO>>00282000
                                                                        00284000
                                                                        00286000
PROCEDURE PACKANDPOINT (FILEREF, LEN, GPNTR, APNTR);                    00288000
   BYTE ARRAY FILEREF;                                                  00290000
   INTEGER LEN;                                                         00292000
   LOGICAL GPNTR, APNTR;                                                00294000
   OPTION UNCALLABLE;                                                   00296000
<< THIS PROCEDURE ANALYZES <FILEREF> AND ENSURES THAT IT IS IN A        00298000
   LEGITIMATE FILE REFERENCE FORMAT.                                    00300000
   RETURNS:                                                             00302000
      CCL- INVALID NAME.                                                00304000
      CCE- OKAY:                                                        00306000
      <GPNTR> IS BYTE POINTER TO GROUP NAME, OR 0.                      00308000
      <APNTR> IS BYTE POINTER TO ACCOUNT NAME, OR 0.                    00310000
   >>                                                                   00312000
BEGIN                                                                   00314000
   INTEGER FLAG := -1;                                                  00316000
   LOGICAL STATUS = Q-1;                                                00318000
   EQUATE  CCE = 2 ,                                                    00320000
           CCG = 0 ,                                                    00322000
           CCL = 1 ;                                                    00324000
   DEFINE  CC = STATUS.(6:2) #;                                         00326000
                                                                        00328000
LOGICAL SUBROUTINE DONAME (NAME);                                       00330000
   VALUE NAME;                                                          00332000
   LOGICAL NAME;                                                        00334000
<< SCANS <NAME> TO ENSURE THAT IT IS LEGITIMATE;                        00336000
   IF <NAME> EXACTLY SATISFIES <LEN>, THEN CCE RETURN TO PACKANDPOINT   00338000
      CALLER.                                                           00340000
   ALLOWS FOR LOCKWORD FOLLOWING FIRST NAME;                            00342000
   IF STILL CHARACTERS LEFT AND DELIMITER IS ".", THEN                  00344000
      RETURNS BYTE POINTER TO NEXT NAME.>>                              00346000
 BEGIN                                                                  00348000
   IF BPS1 <> ALPHA THEN GOTO ERROR;                                    00350000
   TOS := NAME;                                                         00352000
   ASSEMBLE (DUP, DUP);                                                 00354000
   MOVE * := * WHILE ANS, 0;                                            00356000
   ASSEMBLE (CAB, SUB);                                                 00358000
   IF = THEN GOTO ERROR;                                                00360000
   IF TOS > 8 THEN GOTO ERROR;                                          00362000
   IF (S0 -@FILEREF) = LEN THEN                                         00364000
      BEGIN                                                             00366000
      TOS := CCE;                                                       00368000
      GOTO EXIT;                                                        00370000
      END;                                                              00372000
   IF > THEN GOTO ERROR;                                                00374000
   FLAG := FLAG +1;                                                     00376000
   IF = AND BPS0 = "/" THEN                                             00378000
      BEGIN                                                             00380000
      ASSEMBLE (DUP, INCA);                                             00382000
      TOS := DONAME (*);                                                00384000
      END                                                               00386000
   ELSE                                                                 00388000
      BEGIN                                                             00390000
      IF BPS0 <> "." THEN GOTO ERROR;                                   00392000
      TOS := TOS +1;                                                    00394000
      END;                                                              00396000
   S3 := TOS;                                                           00398000
   END    <<SUBROUTINE DONAME>>;                                        00400000
                                                                        00402000
   GPNTR := 0;                                                          00404000
   APNTR := 0;                                                          00406000
   DONAME (APNTR := DONAME (GPNTR := DONAME (@FILEREF)));               00408000
ERROR:                                                                  00410000
   TOS := CCL;                                                          00412000
EXIT:                                                          <<U.RAO>>00414000
   CC := TOS;                                                  <<U.RAO>>00416000
   END    <<PACKANDPOINT>>;                                    <<U.RAO>>00418000
LOGICAL PROCEDURE PARSEJOBID(JOBID, RESULT);                   <<U.RAO>>00420000
BYTE ARRAY JOBID;                                              <<U.RAO>>00422000
INTEGER ARRAY RESULT;                                          <<U.RAO>>00424000
OPTION PRIVILEGED, UNCALLABLE;                                 <<U.RAO>>00426000
<<FUNCTION:  PARSE A JOBID FOR CXTELL, CONSTELL, CONSWARN.>>   <<U.RAO>>00428000
<<INPUT:                                                    >> <<U.RAO>>00430000
<<   JOBID - Byte pointer to job id.  Can have any of the   >> <<U.RAO>>00432000
<<        following forms.                                  >> <<U.RAO>>00434000
<<                                                          >> <<U.RAO>>00436000
<<        [#]{S/J}nnn                                       >> <<U.RAO>>00438000
<<        [[jsname],]username.acctname                      >> <<U.RAO>>00440000
<<        @                                                 >> <<U.RAO>>00442000
<<        @S                                                >> <<U.RAO>>00444000
<<        @J                                                >> <<U.RAO>>00446000
<<                                                          >> <<U.RAO>>00448000
<<   OUTPUT:                                                >> <<U.RAO>>00450000
<<                                                          >> <<U.RAO>>00452000
<<        RESULT is a 17 word array to which is returned the>> <<U.RAO>>00454000
<<           output of the parse as follows.                >> <<U.RAO>>00456000
<<           RESULT(13) identifies the type of jobid parsed.>> <<U.RAO>>00458000
<<                                                          >> <<U.RAO>>00460000
<<              0 => job number                             >> <<U.RAO>>00462000
<<              1 => jsname, user.acct                      >> <<U.RAO>>00464000
<<              2 => user.acct                              >> <<U.RAO>>00466000
<<              3 => @.acct                                 >> <<U.RAO>>00468000
<<              4 => @S                                     >> <<U.RAO>>00470000
<<              5 => @J                                     >> <<U.RAO>>00472000
<<              6 => @                                      >> <<U.RAO>>00474000
<<                                                          >> <<U.RAO>>00476000
<<           If 0, the job number will be in the JMAT       >> <<U.RAO>>00478000
<<              format in RESULT(0).                        >> <<U.RAO>>00480000
<<           If 1, RESULT(1) = user name                    >> <<U.RAO>>00482000
<<                 RESULT(5) = acct name                    >> <<U.RAO>>00484000
<<                 RESULT(9) = job name                     >> <<U.RAO>>00486000
<<           If 2, RESULT(1) = user name                    >> <<U.RAO>>00488000
<<                 RESULT(5) = acct name                    >> <<U.RAO>>00490000
<<           If 3, RESULT(5) = acct name                    >> <<U.RAO>>00492000
<<           If 4,5,6 then RESULT(0) - RESULT(12) garbage   >> <<U.RAO>>00494000
<<           RESULT(14) = byte pointer to first character   >> <<U.RAO>>00496000
<<              following character in RESULT(15).          >> <<U.RAO>>00498000
<<           RESULT(15) = first non-blank character         >> <<U.RAO>>00500000
<<              following jobid.                            >> <<U.RAO>>00502000
<<                                                          >> <<U.RAO>>00504000
<<        If an error occurred in parse, PARSEJOBID will    >> <<U.RAO>>00506000
<<           return FALSE  (else true).                     >> <<U.RAO>>00508000
<<           RESULT(14) will be a byte pointer to the place >> <<U.RAO>>00510000
<<              in jobid where the error was found.         >> <<U.RAO>>00512000
<<           RESULT(15) will be the internal error number   >> <<U.RAO>>00514000
<<           RESULT(16) will be the ordinal of the parameter>> <<U.RAO>>00516000
<<              in error.                                   >> <<U.RAO>>00518000
<<                                                          >> <<U.RAO>>00520000
<<                                                          >> <<U.RAO>>00522000
BEGIN                                                          <<U.RAO>>00524000
INTEGER TOKENLEN;  <<LENGTH OF CURRENT PART OF JOBID>>         <<U.RAO>>00526000
BYTE POINTER TOKENPTR;  <<CURRENT PLACE IN JOBID>>             <<U.RAO>>00528000
   <<ALSO WHEN ERROR ENCOUNTERED, POINTS TO ERROR LOCATION>>   <<U.RAO>>00530000
BYTE POINTER IDPTR;  <<POINTS TO NEXT PLACE IN JOBID>>         <<U.RAO>>00532000
BYTE POINTER DELIM;  <<POINTS OT CURRENT DELIMITER>>           <<U.RAO>>00534000
DEFINE JOBFIELD = (0:2)#;                                      <<U.RAO>>00536000
EQUATE JOBFLAG = 2,                                            <<U.RAO>>00538000
       SESSIONFLAG = 1;                                        <<U.RAO>>00540000
BYTE ARRAY BRESULT(*) = RESULT;                                <<U.RAO>>00542000
INTEGER ERRNUM := 0;                                           <<U.RAO>>00544000
EQUATE JOBNUM = 0,                                             <<U.RAO>>00546000
       FULLNAME = 1,                                           <<U.RAO>>00548000
       USERID = 2,                                             <<U.RAO>>00550000
       ALLOFACCT = 3,                                          <<U.RAO>>00552000
       ALLSESSIONS = 4,                                        <<U.RAO>>00554000
       ALLJOBS = 5,                                            <<U.RAO>>00556000
       ALL = 6;                                                <<U.RAO>>00558000
EQUATE INVJOBNUMBER = 1,                                       <<U.RAO>>00560000
       INVSESSIONNUM = 2,                                      <<U.RAO>>00562000
       XPCTJORS = 3,                                           <<U.RAO>>00564000
       XPCTJSORAT = 4,                                         <<U.RAO>>00566000
       JOBXPCTJUSTAT = 5,                                      <<U.RAO>>00568000
       JOBNAMETOOLONG = 6,                                     <<U.RAO>>00570000
       JOBXPCTALPHA = 7,                                       <<U.RAO>>00572000
       USERNAMEMISSING = 8,                                    <<U.RAO>>00574000
       USERNAMETOOLONG = 9,                                    <<U.RAO>>00576000
       USERXPCTALPHA = 10,                                     <<U.RAO>>00578000
       XPCTPERIODDELIM = 11,                                   <<U.RAO>>00580000
       ACCTNAMEMISSING = 12,                                   <<U.RAO>>00582000
       ACCTXPCTNAMNTAT = 13,                                   <<U.RAO>>00584000
       ACCTNAMETOOLONG = 14,                                   <<U.RAO>>00586000
       ACCTXPCTALPHA = 15,                                     <<U.RAO>>00588000
       JOBIDMISSING = 16;                                      <<U.RAO>>00590000
LOGICAL SUBROUTINE GETNEXT;                                    <<U.RAO>>00592000
<<GETS NEXT TOKEN FROM JOBID>>                                 <<U.RAO>>00594000
BEGIN                                                          <<U.RAO>>00596000
TOKENLEN := 0;                                                 <<U.RAO>>00598000
SCAN IDPTR WHILE %6440, 1;  <<SKIP LEADING BLANKS>>            <<U.RAO>>00600000
@TOKENPTR := TOS;                                              <<U.RAO>>00602000
IF CARRY THEN   <<NO MORE NON-BLANK CHARACTERS>>               <<U.RAO>>00604000
   GETNEXT := FALSE                                            <<U.RAO>>00606000
ELSE                                                           <<U.RAO>>00608000
   BEGIN  <<LOOK FOR "@" SIGN>>                                <<U.RAO>>00610000
   GETNEXT := TRUE;                                            <<U.RAO>>00612000
   IF TOKENPTR <> "@" THEN                                     <<U.RAO>>00614000
      BEGIN                                                    <<U.RAO>>00616000
      IF TOKENPTR="#" THEN   <<SKIP PAST IT>>                  <<U.RAO>>00618000
         TOS := @TOKENPTR+1                                    <<U.RAO>>00620000
      ELSE                                                     <<U.RAO>>00622000
         TOS := @TOKENPTR;                                     <<U.RAO>>00624000
      ASSEMBLE(DUP);                                           <<U.RAO>>00626000
      MOVE * := * WHILE ANS,1;                                 <<U.RAO>>00628000
      TOKENLEN := S0-@TOKENPTR;                                <<U.RAO>>00630000
      SCAN * WHILE %6440, 1;  <<SKIP BLANKS TO NEXT DELIM>>    <<U.RAO>>00632000
      @DELIM := S0;  <<POINTER TO DELIMITER>>                  <<U.RAO>>00634000
      @IDPTR := TOS+1;                                         <<U.RAO>>00636000
      END                                                      <<U.RAO>>00638000
   ELSE IF TOKENPTR(1) <> " " AND TOKENPTR(1) <> %15 THEN      <<U.RAO>>00640000
      BEGIN                                                    <<U.RAO>>00642000
      @IDPTR := @TOKENPTR+1;  <<SKIP "@">>                     <<U.RAO>>00644000
      GETNEXT;                                                 <<U.RAO>>00646000
      @TOKENPTR := @TOKENPTR-1;                                <<U.RAO>>00648000
      TOKENLEN := TOKENLEN+1;                                  <<U.RAO>>00650000
      END                                                      <<U.RAO>>00652000
   ELSE   <<HAS TRAILING BLANK(S)>>                            <<U.RAO>>00654000
      BEGIN                                                    <<U.RAO>>00656000
      TOKENLEN := 1;  <<FOR "@">>                              <<U.RAO>>00658000
      SCAN TOKENPTR(1) WHILE %6440,1;  <<FIND FIRST NON-BLANK>><<U.RAO>>00660000
      @DELIM := TOS;  <<FIRST NON-BLANK AFTER "@">>            <<U.RAO>>00662000
      @IDPTR := @DELIM+1;                                      <<U.RAO>>00664000
      END;                                                     <<U.RAO>>00666000
   END;                                                        <<U.RAO>>00668000
END;                                                           <<U.RAO>>00670000
SUBROUTINE PARSEJSNUMBER;                                      <<U.RAO>>00672000
BEGIN                                                          <<U.RAO>>00674000
<<On entrance, the entity believed to be a job or session numbe<<U.RAO>>00676000
<<has been tokenized and any leading "#" has been stripped.  >><<U.RAO>>00678000
<<This subroutine converts the ID into a format compatible with<<U.RAO>>00680000
<<the JMAT format for job numbers.  If any errors, the return>><<U.RAO>>00682000
<<values are completely set up inside PARSEJSNUMBER.>>         <<U.RAO>>00684000
RESULT(13) := JOBNUM;  <<TYPE OF PARSED ID>>                   <<U.RAO>>00686000
RESULT(15) := 0;  <<ERROR CODE>>                               <<U.RAO>>00688000
IF TOKENPTR = "J" THEN   <<JOB>>                               <<U.RAO>>00690000
   BEGIN                                                       <<U.RAO>>00692000
   RESULT := BINARY(TOKENPTR(1), TOKENLEN-1);                  <<U.RAO>>00694000
   IF <> OR NOT(1<=RESULT<=16383) THEN  <<INVALID NUMBER>>     <<U.RAO>>00696000
      BEGIN                                                    <<U.RAO>>00698000
      RESULT(14) := @TOKENPTR(1);                              <<U.RAO>>00700000
      RESULT(15) := INVJOBNUMBER;                              <<U.RAO>>00702000
      END                                                      <<U.RAO>>00704000
   ELSE  <<GOOD JOB NUMBER, COMPLETE FORMATTING>>              <<U.RAO>>00706000
      RESULT.JOBFIELD := JOBFLAG;                              <<U.RAO>>00708000
   END                                                         <<U.RAO>>00710000
ELSE IF TOKENPTR="S" THEN   <<SESSION>>                        <<U.RAO>>00712000
   BEGIN                                                       <<U.RAO>>00714000
   RESULT := BINARY(TOKENPTR(1), TOKENLEN-1);                  <<U.RAO>>00716000
   IF <> OR NOT(1<=RESULT<=16383) THEN                         <<U.RAO>>00718000
      BEGIN                                                    <<U.RAO>>00720000
      RESULT(14) := @TOKENPTR(1);                              <<U.RAO>>00722000
      RESULT(15) := INVSESSIONNUM;                             <<U.RAO>>00724000
      END                                                      <<U.RAO>>00726000
   ELSE  <<GOOD SESSION NUMBER>>                               <<U.RAO>>00728000
      RESULT.JOBFIELD := SESSIONFLAG;                          <<U.RAO>>00730000
   END                                                         <<U.RAO>>00732000
ELSE   <<NOT J OR S, WHAT IS IT?>>                             <<U.RAO>>00734000
   BEGIN                                                       <<U.RAO>>00736000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>00738000
   RESULT(15) := XPCTJORS;                                     <<U.RAO>>00740000
   END;                                                        <<U.RAO>>00742000
IF RESULT(15)=0 THEN   <<GOOD PARSE - FINISH UP>>              <<U.RAO>>00744000
   BEGIN                                                       <<U.RAO>>00746000
   PARSEJOBID := TRUE;                                         <<U.RAO>>00748000
   RESULT(14) := @IDPTR;                                       <<U.RAO>>00750000
   RESULT(15) := DELIM;                                        <<U.RAO>>00752000
   END;                                                        <<U.RAO>>00754000
END;   <<SUBROUTINE PARSEJSNUMBER>>                            <<U.RAO>>00756000
SUBROUTINE PARSEJSNAME;                                        <<U.RAO>>00758000
BEGIN                                                          <<U.RAO>>00760000
<<On entrance, the first name has been tokenized by GETNEXT,>> <<U.RAO>>00762000
<<the return values to the procedure have been initialized to>><<U.RAO>>00764000
<<Syntax Error and we are sure that the jobid is not a >>      <<U.RAO>>00766000
<<j/s number.  We do not know if anything else weird is present<<U.RAO>>00768000
<<On return, either an error has been detected, in which case>><<U.RAO>>00770000
<<the return values are properly set, or no error was detected,<<U.RAO>>00772000
<<in which case RESULT is properly set.>>                      <<U.RAO>>00774000
RESULT(1) := "  ";                                             <<U.RAO>>00776000
MOVE RESULT(2) := RESULT(1), (11);  <<INIT RETURN>>            <<U.RAO>>00778000
RESULT(13) := USERID;  <<DEFAULT TYPE OF JOBID>>               <<U.RAO>>00780000
RESULT(16) := 0;  <<CURRENT PARAMETER NUMBER>>                 <<U.RAO>>00782000
IF DELIM = "," THEN   <<JOB NAME PART PRESENT>>                <<U.RAO>>00784000
   BEGIN                                                       <<U.RAO>>00786000
   RESULT(16) := 1; <<FIRST TOKEN>>                            <<U.RAO>>00788000
   IF TOKENLEN = 0 THEN                                        <<U.RAO>>00790000
      <<IGNORE - SAME AS NOT SPECIFIED>>                       <<U.RAO>>00792000
      IF NOT GETNEXT THEN   <<NO MORE TOKENS AVAILABLE>>       <<U.RAO>>00794000
         ERRNUM := USERNAMEMISSING                             <<U.RAO>>00796000
      ELSE  <<REALLY IGNORE>>                                  <<U.RAO>>00798000
   ELSE IF TOKENPTR = "@" AND TOKENLEN>1 THEN                  <<U.RAO>>00800000
      BEGIN                                                    <<U.RAO>>00802000
      @TOKENPTR := @TOKENPTR+1;                                <<U.RAO>>00804000
      ERRNUM := JOBXPCTJUSTAT                                  <<U.RAO>>00806000
      END                                                      <<U.RAO>>00808000
   ELSE IF TOKENLEN>8 THEN                                     <<U.RAO>>00810000
      ERRNUM := JOBNAMETOOLONG                                 <<U.RAO>>00812000
   ELSE IF TOKENPTR<>ALPHA AND TOKENPTR<>"@" THEN              <<U.RAO>>00814000
      ERRNUM := JOBXPCTALPHA                                   <<U.RAO>>00816000
   ELSE   <<LOOKS OK>>                                         <<U.RAO>>00818000
      BEGIN  <<PUT UPSHIFTED COPY IN RESULT>>                  <<U.RAO>>00820000
      MOVE BRESULT(18) := TOKENPTR WHILE ANS;                  <<U.RAO>>00822000
      RESULT(13) := FULLNAME;  <<JOBID PARSED TYPE>>           <<U.RAO>>00824000
      IF NOT GETNEXT THEN                                      <<U.RAO>>00826000
         ERRNUM := USERNAMEMISSING;                            <<U.RAO>>00828000
      END;                                                     <<U.RAO>>00830000
   END;                                                        <<U.RAO>>00832000
IF ERRNUM = 0 THEN   <<NO ERRORS YET - CONTINUE PARSE>>        <<U.RAO>>00834000
   BEGIN <<DO user.acct PART>>                                 <<U.RAO>>00836000
   RESULT(16) := RESULT(16)+1;                                 <<U.RAO>>00838000
   IF TOKENLEN = 0 THEN                                        <<U.RAO>>00840000
      ERRNUM := USERNAMEMISSING                                <<U.RAO>>00842000
   ELSE IF TOKENPTR="@" THEN                                   <<U.RAO>>00844000
      IF TOKENLEN=1 THEN  <<COULD BE "@" OR "@.acct">>         <<U.RAO>>00846000
         IF DELIM<>"." THEN  <<JUST PLAIN "@">>                <<U.RAO>>00848000
            RESULT(13) := ALL  <<EVERY JOB OR SESSION>>        <<U.RAO>>00850000
         ELSE   <<@.acct>>                                     <<U.RAO>>00852000
            RESULT(13) := ALLOFACCT  <<ALL OF PARTICULAR ACCT>><<U.RAO>>00854000
      ELSE IF TOKENLEN=2 THEN  <<COULD BE @S OR @J>>           <<U.RAO>>00856000
         IF TOKENPTR(1) = "S" THEN                             <<U.RAO>>00858000
            RESULT(13) := ALLSESSIONS                          <<U.RAO>>00860000
         ELSE IF TOKENPTR(1) = "J" THEN                        <<U.RAO>>00862000
            RESULT(13) := ALLJOBS                              <<U.RAO>>00864000
         ELSE   <<DON'T RECOGNIZE FIRST CHARACTER>>            <<U.RAO>>00866000
            BEGIN                                              <<U.RAO>>00868000
            @TOKENPTR := @TOKENPTR+1;                          <<U.RAO>>00870000
            ERRNUM := XPCTJORS                                 <<U.RAO>>00872000
            END                                                <<U.RAO>>00874000
      ELSE                                                     <<U.RAO>>00876000
         ERRNUM := XPCTJSORAT                                  <<U.RAO>>00878000
   ELSE IF TOKENLEN>8 THEN                                     <<U.RAO>>00880000
      ERRNUM := USERNAMETOOLONG                                <<U.RAO>>00882000
   ELSE IF TOKENPTR <> ALPHA THEN                              <<U.RAO>>00884000
      ERRNUM := USERXPCTALPHA                                  <<U.RAO>>00886000
   ELSE IF DELIM <> "." THEN                                   <<U.RAO>>00888000
      BEGIN                                                    <<U.RAO>>00890000
      @TOKENPTR := @DELIM;                                     <<U.RAO>>00892000
      ERRNUM := XPCTPERIODDELIM                                <<U.RAO>>00894000
      END                                                      <<U.RAO>>00896000
   ELSE                                                        <<U.RAO>>00898000
      MOVE BRESULT(2) := TOKENPTR WHILE ANS;                   <<U.RAO>>00900000
   <<PRETTY MUCH FINISHED NOW.  JUST PARSE ACCT NAME, IF ANY>> <<U.RAO>>00902000
   IF ERRNUM = 0 AND RESULT(13) < ALLSESSIONS THEN             <<U.RAO>>00904000
      BEGIN   <<EXPECTING ACCT NAME>>                          <<U.RAO>>00906000
      RESULT(16) := RESULT(16)+1;                              <<U.RAO>>00908000
      IF NOT GETNEXT OR TOKENLEN=0 THEN                        <<U.RAO>>00910000
         ERRNUM := ACCTNAMEMISSING                             <<U.RAO>>00912000
      ELSE IF TOKENPTR="@" THEN                                <<U.RAO>>00914000
         ERRNUM := ACCTXPCTNAMNTAT                             <<U.RAO>>00916000
      ELSE IF TOKENLEN>8 THEN                                  <<U.RAO>>00918000
         ERRNUM := ACCTNAMETOOLONG                             <<U.RAO>>00920000
      ELSE IF TOKENPTR<>ALPHA THEN                             <<U.RAO>>00922000
         ERRNUM := ACCTXPCTALPHA                               <<U.RAO>>00924000
      ELSE  <<ACCT NAME PARSED - NOW FINISH UP>>               <<U.RAO>>00926000
         MOVE BRESULT(10) := TOKENPTR WHILE ANS;               <<U.RAO>>00928000
      END                                                      <<U.RAO>>00930000
   END;                                                        <<U.RAO>>00932000
IF ERRNUM <> 0 THEN                                            <<U.RAO>>00934000
   BEGIN                                                       <<U.RAO>>00936000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>00938000
   RESULT(15) := ERRNUM;                                       <<U.RAO>>00940000
   END                                                         <<U.RAO>>00942000
ELSE                                                           <<U.RAO>>00944000
   BEGIN                                                       <<U.RAO>>00946000
   PARSEJOBID := TRUE;                                         <<U.RAO>>00948000
   RESULT(15) := DELIM;                                        <<U.RAO>>00950000
   RESULT(14) := @IDPTR;                                       <<U.RAO>>00952000
   END;                                                        <<U.RAO>>00954000
END;   <<SUBROUTINE PARSEJSNAME>>                              <<U.RAO>>00956000
<<             OUTER BLOCK OF PROCEDURE               >>       <<U.RAO>>00958000
<<FIRST STEP IS MISC INITIALIZATION>>                          <<U.RAO>>00960000
@IDPTR := @TOKENPTR := @JOBID;                                 <<U.RAO>>00962000
RESULT(16) := 1;                                               <<U.RAO>>00964000
<<ERRNUM INITIALIZED TO 0 IN DECLARATIONS>>                    <<U.RAO>>00966000
<<PARSEJOBID ASSUMED INITIALIZED TO FALSE>>                    <<U.RAO>>00968000
<<  GET FIRST TOKEN TO CHOOSE BETWEEN JOB NAME OR NUMBER>>     <<U.RAO>>00970000
IF NOT GETNEXT THEN    <<JOBID MISSING>>                       <<U.RAO>>00972000
   BEGIN                                                       <<U.RAO>>00974000
   RESULT(14) := @TOKENPTR;                                    <<U.RAO>>00976000
   RESULT(15) := JOBIDMISSING;                                 <<U.RAO>>00978000
   END                                                         <<U.RAO>>00980000
ELSE IF TOKENPTR = "#" THEN                                    <<U.RAO>>00982000
   BEGIN  <<ASSUME J/S NUMBER>>                                <<U.RAO>>00984000
   @TOKENPTR := @TOKENPTR+1;  <<SKIP "#">>                     <<U.RAO>>00986000
   TOKENLEN := TOKENLEN-1;                                     <<U.RAO>>00988000
   PARSEJSNUMBER;                                              <<U.RAO>>00990000
   END                                                         <<U.RAO>>00992000
ELSE IF DELIM <> "." AND DELIM <> "," AND                      <<U.RAO>>00994000
   (TOKENPTR="J" OR TOKENPTR="S") THEN                         <<U.RAO>>00996000
      PARSEJSNUMBER                                            <<U.RAO>>00998000
ELSE   <<ASSUME ACTUAL [JSNAME,]USER.ACCT>>                    <<U.RAO>>01000000
   PARSEJSNAME;                                                <<U.RAO>>01002000
END;   <<PARSEJOBID>>                                          <<U.RAO>>01004000
LOGICAL PROCEDURE SCANJMAT(NEXTINDEX, JOBID, RESULT);          <<U.RAO>>01006000
INTEGER NEXTINDEX;                                             <<U.RAO>>01008000
INTEGER ARRAY JOBID;                                           <<U.RAO>>01010000
INTEGER ARRAY RESULT;                                          <<U.RAO>>01012000
OPTION PRIVILEGED, UNCALLABLE;                                 <<04.RO>>01014000
<<FUNCTION:  Finds next qualified entry in JMAT based on     >><<U.RAO>>01016000
<<           NEXTINDEX and the information in JOBID.         >><<U.RAO>>01018000
<<INPUT:                                                     >><<U.RAO>>01020000
<<       NEXTINDEX - JMAT index of JMAT entry at which scan  >><<U.RAO>>01022000
<<          will be started.  This typically will be the     >><<U.RAO>>01024000
<<          value returned from the last call to SCANJMAT.   >><<U.RAO>>01026000
<<          Note that the first legal index in the JMAT is 1.>><<U.RAO>>01028000
<<       JOBID - A formatted array containing the qualifying >><<U.RAO>>01030000
<<          information.                                     >><<U.RAO>>01032000
<<             JOBID(13) = 0 => job number                   >><<U.RAO>>01034000
<<                         1 => job name, user.acct          >><<U.RAO>>01036000
<<                         2 => user.acct                    >><<U.RAO>>01038000
<<                         3 => @.acct                       >><<U.RAO>>01040000
<<                         4 => @S                           >><<U.RAO>>01042000
<<                         5 => @J                           >><<U.RAO>>01044000
<<                         6 => @   (all jobs and sessions)  >><<U.RAO>>01046000
<<             If JOBID(12) = 0, the job number is formatted >><<U.RAO>>01048000
<<                in JOBID(0).                               >><<U.RAO>>01050000
<<             If JOBID(12) >= 4, the rest of JOBID can be   >><<U.RAO>>01052000
<<                ignored.                                   >><<U.RAO>>01054000
<<             Otherwise, JOBID has the job, user and account>><<U.RAO>>01056000
<<                names in the form required by the JMAT,    >><<U.RAO>>01058000
<<                starting at JOBID(1).                      >><<U.RAO>>01060000
<<OUTPUT:                                                    >><<U.RAO>>01062000
<<         SCANJMAT - TRUE if scan found candidate,          >><<U.RAO>>01064000
<<            FALSE if end of JMAT encountered first.        >><<U.RAO>>01066000
<<                                                           >><<U.RAO>>01068000
<<         NEXTINDEX -   JMAT index of this candidate, plus 1>><<U.RAO>>01070000
<<                                                           >><<U.RAO>>01072000
<<         RESULT(0) -   JMAT entry element 0.               >><<U.RAO>>01074000
<<         RESULT(1) -   $STDLIST ldev.                      >><<U.RAO>>01076000
<<         RESULT(2) -   Funny terminal (APL) bits.          >><<U.RAO>>01078000
<<                                                           >><<U.RAO>>01080000
<<         JOBID(0) -    Job type and number for this candidate<<U.RAO>>01082000
<<         JOBID(1-4) -  User name.                          >><<U.RAO>>01084000
<<         JOBID(5-8) -  Account name.                       >><<U.RAO>>01086000
<<         JOBID(9-12) - Job name, if any, or blanks.        >><<U.RAO>>01088000
<<                                                           >><<U.RAO>>01090000
<<                                                           >><<U.RAO>>01092000
BEGIN                                                          <<U.RAO>>01094000
ARRAY LOCALCOPY(0:25);                                         <<U.RAO>>01096000
BYTE ARRAY BLOCALCOPY(*) = LOCALCOPY;                          <<U.RAO>>01098000
BYTE ARRAY BJOBID(*) = JOBID;                                  <<U.RAO>>01100000
INTEGER COMPARELEN;   <<LENGTH OF BYTE COMPARE WHEN NEEDED.>>  <<U.RAO>>01102000
INTEGER TCOMPAREOFFSET;  <<BYTE OFFSET FROM JMATENTRY(0)   >>  <<U.RAO>>01104000
INTEGER SCOMPAREOFFSET;  <<BYTE OFFSET FROM JOBID(0)       >>  <<U.RAO>>01106000
INTEGER OLDSIR;  <<HOLDS RETURN FROM GETSIR>>                  <<U.RAO>>01108000
LOGICAL FOUNDENTRY;   <<FLAG TO SHOW FOUND CANDIDATE.      >>  <<U.RAO>>01110000
LOGICAL MASK;   <<USED FOR COMPARES FOR @, @S AND @J       >>  <<U.RAO>>01112000
DOUBLE JMATDATA;  <<GLOBAL DATA FROM JMAT>>                    <<U.RAO>>01114000
INTEGER LASTJMATINDEX = JMATDATA;                              <<U.RAO>>01116000
INTEGER JMATENTRYSIZE = JMATDATA+1;                            <<U.RAO>>01118000
EQUATE JMATDST = 25,                                           <<U.RAO>>01120000
       JMATSIR = 15;                                           <<U.RAO>>01122000
DEFINE ENTRYTYPE = (0:6)#;  <<TYPE OF JMAT ENTRY FIELD.>>      <<U.RAO>>01124000
DEFINE FUNNYTERMBITS = 24).(3:2 #,  <<APL TERM TYPE>>          <<U.RAO>>01126000
       LISTLDEV = 18).(8:8 #;   <<$STDLIST LDEV>>              <<U.RAO>>01128000
EQUATE ALLSESSIONS = 4;                                        <<U.RAO>>01130000
EQUATE JOBTYPESESSION = %40000,                                <<U.RAO>>01132000
       JOBTYPEJOB = %100000;                                   <<U.RAO>>01134000
LOGICAL SUBROUTINE GETJMATENTRY;                               <<U.RAO>>01136000
BEGIN                                                          <<U.RAO>>01138000
<<This subroutine whirls through the JMAT looking for the>>    <<U.RAO>>01140000
<<next non-garbage entry.  If one is found before the end>>    <<U.RAO>>01142000
<<of the JMAT the subroutine returns true and the entry>>      <<U.RAO>>01144000
<<will reside in LOCALCOPY.>>                                  <<U.RAO>>01146000
IF NEXTINDEX <= LASTJMATINDEX THEN                             <<U.RAO>>01148000
   BEGIN                                                       <<00745>>01150000
   DO   <<LOOP THROUGH JMAT>>                                  <<U.RAO>>01152000
      BEGIN                                                    <<U.RAO>>01154000
      TOS := @LOCALCOPY;                                       <<U.RAO>>01156000
      TOS := JMATDST;                                          <<U.RAO>>01158000
      TOS := NEXTINDEX*JMATENTRYSIZE;                          <<U.RAO>>01160000
      TOS := JMATENTRYSIZE;                                    <<U.RAO>>01162000
      ASSEMBLE(MFDS);                                          <<U.RAO>>01164000
      NEXTINDEX := NEXTINDEX+1;                                <<U.RAO>>01166000
      END                                                      <<U.RAO>>01168000
   UNTIL (LOCALCOPY.ENTRYTYPE<>0) OR (NEXTINDEX>LASTJMATINDEX);<<U.RAO>>01170000
   IF LOCALCOPY.ENTRYTYPE <> 0 THEN GETJMATENTRY := TRUE;      <<00745>>01172000
   END;                                                        <<00745>>01174000
END;   <<SUBROUTINE GETJMATENTRY>>                             <<U.RAO>>01176000
<<INITIALIZATION SECTION>>                                     <<U.RAO>>01178000
OLDSIR := GETSIR(JMATSIR);                                     <<U.RAO>>01180000
TOS := @JMATDATA;                                              <<U.RAO>>01182000
TOS := JMATDST;                                                <<U.RAO>>01184000
TOS := 0;                                                      <<U.RAO>>01186000
TOS := 2;                                                      <<U.RAO>>01188000
ASSEMBLE(MFDS);  <<GET JMAT GLOBAL DATA>>                      <<U.RAO>>01190000
JMATENTRYSIZE := JMATENTRYSIZE.(8:8);                          <<00725>>01192000
LASTJMATINDEX:= ((LASTJMATINDEX.(8:8)&LSL(7))/JMATENTRYSIZE)-1;<<00625>>01194000
IF JOBID(13) < ALLSESSIONS THEN   <<COMPARE IS NECESSARY>>     <<U.RAO>>01196000
   BEGIN                                                       <<U.RAO>>01198000
   <<SET PARAMETERS FOR COMPARE>>                              <<U.RAO>>01200000
   CASE JOBID(13) OF                                           <<U.RAO>>01202000
      BEGIN                                                    <<U.RAO>>01204000
                                                               <<U.RAO>>01206000
         BEGIN   <<JOB/SESSION NUMBER>>                        <<U.RAO>>01208000
         COMPARELEN := 2;                                      <<U.RAO>>01210000
         TCOMPAREOFFSET := 2;  <<BYTE FROM START OF JMAT ENTRY><<U.RAO>>01212000
         SCOMPAREOFFSET := 0;  <<BYTES FROM START OF JOBID>>   <<U.RAO>>01214000
         END;                                                  <<U.RAO>>01216000
                                                               <<U.RAO>>01218000
         BEGIN   <<FULLY QUALIFIED JOB ID>>                    <<U.RAO>>01220000
         COMPARELEN := 24;    <<BYTES>>                        <<U.RAO>>01222000
         TCOMPAREOFFSET := 4;                                  <<U.RAO>>01224000
         SCOMPAREOFFSET := 2;                                  <<U.RAO>>01226000
         END;                                                  <<U.RAO>>01228000
                                                               <<U.RAO>>01230000
         BEGIN   <<USER.ACCT>>                                 <<U.RAO>>01232000
         COMPARELEN := 16;                                     <<U.RAO>>01234000
         TCOMPAREOFFSET := 4;                                  <<U.RAO>>01236000
         SCOMPAREOFFSET := 2;                                  <<U.RAO>>01238000
         END;                                                  <<U.RAO>>01240000
                                                               <<U.RAO>>01242000
         BEGIN   <<@.ACCT>>                                    <<U.RAO>>01244000
         COMPARELEN := 8;                                      <<U.RAO>>01246000
         TCOMPAREOFFSET := 12;                                 <<U.RAO>>01248000
         SCOMPAREOFFSET := 10;                                 <<U.RAO>>01250000
         END;                                                  <<U.RAO>>01252000
      END;   <<CASE STATEMENT>>                                <<U.RAO>>01254000
   <<NOW QUALIFY ENTRY>>                                       <<U.RAO>>01256000
   DO                                                          <<U.RAO>>01258000
      FOUNDENTRY := GETJMATENTRY                               <<U.RAO>>01260000
      UNTIL NOT FOUNDENTRY <<NO MORE IN JMAT>>   OR            <<U.RAO>>01262000
         (BJOBID(SCOMPAREOFFSET) = BLOCALCOPY(TCOMPAREOFFSET), <<U.RAO>>01264000
            (COMPARELEN));  <<HAVE MATCH>>                     <<U.RAO>>01266000
   END                                                         <<U.RAO>>01268000
ELSE   <<@, @S, @J - FIND NEXT QUALIFYING JOB TYPE>>           <<U.RAO>>01270000
   BEGIN                                                       <<U.RAO>>01272000
   <<TECHNIQUE IS TO CREATE A MASK WITH THE DESIRED JOB TYPE>> <<U.RAO>>01274000
   <<IN BITS 0:2, THEN DO LAND ON CANDIDATES IN JMAT FOR MATCH><<U.RAO>>01276000
   CASE JOBID(13) - ALLSESSIONS OF                             <<U.RAO>>01278000
      BEGIN                                                    <<U.RAO>>01280000
      MASK := JOBTYPESESSION;   <<ALL SESSIONS>>               <<U.RAO>>01282000
      MASK := JOBTYPEJOB;       <<ALL JOBS>>                   <<U.RAO>>01284000
      MASK := -1;   <<EVERYTHING>>                             <<U.RAO>>01286000
      END;   <<MASK IS NOW SET UP>>                            <<U.RAO>>01288000
   DO                                                          <<U.RAO>>01290000
      FOUNDENTRY := GETJMATENTRY   <<SCAN FOR ENTRY>>          <<U.RAO>>01292000
      UNTIL NOT FOUNDENTRY  <<JMAT EXHAUSTED>>                 <<U.RAO>>01294000
         OR ((LOCALCOPY(1) LAND MASK) <> 0);  <<HAVE A HIT>>   <<U.RAO>>01296000
   END;                                                        <<U.RAO>>01298000
<<NOW RETURN SCAN RESULTS>>                                    <<U.RAO>>01300000
IF FOUNDENTRY THEN   <<HAVE A WINNER>>                         <<U.RAO>>01302000
   BEGIN                                                       <<U.RAO>>01304000
   RESULT := LOCALCOPY;                                        <<U.RAO>>01306000
   RESULT(1) := LOCALCOPY(LISTLDEV);                           <<U.RAO>>01308000
   RESULT(2) := LOCALCOPY(FUNNYTERMBITS);                      <<U.RAO>>01310000
   MOVE JOBID := LOCALCOPY(1), (13);                           <<U.RAO>>01312000
   SCANJMAT := TRUE;                                           <<U.RAO>>01314000
   END;                                                        <<U.RAO>>01316000
RELSIR(JMATSIR, OLDSIR);                                       <<U.RAO>>01318000
END;   <<PROCEDURE SCANJMAT>>                                  <<U.RAO>>01320000
INTEGER PROCEDURE JMATINFO(JOBID,RESULT);                      <<U.RAO>>01322000
   BYTE ARRAY JOBID;                                           <<00.06>>01324000
   INTEGER ARRAY RESULT;                                       <<00.06>>01326000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00.06>>01328000
<<                                                             <<00.06  01330000
   RETURNS WORD 0 FROM JMAT FOR THIS <JOBID>.                  <<00.06  01332000
   RETURNS $STDLIST AND FUNNYTERMINAL TYPE FROM JMAT.          <<00.06  01334000
   ALSO DOES SOME PARSING OF JOBID FOR TELL & WARN CMDS.       <<00.06  01336000
                                                               <<00.06  01338000
   JOBID  - IS STRING FROM CONSTELL,CONSWARN OR TELL CMDS.     <<00.06  01340000
                                                               <<00.06  01342000
                                                               <<00.06  01344000
   RETURNS:                                                             01346000
      0- OKAY                                                           01348000
         RESULT (0) = DELIMITER DETECTED FOLLOWING <JOBID>,             01350000
         RESULT (1) = BYTE POINTER TO CHARACTER PAST LAST DELIMITER,    01352000
         RESULT (2) = WORD 0 OF JMAT ENTRY,                             01354000
         RESULT (3) = (6:2) IS JMAT(24).(3:2) APL TERMINAL,    <<00.06  01356000
                      (8:8) IS JMAT(18).(8:8) $STDLIST         <<00.06  01358000
      1- SYNTAX ERROR.                                                  01360000
      2- JOB NOT FOUND.                                                 01362000
   DB MUST BE AT STACK.    JMATSIR ACQUIRED AND RELEASED.               01364000
   MOTE:  RESULT(2) SHOULD BE CHECKED TO ENSURE THAT JOB IS IN CORRECT  01366000
      STATE FOR THE APPLICATION.  (JMAT ENTRY HAS DIFFERENT FORMAT      01368000
      DEPENDING ON STATE.)                                              01370000
>>                                                                      01372000
                                                                        01374000
BEGIN                                                                   01376000
   INTEGER           NP,                                                01378000
                     LEN               := 16,                           01380000
                     P                 := -1;                           01382000
   POINTER           DLTARGET;                                 <<00.06>>01384000
   INTEGER ARRAY     TARGET (0:11);                                     01386000
   BYTE ARRAY        BTARGET (*)       = TARGET;                        01388000
   ARRAY             STRING(0:36);                            <<01.01>> 01390000
   BYTE ARRAY        BSTRING(*)         =STRING;              <<01.01>> 01392000
   LOGICAL           TEMP;                                    <<01.01>> 01394000
<< FOR MYCOMMAND >>                                                     01396000
   INTEGER           X1                := ";,",                         01398000
                     X2                := %27015;                       01400000
   BYTE ARRAY        DELS (*)          = X1;                            01402000
   DOUBLE ARRAY      PARMS (0:2)=Q;                                     01404000
   INTEGER ARRAY     WPARMS (*)        = PARMS;                         01406000
   BYTE POINTER      PARM1             = PARMS;                         01408000
   DEFINE            PARM1LEN          = WPARMS(1) & LSR(8) #,          01410000
                     PARM1DEL          = WPARMS(1).(11:5) #;            01412000
<< JMAT STUFF >>                                                        01414000
   EQUATE            JMATSIR           = 15,                            01416000
                     JMATDST           = 25;                            01418000
   INTEGER POINTER   JMATLAST;                                          01420000
   DEFINE            JMAT'CURSIZE      = DB0.(8:8) #;                   01422000
   INTEGER           JMATESIZE         = DB +1;                         01424000
   ARRAY              JMATTEMP (*)      =DB+12;               <<01.01>> 01426000
   BYTE ARRAY        BJMATTEMP (*)     = JMATTEMP;                      01428000
<< >>                                                                   01430000
                                                                        01432000
                                                                        01434000
INTEGER SUBROUTINE MOVENAME (BDEST);                                    01436000
   VALUE BDEST;                                                         01438000
   INTEGER BDEST;                                                       01440000
BEGIN                                                                   01442000
   P := P+1;                                                            01444000
   TOS := @BTARGET (BDEST);                                             01446000
   TOS := PARMS (P);                                                    01448000
   S5 := S0.(11:5);                                                     01450000
   TOS := TOS & LSR(8);                                                 01452000
   IF = OR S0 > 8 THEN GOTO SYNERR;                                     01454000
   MOVE * := *, (TOS);                                                  01456000
   END    <<MOVENAME>>;                                                 01458000
                                                                        01460000
                                                                        01462000
   MOVE BSTRING:=JOBID, (72);                                 <<01.01>> 01464000
   STRING(36):=%6415;                                         <<01.01>> 01466000
   MYCOMMAND (JOBID, DELS, 3, NP, PARMS);                               01468000
   IF <  THEN GOTO SYNERR;                                    <<01.01>> 01470000
   SCAN BSTRING UNTIL %6415, 1;                               <<01.01>> 01472000
   TEMP:=TOS+1;                                               <<01.01>> 01474000
   TEMP:=TEMP-LOGICAL(@BSTRING);                              <<01.01>> 01476000
   IF NP = 0 THEN GOTO SYNERR;                                          01478000
   IF PARM1 = "#" THEN                                                  01480000
      BEGIN                            << JOB NUMBER SPECIFICATION>>    01482000
      TOS := 0;                                                         01484000
      TOS := @PARM1(2);                                                 01486000
      TOS := PARM1LEN -2;                                               01488000
      IF <= THEN GOTO SYNERR;                                           01490000
      TOS := BINARY (*, *);                                             01492000
      IF <> OR S0.(0:2) <> 0 THEN GOTO SYNERR;                          01494000
      IF PARM1(1) = "S" THEN TOS := 1                                   01496000
         ELSE IF PARM1 (XREG) = "J" THEN TOS := 2                       01498000
               ELSE                                                     01500000
SYNERR:           BEGIN                                                 01502000
                  JMATINFO := 1;                                        01504000
                  RETURN;                                               01506000
                  END;                                                  01508000
      TOS.(0:2) := TOS;                                                 01510000
      TARGET := TOS;                                                    01512000
      P := 0;                                                           01514000
      LEN := 2;                                                         01516000
      END                                                               01518000
   ELSE                                                                 01520000
      BEGIN                            << JOBNAME >>                    01522000
      TARGET := %20040;                                                 01524000
      MOVE TARGET (1) := TARGET, (11);                                  01526000
      IF PARM1DEL = 1 THEN                                              01528000
         BEGIN                         << USER'S JOB NAME >>            01530000
         MOVENAME (16);                                                 01532000
         LEN := 24;                                                     01534000
         END;                                                           01536000
      IF MOVENAME (0) <> 2 THEN GOTO SYNERR;                            01538000
      MOVENAME (8);                                                     01540000
      END;                                                              01542000
   TOS := PARMS (P);                   << GET LAST DEL AND POINTER >>   01544000
   TOS := (RESULT := DELS (TOS.(11:5)));                                01546000
   SCAN * UNTIL (TOS), 1;                                               01548000
   RESULT (1) := TOS +1;                                                01550000
   PUSH (DL);                                                           01552000
@DLTARGET := -TOS + @TARGET;                                  <<01.01>> 01554000
   TOS := JMATSIR;                                                      01556000
   TOS := GETSIR (S0);                                                  01558000
   EXCHANGEDB (JMATDST);                                                01560000
                                                                        01562000
   TOS := @JMATTEMP;                                                    01564000
TOS := @DLTARGET;                                             <<01.01>> 01566000
   TOS := LEN &ASR(1);                                                  01568000
   ASSEMBLE (MVLB);                                                     01570000
   @JMATLAST := JMAT'CURSIZE&ASL(7) - JMATESIZE;                        01572000
   TOS := JMATESIZE;                                                    01574000
   DO IF PS0 <> 0 THEN                                                  01576000
         BEGIN                                                          01578000
         TOS := (@PS0 +2) & LSL(1);                                     01580000
         IF LEN = 2 THEN TOS := TOS -2;                                 01582000
         IF * = BJMATTEMP, (LEN) THEN                                   01584000
            BEGIN                      << FOUND ONE >>                  01586000
            TOS := @DLTARGET;                                  <<00.06>>01588000
            TOS := @PS1(18); <<OFFSET TO $STDLIST>>            <<00.06>>01590000
            TOS := 7;        <<LENGTH TO FUNNYTERM TYPE>>      <<00.06>>01592000
            ASSEMBLE (MVBL);                                            01594000
            TOS := PS0;                                                 01596000
            EXCHANGEDB (0);                                             01598000
            RESULT (2) := TOS;                                          01600000
            TOS := TARGET.(8:8);  <<$STDLIST>>                 <<00.06>>01602000
            RESULT(3) := TOS CAT TARGET(6) (6:3:2);<<FUNNYTERM><<00.06>>01604000
            TOS := 0;                                                   01606000
            GOTO LEAVEJMAT;                                             01608000
            END;                                                        01610000
         END                                                            01612000
   UNTIL (TOS := TOS+JMATESIZE) > @JMATLAST;                            01614000
   TOS := 2;                           << NOT FOUND >>                  01616000
   EXCHANGEDB (0);                                                      01618000
LEAVEJMAT:                                                              01620000
   JMATINFO := TOS;                                                     01622000
   ASSEMBLE (DEL);                                                      01624000
   RELSIR (*, *);                                                       01626000
   MOVE JOBID:= BSTRING, (TEMP);                              <<01.01>> 01628000
   END    <<JMATINFO>>;                                                 01630000
                                                                        01632000
                                                                        01634000
PROCEDURE CRUNCH(N1,N2,N3,DEST,NWORDS);                                 01636000
    INTEGER NWORDS;                                                     01638000
    INTEGER ARRAY DEST;                                                 01640000
    BYTE ARRAY N1,N2,N3;                                                01642000
   OPTION PRIVILEGED, UNCALLABLE;                                       01644000
         <<PROCEDURE TO PUT ENTRY NAMES INTO STANDARD FORM.           >>01646000
         <<HIGH ORDER BIT OF FIRST BYTE OF EACH NAME PART IS TURNED ON>>01648000
         <<EACH NAME PART MUST BE TERMINATED BY A NON-ALPHANUMERIC.   >>01650000
         <<N1,N2,N3 - NAME PARTS TO BE CONCATENATED TO FORM ENTRY NAME>>01652000
         <<DEST - ARRAY WHERE ENTRY NAME IS TO BE STORED.             >>01654000
         <<NWORDS:= SIZE OF ENTRY NAME IN WORDS (OUTPUT)              >>01656000
         <<NOTE: DB MUST BE POINTING TO THE STACK                     >>01658000
         <<      ARRAY "DEST" MUST BE AT LEAST 25 BYTES LONG          >>01660000
   BEGIN                                                                01664000
    INTEGER ARRAY                                                       01666000
         ISRC(0:14)=Q                                                   01668000
        ,IDEST(0:12) = Q                                                01670000
   ;BYTE ARRAY                                                          01672000
         BSRC(*) = ISRC                                                 01674000
        ,BDEST(*) = IDEST                                               01676000
   ;BYTE POINTER                                                        01678000
         BP                                                             01680000
   ;INTEGER I   <<USED AS A LOOP VARIABLE>>                    <<U.RAO>>01682000
   ;                                                                    01684000
   I := -1;                                                             01686000
   WHILE (I:=I+1)<8 DO                                                  01688000
      BEGIN   <<COMBINE SOURCES INTO LOCAL ARRAY>>                      01690000
      BSRC(I) := N1(I);                                                 01692000
      BSRC(I+10) := N2(I);                                              01694000
      BSRC(I+20) := N3(I);                                              01696000
      END;                                                              01698000
   TOS := @BDEST;                                                       01700000
   ASSEMBLE(DUP);                                                       01702000
   I := -10;                                                            01704000
   WHILE (I:=I+10)<21 DO                                                01706000
      BEGIN                                                             01708000
      BSRC(I+8) := " ";   <<TO INSURE TERMINATION>>                     01710000
      ASSEMBLE(DUP);                                                    01712000
      @BP := TOS;                                                       01714000
      MOVE * := BSRC(I) WHILE AN,1;                                     01716000
      BP := LOGICAL(BP) LOR %200;   <<TURN ON HIGH BIT OF FIRST BYTE>>  01718000
      END;                                                              01720000
   BPS0 := " ";   <<IN CASE STRING ENDS NOT ON WORD BOUNDARY>>          01722000
   ASSEMBLE(XCH; LSUB; INCA; LSR 1);                                    01724000
   NWORDS := TOS;                                                       01726000
   TOS := @DEST;   <<TARGET>>                                           01728000
   TOS := @IDEST;   <<SOURCE>>                                          01730000
   TOS := NWORDS;   <<WORD COUNT>>                                      01732000
   ASSEMBLE(MOVE 3);   <<MOVE TO CALLER ARRAY>>                         01734000
   END;   <<CRUNCH>>                                                    01736000
                                                                        01738000
                                                                        01740000
INTEGER PROCEDURE FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                   01742000
    VALUE TNO;                                                          01744000
    INTEGER TNO,PXGJDT;                                                 01746000
    BYTE ARRAY N1,N2,N3;                                                01748000
    LOGICAL A;                                                          01750000
    OPTION UNCALLABLE,PRIVILEGED;                                       01752000
         <<PROCEDURE TO FIND AN ENTRY IN THE JOB TABLE                >>01754000
         <<N1,N2,N3 = NAMES TO BE CONCATENATED AND SEARCHED (INPUT)   >>01756000
         <<TNO = TABLE # (1,2 OR 3) (INPUT)                           >>01758000
         <<TNO = 0- EXCHANGEDB,GETSIR,PASS BACK PXGJSIR,A,PXGJDT      >>01760000
         <<         BUT DO NO MORE                                    >>01762000
         <<A := LOCKJIR RETURN VALUE                                   >01764000
         <<PXGJDT:= JOB TABLE DST# (OUTPUT)                           >>01766000
         <<FINDJTENTRY:= SEG.REL.ADR.OF ENTRY (:=0 IF NOT FOUND)      >>01768000
         <<UPON ENTRY, DB MUST BE POINTING AT THE STACK               >>01770000
         <<UPON EXIT, DB WILL BE POINTING AT THE JOB TABLE            >>01772000
   BEGIN                                                                01774000
    INTEGER                                                             01776000
         I                                                              01778000
        ,NAMSIZE   <<#WORDS IN CONCATENATED ENTRY NAME>>                01780000
        ,IDNO = Q-10   <<INDEX OF ENTRY WORD 0 (SEG.REL.ADR.)>>         01782000
   ;INTEGER ARRAY                                                       01784000
         CRUNCHED(0:12) = Q   <<Q-REL.ARRAY FOR NAME>>                  01786000
   ;INTEGER POINTER                                                     01788000
         PXPNTR                                                         01790000
   ;                                                                    01792000
    EQUATE JDTWORD = 5;                                                 01794000
   PUSH(DL);                                                            01796000
   @PXPNTR := TOS - PS0(-1);                                            01798000
   PXGJDT := PXPNTR(JDTWORD).(6:10);                                    01800000
   IF TNO>0 THEN                                                        01802000
      CRUNCH(N1,N2,N3,CRUNCHED,NAMSIZE);                                01804000
   A := LOCKJIR;                                                        01806000
   EXCHANGEDB(PXGJDT);                                                  01808000
   IF TNO = 0 THEN RETURN;   <<DUMMY CALL>>                             01810000
   JDTWORKSPC := NAMSIZE;   <<WORK AREA>>                      <<U.RAO>>01812000
   I := -1;                                                             01814000
   WHILE (I:=I+1) < NAMSIZE DO                                          01816000
      BEGIN   <<MOVE CRUNCHED NAME INTO WORK AREA>>                     01818000
      JDTWORKSPC(I+1) := CRUNCHED(I);                          <<U.RAO>>01820000
      END;                                                              01822000
   I := JDTARR(TNO);   <<STARTING INDEX OF PROPER TABLE>>      <<U.RAO>>01824000
   WHILE I < JDTARR(TNO+1) DO                                  <<U.RAO>>01826000
      BEGIN   <<SEARCH UNTIL FOUND OR INDEX=START OF NEXT TABLE>>       01828000
      TOS := (@JDTARR(I)&LSL(1))+1;   <<CURRENT ENTRY>>        <<U.RAO>>01830000
      TOS := @JDTWORKSPC&LSL(1)+1;  <<GOAL NAME>>              <<U.RAO>>01832000
      TOS := (NAMSIZE&LSL(1))+1;   <<#CHAR>>                            01834000
      ASSEMBLE(CMPB 3);                                                 01836000
      IF = THEN                                                         01838000
         BEGIN                                                          01840000
         IDNO := I;   <<INDEX OF ENTRY>>                                01842000
         RETURN;                                                        01844000
         END;                                                           01846000
      I := I + JDTARR(I).(0:8);   <<INC.TO NEXT ENTRY>>        <<U.RAO>>01848000
      END;                                                              01850000
   IDNO := 0;                                                           01852000
   END;   <<FINDJTENTRY>>                                               01854000
                                                                        01856000
                                                                        01858000
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,SIZE,INFO);                      01860000
    INTEGER SIZE;                                                       01862000
    INTEGER ARRAY INFO;                                                 01864000
    BYTE ARRAY N1,N2,N3;                                                01866000
   OPTION PRIVILEGED, UNCALLABLE;                                       01868000
         <<TRACE POINTERS ORIGINATING FROM GIVEN ENTRY AND RETURN     >>01870000
         <<INFO FOUND IN FINAL ENTRY. SEARCH IS DONE IN TABLE #3      >>01872000
         <<INPUT:.....................................................>>01874000
         <<N1,N2,N3 - NAME OF ENTRY WHOSE POINTERS ARE TO BE TRACED   >>01876000
         <<OUTPUT:....................................................>>01878000
         <<SIZE     - #WORDS OF INFO RETURNED TO CALLER               >>01880000
         <<INFO     - INFORMATION FOUND IN FINAL ENTRY                >>01882000
         <<XRETJTENTRY                                                >>01884000
         <<      =0 - OK                                              >>01886000
         <<      =1 - ENTRY GIVEN CANNOT BE FOUND                     >>01888000
         <<      =2 - ENTRY POINTING TO NON-EXISTENT ENTRY            >>01890000
   BEGIN                                                                01892000
    LOGICAL                                                             01894000
         A   <<REDUNDANT LOCKJIR RETURN VALUE>>                         01896000
        ,B   <<LOCKJIR RETURN VALUE>>                                   01898000
   ;INTEGER ARRAY                                                       01900000
        IN1(0:17) = Q   <<LOCAL ARRAY FOR UNPACKING NAMES>>    <<U.RAO>>01902000
   ;BYTE ARRAY                                                          01904000
         BN1(*) = IN1                                                   01906000
        ;INTEGER                                                        01908000
         I,J,K                                                          01910000
        ,PXGJDT   <<JOB TABLE DST#>>                                    01912000
        ,SAVEDL                                                         01914000
        ,ADRIN1   <<DB-REL.ADR.OF IN1(*)>>                              01916000
        ,BN2,BN3                                                        01918000
   ;                                                                    01920000
   PUSH(DL);                                                            01922000
   SAVEDL := TOS;                                                       01924000
   ADRIN1 := @IN1;                                                      01926000
   I := FINDJTENTRY(N1,N2,N3,3,B,PXGJDT);                               01928000
   IF I=0 THEN                                                          01930000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 01932000
      XRETJTENTRY := 1;                                                 01934000
EXIT: EXCHANGEDB(0);                                                    01936000
      UNLOCKJIR(B);                                                     01938000
      RETURN;                                                           01940000
      END;                                                              01942000
NEXT:                                                                   01944000
   K := I + JDTARR(I).(8:8) + 2;   <<INDEX OF 2ND WORD OF INFO><<U.RAO>>01946000
   IF JDTARR(K).(6:1) = 0 THEN GO ENDOFLINE;   <<NO MORE POINTE<<U.RAO>>01948000
   J := JDTARR(K+1).(0:8);   <<SIZE OF NAME IN INFO (BYTES)>>  <<U.RAO>>01950000
   TOS := ADRIN1 - SAVEDL;   <<DL-REL.TARGET>>                          01952000
   TOS := K+2;   <<DB-REL.SOURCE>>                                      01954000
   TOS := (J+1)&LSR(1);   <<WORD COUNT>>                                01956000
   ASSEMBLE(MVBL 3);   <<MOVE INFO NAME INTO LOCAL ARRAY>>              01958000
   EXCHANGEDB(0);                                                       01960000
   PACKANDPOINT(BN1,J,BN2,BN3);                                         01962000
   BN1 (J) := " ";                                                      01964000
   I := FINDJTENTRY(BN1,BN2,BN3,3,A,PXGJDT);                            01966000
   IF I=0 THEN                                                          01968000
      BEGIN   <<POINTING TO NON-EXISTENT ENTRY>>                        01970000
      XRETJTENTRY := 2;                                                 01972000
      GO EXIT;                                                          01974000
      END;                                                              01976000
   EXCHANGEDB(PXGJDT);                                                  01978000
   GO NEXT;                                                             01980000
ENDOFLINE:                                                              01982000
   J := JDTARR(I).(0:8);   <<ENTRY SIZE>>                      <<U.RAO>>01984000
   TOS := @INFO-SAVEDL;   <<DL-REL.TARGET>>                             01986000
   TOS := I;   <<DB-REL.SOURCE>>                                        01988000
   TOS := J;   <<WORD COUNT>>                                           01990000
   ASSEMBLE(MVBL 3);                                                    01992000
   EXCHANGEDB(0);                                                       01994000
   SIZE := J;                                                           01996000
   GO EXIT;                                                             01998000
END;   <<PROCEDURE XRETJTENTRY>>                                        02000000
                                                                        02002000
                                                                        02004000
INTEGER PROCEDURE RETJTENTRY(N1,N2,N3,SIZE,INFO);                       02006000
    INTEGER SIZE;                                                       02008000
    INTEGER ARRAY INFO;                                                 02010000
    BYTE ARRAY N1,N2,N3;                                                02012000
OPTION PRIVILEGED, UNCALLABLE;                                          02014000
         <<RETURN JOB TABLE ENTRY INFORMATION                         >>02016000
         <<N1,N2,N3 = NAMES TO BE CONCATENATED AND SEARCHED (INPUT)   >>02018000
         <<SIZE = 1,2 OR 3 INDICATING WHICH TABLE TO SEARCH (INPUT)   >>02020000
         <<SIZE:= #WORDS OF INFORMATION PUT IN "INFO" (OUTPUT)        >>02022000
         <<INFO:= INFORMATION PORTION OF TABLE ENTRY (OUTPUT)         >>02024000
         <<RETJTENTRY:= 0 IF OK, 1 IF ENTRY CANNOT BE FOUND (OUTPUT)  >>02026000
   BEGIN                                                                02028000
    INTEGER                                                             02030000
         PXGJDT   <<JOB TABLE DST#>>                                    02032000
        ,I,J,K                                                          02034000
        ,QSIZE   <<SIZE OF INFO (WORDS)>>                               02036000
        ,SAVEDL                                                         02038000
   ;LOGICAL                                                             02040000
         A   <<LOCKJIR RETURN VALUE>>                                   02042000
   ;                                                                    02044000
   PUSH(DL);                                                            02046000
   SAVEDL := TOS;                                                       02048000
   I := FINDJTENTRY(N1,N2,N3,SIZE,A,PXGJDT);                            02050000
   IF I = 0 THEN                                                        02052000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 02054000
      RETJTENTRY := 1;                                                  02056000
      EXCHANGEDB(0);                                                    02058000
      UNLOCKJIR(A);                                            <<U.RAO>>02060000
      RETURN;                                                           02062000
      HELP;                                                             02064000
      END;                                                              02066000
   K := JDTARR(I);   <<ENTRY SIZE / NAME SIZE>>                <<U.RAO>>02068000
   J := K.(8:8) + I + 1;   <<INFO STARTING INDEX>>                      02070000
   QSIZE := K.(0:8) + I - J;   <<#WORDS OF INFO>>                       02072000
   TOS := @INFO - SAVEDL;   <<DL-REL.>>                                 02074000
   TOS := @JDTARR(J);   <<DB-REL.>>                            <<U.RAO>>02076000
   TOS := QSIZE;   <<WORD COUNT>>                                       02078000
   ASSEMBLE(MVBL 3);                                                    02080000
   EXCHANGEDB(0);                                                       02082000
   SIZE := QSIZE;                                                       02084000
   UNLOCKJIR(A);                                               <<U.RAO>>02086000
   END;   <<RETJTENTRY>>                                                02088000
                                                                        02090000
                                                                        02092000
INTEGER PROCEDURE REMJTENTRY(N1,N2,N3,TNO,ADR);                         02094000
    VALUE TNO,ADR;                                                      02096000
    INTEGER TNO,ADR;                                                    02098000
    BYTE ARRAY N1,N2,N3;                                                02100000
   OPTION PRIVILEGED, UNCALLABLE;                                       02102000
         <<PROCEDURE TO REMOVE AN ENTRY FROM THE JOB TABLE            >>02104000
         <<N1,N2,N3 - NAME PARTS OF ENTRY TO BE REMOVED (INPUT)       >>02106000
         <<TNO - TABLE # (1,2 OR 3) FROM WHICH TO REMOVE ENTRY (INPUT)>>02108000
         <<ADR = 0 - USE N1,N2,N3 TO FIND ENTRY                       >>02110000
         <<ADR > 0 - ENTRY TO BE REMOVED STARTS AT THIS ADDRESS       >>02112000
         <<REMJTENTRY.(8:8) = 0 - OK, ENTRY DELETED          >><<04573>>02114000
         <<                 = 1 - NO SUCH ENTRY              >><<04573>>02116000
         <<REMJTENTRY.(0:8) = OLD FILE REFERENCE COUNT. THIS >><<04573>>02118000
         <<                   IS RETURNED TO PRESERVE THIS   >><<04573>>02120000
         <<                   VALUE WHEN ADDING NEW FILE     >><<04573>>02122000
         <<                   EQUATIONS OF THE SAME NAME THAT>><<04573>>02124000
         <<                   IS BEING DELETED.              >><<04573>>02126000
         <<NOTE: DB MUST BE POINTING TO THE STACK                     >>02128000
OPTION PRIVILEGED, UNCALLABLE;                                          02130000
   BEGIN                                                                02132000
    INTEGER                                                             02134000
        I,J                                                             02136000
        ,PXGJDT   <<JOB TABLE DST#>>                                    02138000
        ,SEGSIZE   <<CURRENT ACTUAL SIZE OF JOB TABLE SEGMENT>>         02140000
         ,ACTLNAMEWORD  <<INDEX TO ACTUAL NAME/DEV LEN.>>      <<04573>>02142000
         ,REFCOUNT := 0 <<REFERENCE COUNT VALUE        >>      <<04573>>02144000
         ,Z             <<WORD LENGTH OF NAME/DEV      >>      <<04573>>02146000
         ,REFCNTINDEX   <<INDEX TO REF. COUNT WORD     >>      <<04573>>02148000
         ;                                                     <<04573>>02150000
   LOGICAL                                                     <<04573>>02152000
         A   <<LOCKJIR RETURN VALUE>>                                   02154000
   ;                                                                    02156000
   IF ADR = 0 THEN                                                      02158000
      I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT)                           02160000
   ELSE                                                                 02162000
      BEGIN                                                             02164000
      I := ADR;                                                         02166000
       <<DUMMY CALL-EXCH.DB,LOCKJIR,PASS BACK A,PXGJDT>>                02168000
      FINDJTENTRY(J,J,J,0,A,PXGJDT);                                    02170000
      END;                                                              02172000
   IF I=0 THEN                                                          02174000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 02176000
      REMJTENTRY := 1;                                                  02178000
EXIT: REMJTENTRY.(0:8) := REFCOUNT;                            <<04573>>02180000
      EXCHANGEDB(0);                                           <<04573>>02182000
      UNLOCKJIR(A);                                                     02184000
      RETURN;                                                           02186000
      END;                                                              02188000
    <<COMPRESS DATA TO ELIMINATE ENTRY>>                                02190000
<< Find out if the reference count is greater than zero. >>    <<04573>>02192000
<< This value will be returned as the upper 8 bits of the>>    <<04573>>02194000
<< REMJTENTRY integer value returned.                    >>    <<04573>>02196000
<<                                                       >>    <<04573>>02198000
IF TNO = 3 THEN                                                <<04906>>02200000
BEGIN                                                          <<04906>>02202000
ACTLNAMEWORD := I + JDTARR(I).(8:8) + 3;                       <<04573>>02204000
Z := (JDTARR(ACTLNAMEWORD).(0:8) + 1)&LSR(1)                   <<04573>>02206000
   + (JDTARR(ACTLNAMEWORD).(8:8) + 1)&LSR(1);                  <<04573>>02208000
   REFCNTINDEX := (ACTLNAMEWORD + Z + 10 );<<REFCNT. WORD>>    <<04573>>02210000
   REFCOUNT := (JDTARR(REFCNTINDEX)).(0:6);                    <<04573>>02212000
END;                                                           <<04906>>02214000
   TOS := I;   <<TARGET>>                                               02216000
   TOS := JDTARR(I).(0:8)+I;   <<SOURCE>>                      <<U.RAO>>02218000
   ASSEMBLE(DUP);                                                       02220000
   J := TOS;                                                            02222000
   TOS _ JFREESPCADR-J;   <<WORD COUNT (POSITIVE)>>            <<U.RAO>>02224000
   I := JDTARR(I).(0:8);                                       <<U.RAO>>02226000
   ASSEMBLE(MOVE 3);                                                    02228000
   J := TNO;                                                            02230000
   WHILE (J:=J+1) <= NUMJDTPTRS DO                             <<U.RAO>>02232000
      BEGIN   <<REDUCE STARTING ADDRESSES OF SUBSEQUENT TABLES>>        02234000
      JDTARR(J) := JDTARR(J)-I;                                <<U.RAO>>02236000
      END;                                                              02238000
   SEGSIZE := (SYS'DST(PXGJDT&LSL(2)).(3:13))&LSL(2)-1;                 02240000
   J _ JFREESPCADR-SEGSIZE;                                    <<U.RAO>>02242000
   ALTDSEGSIZE(PXGJDT,J);                                               02244000
   IF  <>  THEN  SUDDENDEATH(500);  << FATAL ERROR >>                   02246000
   GO EXIT;                                                             02248000
END;   <<REMJTENTRY>>                                                   02250000
                                                                        02252000
                                                                        02254000
PROCEDURE DELJTENTRIES(KEYNAME,KEYNAMESIZE,TNO,PXGJDT,SAVEDL);          02256000
    VALUE TNO,PXGJDT,SAVEDL,KEYNAMESIZE;                                02258000
    INTEGER TNO,PXGJDT,SAVEDL,KEYNAMESIZE;                              02260000
    BYTE ARRAY KEYNAME;                                                 02262000
    OPTION INTERNAL,PRIVILEGED,UNCALLABLE;                              02264000
         <<DELETE ALL ENTRIES POINTING TO ENTRY "KEYNAME"             >>02266000
         <<DB MUST BE POINTING AT THE STACK                           >>02268000
         <<KEYNAME = NAME OF ENTRY IN STANDARD FORM                   >>02270000
         <<KEYNAMESIZE = SIZE OF KEYNAME IN WORDS                     >>02272000
         <<TNO = TABLE #                                              >>02274000
         <<PXGJDT = DST# OF JOB TABLE                                 >>02276000
         <<SAVEDL = VALUE OF DL                                       >>02278000
   BEGIN                                                                02280000
    INTEGER ARRAY                                                       02282000
         IRAWTESTNAME(0:17)                                             02284000
        ,IENTRYNAME(0:14)                                               02286000
        ,ITESTNAME(0:14)                                                02288000
   ;BYTE ARRAY                                                          02290000
         TESTNAME(*) = ITESTNAME   <<NAME FROM INFO.-STD.FORM>>         02292000
        ,ENTRYNAME(*) = IENTRYNAME   <<NAME OF ENTRY FROM WHICH         02294000
                                       "TESTNAME" CAME (STD.FORM)>>     02296000
        ,RAWTESTNAME(*) = IRAWTESTNAME   <<INFO.NAME (RAW FORM)>>       02298000
   ;INTEGER                                                             02300000
         RAWTESTNAMESIZE   <<BYTES>>                                    02302000
        ,TESTNAMESIZE   <<WORDS>>                                       02304000
        ,I,J,K                                                          02306000
        ,ENTRYNAMESIZE   <<WORDS>>                                      02308000
        ,ENTRYSIZE   <<WORDS>>                                          02310000
        ,ADRIENTRYNAME   <<DB-REL.ADR OF IENTRYNAME>>                   02312000
        ,ADRIRAWTESTNAME   <<DB-REL.ADR OF IRAWTESTNAME>>               02314000
   ;                                                                    02316000
   ADRIENTRYNAME := @IENTRYNAME;                                        02318000
   ADRIRAWTESTNAME := @IRAWTESTNAME;                                    02320000
START:                                                                  02322000
   EXCHANGEDB(PXGJDT);                                                  02324000
   I := JDTARR(TNO);   <<STARTING INDEX OF PROPER TABLE>>      <<U.RAO>>02326000
   WHILE I < JDTARR(TNO+1) DO                                  <<U.RAO>>02328000
      BEGIN   <<CYCLE ON ENTRY>>                                        02330000
       <<MOVE ENTRY NAME TO LOCAL ARRAY>>                               02332000
      ENTRYSIZE := JDTARR(I).(0:8);                            <<U.RAO>>02334000
      TOS := ADRIENTRYNAME - SAVEDL;   <<DL-REL.TARGET>>                02336000
      TOS := I+1;   <<DB-REL.SOURCE>>                                   02338000
      TOS := JDTARR(I).(8:8);   <<WORD COUNT>>                 <<U.RAO>>02340000
      ASSEMBLE(DUP; STOR ENTRYNAMESIZE;);                               02342000
      ASSEMBLE(MVBL 3);   <<MOVE DB TO DL>>                             02344000
      K := JDTARR(I+ENTRYNAMESIZE+2);<<SAVE 2ND WORD OF PMASK>><<00272>>02346000
       <<MOVE INFO NAME TO LOCAL ARRAY>>                                02348000
      J := I+ENTRYNAMESIZE+4;   <<ADR.OF INFO.NAME>>                    02350000
      TOS := ADRIRAWTESTNAME - SAVEDL;   <<DL-REL.TARGET>>              02352000
      TOS := J;   <<DB-REL.SOURCE>>                                     02354000
      RAWTESTNAMESIZE := JDTARR(J-1).(0:8);                    <<U.RAO>>02356000
      TOS := (RAWTESTNAMESIZE+1)&LSR(1);   <<WORD COUNT>>               02358000
      ASSEMBLE(MVBL 3);   <<DB TO DL MOVE>>                             02360000
      EXCHANGEDB(0);                                                    02362000
   <<IF NOT A BACK REFERENCE OR NO ACTUAL NAME THEN SKIP TEST>><<00272>>02364000
      IF K.(6:1)=0 OR RAWTESTNAMESIZE=0 THEN GO INC;           <<00272>>02366000
       <<PUT INFO.NAME IN STANDARD FORM>>                               02368000
      PACKANDPOINT(RAWTESTNAME,RAWTESTNAMESIZE,J,K);                    02370000
   RAWTESTNAME (RAWTESTNAMESIZE) := " ";                                02372000
   << NOTE: J AND K ARE STACKED BECAUSE CRUNCH EXPECTS BYTE >> <<00271>>02374000
   << ARRAYS AS PARAMETERS AND J AND K ARE DECLARED AS      >> <<00271>>02376000
   << INTEGERS IN THIS ROUTINE.  TYPE MIXING IS DANGEROUS!! >> <<00271>>02378000
      TOS := @RAWTESTNAME;                                     <<00271>>02380000
      TOS := J;                                                <<00271>>02382000
      TOS := K;                                                <<00271>>02384000
      CRUNCH(*,*,*,ITESTNAME,TESTNAMESIZE);                    <<00271>>02386000
      IF TESTNAMESIZE = KEYNAMESIZE THEN                                02388000
         BEGIN   <<SEE IF TESTNAME SAME AS KEYNAME>>                    02390000
         TOS := @KEYNAME;   <<TARGET>>                                  02392000
         TOS := @TESTNAME;   <<SOURCE>>                                 02394000
         TOS := KEYNAMESIZE & LSL(1);   <<BYTE COUNT>>                  02396000
         ASSEMBLE(CMPB 3);                                              02398000
         IF = THEN                                                      02400000
            BEGIN   <<DELETE ENTRY AND ALL ENTRIES POINTING AT IT>>     02402000
            REMJTENTRY(J,J,J,TNO,I);                                    02404000
            DELJTENTRIES(ENTRYNAME,ENTRYNAMESIZE,TNO,PXGJDT,SAVEDL);    02406000
            GO START;   <<START SEARCH OVER AGAIN>>                     02408000
            END;                                                        02410000
         END;                                                           02412000
INC:                                                                    02414000
      I := I+ENTRYSIZE;                                                 02416000
      EXCHANGEDB(PXGJDT);                                               02418000
      END;                                                              02420000
   EXCHANGEDB(0);                                                       02422000
   END;   <<DELJTENTRIES>>                                              02424000
                                                                        02426000
                                                                        02428000
INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,TNO);                            02430000
    VALUE TNO;                                                          02432000
    INTEGER TNO;                                                        02434000
    BYTE ARRAY N1,N2,N3;                                                02436000
OPTION PRIVILEGED, UNCALLABLE;                                          02438000
   BEGIN                                                                02440000
         <<PROCEDURE TO REMOVE FROM THE JOB TABLE AN ENTRY (N1,N2,N3) >>02442000
         <<AND ALL OTHER ENTRIES DIRECTLY OR INDIRECTLY POINTING AT   >>02444000
         <<IT. ALSO, IF THE ENTRY (N1,N2,N3) POINTS TO ANOTHER ENTRY, >>02446000
         <<DECREMENT THE REF.COUNT FOR THAT ENTRY. IF THIS REF.COUNT  >>02448000
         <<GOES TO ZERO, DELETE THE ENTRY.                            >>02450000
         <<N1,N2,N3 - NAME OF ENTRY TO BE DELETED.                    >>02452000
         <<TNO - TABLE#(1,2 OR 3) FROM WHICH ENTRY IS TO BE DELETED. >> 02454000
         <<XREMJTENTRY:= 0 - OK,ENTRY DELETED.                        >>02456000
         <<           := 1 - NO SUCH ENTRY.                           >>02458000
         <<           := 2 - N1,N2,N3 POINTING TO NON-EXISTENT ENTRY. >>02460000
         <<           := 3 - REF.COUNT ALREADY ZERO IN ENTRY POINTED  >>02462000
         <<                  TO BY ENTRY N1,N2,N3.                    >>02464000
         <<NOTE: DB MUST BE POINTING TO THE STACK.                    >>02466000
    LOGICAL                                                             02468000
         A   <<LOCKJIR RETURN VALUE (NOT USED)>>                        02470000
        ,B   <<LOCKJIR RETURN VALUE>>                                   02472000
   ;INTEGER                                                             02474000
         PXGJDT   <<JOB TABLE DST#>>                                    02476000
        ,I,J,K,L      <<MISCELLANEOUS DUMMIES>>                <<U.RAO>>02478000
        ,SAVEDL                                                         02480000
        ,ADRIN1   <<DB-REL.ADR OF IN1>>                                 02482000
        ,KEYADR   <<ADR.OF ENTRY N1,N2,N3>>                             02484000
   ;INTEGER ARRAY                                                       02486000
        IN1(0:17) = Q                                          <<U.RAO>>02488000
   ;BYTE ARRAY                                                          02490000
         BN1(*) = IN1                                                   02492000
   ;LOGICAL                                                             02494000
         BN2                                                            02496000
        ,BN3                                                            02498000
   ;BYTE POINTER                                               <<00069>>02500000
         CN2                                                   <<00069>>02502000
        ,CN3                                                   <<00069>>02504000
   ;                                                                    02506000
   PUSH(DL);                                                            02508000
   SAVEDL := TOS;                                                       02510000
   B := LOCKJIR;                                                        02512000
   ADRIN1 := @IN1;                                                      02514000
   KEYADR := I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                   02516000
   IF I=0 THEN                                                          02518000
      BEGIN   <<NO SUCH ENTRY>>                                         02520000
      XREMJTENTRY := 1;                                                 02522000
EXIT1:                                                                  02524000
      EXCHANGEDB(0);                                                    02526000
EXIT2:                                                                  02528000
      UNLOCKJIR(B);                                                     02530000
      RETURN;                                                           02532000
      END;                                                              02534000
   K := I+JDTARR(I).(8:8)+2;   <<INDEX OF 2ND WORD IN INFO>>   <<U.RAO>>02536000
   IF JDTARR(K).(6:1) = 1 THEN                                 <<U.RAO>>02538000
      BEGIN   <<DECREMENT REF.COUNT IN ENTRY POINTED AT>>               02540000
      J := JDTARR(K+1).(0:8);   <<SIZE OF NAME IN INFO(BYTES)>><<U.RAO>>02542000
      TOS := ADRIN1 - SAVEDL;   <<DL-REL.TARGET>>                       02544000
      TOS := K+2;   <<DB-REL.SOURCE>>                                   02546000
      TOS := (J+1)&LSR(1);   <<WORD COUNT>>                             02548000
      ASSEMBLE(MVBL 3);   <<MOVE INFO.NAME TO LOCAL ARRAY>>             02550000
      EXCHANGEDB(0);                                                    02552000
      PACKANDPOINT(BN1,J,BN2,BN3);                                      02554000
      BN1 (J) := " ";                                                   02556000
      @CN2:=BN2;                                               <<00069>>02558000
      @CN3:=BN3;                                               <<00069>>02560000
      I := FINDJTENTRY(BN1,CN2,CN3,TNO,A,PXGJDT);              <<00069>>02562000
      IF I=0 THEN                                                       02564000
         BEGIN   <<N1,N2,N3 POINTING AT NON-EXISTENT ENTRY>>            02566000
         XREMJTENTRY := 2;                                              02568000
         GO EXIT1;                                                      02570000
         END;                                                           02572000
      K := I+JDTARR(I).(8:8)+2;   <<INDEX OF SECOND WORD IN INF<<U.RAO>>02574000
     K:=K+1;                                                   <<FORMS>>02576000
     L:=(JDTARR(K).(0:8)+1)&LSR(1)                                      02578000
     +(JDTARR(K).(8:8)+1)&LSR(1);                                       02580000
     K:=(K+L+10);                                              <<FORMS>>02582000
      L := JDTARR(K).(0:6);   <<REF.COUNT>>                    <<U.RAO>>02584000
      IF L=0 THEN                                                       02586000
         BEGIN   <<REF.COUNT ALREADY ZERO>>                             02588000
         XREMJTENTRY := 3;                                              02590000
         GO EXIT1;                                                      02592000
         END;                                                           02594000
      JDTARR(K).(0:6) := L-1;   <<DECREMENT REF.COUNT>>        <<U.RAO>>02596000
      END;                                                              02598000
   EXCHANGEDB(0);                                                       02600000
   REMJTENTRY(J,J,J,TNO,KEYADR);                                        02602000
   CRUNCH(N1,N2,N3,BN1,I);                                              02604000
   DELJTENTRIES(BN1,I,TNO,PXGJDT,SAVEDL);                               02606000
   GO EXIT2;                                                            02608000
   END;   <<XREMJTENTRY>>                                               02610000
                                                                        02612000
                                                                        02614000
INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                   02616000
    VALUE SIZE,TNO;                                                     02618000
    INTEGER SIZE,TNO;                                                   02620000
    INTEGER ARRAY INFO;                                                 02622000
    BYTE ARRAY N1,N2,N3;                                                02624000
OPTION PRIVILEGED, UNCALLABLE;                                          02626000
   BEGIN                                                                02628000
         <<PROCEDURE TO ADD ENTRY TO THE JOB TABLE.                   >>02630000
         <<N1,N2,N3 - NAME OF ENTRY BEING ADDED.                      >>02632000
         <<TNO = 1,2 OR 3 - TABLE# TO WHICH ENTRY IS TO BE ADDED.     >>02634000
         <<    = -1,-2 OR -3 - USE -TNO AS THE TABLE# AND DO NOT ISSUE>>02636000
         <<                    AN ERROR #2. IN CASE OF DUPLICATE, THE >>02638000
         <<                    OLD ENTRY IS DELETED AND THE NEW ADDED.>>02640000
         <<    = 0 - SPECIAL CALL TO ADD AN ENTRY TO TABLE #1. NAME   >>02642000
         <<          LENGTH IS ALWAYS 1 WORD (NOT PUT IN STD.FORM);   >>02644000
         <<          INFO IS 2 WORDS (4 WORD ENTRY). NO CHECK IS MADE >>02646000
         <<          FOR DUPLICATE NAMES.                             >>02648000
         <<SIZE - LENGTH OF "INFO" IN WORDS.                          >>02650000
         <<INFO - INFORMATION TO BE PUT IN TABLE ENTRY.               >>02652000
         <<ADDJTENTRY:= 0 - ENTRY ADDED.                              >>02654000
         <<          := 1 - NO ROOM FOR NEW ENTRY.                    >>02656000
         <<          := 2 - DUPLICATE NAME.                           >>02658000
         <<NOTE: DB MUST BE POINTING TO THE STACK.                    >>02660000
   INTEGER POINTER SAVETOS; <<PMASK1 WORD TARGET ADDR >>       <<04573>>02662000
    INTEGER                                                             02664000
        I,J                                                    <<U.RAO>>02666000
        ,SAVEDL   <<STACK REL.ADR.OF DL>>                               02668000
        ,PXGJDT   <<JOB TABLE DST#>>                                    02670000
        ,SEGSIZE   <<CURRENT ACTUAL SIZE OF JOB TABLE SEGMENT>>         02672000
        ,REFCOUNT := 0   <<FILE REFERENCE COUNT         >>     <<04573>>02674000
        ,RESULT := 0     <<RETURN VALUE FOR REMJTENTRY  >>     <<04573>>02676000
        ,ACTUALDEVLEN    <<FROM INFO STRING NAME/DEV LEN>>     <<04573>>02678000
        ,INFOREFINDEX    <<REF CNT INDEX FOR INFO STRING>>     <<04573>>02680000
        ,UPPERINFO       << BITS (0:8) OF INFO STRING WORD 2>> <<04573>>02682000
        ,LOWERINFO       << BITS (8:8) OF INFO STRING WORD 2>> <<04573>>02684000
   ;LOGICAL                                                             02686000
         A   <<LOCKJIR RETURN VALUE>>                                   02688000
        ,SPECALL := FALSE  <<TNO<0, NO ERROR #2 TO BE ISSUED (IF TRUE)>>02690000
   ;                                                                    02692000
   PUSH(DL);                                                            02694000
   SAVEDL := TOS;                                                       02696000
   IF TNO < 0 THEN                                                      02698000
      BEGIN                                                             02700000
      TNO := -TNO;                                                      02702000
      SPECALL := TRUE;                                                  02704000
      END;                                                              02706000
   J.(0:8) := N1;   <<SAVE ID FOR TABLE#1 (SPECIAL CALL)>>              02708000
   J.(8:8) := N1(1);                                                    02710000
FIX:                                                                    02712000
   I := FINDJTENTRY(N1,N2,N3,TNO,A,PXGJDT);                             02714000
       << AM NOW OPERATING IN SPLIT STACK MODE WITH THE >>     <<04573>>02716000
       << STACK POINTING TO THE JDT DST.  FINDJTENTRTY  >>     <<04573>>02718000
       << PUTS THE CALLER INTO SPLIT STACK MODE.        >>     <<04573>>02720000
   IF TNO = 0 THEN                                                      02722000
      BEGIN   <<SPECIAL ADD TO TABLE #1>>                               02724000
      JDTWORKSPC := %2001;   <<ENTRY SIZE=4, NAME SIZE=1>>     <<U.RAO>>02726000
      JDTWORKSPC(1) := J;   <<ENTRY NAME>>                     <<U.RAO>>02728000
      SIZE := 2;   <<INFO SIZE>>                                        02730000
      I := 4;   <<ENTRY SIZE>>                                          02732000
      GO SEG;                                                           02734000
      END;                                                              02736000
   IF I <> 0 THEN                                                       02738000
      IF NOT SPECALL THEN                                               02740000
         BEGIN   <<DUPLICATE NAME>>                                     02742000
         ADDJTENTRY := 2;                                               02744000
EXIT:    EXCHANGEDB(0);                                                 02746000
         UNLOCKJIR(A);                                                  02748000
         RETURN;                                                        02750000
         END                                                            02752000
      ELSE                                                              02754000
         BEGIN   <<DELETE OLD ENTRY>>                                   02756000
         EXCHANGEDB(0);                                                 02758000
         RESULT := REMJTENTRY(N1,N2,N3,TNO,0);                 <<04573>>02760000
 <<                                                      >>    <<04573>>02762000
 << REMJTENTRY returns an integer value. Bits (8:8) are  >>    <<04573>>02764000
 << the return value of REMJTENTRY  and are 0 or 1. Bits >>    <<04573>>02766000
 << (0:8) are the reference count from the removed file. >>    <<04573>>02768000
 << Ths is done to preserve this value so that the file  >>    <<04573>>02770000
 << being replaced with a FILE equation with the same    >>    <<04573>>02772000
 << name will not lose track of any pointer files point- >>    <<04573>>02774000
 << ing to the file being replaced.                      >>    <<04573>>02776000
                                                               <<04573>>02778000
         REFCOUNT := RESULT.(0:8);                             <<04573>>02780000
         UNLOCKJIR(A);  GO FIX;  << WRONG NAME IN WORK AREA >>          02782000
         END;                                                           02784000
       << AM IN SPLIT STACK MODE WITH STACK AT JDT DST  >>     <<04573>>02786000
   I := JDTWORKSPC.(8:8);   <<NAME SIZE>>                      <<U.RAO>>02788000
   I := SIZE + I + 1;   <<NEW ENTRY SIZE>>                              02790000
   JDTWORKSPC.(0:8) := I;   <<STORE ENTRY SIZE IN WORK AREA>>  <<U.RAO>>02792000
SEG:                                                                    02794000
   SEGSIZE := (SYS'DST(PXGJDT&LSL(2)).(3:13))&LSL(2)-1;                 02796000
   J := I - (SEGSIZE-JFREESPCADR);   <<#EXTRA WORDS NEEDED>>   <<U.RAO>>02798000
   IF (SEGSIZE+J) > JDTARR THEN                                <<U.RAO>>02800000
      BEGIN   <<NO MORE ROOM>>                                          02802000
NMR:                                                                    02804000
      ADDJTENTRY := 1;                                                  02806000
      GO EXIT;                                                          02808000
      END;                                                              02810000
   IF J > 0 THEN                                                        02812000
      BEGIN   <<INCREASE SEG.SIZE>>                                     02814000
      ALTDSEGSIZE(PXGJDT,J);                                            02816000
      IF <> THEN                                                        02818000
         GO NMR;   <<NO MORE ROOM>>                                     02820000
      END;                                                              02822000
    <<MOVE PART OF DATA  DOWN TO FIT NEW ENTRY>>                        02824000
   TOS := JFREESPCADR + I - 1;   <<TARGET>>                    <<U.RAO>>02826000
   TOS := JFREESPCADR - 1;   <<SOURCE>>                        <<U.RAO>>02828000
   TOS := JDTARR(TNO+1) - JFREESPCADR;   <<WORD COUNT (NEGATIVE<<U.RAO>>02830000
   ASSEMBLE(MOVE 3);                                                    02832000
    <<MOVE ENTRY SIZE, NAME SIZE & NAME INTO NEW ENTRY>>                02834000
   TOS := JDTARR(TNO+1);   <<TARGET>>                          <<U.RAO>>02836000
   TOS := @JDTWORKSPC;                                         <<U.RAO>>02838000
   TOS := JDTWORKSPC.(8:8) + 1;   <<#WORDS (NAME SIZE+1 FOR "SI<<U.RAO>>02840000
   ASSEMBLE(MOVE 2);                                                    02842000
    <<MOVE INFO INTO NEW ENTRY (NOTE TARGET ADR.STILL ON TOS)>>         02844000
   @SAVETOS := TOS;  <<SAVE TARGET ADDRESS, BEGINNING OF >>    <<04573>>02846000
                     <<INFO STRING                       >>    <<04573>>02848000
   TOS := @SAVETOS;  <<PUT TARGET BACK, MOVE INFO IN     >>    <<04573>>02850000
   TOS := @INFO - SAVEDL;   <<DL-REL.SOURCE ADR.>>                      02852000
   TOS := SIZE;   <<WORD COUNT (POSITIVE)>>                             02854000
   ASSEMBLE(MVLB 3);   <<DL+ TO DB+ MOVE>>                              02856000
        << MOVE IN THE REFERENCE COUNT      >>                 <<04573>>02858000
   IF TNO = 3 THEN  << Reference count only in JFEQ. >>        <<04906>>02860000
   BEGIN                                                       <<04906>>02862000
      UPPERINFO := SAVETOS(2).(0:8); <<ACTUAL DESIG. LENGTH >> <<04906>>02864000
      LOWERINFO := SAVETOS(2).(8:8); <<DEVICE LENGTH        >> <<04906>>02866000
      ACTUALDEVLEN := (UPPERINFO + LOWERINFO + 1)&LSR(1);      <<04906>>02868000
      INFOREFINDEX := 12 + ACTUALDEVLEN; <<REF COUNT INDEX>>   <<04906>>02870000
      SAVETOS(INFOREFINDEX).(0:6) := REFCOUNT.(10:6);          <<04906>>02872000
   END;                                                        <<04906>>02874000
   J := IF TNO=0 THEN 1 ELSE TNO;                                       02876000
   WHILE (J:=J+1) <= NUMJDTPTRS DO                             <<U.RAO>>02878000
      BEGIN   <<INCREASE STARTING ADDRESSES OF SUBSEQUENT TABLES>>      02880000
      JDTARR(J) := JDTARR(J)+I;                                <<U.RAO>>02882000
      END;                                                              02884000
   GO EXIT;                                                             02886000
END;   <<ADDJTENTRY>>                                                   02888000
                                                                        02890000
                                                                        02892000
INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO,                   02894000
                                           XN1,XN2,XN3);                02896000
    VALUE SIZE,TNO;                                                     02898000
    INTEGER SIZE,TNO;                                                   02900000
    BYTE ARRAY N1,N2,N3,XN1,XN2,XN3;                                    02902000
    INTEGER ARRAY INFO;                                                 02904000
OPTION PRIVILEGED, UNCALLABLE;                                          02906000
         <<ADD ENTRY N1,N2,N3 TO JOB-TABLE                            >>02908000
         <<INCREMENT REFERENCE COUNT IN EXISTING ENTRY XN1,XN2,XN3    >>02910000
         <<TNO = TABLE # (1,2 OR 3) (INPUT)                           >>02912000
         <<SIZE = #WORDS OF INFO (INPUT)                              >>02914000
         <<INFO = ARRAY OF INFORMATION (INPUT)                        >>02916000
         <<XADDJTENTRY:= 0 - EVERYTHING OK                            >>02918000
         <<           := 1 - NO ROOM FOR NEW ENTRY N1,N2,N3           >>02920000
         <<           := 2 - DUPLICATE NAME N1,N2,N3                  >>02922000
         <<           := 3 - NO SUCH ENTRY XN1,XN2,XN3                >>02924000
         <<           := 4 - REFERENCE COUNT OVERFLOW                 >>02926000
         <<           := 5 - CIRCULAR LIST                  >> <<00834>>02928000
   BEGIN                                                                02930000
   INTEGER ARRAY                                               <<U.RAO>>02932000
         IN1(0:17)=Q                                                    02934000
        ,LHS(0:12)   <<CRUNCHED LHS>>                                   02936000
        ,CHAINEL(0:12)   <<CRUNCHED RHS CHAIN ELEMENT>>                 02938000
   ;BYTE ARRAY                                                          02940000
         BN1(*) = IN1                                                   02942000
        ,BLHS(*) = LHS                                                  02944000
        ,BCHAINEL(*) = CHAINEL                                          02946000
   ;INTEGER                                                             02948000
         K                                                              02950000
        ,ABSTNO   <<ABS(TNO)>>                                          02952000
        ,RHSADR   <<ADR.OF RHS(XN1,XN2,XN3) IN TABLE>>                  02954000
        ,ADRIN1   <<ADR OF IN1(*)>>                                     02956000
        ,SAVEDL                                                         02958000
        ,BN2,BN3                                                        02960000
        ,NWDS   <<FOR COMPARE>>                                         02962000
   ;INTEGER                                                             02964000
        I,J                                                             02966000
        ,PXGJDT   <<TABLE DST #>>                                       02968000
   ;LOGICAL                                                             02970000
         A   <<LOCKJIR RETURN VALUE (NOT USED)>>                        02972000
        ,ERROR := FALSE                                                 02974000
        ,B   <<LOCKJIR RETURN VALUE>>                                   02976000
   ;                                                                    02978000
   ADRIN1 := @IN1;                                                      02980000
   PUSH(DL);                                                            02982000
   SAVEDL := TOS;                                                       02984000
   ABSTNO := IF TNO>0 THEN TNO ELSE -TNO;                               02986000
   B := LOCKJIR;                                                        02988000
   RHSADR := I := FINDJTENTRY(XN1,XN2,XN3,ABSTNO,A,PXGJDT);             02990000
   IF I=0 THEN                                                          02992000
      BEGIN   <<ENTRY CANNOT BE FOUND>>                                 02994000
      XADDJTENTRY := 3;   <<NO SUCH ENTRY>>                             02996000
EXIT1:                                                                  02998000
      EXCHANGEDB(0);                                                    03000000
EXIT: UNLOCKJIR(B);                                                     03002000
      IF ERROR THEN REMJTENTRY(N1,N2,N3,ABSTNO,0);                      03004000
      RETURN;                                                           03006000
      END;                                                              03008000
   EXCHANGEDB(0);                                                       03010000
   CRUNCH(N1,N2,N3,LHS,NWDS);   <<CRUNCH LHS>>                          03012000
   J := FINDJTENTRY(N1,N2,N3,ABSTNO,A,PXGJDT);                          03014000
   IF J=0 THEN GO RHSOK;                                                03016000
   IF I=J THEN                                                          03018000
      BEGIN   <<ERROR, N POINTING AT XN>>                               03020000
      XADDJTENTRY := 3;                                                 03022000
      GO EXIT1;                                                         03024000
      END;                                                              03026000
NEXT:                                                                   03028000
   K := I+JDTARR(I).(8:8)+2;   <<INDEX OF 2ND WORD OF INFO>>   <<U.RAO>>03030000
   IF JDTARR(K).(6:1) = 0 THEN GO RHSOK;   <<NO MORE POINTERS>><<U.RAO>>03032000
   J := JDTARR(K+1).(0:8);   <<SIZE (BYTES) OF NAME IN INFO>>  <<U.RAO>>03034000
   TOS := ADRIN1 - SAVEDL;   <<DL-REL TARGET>>                          03036000
   TOS := K+2;   <<DL-REL SOURCE>>                                      03038000
   TOS := (J+1)&LSR(1);   <<WORD COUNT>>                                03040000
   ASSEMBLE (MVBL 3);   <<MOVE INFO NAME TO LOCAL ARRAY>>               03042000
   EXCHANGEDB(0);                                                       03044000
   PACKANDPOINT(BN1,J,BN2,BN3);                                         03046000
   BN1 (J) := " ";                                                      03048000
   CRUNCH(BN1,BN2,BN3,CHAINEL,NWDS);   <<CRUNCH RHS CHAIN ELEMENT>>     03050000
   TOS := @BLHS;   <<TARGET>>                                           03052000
   TOS := @BCHAINEL;   <<SOURCE>>                                       03054000
   TOS := NWDS&LSL(1);   <<BYTE COUNT>>                                 03056000
   ASSEMBLE(CMPB 3);                                                    03058000
   IF = THEN                                                            03060000
      BEGIN   <<ERROR, CIRCULAR LINK LIST>>                             03062000
      XADDJTENTRY := 5;                                        <<00834>>03064000
      GO EXIT;                                                          03066000
      END;                                                              03068000
   I := FINDJTENTRY(BN1,BN2,BN3,ABSTNO,A,PXGJDT);                       03070000
   IF I=0 THEN SUDDENDEATH(501);   <<POINTER TO NON-EXISTENT ENTRY>>    03072000
   GO NEXT;                                                             03074000
RHSOK:   <<NO LOOPS, RHS ENTRY EXISTS>>                                 03076000
   EXCHANGEDB(0);                                                       03078000
   I := ADDJTENTRY(N1,N2,N3,TNO,SIZE,INFO);                             03080000
   IF I<>0 THEN                                                         03082000
      BEGIN   <<ERROR>>                                                 03084000
      XADDJTENTRY := I;                                                 03086000
      ERROR := TRUE;                                                    03088000
      GO EXIT;                                                          03090000
      END;                                                              03092000
   J := FINDJTENTRY(XN1,XN2,XN3,ABSTNO,A,PXGJDT);                       03094000
   I := J + JDTARR(J).(8:8) + 2;                               <<U.RAO>>03096000
     I:=I+1;                                                   <<FORMS>>03098000
     J:=(JDTARR(I).(0:8)+1)&LSR(1)                                      03100000
     +(JDTARR(I).(8:8)+1)&LSR(1);                                       03102000
     I:=(I+J+10);                                              <<FORMS>>03104000
   IF (J:=JDTARR(I).(0:6)) = 63 THEN                           <<U.RAO>>03106000
      BEGIN   <<REFERENCE COUNT OVERFLOW>>                              03108000
      XADDJTENTRY := 4;                                                 03110000
      ERROR := TRUE;                                                    03112000
      GO EXIT1;                                                         03114000
      END;                                                              03116000
   JDTARR(I).(0:6) := J+1;   <<INC.REF.COUNT>>                 <<U.RAO>>03118000
   GO EXIT1;                                                            03120000
   END;   <<XADDJTENTRY>>                                               03122000
                                                                        03124000
                                                                        03126000
INTEGER PROCEDURE XJDT(FUNC,ID,DSTNO);                                  03128000
    VALUE FUNC,ID,DSTNO;                                                03130000
    INTEGER FUNC,ID,DSTNO;                                              03132000
   OPTION PRIVILEGED, UNCALLABLE;                                       03134000
         <<PROCEDURE TO MAINTAIN TABLE #1 OF JOB TABLES.              >>03136000
         <<ID - NAME OF ENTRY (1 WORD, NOT IN STANDARD FORM).         >>03138000
         <<DSTNO - DATA SEGMENT TABLE # ASSOCIATED WITH "ID" IN TABLE.>>03140000
         <<FUNC = 0 - SEARCH: USE ID TO FIND ENTRY (DSTNO NOT USED).  >>03142000
         <<           IF ENTRY EXISTS, RETURN XJDT=DST#(3RD WORD),    >>03144000
         <<           INCREMENT REF (4TH WORD). IF ENTRY DOES NOT     >>03146000
         <<           EXIST, RETURN XJDT=0.                           >>03148000
         <<FUNC = 1 - PUT: USE ID TO FIND ENTRY. IF ENTRY EXISTS,     >>03150000
         <<           RETURN XJDT=DST# (3RD WORD), INCREMENT REF (4TH >>03152000
         <<           WORD). IF ENTRY DOES NOT EXIST, ADD NEW ENTRY   >>03154000
         <<           (ID,DSTNO,REF=1), RETURN XJDT=0. IF INSUFFICIENT>>03156000
         <<           ROOM FOR NEW ENTRY, RETURN XJDT=-1.             >>03158000
         <<FUNC = 2 - RELEASE: IF ID<>0, THEN USE ID TO FIND ENTRY. IF>>03160000
         <<           ID=0, THEN USE DSTNO TO FIND ENTRY. IF ENTRY    >>03162000
         <<           CANNOT BE FOUND, THEN RETURN XJDT=0. IF ENTRY IS>>03164000
         <<           FOUND AND 3RD WORD (DST#) = DSTNO THEN DECREMENT>>03166000
         <<           REFERENCE COUNT, RETURN XJDT=ORIGINAL REF. IF   >>03168000
         <<           REF GOES TO ZERO, THEN DELETE ENTRY.            >>03170000
         <<FUNC = 3 - DESTROY: RETURN XJDT=0 IF TABLE IS EMPTY.       >>03172000
         <<           OTHERWISE FIND LAST ENTRY IN TABLE,             >>03174000
         <<           SET XJDT=DST# (3RD WORD) AND DELETE THE ENTRY.  >>03176000
         <<FUNC = 4 - RELEASE: SAME AS FUNC=2, EXCEPT DON'T>>  <<00428>>03178000
         <<           DELETE ENTRY IF REF GOES TO 0.       >>  <<00428>>03180000
         <<NOTE: UPON ENTRY, DB MUST BE POINTING TO THE STACK.        >>03182000
   BEGIN                                                                03184000
    INTEGER ARRAY                                                       03186000
        DUMMY(0:2)=Q   <<ID,DSTNO,REF>>                        <<U.RAO>>03188000
   ;BYTE ARRAY                                                          03190000
         BDUMMY(*) = DUMMY                                              03192000
   ;INTEGER                                                             03194000
         PXGJDT     <<JDT DST#>>                               <<U.RAO>>03196000
        ,I,J,K,L                                                        03198000
   ;LOGICAL                                                             03200000
         A   <<GETSIR RETURN VALUE (NOT USED)>>                         03202000
        ,B   <<LOCKJIR RETURN VALUE>>                                   03204000
   ;                                                                    03206000
   XJDT := 0;                                                           03208000
   B := LOCKJIR;                                                        03210000
   FINDJTENTRY(J,J,J,0,A,PXGJDT);   <<DUMMY CALL>>                      03212000
   I := JDSDADR;   <<STARTING ADR.OF TABLE #1>>                <<U.RAO>>03214000
   J := JTFDADR;   <<STARTING ADR.OF TABLE #2>>                <<U.RAO>>03216000
   IF FUNC = 3 THEN                                                     03218000
      BEGIN   <<DESTROY>>                                               03220000
      IF I=J THEN                                                       03222000
         BEGIN   <<NO ENTRIES LEFT>>                                    03224000
         XJDT := 0;                                                     03226000
EXIT1:   EXCHANGEDB(0);                                                 03228000
EXIT2:   UNLOCKJIR(B);                                                  03230000
         RETURN;                                                        03232000
         END;                                                           03234000
       <<DELETE LAST ENTRY & RETURN DST# (3RD WORD)>>                   03236000
      J := J-4;                                                         03238000
      XJDT := JDTARR(J+2);   <<DST #>>                         <<U.RAO>>03240000
      EXCHANGEDB(0);                                                    03242000
      REMJTENTRY(J,J,J,1,J);                                            03244000
      GO EXIT2;                                                         03246000
      END;                                                              03248000
   IF (FUNC=2 OR FUNC=4) AND ID=0 THEN                         <<00428>>03250000
      BEGIN   <<SEARCH ON DSTNO>>                                       03252000
      K := 2;                                                           03254000
      L := DSTNO;                                                       03256000
      END                                                               03258000
   ELSE                                                                 03260000
      BEGIN   <<SEARCH ON ID>>                                          03262000
      K := 1;                                                           03264000
      L := ID;                                                          03266000
      END;                                                              03268000
   I := I+K;                                                            03270000
   WHILE I<J DO                                                         03272000
      BEGIN   <<CYCLE ON ENTRY>>                                        03274000
      IF JDTARR(I) = L THEN                                    <<U.RAO>>03276000
         BEGIN                                                          03278000
         I := I-K;   <<POINT TO 1ST WORD>>                              03280000
         GO FOUND;                                                      03282000
         END;                                                           03284000
      I := I+4;                                                         03286000
      END;                                                              03288000
    <<ENTRY CANNOT BE FOUND>>                                           03290000
   IF FUNC <> 1 THEN                                                    03292000
      GO EXIT1;                                                         03294000
    <<ADD ENTRY>>                                                       03296000
   EXCHANGEDB(0);                                                       03298000
   DUMMY := ID;                                                         03300000
   DUMMY(1) := DSTNO;                                                   03302000
   DUMMY(2) := 1;   <<REF.COUNT>>                                       03304000
   I := ADDJTENTRY(BDUMMY,J,J,0,2,DUMMY(1));   <<SPECIAL CALL>>         03306000
   IF I=1 THEN                                                          03308000
      XJDT := -1;   <<NO ROOM>>                                         03310000
   GO EXIT2;                                                            03312000
FOUND:                                                                  03314000
    <<NOTE: I=INDEX OF 1ST WORD OF ENTRY>>                              03316000
   IF FUNC < 2 THEN                                                     03318000
      BEGIN   <<"SEARCH" OR "PUT">>                                     03320000
      XJDT := JDTARR(I+2);   <<DST #>>                         <<U.RAO>>03322000
      JDTARR(I+3) := JDTARR(I+3)+1;   <<INC.REF.COUNT>>        <<U.RAO>>03324000
      GO EXIT1;                                                         03326000
      END;                                                              03328000
    <<FUNC=2 OR 4 - "RELEASE">>                                <<00428>>03330000
   IF DSTNO = JDTARR(I+2) THEN                                 <<U.RAO>>03332000
      BEGIN                                                             03334000
      XJDT := J := JDTARR(I+3);   <<ORIGINAL REF.COUNT>>       <<U.RAO>>03336000
      << DECREMENT REF COUNT IN JDT AND REMOVE ENTRY FROM >>   <<00428>>03338000
      << JDT ONLY IF COUNT = 0 AND FUNC = 2.              >>   <<00428>>03340000
      IF (JDTARR(I+3) := J-1) = 0 AND FUNC = 2 THEN            <<00428>>03342000
         BEGIN   <<REMOVE ENTRY>>                                       03344000
         EXCHANGEDB(0);                                                 03346000
         REMJTENTRY(J,J,J,1,I);                                         03348000
         GO EXIT2;                                                      03350000
         END;                                                           03352000
      END;                                                              03354000
   GO EXIT1;                                                            03356000
   END;   <<PROCEDURE XJDT>>                                            03358000
                                                                        03360000
                                                                        03362000
INTEGER PROCEDURE CSJTENTRYLOC(LINEGROUP,ENTRYSIZE,TNO,DSTNO,           03364000
    JIR);                                                               03366000
    VALUE TNO;                                                          03368000
    BYTE ARRAY LINEGROUP;                                               03370000
    INTEGER ENTRYSIZE,TNO,DSTNO;                                        03372000
    LOGICAL JIR;                                                        03374000
   OPTION PRIVILEGED,UNCALLABLE;                                        03376000
         <<PROCEDURE TO DETERMINE IF CS ENTRIES EXIST                 >>03378000
         <<LINEGROUP - NAME OF LINE OR GROUP                          >>03380000
         <<ENTRYSIZE - SIZE OF ENTRY (WORDS), IF FOUND                >>03382000
         <<TNO - TABLE NUMBER: 4 = LINE TABLE, 5 = GROUP TABLE        >>03384000
         <<DSTNO - DATA SEGMENT TABLE NUMBER OF JDT                   >>03386000
   BEGIN                                                                03388000
    LOGICAL                                                             03390000
         A   <<REDUNDANT LOCKJIR RETURN VALUE>>                         03392000
        ,B   <<LOCKJIR RETURN VALUE>>                                   03394000
    ;INTEGER ARRAY                                                      03396000
        IN1(0:3) = Q   <<LOCAL ARRAY FOR STORING NAMES>>       <<U.RAO>>03398000
    ;INTEGER                                                            03400000
         I,K                                                            03402000
        ,SAVEDL                                                         03404000
        ,ADRIN1   <<DL - REL. ADDR. OF IN1(*)>>                         03406000
    ;                                                                   03408000
    BYTE ARRAY N2(0:1),N3(*)=N2,BN1(*)=IN1;                             03410000
    PUSH(DL);                                                           03412000
    SAVEDL _ TOS;                                                       03414000
    ADRIN1 _ @IN1;                                                      03416000
    N2 _ " ";                                                           03418000
    I _ FINDJTENTRY(LINEGROUP,N2,N3,TNO,B,DSTNO);                       03420000
    WHILE I<>0                                                 <<U.RAO>>03422000
      AND LOGICAL(JDTARR(K:=I+JDTARR(I).(8:8)+2).(6:1)) DO     <<U.RAO>>03424000
       BEGIN                                                            03426000
       TOS _ ADRIN1 - SAVEDL;                                           03428000
       TOS _ K+2;                                                       03430000
       TOS _ 4;   <<SIZE OF NAME (WORDS)>>                              03432000
       ASSEMBLE(MVBL);                                                  03434000
       EXCHANGEDB(0);                                                   03436000
       I _ FINDJTENTRY(BN1,N2,N3,TNO,A,DSTNO);                          03438000
       END;                                                             03440000
    IF (CSJTENTRYLOC _ I) <> 0 THEN                                     03442000
       BEGIN                                                            03444000
       I := JDTARR(I)&LSR(8);                                  <<U.RAO>>03446000
       K _ B;                                                           03448000
       END ELSE UNLOCKJIR(B);                                           03450000
    EXCHANGEDB(0);                                                      03452000
    ENTRYSIZE _ I;                                                      03454000
    JIR _ K;                                                            03456000
END <<CSJTENTRYLOC>>;                                                   03458000
INTEGER PROCEDURE RETPMASK(N1,N2,N3,PMASKHI,PMASKLO);                   03460000
LOGICAL PMASKHI,PMASKLO;                                                03462000
BYTE ARRAY N1,N2,N3;                                                    03464000
OPTION PRIVILEGED,UNCALLABLE;                                           03466000
<<                                                   >>                 03468000
<<  PROCEDURE TO OBTAIN INFORMATION CONCERNING WHICH >>                 03470000
<<  PARAMETERS A USER HAS SPECIFIED IN A FILE        >>                 03472000
<<  EQUATION                                         >>                 03474000
<<                                                   >>                 03476000
<<  INPUT: N1,N2,N3  FILE NAME IN STANDARD FORMAT    >>                 03478000
<<                                                   >>                 03480000
<<  OUTPUT: PMASKHI = FIRST WORD OF PMASK PARAMETER  >>                 03482000
<<                    IN FILE EQUATION TABLE ENTRY   >>                 03484000
<<          PMASKLO = REMAINING BITS OF PMASK        >>                 03486000
<<                                                   >>                 03488000
<<          RETPMASK= 0 OK                           >>                 03490000
<<                  = 1 ENTRY NOT FOUND              >>                 03492000
<<                                                   >>                 03494000
<<                                                   >>                 03496000
<<  FORMAT OF PMASKHI :                              >>                 03498000
<<       BIT 0    BLOCKFACTOR                        >>                 03500000
<<           1    RECSIZE                            >>                 03502000
<<           2    DISPOSITION                        >>                 03504000
<<           3    NUMBUFFERS                         >>                 03506000
<<           4    INHIBIT BUFFERING                  >>                 03508000
<<           5    EXCLUSIVE                          >>                 03510000
<<           6    MULTI-RECORD                       >>                 03512000
<<           7    ACCESS TYPE                        >>                 03514000
<<           8    COPY/NOCOPY                        >>        <<02557>>03516000
<<           9    CARRIAGE CONTROL                   >>                 03518000
<<          10    RECORD FORMAT                      >>                 03520000
<<          11    DEFAULT DESIGNATION                >>                 03522000
<<          12    ASCII/BINARY                       >>                 03524000
<<          13    DOMAIN                             >>                 03526000
<<          14    DEVICE                             >>                 03528000
<<          15    NAME                               >>                 03530000
<<                                                   >>                 03532000
<<  FORMAT OF PMASKLO:                               >>                 03534000
<<       BIT   0   FILE TYPE                         >>        <<02557>>03536000
<<             1   LABELLED TAPE                     >>        <<02557>>03538000
<<             2   FORMS MESSAGE                     >>                 03540000
<<             3   USER LABELS                       >>                 03542000
<<             4     ** UNUSED **                    >>                 03544000
<<             5     ** UNUSED **                    >>                 03546000
<<             6   THIS IS A BACK REFERENCE ENTRY    >>                 03548000
<<             7   DYNAMIC LOCKING                   >>                 03550000
<<             8   WAIT/NOWAIT                       >>                 03552000
<<             9   MULTI-ACCESS                      >>                 03554000
<<            10   NUMCOP                            >>                 03556000
<<            11   OUTPRI                            >>                 03558000
<<            12   FILECODE                          >>                 03560000
<<            13   FILESIZE                          >>                 03562000
<<            14   NUMEXTS                           >>                 03564000
<<            15   INIT ALLOC                        >>                 03566000
<<                                                   >>                 03568000
<< IF BIT = 1, THEN USER SPECIFIED THE PARAMETER IN  >>                 03570000
<<            IN A FILE EQUATION                     >>                 03572000
<<                                                   >>                 03574000
<<            USED BY IMAGE/3000                     >>                 03576000
<<                                                   >>                 03578000
<<                                                   >>                 03580000
                                                                        03582000
BEGIN                                                                   03584000
INTEGER SIZE;                                                           03586000
INTEGER ARRAY INFO(0:255);                                              03588000
                                                                        03590000
SIZE := 3;                                                              03592000
IF (RETPMASK := RETJTENTRY(N1,N2,N3,SIZE,INFO))  = 0      THEN          03594000
  BEGIN                                                                 03596000
  PMASKHI := INFO;                                                      03598000
  PMASKLO := INFO(1);                                                   03600000
  END;                                                                  03602000
END;                                                                    03604000
INTEGER PROCEDURE XRETPMASK(N1,N2,N3,PMASKHI,PMASKLO);         <<02557>>03606000
   LOGICAL PMASKHI,PMASKLO;                                    <<02557>>03608000
   BYTE ARRAY N1,N2,N3;                                        <<02557>>03610000
   OPTION PRIVILEGED,UNCALLABLE;                               <<02557>>03612000
                                                               <<02557>>03614000
COMMENT                                                        <<02557>>03616000
                                                               <<02557>>03618000
   Procedure to obtain information concerning which parameters <<02557>>03620000
a user has specified in a file equation.  Unlike RETPMASK, it  <<02557>>03622000
traces down the pointer file equations until it reaches the end<<02557>>03624000
of the chain.                                                  <<02557>>03626000
                                                               <<02557>>03628000
INPUT:  N1,N2,N3 -- File name in standard format               <<02557>>03630000
                                                               <<02557>>03632000
OUTPUT: PMASKHI  -- First word of PMASK parameter in file      <<02557>>03634000
                    equation table entry.                      <<02557>>03636000
        PMASKLO  -- Remaining bits of PMASK.                   <<02557>>03638000
                                                               <<02557>>03640000
        RETPMASK  = 0, OK                                      <<02557>>03642000
                  = 1, Entry not found                         <<02557>>03644000
                  = 2, An entry points to a non-existent entry <<02557>>03646000
                                                               <<02557>>03648000
The PMASK bit definitions are the same as those listed in      <<02557>>03650000
the header comment for RETPMASK.                               <<02557>>03652000
                                                               <<02557>>03654000
;   << end of comment >>                                       <<02557>>03656000
                                                               <<02557>>03658000
BEGIN                                                          <<02557>>03660000
INTEGER                                                        <<02557>>03662000
   NAMESIZE,   << Length of formal name in words >>            <<02557>>03664000
   SIZE;       << Return from XRETJTENTRY >>                   <<02557>>03666000
INTEGER ARRAY                                                  <<02557>>03668000
   INFO(0:255);  << File equation entry returned >>            <<02557>>03670000
                                                               <<02557>>03672000
   IF (XRETPMASK := XRETJTENTRY(N1,N2,N3,SIZE,INFO)) = 0 THEN  <<02557>>03674000
      BEGIN                                                    <<02557>>03676000
      NAMESIZE := INFO.(8:8);                                  <<02557>>03678000
      PMASKHI := INFO(NAMESIZE + 1);                           <<02557>>03680000
      PMASKLO := INFO(X + 1);                                  <<02557>>03682000
      END;                                                     <<02557>>03684000
                                                               <<02557>>03686000
END;   << of XRETJTENTRY >>                                    <<02557>>03688000
LOGICAL PROCEDURE SEARCHJCW(GOAL, JCWADR, JCWVALUE);           <<U.RAO>>03690000
BYTE ARRAY GOAL;                                               <<U.RAO>>03692000
INTEGER JCWADR,JCWVALUE;                                       <<U.RAO>>03694000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>03696000
BEGIN                                                          <<U.RAO>>03698000
<<THIS PROCEDURE SEARCHES THE JCW TABLE IN THE JDT FOR  >>     <<U.RAO>>03700000
<<THE ID "GOAL".                                        >>     <<U.RAO>>03702000
<<INPUT:  GOAL - A BYTE ARRAY CONTAINING THE NAME OF THE>>     <<U.RAO>>03704000
<<      DESIRED JCW, WITH BYTE 0 BEING THE LENGTH.      >>     <<U.RAO>>03706000
<<      OF THE NAME.                                    >>     <<U.RAO>>03708000
<<OUTPUT: SEARCHJCW - TRUE IF FOUND IN TABLE ELSE FALSE >>     <<U.RAO>>03710000
<<   JCWADR - IF SEARCH WAS SUCCESSFUL, WORD OFFSET TO  >>     <<U.RAO>>03712000
<<            START OF ENTRY FROM START OF JDT.         >>     <<U.RAO>>03714000
<<   JCWVALUE - IF SEARCH WAS SUCCESSFUL, ACTUAL VALUE  >>     <<U.RAO>>03716000
<<            OF JCW.                                   >>     <<U.RAO>>03718000
<<METHOD IS A STRAIGHTFORWARD LOOP THROUGH THE TABLE.   >>     <<U.RAO>>03720000
INTEGER JDTDST;   <<HOLDS JDT DST NUMBER>>                     <<U.RAO>>03722000
DOUBLE JCWTABLIMITS;  <<BOUNDS ON JCW PART OF JDT>>            <<U.RAO>>03724000
INTEGER NEXTJCWADR = JCWTABLIMITS;  <<ADDRESS OF NEXT ENTRY>>  <<U.RAO>>03726000
INTEGER JCWTABEND = JCWTABLIMITS+1; <<ADDRESS OF END OF TABLE>><<U.RAO>>03728000
INTEGER ARRAY CANDIDATEW(0:128);  <<LOCAL COPY FOR SEARCH>>    <<U.RAO>>03730000
BYTE ARRAY CANDIDATE(*) = CANDIDATEW;                          <<U.RAO>>03732000
SEARCHJCW := FALSE;                                            <<U.RAO>>03734000
STACKJDTDST;                                                   <<U.RAO>>03736000
JDTDST := TOS;                                                 <<U.RAO>>03738000
<<FIRST GET BOUNDS ON JCW TABLE>>                              <<U.RAO>>03740000
TOS := @JCWTABLIMITS;                                          <<U.RAO>>03742000
TOS := JDTDST;                                                 <<U.RAO>>03744000
TOS := @JJCWADR;                                               <<U.RAO>>03746000
TOS := 2;                                                      <<U.RAO>>03748000
ASSEMBLE(MFDS);                                                <<U.RAO>>03750000
<<NEXT DO LOOP THROUGH JCW TABLE>>                             <<U.RAO>>03752000
WHILE NEXTJCWADR < JCWTABEND DO                                <<U.RAO>>03754000
   BEGIN                                                       <<U.RAO>>03756000
   <<STRATEGY IS 1) MAKE LOCAL COPY FROM TABLE, >>             <<U.RAO>>03758000
   << 2) COMPARE CANDIDATE WITH GOAL, >>                       <<U.RAO>>03760000
   << 3) IF HIT, RETURN VALUES ELSE UPDATE NEXTJCWADR>>        <<U.RAO>>03762000
   TOS := @CANDIDATEW;                                         <<U.RAO>>03764000
   TOS := JDTDST;                                              <<U.RAO>>03766000
   TOS := NEXTJCWADR;  <<SOURCE ADDRESS IN JDT>>               <<U.RAO>>03768000
   <<NEXT WE STACK TRANSFER COUNT.  IT IS THE MIN OF>>         <<U.RAO>>03770000
   <<THE SPACE LEFT IN THE TABLE OR 129>>                      <<U.RAO>>03772000
   IF JCWTABEND-NEXTJCWADR > 129 THEN                          <<U.RAO>>03774000
      TOS := 129  <<MAX POSSIBLE ENTRY SIZE>>                  <<U.RAO>>03776000
   ELSE                                                        <<U.RAO>>03778000
      TOS := JCWTABEND - NEXTJCWADR;                           <<U.RAO>>03780000
   ASSEMBLE(MFDS);                                             <<U.RAO>>03782000
   <<NOW WE HAVE THE LOCAL COPY OF THE ENTRY.  DO COMPARE>>    <<U.RAO>>03784000
   IF GOAL = CANDIDATE, (GOAL+1) THEN  <<A HIT>>               <<U.RAO>>03786000
      BEGIN   <<RETURN VALUES, KILL SEARCH>>                   <<U.RAO>>03788000
      JCWADR := NEXTJCWADR;                                    <<U.RAO>>03790000
      SEARCHJCW := TRUE;                                       <<U.RAO>>03792000
      JCWVALUE := CANDIDATEW(CANDIDATE&LSR(1)+1);              <<U.RAO>>03794000
      NEXTJCWADR := JCWTABEND;  <<KILLS WHILE LOOP>>           <<U.RAO>>03796000
      END                                                      <<U.RAO>>03798000
   ELSE   <<POINT TO NEXT ENTRY FOR NEXT LOOP>>                <<U.RAO>>03800000
      NEXTJCWADR := NEXTJCWADR+INTEGER(CANDIDATE)&LSR(1)+2;    <<U.RAO>>03802000
   END;   << OF WHILE LOOP>>                                   <<U.RAO>>03804000
END;   <<PROCEDURE SEARCHJCW>>                                 <<U.RAO>>03806000
PROCEDURE FINDJCW(JCWNAME, JCWVALUE, ERROR);                   <<U.RAO>>03808000
BYTE ARRAY JCWNAME;                                            <<U.RAO>>03810000
LOGICAL JCWVALUE;                                              <<U.RAO>>03812000
INTEGER ERROR;                                                 <<U.RAO>>03814000
OPTION PRIVILEGED;   <<CALLABLE INTRINSIC>>                    <<U.RAO>>03816000
BEGIN                                                          <<U.RAO>>03818000
<<THIS INTRINSIC SEARCHES THE JDT JCW TABLE FOR JCWNAME.>>     <<U.RAO>>03820000
<<THE WORK IS ACTUALLY DONE BY SEARCHJCW.  THIS PROCEDURE>>    <<U.RAO>>03822000
<<PRIMARILY CHECKS THE PARAMETERS.>>                           <<U.RAO>>03824000
EQUATE FINDJCWNUM = 86,   <<INTRINSIC NUMBER>>                 <<U.RAO>>03826000
       FINDJCWPARMS = 3,  <<NUMBER OF PARAMETERS>>             <<U.RAO>>03828000
       FINDJCWMODE = [10/FINDJCWNUM, 6/FINDJCWPARMS];          <<U.RAO>>03830000
INTEGER NAMELEN;   <<HOLDS LENGTH OF NAME IN BYTES>>           <<U.RAO>>03832000
BYTE ARRAY COPY(0:255);  <<HOLDS LOCAL COPY OF JCWNAME>>       <<U.RAO>>03834000
INTEGER DUMMY;   <<UNUSED PARAMETER TO SEARCHJCW>>             <<U.RAO>>03836000
EQUATE   <<POSSIBLE ERROR RETURNS>>                            <<U.RAO>>03838000
   NAMETOOBIG = 1,  <<NAME > 255 CHARACTERS LONG>>             <<U.RAO>>03840000
   NOLEADINGALPHA = 2,  <<NAME DOES NOT START WITH ALPHA>>     <<U.RAO>>03842000
   JCWNOTFOUND = 3;   <<THIS ID NOT FOUND IN JCW TABLE>>       <<U.RAO>>03844000
LOGICAL SAVEJIR;  <<HOLDS RETURN FROM LOCKJIR>>                <<U.RAO>>03846000
ERRORON;                                                       <<U.RAO>>03848000
CHEK(FINDJCWMODE, 3, [2/2, 2/2, 2/3]D);                        <<U.RAO>>03850000
ERROR := 0;                                                    <<U.RAO>>03852000
MOVE JCWNAME := JCWNAME WHILE AN,1;                            <<U.RAO>>03854000
NAMELEN := TOS-@JCWNAME;                                       <<U.RAO>>03856000
IF NAMELEN > 255 THEN                                          <<U.RAO>>03858000
   ERROR := NAMETOOBIG                                         <<U.RAO>>03860000
ELSE IF JCWNAME <> ALPHA THEN                                  <<U.RAO>>03862000
   ERROR := NOLEADINGALPHA                                     <<U.RAO>>03864000
ELSE  <<NO APPARENT ERRORS, TRY FOR VALUE>>                    <<U.RAO>>03866000
   BEGIN                                                       <<U.RAO>>03868000
   COPY := NAMELEN;                                            <<U.RAO>>03870000
   MOVE COPY(1) := JCWNAME WHILE ANS;  <<UPSHIFT>>             <<U.RAO>>03872000
   SAVEJIR := LOCKJIR;                                         <<U.RAO>>03874000
   IF NOT SEARCHJCW(COPY, DUMMY, JCWVALUE) THEN                <<U.RAO>>03876000
      ERROR := JCWNOTFOUND;                                    <<U.RAO>>03878000
   UNLOCKJIR(SAVEJIR);                                         <<U.RAO>>03880000
   END;                                                        <<U.RAO>>03882000
ERROREXIT(FINDJCWMODE, 0, 0);                                  <<U.RAO>>03884000
END;                                                           <<U.RAO>>03886000
PROCEDURE PUTJCW(JCWNAME, JCWVALUE, ERROR);                    <<U.RAO>>03888000
BYTE ARRAY JCWNAME;                                            <<U.RAO>>03890000
LOGICAL JCWVALUE;                                              <<U.RAO>>03892000
INTEGER ERROR;                                                 <<U.RAO>>03894000
OPTION PRIVILEGED;                                             <<U.RAO>>03896000
BEGIN                                                          <<U.RAO>>03898000
<<THIS INTRINSIC UPDATES THE VALUE OF A JCW IN THE JDT.>>      <<U.RAO>>03900000
<<IF AN ENTRY FOR JCWNAME DOES NOT EXIST, PUTJCW ALSO  >>      <<U.RAO>>03902000
<<CREATES A NEW ENTRY.                                 >>      <<U.RAO>>03904000
<<INPUT: JCWNAME IS A BYTE ARRAY HOLDING THE NAME OF   >>      <<U.RAO>>03906000
<<       THE DESIRED JCW.  THE NAME MUST START WITH AN >>      <<U.RAO>>03908000
<<       ALPHA CHARACTER, BE LESS THAN 256 CHARACTERS  >>      <<U.RAO>>03910000
<<       LONG, AND BE TERMINATED WITH A NON-ALPHANUMERIC>>     <<U.RAO>>03912000
<<       CHARACTER.  IT MAY ALSO BE "@", IN WHICH      >>      <<04.RO>>03914000
<<       CASE IT RESULTS IN ALL EXISTING JCW'S BEING   >>      <<04.RO>>03916000
<<       SET TO JCWVALUE.                              >>      <<04.RO>>03918000
<<       JCWVALUE IS THE VALUE TO WHICH JCW JCWNAME IS >>      <<U.RAO>>03920000
<<       TO BE SET.                                    >>      <<U.RAO>>03922000
<<OUTPUT: ERROR - 0 IF NO ERRORS OCCURRED              >>      <<U.RAO>>03924000
<<                1 IF NAME > 255 CHARACTERS LONG      >>      <<U.RAO>>03926000
<<                2 IF NAME DOES NOT START WITH AN ALPHA>>     <<U.RAO>>03928000
<<                3 IF UNABLE TO COMPLETE DUE TO LACK  >>      <<U.RAO>>03930000
<<                  OF SPACE IN JDT.                   >>      <<U.RAO>>03932000
<<                4 NAME HAS A SPECIAL JCW MEANING     >>      <<04696>>03934000
                                                               <<U.RAO>>03936000
INTEGER NAMELEN;  <<# BYTES IN NAME>>                          <<U.RAO>>03938000
BYTE NAMELENB = NAMELEN;  <<FOR LOOKING AT ENTRIES>>           <<04.RO>>03940000
ARRAY COPYW(0:128);  <<CONTAINS PROTOTYPE ENTRY>>              <<U.RAO>>03942000
BYTE ARRAY COPY(*) = COPYW;                                    <<U.RAO>>03944000
LOGICAL SAVEJIR;  <<HOLD RETURN FROM LOCKJIR>>                 <<U.RAO>>03946000
INTEGER JDTDST;  <<HOLDS DST # FOR JDT FROM PXGLOB>>           <<U.RAO>>03948000
INTEGER OLDVALUE;  <<DUMMY FOR SEARCHJCW CALL - UNUSED>>       <<U.RAO>>03950000
INTEGER JCWADR;  <<IF VALID, ENTRY POINTER FROM SEARCHJCW>>    <<U.RAO>>03952000
INTEGER ENTRYSIZE;  <<LENGTH OF WHOLE ENTRY IN WORDS>>         <<U.RAO>>03954000
DOUBLE DBEQV; << HOLDS THE VALUE FROM INTRINSIC DBINARY >>     <<04696>>03956000
INTEGER SEGSIZE;  <<CURRENT LENGTH OF JDT>>                    <<U.RAO>>03958000
INTEGER ARRAY LOCALJDT(0:NUMJDTPTRS)=Q;  <<COPY OF JDT PTR ARRA<<U.RAO>>03960000
INTEGER LOCALFSPCADR = LOCALJDT+NUMJDTPTRS;                    <<U.RAO>>03962000
INTEGER LOCALJJCW = LOCALJDT+5;  <<JCW TABLE ADDRESS>>         <<04.RO>>03964000
EQUATE NAMETOOBIG = 1,                                         <<U.RAO>>03966000
       NOLEADINGALPHA = 2,                                     <<U.RAO>>03968000
       OUTOFSPACE = 3,                                         <<04696>>03970000
       NAMEISRESERVED = 4;                                     <<04696>>03972000
EQUATE PUTJCWNUM = 85,                                         <<U.RAO>>03974000
       PUTJCWPARMS = 3,                                        <<U.RAO>>03976000
       PUTJCWMODE = [10/PUTJCWNUM, 6/PUTJCWPARMS];             <<U.RAO>>03978000
                                                               <<04696>>03980000
LOGICAL SUBROUTINE ILLEGALNAME;                                <<04696>>03982000
<< THIS SUBROUTINE CHECKS TO SEE IF THE JCWNAME IS A VALID>>   <<04696>>03984000
<< JCWVALUE.  IF SO THEN ILLEGALNAME BECOMES TRUE >>           <<04696>>03986000
    BEGIN                                                      <<04696>>03988000
      ILLEGALNAME := FALSE;                                    <<04696>>03990000
      DBEQV := -1D;                                            <<04696>>03992000
      IF JCWNAME ="OK" AND NAMELEN >= 2 THEN                   <<04696>>03994000
         BEGIN                                                 <<04696>>03996000
           IF NAMELEN = 2                                      <<04696>>03998000
              THEN ILLEGALNAME := TRUE                         <<04696>>04000000
              ELSE BEGIN                                       <<04696>>04002000
                     DBEQV := DBINARY(JCWNAME(2),NAMELEN-2);   <<04696>>04004000
                     IF = AND (DBEQV >=0D) AND (DBEQV <=65535D)<<04696>>04006000
                        THEN ILLEGALNAME := TRUE;              <<04696>>04008000
                   END;                                        <<04696>>04010000
         END                                                   <<04696>>04012000
      ELSE IF JCWNAME ="WARN" AND NAMELEN >= 4 THEN            <<04696>>04014000
              BEGIN                                            <<04696>>04016000
                IF NAMELEN = 4                                 <<04696>>04018000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>04020000
                   BEGIN                                       <<04696>>04022000
                     DBEQV := DBINARY(JCWNAME(4),NAMELEN-4);   <<04696>>04024000
                     IF = AND(DBEQV >=0D) AND (DBEQV <=49151D) <<04696>>04026000
                         THEN ILLEGALNAME := TRUE;             <<04696>>04028000
                   END;                                        <<04696>>04030000
         END                                                   <<04696>>04032000
      ELSE IF JCWNAME ="FATAL" AND NAMELEN >= 5 THEN           <<04696>>04034000
              BEGIN                                            <<04696>>04036000
                IF NAMELEN = 5                                 <<04696>>04038000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>04040000
                   BEGIN                                       <<04696>>04042000
                     DBEQV := DBINARY(JCWNAME(5),NAMELEN-5);   <<04696>>04044000
                     IF = AND(DBEQV >=0D) AND (DBEQV <=32767D) <<04696>>04046000
                        THEN ILLEGALNAME := TRUE;              <<04696>>04048000
                    END;                                       <<04696>>04050000
         END                                                   <<04696>>04052000
      ELSE IF JCWNAME ="SYSTEM" AND NAMELEN >= 6 THEN          <<04696>>04054000
              BEGIN                                            <<04696>>04056000
                IF NAMELEN = 6                                 <<04696>>04058000
                   THEN ILLEGALNAME := TRUE ELSE               <<04696>>04060000
                   BEGIN                                       <<04696>>04062000
                     DBEQV := DBINARY(JCWNAME(6),NAMELEN-6);   <<04696>>04064000
                     IF = AND(DBEQV >=0D) AND (DBEQV <= 16383D)<<04696>>04066000
                        THEN ILLEGALNAME := TRUE;              <<04696>>04068000
                   END;                                        <<04696>>04070000
         END;                                                  <<04696>>04072000
       END;  << ILLEGALNAME >>                                 <<04696>>04074000
                                                               <<04696>>04076000
ERRORON;                                                       <<U.RAO>>04078000
CHEK(PUTJCWMODE, 3, [2/2, 2/2, 2/3]D);                         <<U.RAO>>04080000
ERROR := 0;  <<ASSUME NO ERRORS>>                              <<U.RAO>>04082000
MOVE JCWNAME := JCWNAME WHILE AN,1;  <<SCAN FOR END OF NAME>>  <<U.RAO>>04084000
NAMELEN := TOS-@JCWNAME;  <<LENGTH IN BYTES>>                  <<U.RAO>>04086000
IF NAMELEN>255 THEN                                            <<U.RAO>>04088000
   ERROR := NAMETOOBIG                                         <<04.RO>>04090000
ELSE IF JCWNAME = "@" THEN                                     <<04.RO>>04092000
   BEGIN  <<DO ALL EXISTING JCW'S>>                            <<04.RO>>04094000
   <<INVOLVES SCANNING TABLE FOR ALL ENTRIES>>                 <<04.RO>>04096000
   SAVEJIR := LOCKJIR;  << LOCK DOWN JDT>>                     <<04.RO>>04098000
   STACKJDTDST;  <<GET JDT DST FROM PXGLOB>>                   <<04.RO>>04100000
   JDTDST := TOS;  <<SAVE FOR LATER DATA SEGMENT MOVES>>       <<04.RO>>04102000
   <<NEXT GET BOUNDS ON JCW ARRAY FROM JDT POINTERS>>          <<04.RO>>04104000
   TOS := @LOCALJJCW;                                          <<04.RO>>04106000
   TOS := JDTDST;                                              <<04.RO>>04108000
   TOS := @JJCWADR;                                            <<04.RO>>04110000
   TOS := 2;                                                   <<04.RO>>04112000
   ASSEMBLE(MFDS);                                             <<04.RO>>04114000
   <<NEXT DO LOOP THROUGH JCW ARRAY, MODIFYING VALUES>>        <<04.RO>>04116000
   WHILE LOCALJJCW < LOCALFSPCADR DO                           <<04.RO>>04118000
      BEGIN                                                    <<04.RO>>04120000
      TOS := @NAMELEN;  <<FIRST GET NAME LENGTH>>              <<04.RO>>04122000
      TOS := JDTDST;                                           <<04.RO>>04124000
      TOS := LOCALJJCW;                                        <<04.RO>>04126000
      TOS := 1;                                                <<04.RO>>04128000
      ASSEMBLE(MFDS);                                          <<04.RO>>04130000
      LOCALJJCW := LOCALJJCW+INTEGER(NAMELENB+2)&LSR(1);       <<04.RO>>04132000
      <<NOW WRITE NEW VALUE INTO TABLE>>                       <<04.RO>>04134000
      TOS := JDTDST;                                           <<04.RO>>04136000
      TOS := LOCALJJCW;                                        <<04.RO>>04138000
      TOS := @JCWVALUE;                                        <<04.RO>>04140000
      TOS := 1;                                                <<04.RO>>04142000
      ASSEMBLE(MTDS);                                          <<04.RO>>04144000
      LOCALJJCW := LOCALJJCW+1;                                <<04.RO>>04146000
      END;                                                     <<04.RO>>04148000
   UNLOCKJIR(SAVEJIR);                                         <<04.RO>>04150000
   END <<OF "@" CASE>>                                         <<04.RO>>04152000
ELSE IF JCWNAME <> ALPHA THEN                                  <<U.RAO>>04154000
   ERROR := NOLEADINGALPHA                                     <<U.RAO>>04156000
ELSE IF ILLEGALNAME THEN                                       <<04696>>04158000
   ERROR := NAMEISRESERVED                                     <<04696>>04160000
ELSE                                                           <<04696>>04162000
   BEGIN  <<NO APPARENT ERRORS - SET VALUE>>                   <<U.RAO>>04164000
   COPY := NAMELEN;  <<MUST PUT ON WORD BDY, PACK>>            <<U.RAO>>04166000
   MOVE COPY(1) := JCWNAME WHILE ANS;  <<UPSHIFT LOCAL COPY>>  <<U.RAO>>04168000
   SAVEJIR := LOCKJIR;  <<LOCK DOWN JDT>>                      <<U.RAO>>04170000
   STACKJDTDST;   <<GET JDT DST FROM PXGLOB>>                  <<U.RAO>>04172000
   JDTDST := TOS;                                              <<U.RAO>>04174000
   IF SEARCHJCW(COPY, JCWADR, OLDVALUE) THEN                   <<U.RAO>>04176000
      BEGIN  <<NAME EXISTS, JUST REPLACE VALUE>>               <<U.RAO>>04178000
      TOS := JDTDST;                                           <<U.RAO>>04180000
      TOS := JCWADR+NAMELEN&LSR(1)+1;  <<OFFSET TO JCWVALUE>>  <<U.RAO>>04182000
      TOS := @JCWVALUE;  <<SOURCE>>                            <<U.RAO>>04184000
      TOS := 1;  <<JUST TRANSFER VALUE>>                       <<U.RAO>>04186000
      ASSEMBLE(MTDS);                                          <<U.RAO>>04188000
      END                                                      <<U.RAO>>04190000
   ELSE   <<NAME DOES NOT EXIST.  MUST ADD NAME TO TABLE>>     <<U.RAO>>04192000
      BEGIN                                                    <<U.RAO>>04194000
      <<PROBLEM IS TO ALLOCATE SPACE TO HOLD NEW VALUE>>       <<U.RAO>>04196000
      <<FIRST CHECK TO SEE IF SPACE EXISTS IN JDT>>            <<U.RAO>>04198000
      ENTRYSIZE := NAMELEN&LSR(1)+2;                           <<U.RAO>>04200000
      SEGSIZE := (SYS'DST(JDTDST&LSL(2)).(3:13))&LSL(2)-1;     <<U.RAO>>04202000
      <<GET COPY OF JDT POINTERS>>                             <<U.RAO>>04204000
      TOS := @LOCALJDT;                                        <<U.RAO>>04206000
      TOS := JDTDST;                                           <<U.RAO>>04208000
      TOS := @JDTBASE;                                         <<U.RAO>>04210000
      TOS := NUMJDTPTRS+1;                                     <<U.RAO>>04212000
      ASSEMBLE(MFDS);                                          <<U.RAO>>04214000
      IF ENTRYSIZE+LOCALFSPCADR > LOCALJDT THEN                <<U.RAO>>04216000
         ERROR := OUTOFSPACE                                   <<U.RAO>>04218000
      ELSE   <<SHOULD BE POSSIBLE TO FIT IN EXPANDED JDT>>     <<U.RAO>>04220000
         BEGIN                                                 <<U.RAO>>04222000
         IF SEGSIZE < ENTRYSIZE+LOCALFSPCADR THEN              <<U.RAO>>04224000
            BEGIN   <<NEED TO ENLARGE SEGMENT>>                <<U.RAO>>04226000
            ALTDSEGSIZE(JDTDST,ENTRYSIZE+LOCALFSPCADR-SEGSIZE);<<U.RAO>>04228000
            IF <> THEN    <<REAL PROBLEM HERE, PERHAPS>>       <<U.RAO>>04230000
               BEGIN                                           <<U.RAO>>04232000
               ERROR := OUTOFSPACE;                            <<U.RAO>>04234000
               UNLOCKJIR(SAVEJIR);                             <<U.RAO>>04236000
               ERROREXIT(PUTJCWMODE, 0, 0);                    <<U.RAO>>04238000
               RETURN                                          <<U.RAO>>04240000
               END;                                            <<U.RAO>>04242000
            END;                                               <<U.RAO>>04244000
         <<AT THIS POINT WE KNOW WE HAVE ENOUGH SPACE IN>>     <<U.RAO>>04246000
         <<THE JDT FOR THE ENTRY.  NOW MOVE DATA IN>>          <<U.RAO>>04248000
         COPYW(ENTRYSIZE-1) := JCWVALUE;  <<FINALIZE ENTRY>>   <<U.RAO>>04250000
         TOS := JDTDST;                                        <<U.RAO>>04252000
         TOS := LOCALFSPCADR;                                  <<U.RAO>>04254000
         TOS := @COPYW;                                        <<U.RAO>>04256000
         TOS := ENTRYSIZE;                                     <<U.RAO>>04258000
         ASSEMBLE(MTDS);                                       <<U.RAO>>04260000
         <<FINALLY UPDATE THE FREESPACE POINTER IN THE JDT>>   <<U.RAO>>04262000
         LOCALFSPCADR := LOCALFSPCADR+ENTRYSIZE;               <<U.RAO>>04264000
         TOS := JDTDST;                                        <<U.RAO>>04266000
         TOS := @JFREESPCADR;                                  <<U.RAO>>04268000
         TOS := @LOCALFSPCADR;                                 <<U.RAO>>04270000
         TOS := 1;  <<JUST FIXUP FREE SPACE POINTER>>          <<U.RAO>>04272000
         ASSEMBLE(MTDS);                                       <<U.RAO>>04274000
         END;                                                  <<U.RAO>>04276000
      END;                                                     <<U.RAO>>04278000
   UNLOCKJIR(SAVEJIR);                                         <<U.RAO>>04280000
   END;                                                        <<U.RAO>>04282000
ERROREXIT(PUTJCWMODE, 0, 0);                                   <<U.RAO>>04284000
END;                                                           <<U.RAO>>04286000
LOGICAL PROCEDURE GETJCW;                                      <<U.RAO>>04288000
OPTION PRIVILEGED;                                             <<U.RAO>>04290000
<<This callable intrinsic returns the current value of the>>   <<U.RAO>>04292000
<<specific jcw "JCW" to the user.>>                            <<U.RAO>>04294000
BEGIN                                                          <<U.RAO>>04296000
EQUATE GETJCWERRMODE = [10/73,6/0];                            <<U.RAO>>04298000
INTEGER RESULT = GETJCW;  <<AVOIDS SPL LLBL>>                  <<U.RAO>>04300000
DOUBLE NAME := "JCW ";                                         <<U.RAO>>04302000
INTEGER ERRORRTN;  <<A DUMMY SINCE SHOULD NOT FAIL>>           <<U.RAO>>04304000
ERRORON;                                                       <<U.RAO>>04306000
FINDJCW(NAME, RESULT, ERRORRTN);                               <<U.RAO>>04308000
ERROREXIT(GETJCWERRMODE, 0, 0);                                <<U.RAO>>04310000
END;                                                           <<U.RAO>>04312000
PROCEDURE SETJCW(NEWJCW);                                      <<U.RAO>>04314000
VALUE NEWJCW;                                                  <<U.RAO>>04316000
INTEGER NEWJCW;                                                <<U.RAO>>04318000
<<This callable intrinsic updates jcw "JCW" in the JDT >>      <<U.RAO>>04320000
<<to the value NEWJCW through the intrinsic PUTJCW.>>          <<U.RAO>>04322000
BEGIN                                                          <<U.RAO>>04324000
EQUATE SETJCWERRMODE = [10/72, 6/1];                           <<U.RAO>>04326000
DOUBLE NAME := "JCW ";                                         <<U.RAO>>04328000
INTEGER ERRORRTN;  <<A DUMMY>>                                 <<U.RAO>>04330000
ERRORON;                                                       <<U.RAO>>04332000
PUTJCW(NAME, NEWJCW, ERRORRTN);                                <<U.RAO>>04334000
ERROREXIT(SETJCWERRMODE, 0, 0);                                <<U.RAO>>04336000
END;                                                           <<U.RAO>>04338000
$CONTROL SEGMENT=MAIN                                          <<U.RAO>>04340000
END.                                                           <<U.RAO>>04342000
