         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
EQUATE                                                         <<09729>>00172500
        JDT'WORKAREA'SIZE  =  44;   << in words >>             <<09729>>00172750
        JDSJNUM = JDTWORKSPCBASE+JDT'WORKAREA'SIZE,            <<09729>>00215000
        JESMPN  = JDSJNUM+2;   <<MAIN PIN NUMBER>>             <<09729>>00220000
DOUBLE  JDTJOBTYPENUM  =  JDSJNUM;                             <<09729>>00221000
<< .................................................... >>     <<09729>>00275004
<<  The following two equates are for use in the JDT    >>     <<09729>>00275008
<<  access procedures.  They are the maximum lengths    >>     <<09729>>00275012
<<  possible for formal designators (left hand side     >>     <<09729>>00275016
<<  of file equation) and actual designators (right hand>>     <<09729>>00275020
<<  side.  They were derived as follows:                >>     <<09729>>00275025
<<                                                      >>     <<09729>>00275029
<<    FD:  <n1>.<n2>.<n3>:<n4>      =  77b/39wds        >>     <<09729>>00275033
<<         8  +1+8 +1 +8+1+50                           >>     <<09729>>00275035
<<                                                      >>     <<09729>>00275037
<<    AD:  <F>/<L>.<G>.<A>:<ENVID>  =  86b/43wds        >>     <<09729>>00275038
<<          8+1+8+1+8+1+8+1+50                          >>     <<09729>>00275040
<<                                                      >>     <<09729>>00275042
<< .................................................... >>     <<09729>>00275044
                                                               <<09729>>00275048
EQUATE                                                         <<09729>>00275083
       MAX'FDLEN  = 39,  << formal designator >>               <<09729>>00275125
       MAX'ADLEN  = 43;  << actual designator >>               <<09729>>00275166
                                                               <<09729>>00275208
<< -------------------------------------------------------- >> <<09729>>00275295
<<          Declarations for use with FPARSE                >> <<09729>>00275300
<<                                                          >> <<09729>>00275304
<< Following variable declarations must have been made      >> <<09729>>00275308
<< INTEGER ARRAY ITEMS (0:MAXNUMOFNAMES)                    >> <<09729>>00275312
<< DOUBLE ARRAY ITEM'VECTORS (0:MAXNUMOFNAMES);             >> <<09729>>00275316
<< INTEGER ARRAY IITEM'VECTORS(*) = ITEM'VECTORS;           >> <<09729>>00275320
<< -------------------------------------------------------- >> <<09729>>00275325
                                                               <<09729>>00275329
EQUATE                                                         <<09729>>00275333
   ITEM'END   = 0,                                             <<09729>>00275337
   ITEM'FNAME = 1,                                             <<09729>>00275341
   ITEM'LNAME = 2,                                             <<09729>>00275345
   ITEM'GNAME = 3,                                             <<09729>>00275350
   ITEM'ANAME = 4,                                             <<09729>>00275354
   ITEM'ENAME = 5,                                             <<09729>>00275358
   MAXNUMOFNAMES = ITEM'ENAME,                                 <<09729>>00275362
                                                               <<09729>>00275366
   FP'RET'SYSFILE = 2,                                         <<09729>>00275370
   FP'RET'BACKREF = 1;                                         <<09729>>00275375
                                                               <<09729>>00275379
DEFINE                                                         <<09729>>00275383
   FP'ERRPTR    = IITEM'VECTORS(0) #,                          <<09729>>00275387
   FP'FNAME'OFF = IITEM'VECTORS(0) #,                          <<09729>>00275391
   FP'FNAME'LEN = IITEM'VECTORS(1) #,                          <<09729>>00275395
   FP'LNAME'OFF = IITEM'VECTORS(2) #,                          <<09729>>00275400
   FP'LNAME'LEN = IITEM'VECTORS(3) #,                          <<09729>>00275404
   FP'GNAME'OFF = IITEM'VECTORS(4) #,                          <<09729>>00275408
   FP'GNAME'LEN = IITEM'VECTORS(5) #,                          <<09729>>00275412
   FP'ANAME'OFF = IITEM'VECTORS(6) #,                          <<09729>>00275416
   FP'ANAME'LEN = IITEM'VECTORS(7) #,                          <<09729>>00275420
   FP'ENAME'OFF = IITEM'VECTORS(8) #,                          <<09729>>00275425
   FP'ENAME'LEN = IITEM'VECTORS(9) #,                          <<09729>>00275429
   FP'DEF'DESIG = IITEM'VECTORS (10) #,                        <<09729>>00275433
   FP'DESIG'LEN = IITEM'VECTORS(11) #,                         <<09729>>00275437
   FP'IS'STDLIST = (FP'DEF'DESIG = 1) #,                       <<09729>>00275441
   FP'IS'NEWPASS = (FP'DEF'DESIG = 2) #,                       <<09729>>00275445
   FP'IS'OLDPASS = (FP'DEF'DESIG = 3) #,                       <<09729>>00275450
   FP'IS'STDIN   = (FP'DEF'DESIG = 4) #,                       <<09729>>00275454
   FP'IS'STDINX  = (FP'DEF'DESIG = 5) #,                       <<09729>>00275458
   FP'IS'NULL    = (FP'DEF'DESIG = 6) #,                       <<09729>>00275462
                                                               <<09729>>00275466
   SETALLFPARSEITEMS = ITEMS(0) := ITEM'FNAME;                 <<09729>>00275470
                       ITEMS(1) := ITEM'LNAME;                 <<09729>>00275475
                       ITEMS(2) := ITEM'GNAME;                 <<09729>>00275479
                       ITEMS(3) := ITEM'ANAME;                 <<09729>>00275483
                       ITEMS(4) := ITEM'ENAME;                 <<09729>>00275487
                       ITEMS(5) := ITEM'END; #;                <<09729>>00275491
<<  FPARSE is a procedure to parse file names  >>              <<09729>>00500250
                                                               <<09729>>00500500
PROCEDURE FPARSE(STRING, RESULT, ITEMS, VECTORS);              <<09729>>00500750
BYTE ARRAY STRING;                                             <<09729>>00501000
INTEGER ARRAY RESULT;                                          <<09729>>00501250
LOGICAL ARRAY ITEMS;                                           <<09729>>00501500
DOUBLE ARRAY VECTORS;                                          <<09729>>00501750
OPTION EXTERNAL,VARIABLE;                                      <<09729>>00502000
                                                               <<09729>>00502250
<< AS'DSPLABEL will get Advance DS plabels >>                  <<09729>>00502500
                                                               <<09729>>00502750
INTEGER PROCEDURE AS'DSPLABEL (INDEX);                         <<09729>>00503000
VALUE INDEX;                                                   <<09729>>00503250
INTEGER INDEX;                                                 <<09729>>00503500
OPTION EXTERNAL;                                               <<09729>>00503750
                                                               <<09729>>00504000
$EDIT VOID=01030000                                            <<09729>>00705000
PROCEDURE GETJITVAL(ONENET'VAL);                                        03374010
    INTEGER ONENET'VAL;                                                 03374020
    OPTION PRIVILEGED,UNCALLABLE;                                       03374030
                                                                        03374040
BEGIN                                                                   03374050
                                                                        03374060
<< this procedure is used to retrieve the word reserved >>              03374070
<< for the ONENET project (%50) from the JIT for that   >>              03374080
<< process.  It also has an entry point PUTJITVAL that  >>              03374090
<< will put a value into that same word.                >>              03374100
<< The word passed in ONENET'VAL is an integer by ref.  >>              03374110
<<                                                      >>              03374120
<< This procedure may not be called in split stack mode >>              03374130
                                                                        03374140
ENTRY PUTJITVAL;                                                        03374150
LOGICAL   GETVAL'FLAG := TRUE;                                          03374160
INTEGER   JIT'DSTN,                                                     03374170
          PCBGLOBLOC;                                                   03374180
LOGICAL ARRAY QARRAY(*) = Q+0;                                          03374190
                                                                        03374200
SUBROUTINE DEF'MOVETODSEG;                                              03374210
SUBROUTINE DEF'MOVEFROMDSEG;                                            03374220
                                                                        03374230
                                                                        03374240
<< Main code block >>                                                   03374250
GO AROUND;                                                              03374260
PUTJITVAL:        << entry point PUTJITVAL >>                           03374270
   GETVAL'FLAG := FALSE;                                                03374280
AROUND:                                                                 03374290
                                                                        03374300
   PXGLOBAL;     << set up to get info from pxglobal area >>            03374310
   JIT'DSTN := PXG'JITDST;   << get stacks JIT DST number >>            03374320
                                                                        03374330
   IF GETVAL'FLAG THEN  <<retrieve ONENET JIT word >>                   03374340
      BEGIN                                                             03374350
         MOVEFROMDSEG (@ONENET'VAL,JIT'DSTN,40,1);                      03374360
      END                                                               03374370
   ELSE                                                                 03374380
      BEGIN     << put value in JIT  >>                                 03374390
         MOVETODSEG(JIT'DSTN,40,@ONENET'VAL,1);                         03374400
      END;                                                              03374410
                                                                        03374420
END;    <<   end GETJITVAL/PUTJITVAL procedure >>                       03374430
                                                                        03374440
$EDIT VOID=03885000                                            <<09729>>03380000
$page "Procedure concat'fd"                                    <<09729>>03382500
comment                                                        <<09729>>03382750
                                                               <<09729>>03383000
============================================================   <<09729>>03383250
=====              Procedure  concat'fd                =====   <<09729>>03383500
============================================================   <<09729>>03383750
                                                               <<09729>>03384000
This procedure concatenates the four input parts of a          <<09729>>03384250
file name and returns a pointer to that string.                <<09729>>03384500
Names which are not present should point to a non-             <<09729>>03384750
alpha-numeric ("special") character.                           <<09729>>03385000
                                                               <<09729>>03385250
If the new string has on odd byte length, then a blank         <<09729>>03385500
will be appended to it.                                        <<09729>>03385750
                                                               <<09729>>03386000
A period "." will be placed between names n1 and n2 and        <<09729>>03386250
between names n2 and n3, should the names be there.            <<09729>>03386500
Note that n3 cannot be there if n2 is not there.               <<09729>>03386750
                                                               <<09729>>03387000
If n4 is there, a colon ":" will be placed before              <<09729>>03387250
the name.                                                      <<09729>>03387500
                                                               <<09729>>03387750
Parameters:                                                    <<09729>>03388000
                                                               <<09729>>03388250
       n1      --  Input  --  First part of formal designator  <<09729>>03388500
       n2      --  Input  --  Second part of formal designator <<09729>>03388750
       n3      --  Input  --  Third part of formal designator  <<09729>>03389000
       n4      --  Input  --  Fourth part of formal designator <<09729>>03389250
       fd      --  Output --  Concatenated name                <<09729>>03389500
       fd'len  --  Output --  Name length (including fill byte)<<09729>>03389750
                              in words                         <<09729>>03390000
                                                               <<09729>>03390250
;                                                              <<09729>>03390500
$page                                                          <<09729>>03390750
PROCEDURE CONCAT'FD( N1, N2, N3, N4, FD, FD'LEN );             <<09729>>03391000
BYTE ARRAY N1, N2, N3, N4, FD;                                 <<09729>>03391250
INTEGER FD'LEN;                                                <<09729>>03391500
                                                               <<09729>>03391750
OPTION INTERNAL,UNCALLABLE;                                    <<09729>>03392000
                                                               <<09729>>03392250
begin                        << ***** concat'fd ***** >>       <<09729>>03392500
EQUATE AS'PARSE'ENVID'PLX = 30;                                         03392525
                                                               <<09729>>03392750
INTEGER I;   << counter used in move'name >>                   <<09729>>03393000
INTEGER TEMP'LEN;   << holds length for envids >>              <<09729>>03393250
                                                               <<09729>>03393500
<< ......................................................... >><<09729>>03393750
<< .....           Subroutine move'name                ..... >><<09729>>03394000
<< ......................................................... >><<09729>>03394250
                                                               <<09729>>03394500
INTEGER SUBROUTINE MOVE'NAME(NAME, TARGET);                    <<09729>>03394750
BYTE ARRAY NAME, TARGET;                                       <<09729>>03395000
                                                               <<09729>>03395250
comment                                                        <<09729>>03395500
                                                               <<09729>>03395750
  this routine simply moves "name" into "target"               <<09729>>03396000
and returns the length moved.  Name is assumed to be           <<09729>>03396250
only alpha/numeric and is terminated by a non-alpha/numeric.   <<09729>>03396500
                                                               <<09729>>03396750
;                                                              <<09729>>03397000
                                                               <<09729>>03397250
BEGIN                                                          <<09729>>03397500
                                                               <<09729>>03397750
I := 0;                                                        <<09729>>03398000
                                                               <<09729>>03398250
WHILE NAME(I) <> SPECIAL AND I < 8 DO                          <<09729>>03398500
BEGIN                                                          <<09729>>03398750
  TARGET(I) := NAME(I);                                        <<09729>>03399000
  I := I + 1;                                                  <<09729>>03399250
END;                                                           <<09729>>03399500
                                                               <<09729>>03399750
MOVE'NAME := I;                                                <<09729>>03400000
                                                               <<09729>>03400250
                                                               <<09729>>03400500
END;                                                           <<09729>>03400750
                                                               <<09729>>03401000
$PAGE                                                          <<09729>>03401250
                                                               <<09729>>03401500
<< *********** Start of Main Code for CONCAT'FD ************ >><<09729>>03401750
                                                               <<09729>>03402000
FD'LEN := 0;                                                   <<09729>>03402250
IF N1 = SPECIAL THEN RETURN;   << Fopen with null FD's  >>     <<09729>>03402500
                                                               <<09729>>03402750
FD'LEN := MOVE'NAME(N1, FD);  << move the first name >>        <<09729>>03403000
                                                               <<09729>>03403250
IF N2 <> SPECIAL THEN                                          <<09729>>03403500
BEGIN                                                          <<09729>>03403750
  FD(FD'LEN) := ".";  << period is the separator here >>       <<09729>>03404000
  FD'LEN := FD'LEN + 1;  << the name's now a bit longer >>     <<09729>>03404250
  FD'LEN := FD'LEN + MOVE'NAME(N2, FD(FD'LEN)); << Next name >><<09729>>03404500
                                                               <<09729>>03404750
                                                               <<09729>>03405000
  IF N3 <> SPECIAL THEN                                        <<09729>>03405250
  BEGIN                                                        <<09729>>03405500
    FD(FD'LEN) := ".";  << period is the separator here >>     <<09729>>03405750
    FD'LEN := FD'LEN + 1;  << the name's now a bit longer >>   <<09729>>03406000
    FD'LEN := FD'LEN + MOVE'NAME(N3, FD(FD'LEN));              <<09729>>03406250
  END;                                                         <<09729>>03406500
                                                               <<09729>>03406750
END;                                                           <<09729>>03407000
                                                               <<09729>>03407250
                                                               <<09729>>03407500
IF N4 <> SPECIAL OR N4 = "$BACK" THEN                          <<09729>>03407750
BEGIN                                                          <<09729>>03408000
  FD(FD'LEN) := ":";  << colon is the separator here >>        <<09729>>03408250
  FD'LEN := FD'LEN + 1;  << the name's now a bit longer >>     <<09729>>03408500
  << ...................................................... >> <<09729>>03408750
  << We will let the Adavance DS folks have the final say   >> <<09729>>03409000
  << on the offical length of N4. NOTE!!! at this point ADS >> <<09729>>03409250
  << has to be present otherwise ... Oh shiiii ...          >> <<09729>>03409500
  << ...................................................... >> <<09729>>03409750
  TOS := 0;                                                    <<09729>>03410000
  TOS := @N4;                                                  <<09729>>03410250
  TOS := AS'DSPLABEL (AS'PARSE'ENVID'PLX);                     <<09729>>03410500
  IF S0 = 0 THEN                                               <<09729>>03410525
  BEGIN     << otherwise just happened >>                      <<09729>>03410550
    MOVE FD := "  ";      << make it null name >>              <<09729>>03410575
    FD'LEN := 1;          << so it won't match any entries >>  <<09729>>03410600
    RETURN;                                                    <<09729>>03410625
  END;                                                         <<09729>>03410650
  ASSEMBLE (PCAL 0);                                           <<09729>>03410750
                                                               <<09729>>03411000
  TEMP'LEN := TOS;                                             <<09729>>03411250
  MOVE FD(FD'LEN) := N4, (TEMP'LEN);                           <<09729>>03411500
  FD'LEN := FD'LEN + TEMP'LEN;                                 <<09729>>03412000
END;                                                           <<09729>>03412250
                                                               <<09729>>03412500
                                                               <<09729>>03412750
IF (FD'LEN MOD 2) <> 0   THEN    << pad with a space >>        <<09729>>03413000
BEGIN                                                          <<09729>>03413250
  FD(FD'LEN) := " ";                                           <<09729>>03413500
  FD'LEN := FD'LEN + 1;                                        <<09729>>03413750
END;                                                           <<09729>>03414000
                                                               <<09729>>03414250
                                                               <<09729>>03414500
FD'LEN := FD'LEN/2;    << convert to words >>                  <<09729>>03414750
                                                               <<09729>>03415000
END;                         << ***** concat'fd ***** >>       <<09729>>03415250
$PAGE                                                          <<09729>>03415500
<<***********************************************************>><<09729>>03415525
<<                                                           >><<09729>>03415550
<< Procedure UNCRUNCH                                        >><<09729>>03415575
<<                                                           >><<09729>>03415600
<< Purpose:  To take as input, a byte array of a file desig- >><<09729>>03415625
<<           nator and decompose it to its components.       >><<09729>>03415650
<<           The "crunch" format is no longer w/ ADS names   >><<09729>>03415675
<< Note:     Procedure changed because w/ the ADS fix entry  >><<09729>>03415700
<<           names are no longer crunched.                   >><<09729>>03415705
<<                                                           >><<09729>>03415710
<<***********************************************************>><<09729>>03415725
                                                               <<09729>>03415750
PROCEDURE UNCRUNCH( FNAME, FNAME'SIZE, FILE, GROUP, ACCT);     <<09729>>03415775
  VALUE FNAME'SIZE;                                            <<09729>>03415800
  INTEGER FNAME'SIZE;                                          <<09729>>03415825
  BYTE ARRAY FNAME, FILE, GROUP, ACCT;                         <<09729>>03415850
  OPTION PRIVILEGED, UNCALLABLE;                               <<09729>>03415875
                                                               <<09729>>03415900
BEGIN                                                          <<09729>>03415925
                                                               <<09729>>03416025
DOUBLE ARRAY                                                   <<09729>>03416050
   ITEM'VECTORS (0:MAXNUMOFNAMES);                             <<09729>>03416075
INTEGER ARRAY                                                  <<09729>>03416100
   RESULT (0:1),                                               <<09729>>03416125
   IITEM'VECTORS(*) = ITEM'VECTORS,                            <<09729>>03416150
   ITEMS(0:MAXNUMOFNAMES);                                     <<09729>>03416175
                                                               <<09729>>03416250
SETALLFPARSEITEMS;                                             <<09729>>03416275
FPARSE (FNAME, RESULT, ITEMS, ITEM'VECTORS);                   <<09729>>03416300
<< result is not, checked because it MUST be valid fd >>       <<09729>>03416325
                                                               <<09729>>03416350
MOVE FILE := FNAME(FP'FNAME'OFF),(FP'FNAME'LEN);               <<09729>>03416375
IF FP'GNAME'LEN <> 0 THEN                                      <<09729>>03416400
   MOVE GROUP := FNAME(FP'GNAME'OFF),(FP'GNAME'LEN);           <<09729>>03416425
IF FP'ANAME'LEN <> 0 THEN                                      <<09729>>03416450
   MOVE ACCT := FNAME(FP'ANAME'OFF),(FP'ANAME'LEN);            <<09729>>03416475
                                                               <<09729>>03416500
END;  << Procedure UNCRUNCH >>                                 <<09729>>03416750
$page "Procedure FINDJTENTRY"                                  <<09729>>04820283
INTEGER PROCEDURE FINDJTENTRY(N1,N2,N3,N4,TNO,A,PXGJDT);       <<09729>>04830000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>04845000
         << .............................................. >>  <<09729>>04857500
         <<                                                >>  <<09729>>04905050
         <<   Note that the names N1-N4 are left concaten- >>  <<09729>>04905100
         <<   ated in the work area.  At least ADDJTENTRY  >>  <<09729>>04905150
         <<   depends on this!!                            >>  <<09729>>04905200
         <<                                                >>  <<09729>>04905500
         <<   Fix:                                         >>  <<09729>>04906000
         <<        This fix implements the fourth file name>>  <<09729>>04906500
         <<        parameter (N4).                         >>  <<09729>>04907000
         << .............................................. >>  <<09729>>04907500
        ,IDNO = FINDJTENTRY  << return value >>                <<09729>>04955000
         FD'W(0:MAX'FDLEN-1) = Q   << holds formal desig. >>   <<09729>>04965000
   ;BYTE ARRAY                                                 <<09729>>04967500
         FD'B(*) = FD'W                                        <<09729>>04967750
$EDIT VOID=05015000                                            <<09729>>05005000
   IF TNO > 0 THEN                                             <<09729>>05010000
   CONCAT'FD( N1, N2, N3, N4, FD'B, NAMSIZE );                 <<09729>>05015000
      BEGIN   << move the whole name into the work area >>     <<09729>>05055000
      JDTWORKSPC(I+1) := FD'W(I);                              <<09729>>05060000
$page "Procedure XRETJTENTRY"                                  <<09729>>05157500
INTEGER PROCEDURE XRETJTENTRY(N1,N2,N3,N4,SIZE,INFO);          <<09729>>05160000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>05175000
         << .............................................. >>  <<09729>>05182500
         <<                                                >>  <<09729>>05237500
         <<   Fix:                                         >>  <<09729>>05237750
         <<        This fix implements the fourth file name>>  <<09729>>05238000
         <<        parameter (N4).                         >>  <<09729>>05238250
         << .............................................. >>  <<09729>>05238500
        IN1(0:MAX'ADLEN-1) = Q   << holds actual desig >>      <<09729>>05265000
        << .............................................. >>   <<09729>>05267500
        <<  acually, IN1 will only hold back referenced   >>   <<09729>>05267750
        <<  "actual designators" (right hand side) which  >>   <<09729>>05268000
        <<  are really formal designators.  These can't   >>   <<09729>>05268250
        <<  have lockwords and so don't have to be as     >>   <<09729>>05268500
        <<  long.  But, I'm just being safe by using ADLEN>>   <<09729>>05268750
        << .............................................. >>   <<09729>>05269000
         BN1(*) = IN1                                          <<09729>>05275000
   ;BYTE POINTER                                               <<09729>>05277500
         BN2, BN3, BN4                                         <<09729>>05277750
   << ................................................... >>   <<09729>>05300250
   <<                  FPARSE  Declarations               >>   <<09729>>05300500
   << ................................................... >>   <<09729>>05300750
                                                                        05301000
   ;BYTE                                                       <<09729>>05301250
            BLANK := " "                                       <<09729>>05301500
   ;DOUBLE ARRAY                                               <<09729>>05302500
            ITEM'VECTORS(0:MAXNUMOFNAMES)                      <<09729>>05302750
   ;INTEGER ARRAY                                              <<09729>>05305000
            RESULT(0:1)    << FPARSE parameter >>              <<09729>>05307500
           ,IITEM'VECTORS(*) = ITEM'VECTORS                    <<09729>>05307525
   ;INTEGER ARRAY                                              <<09729>>05307750
            ITEMS(0:MAXNUMOFNAMES)                             <<09729>>05308000
   ;                                                           <<09729>>05310000
$PAGE                                                          <<09729>>05312500
   I := FINDJTENTRY(N1,N2,N3,N4,3,B,PXGJDT);                   <<09729>>05335000
$EDIT VOID=05470000                                            <<09729>>05470000
   << .............................................. >>        <<09729>>05475025
   <<  call FPARSE to break up the file name into    >>        <<09729>>05475050
   <<  its four pieces (file, group, acct, envid)    >>        <<09729>>05475075
   <<  note that BN1 already points to the file name >>        <<09729>>05475077
   << .............................................. >>        <<09729>>05475100
   SETALLFPARSEITEMS;                                          <<09729>>05475150
                                                               <<09729>>05475225
   FPARSE( BN1, RESULT, ITEMS, ITEM'VECTORS );                 <<09729>>05477500
   << result not checked -- file must be good! >>              <<09729>>05477525
                                                               <<09729>>05477750
   @BN2 := IF FP'GNAME'LEN <> 0    << length of group name>>   <<09729>>05478000
           THEN FP'GNAME'OFF + @BN1                            <<09729>>05478025
           ELSE @BLANK;            << indicate no group >>     <<09729>>05478050
   @BN3 := IF FP'ANAME'LEN <> 0    << length of acct name>>    <<09729>>05478250
           THEN FP'ANAME'OFF + @BN1                            <<09729>>05478275
           ELSE @BLANK;            << indicate no acct  >>     <<09729>>05478300
   @BN4 := IF FP'ENAME'LEN <> 0    << length of envid name>>   <<09729>>05478500
           THEN FP'ENAME'OFF + @BN1                            <<09729>>05478750
           ELSE @BLANK;            << indicate no envid >>     <<09729>>05479000
                                                               <<09729>>05479250
   I := FINDJTENTRY(BN1,BN2,BN3,BN4,3,A,PXGJDT);               <<09729>>05480000
$page "Procedure RETJTENTRY"                                   <<09729>>05582500
INTEGER PROCEDURE RETJTENTRY(N1,N2,N3,N4,SIZE,INFO);           <<09729>>05585000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>05600000
         << .............................................. >>  <<09729>>05607500
         <<                                                >>  <<09729>>05637500
         <<   Fix:                                         >>  <<09729>>05637750
         <<        This fix implements the fourth file name>>  <<09729>>05638000
         <<        parameter (N4).                         >>  <<09729>>05638250
         << .............................................. >>  <<09729>>05638500
   I := FINDJTENTRY(N1,N2,N3,N4,SIZE,A,PXGJDT);                <<09729>>05695000
$page "Procedure REMJTENTRY"                                   <<09729>>05827500
INTEGER PROCEDURE REMJTENTRY(N1,N2,N3,N4,TNO,ADR);             <<09729>>05830000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>05845000
         << .............................................. >>  <<09729>>05852500
         <<                                                >>  <<09729>>05932435
         <<   Fix:                                         >>  <<09729>>05932692
         <<        This fix implements the fourth file name>>  <<09729>>05932948
         <<        parameter (N4).                         >>  <<09729>>05933205
         << .............................................. >>  <<09729>>05933461
      I := FINDJTENTRY(N1,N2,N3,N4,TNO,A,PXGJDT)               <<09729>>06010000
      FINDJTENTRY(J,J,J,J,0,A,PXGJDT);                         <<09729>>06035000
$EDIT VOID=06085000                                            <<09729>>06085000
$page "Procedure DELJTENTRIES"                                 <<09729>>06282500
         << .............................................. >>  <<09729>>06307500
         << That is, if you have FILE A = *B  and          >>  <<09729>>06312500
         << FILE C = *B, if KEYNAME is "B", then those two >>  <<09729>>06312750
         << file equations will be deleted.                >>  <<09729>>06313000
         <<                                                >>  <<09729>>06344950
         <<   Fix:                                         >>  <<09729>>06355263
         <<        This fix implements the fourth file name>>  <<09729>>06355789
         <<        parameter (N4).                         >>  <<09729>>06356315
         << .............................................. >>  <<09729>>06356842
$EDIT VOID=06370000                                            <<09729>>06370000
         IENTRYNAME(0:MAX'FDLEN-1)   << holds formal desig >>  <<09729>>06375000
        ,ITESTNAME(0:MAX'ADLEN-1)    << holds actual desig >>  <<09729>>06380000
$EDIT VOID=06405000                                            <<09729>>06405000
$EDIT VOID=06415000                                            <<09729>>06415000
         TESTNAMESIZE   <<WORDS>>                              <<09729>>06420000
        ,ADRITESTNAME   <<DB-REL.ADR OF ITESTNAME>>            <<09729>>06445000
$page                                                          <<09729>>06452500
   ADRITESTNAME := @ITESTNAME;                                 <<09729>>06460000
                                                               <<09729>>06462500
   << TESTNAME holds the right hand side of a back-referenced>><<09729>>06462750
   << file equation (the B of :FILE A=*B).  ENTRYNAME holds  >><<09729>>06463000
   << the left hand side ("A")                               >><<09729>>06463250
                                                               <<09729>>06463500
      TOS := ADRITESTNAME - SAVEDL;   <<DL-REL.TARGET>>        <<09729>>06540000
      TESTNAMESIZE := JDTARR(J-1).(0:8);     << Size in bytes>><<09729>>06550000
      TOS := (TESTNAMESIZE+1)&LSR(1);   <<WORD COUNT>>         <<09729>>06555000
                                                               <<09729>>06567500
      << ................................................... >><<09729>>06567525
      <<  pad the test name (actual designator) with a blank >><<09729>>06567750
      <<  for the comparison (the formal desig. may be so    >><<09729>>06568000
      <<  padded) and convert the length in TESTNAME to words>><<09729>>06568250
      << ................................................... >><<09729>>06568500
      TESTNAME(TESTNAMESIZE) := " ";    << the blank pad >>    <<09729>>06568750
      TESTNAMESIZE := (TESTNAMESIZE+1)&LSR(1);  << words >>    <<09729>>06569000
                                                               <<09729>>06569250
      IF K.(6:1)=0 OR TESTNAMESIZE=0 THEN GO INC;              <<09729>>06575000
$EDIT VOID=06625000                                            <<09729>>06580000
            REMJTENTRY(J,J,J,J,TNO,I);                         <<09729>>06670000
$page "Procedure XREMJTENTRY"                                  <<09729>>06727500
INTEGER PROCEDURE XREMJTENTRY(N1,N2,N3,N4,TNO);                <<09729>>06735000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>06750000
         << .............................................. >>  <<09729>>06762500
         <<                                                >>  <<09729>>06822500
         <<   Fix:                                         >>  <<09729>>06822750
         <<        This fix implements the fourth file name>>  <<09729>>06823000
         <<        parameter (N4).                         >>  <<09729>>06823250
         << .............................................. >>  <<09729>>06823500
   ;INTEGER ARRAY                                              <<09729>>06890000
$EDIT VOID=06895000                                            <<09729>>06890002
        IN1(0:MAX'ADLEN-1) = Q   << holds actual desig >>      <<09729>>06890250
        << .............................................. >>   <<09729>>06890500
        <<  acually, IN1 will only hold back referenced   >>   <<09729>>06890750
        <<  "actual designators" (right hand side) which  >>   <<09729>>06891000
        <<  are really formal designators.  These can't   >>   <<09729>>06891250
        <<  have lockwords and so don't have to be as     >>   <<09729>>06891500
        <<  long.  But, I'm just being safe by using ADLEN>>   <<09729>>06891750
        << .............................................. >>   <<09729>>06892000
   ;BYTE POINTER                                               <<09729>>06910000
        ,BN4                                                   <<09729>>06922500
                                                               <<09729>>06925000
$EDIT VOID=06935000                                            <<09729>>06925002
   << ................................................... >>   <<09729>>06927500
   <<                  FPARSE  Declarations               >>   <<09729>>06927750
   << ................................................... >>   <<09729>>06928000
                                                                        06928250
   ;BYTE                                                       <<09729>>06928500
            BLANK := " "                                       <<09729>>06928750
   ;DOUBLE ARRAY                                               <<09729>>06930000
            ITEM'VECTORS(0:MAXNUMOFNAMES)                      <<09729>>06930250
   ;INTEGER ARRAY                                              <<09729>>06930500
            RESULT(0:1)    << FPARSE parameter >>              <<09729>>06930750
           ,IITEM'VECTORS(*) = ITEM'VECTORS                    <<09729>>06931000
   ;INTEGER ARRAY                                              <<09729>>06931250
            ITEMS(0:MAXNUMOFNAMES)                             <<09729>>06931275
                                                               <<09729>>06931300
                                                               <<09729>>06931500
$page                                                          <<09729>>06942500
   KEYADR := I := FINDJTENTRY(N1,N2,N3,N4,TNO,A,PXGJDT);       <<09729>>06965000
      BN1 (J) := " ";       << ensure termination >>           <<09729>>07072500
      << .............................................. >>     <<09729>>07075000
      <<  call FPARSE to break up the file name into    >>     <<09729>>07075250
      <<  its four pieces (file, group, acct, envid)    >>     <<09729>>07075500
      <<  note that BN1 already points to the file name >>     <<09729>>07075750
      << .............................................. >>     <<09729>>07076000
      SETALLFPARSEITEMS;                                       <<09729>>07076250
$EDIT VOID=07077000                                            <<09729>>07076252
                                                               <<09729>>07077250
      FPARSE( BN1, RESULT, ITEMS, ITEM'VECTORS );              <<09729>>07077500
      << result not checked -- file must be good! >>           <<09729>>07077525
                                                               <<09729>>07077750
   @BN2 := IF FP'GNAME'LEN <> 0    << length of group name>>   <<09729>>07078000
$EDIT VOID=07078500                                            <<09729>>07078002
           THEN FP'GNAME'OFF + @BN1                            <<09729>>07078250
           ELSE @BLANK;            << indicate no group >>     <<09729>>07078500
$EDIT VOID=07080000                                            <<09729>>07078502
   @BN3 := IF FP'ANAME'LEN <> 0    << length of acct name>>    <<09729>>07078750
           THEN FP'ANAME'OFF + @BN1                            <<09729>>07079000
           ELSE @BLANK;            << indicate no acct  >>     <<09729>>07079250
   @BN4 := IF FP'ENAME'LEN <> 0    << length of envid name>>   <<09729>>07079500
           THEN FP'ENAME'OFF + @BN1                            <<09729>>07079750
           ELSE @BLANK;            << indicate no envid >>     <<09729>>07080000
                                                               <<09729>>07080250
$EDIT VOID=07090000                                            <<09729>>07085000
      I := FINDJTENTRY(BN1,BN2,BN3,BN4,TNO,A,PXGJDT);          <<09729>>07095000
         BEGIN   <<N1,N2,N3,N4 POINTING AT NON-EXISTENT ENTRY>><<09729>>07105000
   REMJTENTRY(J,J,J,J,TNO,KEYADR);                             <<09729>>07205000
   CONCAT'FD(N1, N2, N3, N4, BN1, I);  << make a real name >>  <<09729>>07210000
                                                               <<09729>>07212500
$page "Procedure ADDJTENTRY"                                   <<09729>>07237500
INTEGER PROCEDURE ADDJTENTRY(N1,N2,N3,N4,TNO,SIZE,INFO);       <<09729>>07240000
    BYTE ARRAY N1,N2,N3,N4;                                    <<09729>>07260000
         << .............................................. >>  <<09729>>07272500
         <<                                                >>  <<09729>>07354950
         <<   Fix:                                         >>  <<09729>>07365263
         <<        This fix implements the fourth file name>>  <<09729>>07365789
         <<        parameter (N4).                         >>  <<09729>>07366315
         << .............................................. >>  <<09729>>07366842
$page                                                          <<09729>>07452500
   I := FINDJTENTRY(N1,N2,N3,N4,TNO,A,PXGJDT);                 <<09729>>07505000
   << ................................................... >>   <<09729>>07507500
   <<  FINDJTENTRY leaves N1-N4 concatenated into a file  >>   <<09729>>07507750
   <<  name in the JDT work area.  We then use that name. >>   <<09729>>07508000
   <<  We are also left in SPLIT STACK mode, DB is at JDT >>   <<09729>>07508025
   << ................................................... >>   <<09729>>07508250
                                                               <<09729>>07508500
$EDIT VOID=07520000                                            <<09729>>07510000
         RESULT := REMJTENTRY(N1,N2,N3,N4,TNO,0);              <<09729>>07620000
$PAGE "Procedure XADDJTENTRY"                                  <<09729>>08222500
INTEGER PROCEDURE XADDJTENTRY(N1,N2,N3,N4,TNO,SIZE,INFO,       <<09729>>08230000
                                        XN1,XN2,XN3,XN4);      <<09729>>08235000
    BYTE ARRAY N1,N2,N3,N4,XN1,XN2,XN3,XN4;                    <<09729>>08250000
         << .............................................. >>  <<09729>>08262500
         <<                                                 >> <<09729>>08319950
         << This procedure will handle a file equation of  >>  <<09729>>08330263
         << the form:                                      >>  <<09729>>08330789
         <<                                                >>  <<09729>>08330842
         <<         :FILE A = *B                           >>  <<09729>>08331315
         <<                                                >>  <<09729>>08331842
         <<                                                >>  <<09729>>08332368
         <<   Fix:                                         >>  <<09729>>08332894
         <<        This fix implements the fourth file name>>  <<09729>>08333421
         <<        parameter (N4).                         >>  <<09729>>08333947
         <<............................................... >>  <<09729>>08334473
         IN1(0:MAX'ADLEN-1)=Q      << hold actual desig >>     <<09729>>08345000
        ,LHS(0:MAX'FDLEN-1)  << left side of file equation >>  <<09729>>08350000
$EDIT VOID=08355000                                            <<09729>>08355000
   ;BYTE POINTER                                               <<09729>>08372500
         BN2, BN3, BN4                                         <<09729>>08375000
$EDIT VOID=08410000                                            <<09729>>08410000
   << ................................................... >>   <<09729>>08452500
   <<                  FPARSE  Declarations               >>   <<09729>>08452750
   << ................................................... >>   <<09729>>08453000
                                                                        08453250
   ;BYTE                                                       <<09729>>08453500
            BLANK := " "                                       <<09729>>08453750
   ;DOUBLE ARRAY                                               <<09729>>08454000
            ITEM'VECTORS(0:MAXNUMOFNAMES)                      <<09729>>08454250
   ;INTEGER ARRAY                                              <<09729>>08454500
            RESULT(0:1)    << FPARSE parameter >>              <<09729>>08454750
           ,IITEM'VECTORS(*) = ITEM'VECTORS                    <<09729>>08454775
   ;INTEGER ARRAY                                              <<09729>>08454800
            ITEMS(0:MAXNUMOFNAMES)                             <<09729>>08454825
                                                               <<09729>>08454850
                                                               <<09729>>08454875
$page                                                          <<09729>>08457500
   RHSADR := I := FINDJTENTRY(XN1,XN2,XN3,XN4,                 <<09729>>08505000
                                      ABSTNO,A,PXGJDT);        <<09729>>08507500
$EDIT VOID=08507750                                            <<09729>>08507750
      IF ERROR THEN REMJTENTRY(N1,N2,N3,N4,ABSTNO,0);          <<09729>>08540000
   CONCAT'FD(N1, N2, N3, N4, LHS, NWDS);                       <<09729>>08560000
   << we use LHS to check for circular links >>                <<09729>>08562500
                                                               <<09729>>08562750
   J := FINDJTENTRY(N1,N2,N3,N4,ABSTNO,A,PXGJDT);              <<09729>>08565000
   << we are here if there is already a file equation "A" >>   <<09729>>08602500
   << this code is used soley to check for circular links >>   <<09729>>08602750
   << we are here if there is an equation of the form: >>      <<09729>>08612500
   <<    :FILE B = *D  (see example above) in the JDT  >>      <<09729>>08612750
                                                               <<09729>>08613000
$EDIT VOID=08617750                                                     08617500
                                                               <<09729>>08637500
   << we have just moved "D" into IN1 (BN1) >>                 <<09729>>08637750
                                                               <<09729>>08638000
$EDIT VOID=08645000                                                     08645000
   IF (J+1)&LSR(1) = NWDS  THEN                                <<09729>>08652500
   BEGIN          << the names are the same word len. >>       <<09729>>08655000
   TOS := @BN1;      <<SOURCE>>                                <<09729>>08665000
   END;                                                        <<09729>>08700250
   << Now go find "D" to see what it points at >>              <<09729>>08702500
      << .............................................. >>     <<09729>>08702525
      <<  call FPARSE to break up the file name into    >>     <<09729>>08702550
      <<  its four pieces (file, group, acct, envid)    >>     <<09729>>08702575
      <<  note that BN1 already points to the file name >>     <<09729>>08702600
      << .............................................. >>     <<09729>>08702625
      SETALLFPARSEITEMS;                                       <<09729>>08702650
                                                               <<09729>>08702675
      FPARSE( BN1, RESULT, ITEMS, ITEM'VECTORS );              <<09729>>08702700
      << result not checked -- file must be good! >>           <<09729>>08702725
                                                               <<09729>>08702750
   @BN2 := IF FP'GNAME'LEN <> 0    << length of group name>>   <<09729>>08702775
           THEN FP'GNAME'OFF + @BN1                            <<09729>>08702800
           ELSE @BLANK;            << indicate no group >>     <<09729>>08702825
   @BN3 := IF FP'ANAME'LEN <> 0    << length of acct name>>    <<09729>>08702850
           THEN FP'ANAME'OFF + @BN1                            <<09729>>08702875
           ELSE @BLANK;            << indicate no acct  >>     <<09729>>08702900
   @BN4 := IF FP'ENAME'LEN <> 0    << length of envid name>>   <<09729>>08702925
           THEN FP'ENAME'OFF + @BN1                            <<09729>>08702950
           ELSE @BLANK;            << indicate no envid >>     <<09729>>08702975
                                                               <<09729>>08703000
   I := FINDJTENTRY(BN1,BN2,BN3,BN4,ABSTNO,A,PXGJDT);          <<09729>>08705000
   << ****** DB is at the JDT now!! ****** >>                  <<09729>>08707500
                                                               <<09729>>08707750
   I := ADDJTENTRY(N1,N2,N3,N4,TNO,SIZE,INFO);                 <<09729>>08730000
   J := FINDJTENTRY(XN1,XN2,XN3,XN4,ABSTNO,A,PXGJDT);          <<09729>>08765000
   << ................................................ >>      <<09729>>08765500
   <<   This is sort of a strange call since the value >>      <<09729>>08766000
   <<   of J is already in RHSADR.  Mostly, its purp-  >>      <<09729>>08766500
   <<   ose is to get the JIR and switch DB to the JDT >>      <<09729>>08767000
   <<   This is why there is no error check on the call>>      <<09729>>08767050
   << ................................................ >>      <<09729>>08767500
                                                               <<09729>>08768000
$page "Procedure XJDT"                                         <<09729>>08877500
   FINDJTENTRY(J,J,J,J,0,A,PXGJDT);   <<DUMMY CALL>>           <<09729>>09090000
      REMJTENTRY(J,J,J,J,1,J);                                 <<09729>>09170000
   I := ADDJTENTRY(BDUMMY,J,J,J,0,2,DUMMY(1)); <<SPECIAL CALL>><<09729>>09325000
         REMJTENTRY(J,J,J,J,1,I);                              <<09729>>09430000
$page "Procedure CSJTENTRYLOC"                                 <<09729>>09467500
    BYTE ARRAY N2(0:1),N3(*)=N2,N4(*)=N2,BN1(*)=IN1;           <<09729>>09585000
    I := FINDJTENTRY(LINEGROUP,N2,N3,N4,TNO,B,DSTNO);          <<09729>>09610000
       I := FINDJTENTRY(BN1,N2,N3,N4,TNO,A,DSTNO);             <<09729>>09665000
$page "Procedure RETPMASK"                                     <<09729>>09722500
INTEGER PROCEDURE RETPMASK(N1,N2,N3,N4,PMASKHI,PMASKLO);       <<09729>>09725000
BYTE ARRAY N1,N2,N3,N4;                                        <<09729>>09735000
<< ................................................. >>        <<09729>>09742500
<<                                                   >>        <<09729>>10027500
<<       Fix:                                        >>        <<09729>>10027750
<<           This fix implements the fourth file name>>        <<09729>>10028000
<<           parameter (N4).                         >>        <<09729>>10028250
<< ................................................. >>        <<09729>>10028500
IF (RETPMASK := RETJTENTRY(N1,N2,N3,N4,SIZE,INFO))  = 0        <<09729>>10060000
  THEN BEGIN                                                   <<09729>>10065000
$page "Procedure XRETPMASK"                                    <<09729>>10087500
INTEGER PROCEDURE XRETPMASK(N1,N2,N3,N4,PMASKHI,PMASKLO);      <<09729>>10090000
   BYTE ARRAY N1,N2,N3,N4;                                     <<09729>>10100000
                                                               <<09729>>10212500
              Fix:                                             <<09729>>10212750
                   This fix implements the fourth file name    <<09729>>10213000
                   parameter (N4).                             <<09729>>10213250
$EDIT VOID=10213500                                            <<09729>>10213500
   IF (XRETPMASK := XRETJTENTRY(N1,N2,N3,N4,SIZE,INFO)) = 0    <<09729>>10260000
      THEN BEGIN                                               <<09729>>10265000
$page " "                                                      <<09729>>10297500
