*DECK IFKEY 
USETEXT TAREATB 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TFIT
USETEXT TPSTACK 
USETEXT TSBASIC 
PROC IFKEY;                                                              IFKEY
  BEGIN                                                                  IFKEY
# THIS PROC CONVERTS THE EXPRESSION STACK BUILT BY -EXPANAL- IN (0,0) 
  TO A BLP INPUT TABLE -THE ARRAY P1-, USING A SCRATCH TABLE -ARRAY T1-.
  THEN CALL BLP TO GET THE LIST OF KEYS (OR A FILE THAT CONTAINS THE
  LIST) THAT HAD THE POTENTIAL OF SATISFYING THE -IF- CONDITION. THEN 
  STORE INFORMATION OF THE LIST IN COMMON AREA AND LOAD IN (4X,0).
  FOR RULES AND EXAMPLES OF TABLE CONVERSION, TURN ON THE LISTING BELOW#
CONTROL NOLIST; #RULES AND EXAMPLES OF CONVERTING FROM STACK TO P1# 
#A SCRATCH TABLE -T1- IS BEING USED WHILE BUILDING -P1- (THE BLP INPUT
 TABLE), IT CONTAINS 3 FIELDS: (EACH ENTRY CORRESPONDS TO AN OPERATOR)
   RSTADDR--THE RESULT ADDRESS OF AN OPERATION. 
            E.G. THE EXPRESSION A+B WILL HAVE IN THE STACK
                      AN ENTRY FOR -A-
                      AN ENTRY FOR -B-
                      AN ENTRY FOR THE OPERATOR -+-, AND AN ADDRESS THAT
                         CONTAINS THE VALUE (A+B), IT IS THIS ADDRESS 
                         THAT IS BEING STORED IN -RSTADDR-
   DUMFG----ONE BIT FLAG. 
            1 IF THE CORRESPONDING OPERATION IS TRANSPARENT TO BLP, E.G.
              THE EXPRESSION A+B, -A- -B- BOTH TEMPORARY ITEMS, DOES NOT
              GIVE BLP ANY INFORMATION ABOUT WHAT RECORD MAY QUALIFIED. 
              SO -DUMFG- FOR THE OPERATOR -+- WILL BE SET TO 1. 
            0 OTHERWISE 
   BLPENTY--THE ENTRY NUMBER IN THE BLP INPUT TABLE -P1- THAT CORRESPOND
            TO THE SAME OPERATOR. 
            E.G. K < 5 WILL BUILT 3 ENTRIES IN THE BLP TABLE
                    ENTRY N  ---  INFORMATION ABOUT ALTERNATE KEY -K- 
                          N+1---  INFORMATION ABOUT CONSTANT -5-
                          N+2---  INFORMATION ABOUT THE OPERATOR -<-
                             (FOR INFORMATION ABOUT BLP TABLE, SEE BLP
                              ERS)
                 AND -N+2- WILL BE STORED IN -BLPENTY-
 EACH -IF- DIRECTIVE WILL GO THROUGH THE SAME PROCESS TO BUILD A BLP
 TABLE, AND THE BLP TABLES FOR THE SAME TRANSMISSION, IN CASE OF MULTI
 -IF- PER TRANSMISSION, WILL BE LINKED BY EXTRA -OR- ENTRIES IN THE 
 FINAL BLP TABLE. 
 IN THE CASE THAT FOR CERTAIN -IF-, AFTER THE PROCESS, NO BLP TABLE IS
 BUILD, SCANALLAREA WILL BE SET, AND (4X,0) WILL BE LOADED IN.
 UPON RETURN FROM BLP, BITS AND FIELDS WILL BE SET TO INFORM -NEXTGET-
 WHETHER GO THROUGH THE WHOLE FILE, OR USE THE KEY LIST RETURNED BY BLP,
 OR, IN CASE OF ERROR CONDITION (OR NO RECORD QUALIFIES) INFORM -CTL40- 
 TO CLEAN UP AND THEN RETURN TO (1,0) 
        ------RULES FOR CONVERTING STACK TO P1------
 OPERATION               *ACTION           *     T1 ENTRY 
                         *                 *RSTADDR *DUMFG *BLPENTY 
 ------------------------*-----------------*--------*------*----------
 I. ARITHMATIC +,-,*,ETC *                 *        *      *
  A. ITEM OP ITEM        *                 *        *      *
   1. BOTH TEMPORARY     *CALL EXPEVAL TO  *RST ADDR* OFF  * SET TO 0 
                         *EVALUATE         *SAVED   *      *
   2. OTHER CASES        * NO ACTION       *RST ADDR*      *
                         *                 *SAVED   * ON   * SET TO 0 
  B. ITEM OP (RST OF OP) *                 *        *      *
   1. TEMPORARY ITEM AND *CALL EXPEVAL TO  *RST ADDR* OFF  * SET TO 0 
      DUMFG OFF          *EVALUATE         *SAVED   *      *
   2. OTHER CASES        *NO ACTION        *RST ADDR* ON   * SET TO 0 
  C. (RST OF OP) OP      *                 *SAVED   *      *
            (RST OF OP)  *                 *        *      *
   1. DUMFG FOR BOTH     *CALL EXPEVAL TO  *RST ADDR* OFF  * SET TO 0 
      ENTRIES ARE OFF    *EVALUATE         *SAVED   *      *
   2. OTHER CASES        *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
 ------------------------*-----------------*--------*------*----------
 II. RELATIONAL <,>,=,ETC*                 *        *      *
  A. ITEM OP ITEM        *                 *        *      *
   1. ONE ALTERNATE KEY, *BUILD THREE      *RST ADDR* OFF  * BLP ENTRY
      ONE TEMPORARY OR   *CORRESPONDING    *SAVED   *      * SAVED
      CONSTANT           *BLP ENTRIES      *        *      *
   2. OTHER CASES        *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
  B. ITEM OP (RST OF OP) *                 *        *      *
   1.ALTERNATE KEY AND   *BUILD TWO        *RST ADDR* OFF  * BLP ENTRY
     DUMFG OFF           *CORRESPONDING    *SAVED   *      * SAVED
                         *BLP ENTRIES      *        *      *
   2. OTHER CASES        *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
  C. (RST OF OP) OP      *NO ACTION        *RST ADDR* ON   * SET TO 0 
            (RST OF OP)  *                 *SAVED   *      *
 ------------------------*-----------------*--------*------*----------
 III. LOGICAL(EXCEPT NOT)*                 *        *      *
  A. (RST OF OP) OP      *                 *        *      *
            (RST OF OP)  *                 *        *      *
   1. BOTH DUMFG OFF     *BUILD ONE BLP    *RST ADDR* OFF  * BLP ENTRY
                         *ENTRY            *SAVED   *      * SAVED
   2. BOTH DUMFG ON      *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
   3. OTHER CASES        *BUILD 3 DUMMY BLP*RST ADDR* OFF  * BLP ENTRY
                         *ENTRIES (TYPE 1,2*SAVED   *      * SAVED
                         *AND 3) FOR THE   *        *      *
                         *ONE THAT HAD     *        *      *
                         *DUMFG ON         *        *      *
                         *THEN BUILD A TYPE*        *      *
                         *3 ENTRY TO LINK  *        *      *
                         *THEM             *        *      *
  B. ITEM OP (RST OF OP) *                 *        *      *
   1. DUMFG OFF          *BUILD 3 DUMMY BLP*RST ADDR* OFF  * BLP ENTRY
                         *ENTRIES FOR THE  *SAVED   *      * SAVED
                         *LOGICAL ITEM     *        *      *
                         *THEN BUILD A TYPE*        *      *
                         *3 ENTRY TO LINK  *        *      *
                         *THEM             *        *      *
   2. OTHER CASE         *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
  C. ITEM OP ITEM        *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
 ------------------------*-----------------*--------*------*----------
 IV. -NOT-               *                 *        *      *
  A. NOT (RST OF OP) WITH*BUILD ONE BLP    *RST ADDR* OFF  * BLP ENTRY
     DUMFG OFF           *ENTRY            *SAVED   *      * SAVED
  B. OTHER CASES         *NO ACTION        *RST ADDR* ON   * SET TO 0 
                         *                 *SAVED   *      *
 NOTE:  
  (RST OF OP) --- THERE EXIST A T1 ENTRY CORRESPOND TO IT ALREADY.
  WHENEVER AN -OPERATOR- ENTRY IS LOCATED AT THE EXPRESSION STACK, THE
  OPERAND ADDRESSES ARE COMPARED TO THE -RSTADDR- FIELD IN -T1-, (LAST
  ENTRY FIRST, THEN THE SECOND LAST, ETC) IF A MATCH IS FOUND (WHICH
  INDICATES THE OPERAND IS THE RESULT OF A PREVIOUS OPERATION), THEN THE
  -DUMFG- AND -BLPENTY- OF THAT T1 ENTRY ARE USED TO THE ABOVE RULES TO 
  BUILD THE NEXT -T1- AND -P1- ENTRY. 
                     ------EXAMPLE------
 CN   TEMPORARY ITEM
 CNN  TEMPORARY ITEM OF LOGICAL TYPE
 KN   ALTERNATE KEY FIELD 
 FN   NON-KEY AREA ITEM 
 (N)  THE NTH SCRATCH ADDRESS BEING USED IN THE EXPRESSION STACK
IF (K1<4 AND K2>C1+C2  OR (C3=C4-100 OR K3=F2-5)) XOR 
  NOT((((C1+C2+C3) - (C4+C5)) * ((F1-C6)*C7)) < F4 OR C70)) 
      *     *  T1 ENTRY *   P1 ENTRY  * 
      *     *-----------*-------------* 
      *     *    /   /  *E / /        * 
      *     *  R /   /B *N / /        * 
      *     *  S /   /L *T / /        * 
      *     *  T / D /P *R / /        * 
      *     *  A / U /E *Y /T/        * 
      *     *  D / M /N *  /Y/OPERANDS* 
 STACK*     *  D / F /T *N /P/   AND  * 
 ENTRY*RULES*  R / G /Y *O /E/OPERATOR*      COMMENTS 
 -----*-----*----/---/--*--/-/--------*---------------------------------
 K1   *     *    /   /  * 2/1/K1      *FOR P1 ENTRY 0 AND 1, SEE BLP ERS
 4    *     *    /   /  * 3/2/4       * 
 < (1)* IIA1* (1)/OFF/4 * 4/3/<,2,3   *(1) IS THE RESULT OF K1<4
 C1   *     *    /   /  *  / /        * 
 C2   *     *    /   /  *  / /        *C1+C2 WILL BE EVALUATED, RESULT
 + (2)*  IA1* (2)/OFF/  *  / /        *STORED INTO (2)
 K2   *     *    /   /  * 5/1/K2      * 
 (2)  *     *    /   /  * 6/2/C1+C2   *THE ADDR (2) COMPARED TO 
 > (3)* IIB1* (3)/OFF/ 7* 7/3/>,5,6   *RSTADDR TO PICK UP DUMFG 
 (1)  *     *    /   /  *  / /        * 
 (3)  *     *    /   /  *  / /        *4,7 ARE PICKED UP FROM -BLPENTY- 
AND(4)*IIIA1* (4)/OFF/ 8* 8/3/AND,4,7 *AND USED AS OPERAND IN P1  ENTRY 
 C4   *     *    /   /  *  / /        * 
 100  *     *    /   /  *  / /        * 
 - (5)*  IA1* (5)/OFF/  *  / /        *C4-100 IS EVALUATED,STORED IN (5)
 C3   *     *    /   /  *  / /        * 
 (5)  *     *    /   /  *  / /        *C3=C4-100 DOES NOT AFFECT RST OF 
 = (6)* IIB2* (6)/ ON/  *  / /        *BLP, HENSE NO P1 ENTRY IS BUILT
 F2   *     *    /   /  *  / /        * 
 5    *     *    /   /  *  / /        * 
 - (7)*  IA2* (7)/ ON/  *  / /        * 
 K3   *     *    /   /  *  / /        *SINCE K3 IS COMPARED TO F2, BLP
 (7)  *     *    /   /  *  / /        *CANNOT USED IT AS SELECTION
 = (8)* IIB2* (8)/ ON/  *  / /        *CRITERIA, NO P1 ENTRY IS BUILT 
 (6)  *     *    /   /  *  / /        * 
 (8)  *     *    /   /  *  / /        * 
 OR(9)*IIIA2* (9)/ ON/  *  / /        * 
 (4)  *     *    /   /  * 9/2/DUMMY   *3 DUMMY ENTRIES ARE BUILT FOR
 (9)  *     *    /   /  *10/1/DUMMY   *C3=C4-100 OR K3=F2-5 
OR(10)*IIIA3*(10)/OFF/12*11/3/EQ,A,10 *THEN -OR- TOGETHER WITH THE RST
      *     *    /   /  *12/3/OR,8,11 *OF K1<4 AND K2>C1+C2 
 C1   *     *    /   /  *  / /        * 
 C2   *     *    /   /  *  / /        * 
 +(11)*  IA1*(11)/OFF/  *  / /        *C1+C2 EVALUATED,STORED IN (11) 
 (11) *     *    /   /  *  / /        * 
 C3   *     *    /   /  *  / /        *(C1+C2)+C3 EVALUATED, STORED IN
 +(12)*  IB1*(12)/OFF/  *  / /        *(12) 
 C4   *     *    /   /  *  / /        * 
 C5   *     *    /   /  *  / /        * 
 +(13)*  IA1*(13)/OFF/  *  / /        *C4+C5 EVALUATED, STORED IN (13)
 (12) *     *    /   /  *  / /        * 
 (13) *     *    /   /  *  / /        *(C1+C2+C3)-(C4-C5) EVALUATED,
 -(14)*  IC1*(14)/OFF/  *  / /        *STORED IN (14) 
 F1   *     *    /   /  *  / /        * 
 C6   *     *    /   /  *  / /        *SINCE F1-C6 VARIES, NO P1 ENTRY
 -(15)*  IA2*(15)/ ON/  *  / /        *BUILD, DUMFG SET TO ON 
 (15) *     *    /   /  *  / /        * 
 C7   *     *    /   /  *  / /        *NO EVALUATION IS DONE, SINCE 
 *(16)*  IB2*(16)/ ON/  *  / /        *DUMFG FOR (15) IS ON 
 (14) *     *    /   /  *  / /        * 
 (16) *     *    /   /  *  / /        * 
 *(17)*  IC2*(17)/ ON/  *  / /        * 
 (17) *     *    /   /  *  / /        * 
 F4   *     *    /   /  *  / /        * 
 <(18)* IIB2*(18)/ ON/  *  / /        * 
 (18) *     *    /   /  *  / /        * 
 C70  *     *    /   /  *  / /        * 
OR(19)*IIIB2*(19)/ ON/  *  / /        * 
 (19) *     *    /   /  *  / /        * 
NO(20)* IVB *(20)/ ON/  *  / /        * 
 (10) *     *    /   /  *13/2/DUMMY   *3 DUMMY ENTRIES BUILD FOR
 (20) *     *    /   /  *14/1/DUMMY   *NOT((((C1+C2+C3)-(C4+C5))*((F1-C6
XR(21)*IIIA3*(21)/OFF/16*15/3/EQ,13,14*)*C7)) < F4 OR C70)) 
      *     *    /   /  *16/3/XR,12,15*THEN A FINAL XOR                #
CONTROL LIST; 
  XREF ITEM RA0;                                                         IFKEY
      XREF ITEM TARGETAREA;        # PTR TO AREA TO BE UPDATED         #
  XREF PROC CONVERT;               # CONVERT FROM 1 DATATYPE TO ANOTHER#
  XREF PROC EXPEVAL;                                                     IFKEY
  XREF ITEM AKGRPID;               # GROUP ID OF CM CONTAINING LITERAL #
                                   # VALUES OF ALT KEYS WITH UNIVERSAL #
                                   # CHARACTER OR MAJOR ALT KEYS PADDED#
                                   # WITH HIGH OR LOW CHARACTER        #
  XREF PROC RGTABLE;                                                     IFKEY
  XREF PROC DIAG;                  # ISSUE DIAGNOSTIC MESSAGE TO USER  #
          XREF PROC LOADOVL;
  XREF ITEM CDCSDBM B;             # TRUE IF ACCESSING THROUGH CDCS    #
  XREF ITEM ATPTR I;               # AREA TABLE POINTER                #
  XREF ITEM UNIVERSAL;                                                   BLPUNIV
  XREF ITEM RECDORD I;             # RECORD ORDINAL USED BY THIS XMISSN#
  XREF ITEM LOWAREA I;             # ORDINAL OF LOW AREA OF RELATION   # QU30296
  XREF ITEM CURRELLOC;             # ADDRESS OF CURRENT RELATION TABLE #
  BASED ARRAY REL$TAB;             # TEMPLATE USED TO EXTRACT ROOT     #
    BEGIN                          # AREA$TABLE ADDRESS FROM RELATION  #
    ITEM RT$ROOT  U(07,42,18);
    END 
  DEF   ENDCOD #0#;                                                      IFKEY
  DEF NEGATION #10#;                                                     IFKEY
  DEF LOGICALOP #OPERCODE GR 6#;                                         IFKEY
  DEF ORCODE #8#;                                                        IFKEY
  ITEM P1PTR = 1;                                                        IFKEY
    ITEM T1PTR = 0;                                                      BLPUNIV
  ITEM PRGMSTACKPTR = 0;                                                 IFKEY
                             #PTRS OF P1,T1,AND EXPRESSION STACK# 
  ITEM OLDP1PTR = 0;                                                     IFKEY
  ITEM CONSTOPERAND B;             # TRUE IF ALL OPERANDS ARE          #
                                   # CONSTANTS OR RESULTS OF           #
                                   # EVAUATED EXPRESSIONS              #
  ITEM OPERCODE;                                                         IFKEY
  ITEM J,K,L,M,N;                                                        IFKEY
  ITEM PREVIOUS = -1;                                                    IFKEY
  ITEM RC I;                       # RETURN CODE FROM EXPEVAL          #
  ITEM BITPTR,WORDPTR;                                                   BLPUNIV
      XDEF ITEM HIGHCHAR;          # CHAR WITH HIGHEST COLLATE VALUE   #
      XDEF ITEM LOWCHAR;           # CHAR WITH LOWEST COLLATE VALUE    #
      XDEF ITEM AREACOL;           # ADDRESS OF AREA TABLE             #
#     XDEF PROC HIGHLOW              CALCULATE HIGH AND LOW CHARACTER  #
  ITEM LITPTR,LITLG;                                                     BLPUNIV
  ITEM AKEYPTR,AKEYLG;                                                   BLPUNIV
  ITEM CHAR;                                                             BLPUNIV
ARRAY ZD[1];
                                   # ATTRIBUTE FOR CORRESPONDING       #
                                   # CONVERSION CODE                   #
          BEGIN 
          ITEM Z I(0,0,60) = [O"20177777704020140000",   # IF EDIT     #
                              O"00077777700000000000"];  # IF NO EDIT  #
          END 
  XREF ARRAY BLPTBLE; 
                             #BLP INPUT TABLE#
                             #  THE TABLE RESIDES IN OVERLAY 20-00 #
    BEGIN                                                                IFKEY
    ITEM PERR       B(0,0,1);                                            IFKEY
                             #1--IF ERROR IS DETECTED,0--OTHERWISE# 
    ITEM AC         U(0,1,5);                                            IFKEY
                             #1--DATA ITEM ENTRY# 
                             #2--CONSTANT ENTRY#
                             #3--OPERATION# 
    ITEM KEYFWA     U(0,6,18);                                           IFKEY
                             #FWA WHERE BLP RETURNS KEY LIST #
    ITEM KEYLEN     U(0,24,18);                                          IFKEY
                             #LEN OF KEYFWA AREA, SET TO 63 BY IFKEY# 
                             #IF KEY LIST > 63 WORDS, IT IS PUT ON A   #
                             #FILE WHOSE NAME IS SET IN ARRAY -P2-     #
    ITEM BLPFITLOC  U(0,42,18);                                          IFKEY
                             #ADDRESS OF FIT# 
    ITEM COLSEQ     U(0,6,18);                                           BLPUNIV
                             #ADDRESS OF COLLATING SEQUENCE#
    ITEM WSFWA      U(0,24,18);                                          BLPUNIV
                             #WSA THAT BLP CAN USE FOR SCRATCH# 
    ITEM WSLEN      B(0,42,18);                                          BLPUNIV
                             #LENGTH OF THE WSA#
    ITEM OPCOD      U(0,6,6);                                            IFKEY
                             #OPERATOR CODE,1--EQ,2--NE,3--LT,4--GT, #
                             #5--LE,6--GE,7--AND,8--OR,9--XOR,10--NOT#
                             #11--GE LOWER BOUND AND LE UPPER BOUND  #
    ITEM PARM1      U(0,12,18);                                          IFKEY
                             #ENTRY PTR (WITHIN P1) OF 1ST OPERAND# 
    ITEM PARM2      U(0,30,18);                                          IFKEY
                             #ENTRY PTR(WITHIN P1) OF 2ND OPERAND#
    ITEM KEYTYP     U(0,6,2);                                            IFKEY
                             #KEY TYPE,0-NON KEY,1-PRIMARY,2-ALTERNATE# 
    ITEM SORTSEQ    U(0,8,1);                                            IFKEY
                             #SORT SEQ,0-ASCENDING, 1-DESCENDING# 
    ITEM WORDPOS    U(0,9,9);                                            IFKEY
                             #WORD POS IN RECORD WHEN KEYTYP=2# 
    ITEM CHARPOS    U(0,18,9);                                           IFKEY
                             #CHAR POS IN WORD WHEN KEYTYP=2# 
    ITEM CHARLEN    U(0,27,9);                                           IFKEY
                             #LENGTH OF ITEM WHEN KEYTYP=2# 
    ITEM ITEMTYPE   U(0,36,6);                                           IFKEY
                             #ITEM TYPE,0-FILE OF KEYS,1-LIST OF FILE#
                             #2-SYMBOLIC,3-SIGNED,4-UNSIGNED INTEGER# 
    ITEM P1ITEMORD  U(0,45,15); 
                             # ITEM ORDINAL IF CDCS AREA ITEM, ELSE 0  #
    ITEM P2ITEMTYPE U(0,6,3); 
                             #ITEM TYPE FOR CONSTANT,VALUE SAME AS# 
                             #ITEM TYPE#
    ITEM P2LEN      U(0,9,9); 
                             #LENGTH OF CONSTANT IN CHAR# 
    ITEM P2LOC      B(0,18,1);
                             #0--CONSTANT STARTS IN NEXT WORD#
                             #1--P2FWA POINTS TO CONSTANT#
    ITEM P2CPOS     U(0,20,4);
                             # CHARACTER POSITION OF CONSTANT          #
    ITEM P2UBFWA    I(0,24,18);    # FWA OF UPPER BOUND                #
    ITEM P1FULL     U(0,0,60);                                           IFKEY
    ITEM P2FWA      U(0,42,18);                                          IFKEY
                             #FWA OF CONSTANT#
    END                                                                  IFKEY
      XREF BASED ARRAY SAVDAREA;
        BEGIN 
        ITEM AREASAVE   U(0,42,18); 
        ITEM AREAINUSE  B (0,0,1);
        ITEM RELORD     U (0,6,12); 
        ITEM AREASAVEWD U (0,0,60); 
        END 
  ARRAY T1[99];                                                          IFKEY
                             # INTERIM TABLE TO BUILD BLPTBLE.         #
    BEGIN                                                                IFKEY
    ITEM RSTADDR I(0,42,18);                                             IFKEY
    ITEM DUMFG   B(0,0,1);                                               IFKEY
    ITEM BLPENTY I(0,3,12);                                              IFKEY
    ITEM T1WORD  I(0,0,60);                                              IFKEY
    END                                                                  IFKEY
  ARRAY T1ENT[1:2];                                                      IFKEY
    ITEM T1ENTRY I(0,0,60);                                              IFKEY
  ARRAY PREVIST[4];                                                      IFKEY
    ITEM PREVADDR I(0,42,18),                                            IFKEY
         PREVPTR  I(0,24,18);                                            IFKEY
  ARRAY DS[58]; 
    ITEM DUMSTACK U(0,0,60);                                             IFKEY
  ARRAY [6];                                                             IFKEY
    ITEM CHANGCVD I(0,0,60)                                              IFKEY
      =[O"00 00 00 00 00 00 01 02 00 00",                                IFKEY
        O"03 04 05 06 01 00 07 10 00 00",                                IFKEY
        O"00 00 00 00 00 00 01 02 00 00",                                IFKEY
        O"03 04 05 06 11 12 01 02 00 00",                                IFKEY
        O"00 00 00 00 00 00 01 00 00 00", 
        O"00 00 00 00 03 04 05 06 00 00",                                IFKEY
        O"00 00 00 00 00 00 01 00 00 00"];
  BASED ARRAY AA;                                                        IFKEY
    ITEM A U(0,0,60);                                                    IFKEY
  BASED ARRAY BB; #SCRATCH #                                             BLPUNIV
    ITEM B;                                                              BLPUNIV
      ARRAY CVTPARAMS [0:0] S(2);  # CONVERT PARAMETERS                #
        BEGIN 
        ITEM NBCHAR     U(0,12,12);  # NUMBER OF CHARACTERS            #
        ITEM FROMCHAR   U(0, 4, 4);  # REL CHAR PTR OF -FROM- FIELD    #
        ITEM FROMWORD   I(0,24,18);  # ADDR OF -FROM- FIELD OR ADDR OF #
                                     # ATTRIB TABLE OF -FROM- FIELD    #
        ITEM TOWORD     I(0,42,18);  # ADDR OF -TO- FIELD OR ADDR OF   #
                                     # ATTRIB TABLE OF -TO- FIELD      #
        ITEM CONVRTCODE U(1, 0, 6);  # CONVERT CODE                    #
        END 
  
      ARRAY ATTRIBENTRY [0:0] S(2);  # ATTRIB TABLE                    #
        BEGIN 
        ITEM TDEWPOS    I(0,18,18);  # ADDRESS OF SINK FIELD           #
        ITEM TDECLSLG   I(0,42,18);  # LENGTH OF SINK FIELD (CHARS)    #
        ITEM TOVERPUN   B(1,15,01);  # TRUE IF OVERPUNCH EXISTS        #
                                     # FOR COMP ITEMS                  #
        ITEM TDPOINT    B(1,20,01);  # TRUE, DEC PT ACTUALLY PRESENT   #
        ITEM TDPTLOC    I(1,21,06);  # CHAR POS OF DECIMAL POINT       #
        END 
  
  CONTROL EJECT;                                                         IFKEY
  PROC BLDTYP1(PTR);                                                     IFKEY
                             #PROC TO BUILD A TYPE 1 ENTRY, PTR IS THE #
                             #POINTER INTO STACK THAT CONTAINS INFO    #
                             #FOR THIS ENTRY# 
    BEGIN                                                                IFKEY
    ITEM PTR;                                                            IFKEY
ITEM ATTRI B; ITEM I; 
ATTRI=FALSE;
    P1PTR = P1PTR + 1;                                                   IFKEY
    P1FULL[P1PTR] = 0;                                                   IFKEY
    AC[P1PTR] = 1;                                                       IFKEY
    KEYTYP[P1PTR] = 2;                                                   IFKEY
    P1ITEMORD[P1PTR] = ITEMORDINAL[PTR];
IF ENTRYTYPE[PTR] EQ 4 THEN 
ATTRI=TRUE; 
ELSE IF ENTRYTYPE[PTR] EQ 2 THEN
  BEGIN IF EDITFLAG[PTR] THEN I=0; ELSE I=1;
          IF B<CONVERTCODE[PTR],1>Z[I] NQ 0 THEN ATTRI=TRUE;
  END 
IF ATTRI THEN 
BEGIN P<BB>=FROMWORDADDR[PTR];
  WORDPOS[P1PTR]=B<18,18>B[1];
END 
ELSE
    WORDPOS[P1PTR] = FROMWORDADDR[PTR];                                  IFKEY
    CHARPOS[P1PTR] = RELFROMCHAR[PTR];                                   IFKEY
    CHARLEN[P1PTR] = NBRCHARS[PTR];                                      IFKEY
    L = OPCODE[PRGMSTACKPTR];                                            IFKEY
    IF L GR O"35"                                                        IFKEY
      THEN M =2;                                                         IFKEY
      ELSE                                                               IFKEY
      IF OVERSIGN[PRGMSTACKPTR]                                          IFKEY
        THEN M = 3;                                                      IFKEY
        ELSE M =  4;                                                     IFKEY
    ITEMTYPE[P1PTR] = M;                                                 IFKEY
    END                                                                  IFKEY
  CONTROL EJECT;                                                         IFKEY
  PROC BLDTYP2(PTR);                                                     IFKEY
                             #PROC TO BUILD A TYPE 2 ENTRY FROM THE#
                             #-PTR- ENTRY OF THE STACK# 
    BEGIN                                                                IFKEY
    ITEM PTR;                                                            IFKEY
    P1PTR = P1PTR + 1;                                                   IFKEY
    P1FULL[P1PTR] = 0;                                                   IFKEY
    AC[P1PTR] = 2;                                                       IFKEY
    P2ITEMTYPE[P1PTR] = M;                                               IFKEY
    P2LEN[P1PTR] = NBRCHARS[PTR];                                        IFKEY
    P2LOC[P1PTR] = TRUE;                                                 IFKEY
    P2FWA[P1PTR] = FROMWORDADDR[PTR];                                    IFKEY
    P2CPOS[P1PTR] = RELFROMCHAR[PTR];  # STARTING CHAR IN *P2FWA*      #
    END                                                                  IFKEY
  CONTROL EJECT;                                                         IFKEY
  PROC BLDTYP3;                                                          IFKEY
                             #PROC TO BUILD A TYPE 3 ENTRY# 
    BEGIN                                                                IFKEY
    P1PTR = P1PTR + 1;                                                   IFKEY
    P1FULL[P1PTR] =  0;                                                  IFKEY
    AC[P1PTR] = 3;                                                       IFKEY
    OPCOD[P1PTR] = OPERCODE;                                             IFKEY
    BLPENTY[T1PTR] = P1PTR;                                              IFKEY
    PARM1[P1PTR] = M;                                                    BLPUNIV
    PARM2[P1PTR] = N;                                                    BLPUNIV
    END                                                                  IFKEY
      CONTROL EJECT;                                                     IFKEY2 
      PROC CHKAKEY;                                                      IFKEY2 
                             #PROC TO CHECK FOR ALTERNATE KEY USED# 
                             #IN THE STACK# 
      BEGIN                                                              IFKEY2 
      IF (ALKEYENTRY[K]            # IF ALTERNATE KEY                  # QU30296
        OR ALTMAJKEY[K])           # IF MAJOR ALTERNATE KEY            # QU30296
        AND AREAORD[K] EQ LOWAREA  # KEY WITHIN LOW AREA OF RELATION   # QU30296
      THEN
        BEGIN 
        IF (RECDORD NQ 0           # IF SAME RECORD ORDINAL            #
            AND RECDORD EQ RECDORDINAL[K])
          OR RECDORD EQ 0          # IF NOT INITIALIZED YET            #
        THEN
          BEGIN 
          RECDORD = RECDORDINAL[K]; 
          M = -2; 
          END 
        ELSE                       # DIFFERENT RECORD ORDINALS         #
          BEGIN 
          DIAG(378);               # KEYS FROM > 1 RECORD NAME         #
          M = -1;                  # DO NOT TREAT AS KEY               #
          END 
        END 
      ELSE M = -1;                                                       IFKEY2 
      T1ENTRY[PRGMSTACKPTR-K] = M; END                                   IFKEY2 
CONTROL EJECT;
PROC CHKANDOR;
BEGIN 
  ITEM II,JJ,KK;
  IF J GR 0 AND DUMFG[J] THEN II=N; ELSE II=M;
  IF OPERCODE EQ 7 THEN BLPENTY[T1PTR] = II;
  ELSE
  BEGIN 
    REPEAT1: # #
      JJ=PARM1[II]; 
      KK=PARM2[II]; 
      IF JJ GR KK THEN II=KK; ELSE II=JJ; 
      IF AC[II] EQ 3 THEN GOTO REPEAT1; 
      P1PTR=II-1; 
      DUMFG[T1PTR]=TRUE;
  END 
END 
  CONTROL EJECT;                                                         IFKEY
  PROC CHKT1;                                                            IFKEY
                             #PROC TO CHECK ADDRESS IN STACK AGAINST# 
                             #RSTADDR IN T1.# 
                             #UPON RETURN, J=0,1ST OPERAND IS TEMP ITEM#
                             #          J=-1,                 AREA ITEM#
                             #            J=-2,            ALTERNAT KEY#
                             #            J= N,            IS THE RST  #
                             #              OF A PREVIOUS OPERATION, N #
                             #              IS THE T1 ENTRY CORRESPOND #
                             #              TO IT                      #
                             #K REPRESENTS THE SAME FOR THE 2ND ENTRY  #
    BEGIN                                                                IFKEY
    T1ENTRY[1]  =  0;                                                    IFKEY
    T1ENTRY[2] = 0;                                                      IFKEY
      CONSTOPERAND = TRUE;         # ASSUME ONLY CONSTANT OPERANDS     #
      J = PRGMSTACKPTR - 1; 
      FOR K = J STEP - 1
        WHILE (K GQ 0)             # MORE ENTRIES                      #
          AND (ENTRYTYPE[K] NQ 7)  # ENTRY IS OPERAND                  #
      DO
        BEGIN 
        IF FROMWORDBASE[K] EQ 0 
        THEN
          BEGIN 
          L = FROMWORDADDR[K];
          IF L EQ 0 
          THEN
            BEGIN 
            L = TOWORDADDR[K];
            END 
          IF TOWORDBASE[K] NQ 0 
          THEN
            BEGIN 
            CONSTOPERAND = FALSE;  # AREA ITEM                         #
            IF K GQ PRGMSTACKPTR - 2  # IF 1ST TWO OPERANDS            #
            THEN
              BEGIN 
              CHKAKEY;             # CHECK IF ALTERNATE KEY            #
              END 
            END 
          ELSE                     # IF NOT AREA ITEM                  #
            BEGIN 
            FOR M = T1PTR - 1 STEP -1 
              UNTIL 0 
            DO
              BEGIN 
              N = RSTADDR[M]; 
              IF L EQ N 
              THEN
                BEGIN 
                IF DUMFG[M]        # IF RESULT OF OPERATION            #
                                   # THAT WAS NOT EVALUATED            #
                THEN
                  BEGIN 
                  CONSTOPERAND = FALSE; 
                  END 
                IF K GQ PRGMSTACKPTR - 2  # IF 1ST TWO OPERANDS        #
                THEN
                  BEGIN 
                  T1ENTRY[PRGMSTACKPTR - K] = M;
                  END 
                TEST K; 
                END 
              END 
            END 
          END 
        ELSE                       # IF AREA ITEM                      #
          BEGIN 
          CONSTOPERAND = FALSE; 
          IF K GQ PRGMSTACKPTR - 2 # IF 1ST TWO OPERANDS               #
          THEN
            BEGIN 
            CHKAKEY;               # CHECK IF ALTERNATE KEY            #
            END 
          END 
        END 
    J = T1ENTRY[1];                                                      IFKEY
    K = T1ENTRY[2];                                                      IFKEY
    END                                                                  IFKEY
  CONTROL EJECT;                                                         BLPUNIV
  PROC CHKUNIV;                                                          BLPUNIV
                             #PROC TO CHECK UNIVERSAL CHAR IN LITERAL  #
  BEGIN                                                                  BLPUNIV
    ITEM LOOPLIMIT I;              # MIN(KEY LENGTH, LITERAL LENGTH)   #
  
    LITPTR = 0;                                                          BLPUNIV
    AKEYPTR = 0;  #PRESET TO 0#                                          BLPUNIV
#PICK UP LITERAL AND ALTERNATE KEY ENTRY POINTER#                        BLPUNIV
    IF AC[M] EQ 2 THEN LITPTR=M;                                         BLPUNIV
      ELSE IF AC[M] EQ 1 AND KEYTYP[M] EQ 2 THEN AKEYPTR = M;            BLPUNIV
    IF AC[N] EQ 2 THEN LITPTR=N;                                         BLPUNIV
      ELSE IF AC[N] EQ 1 AND KEYTYP[N] EQ 2 THEN AKEYPTR = N;            BLPUNIV
    IF LITPTR EQ 0 OR AKEYPTR EQ 0 THEN                                  BLPUNIV
                              #NOT LITERAL COMPARING TO ALTERNATE KEY#   BLPUNIV
      RETURN;                                                            BLPUNIV
                                                                         BLPUNIV
      IF KEYTYPE[J] EQ DT$LOGICAL  # IF KEY IS LOGICAL, HENCE DIFFERENT#
                                   # VALUES POSSIBLE FOR *TRUE*        #
        OR ENTRYTYPE[K] GQ 4       # IF LITERAL IS SUBSCRIPTED         #
      THEN
        BEGIN 
        RETURN;                    # EXIT, TREAT AS NON-KEY            #
        END 
  
    IF P2ITEMTYPE[LITPTR] NQ 2     # IF KEY IS NOT TYPE CHARACTER      #
    THEN
      BEGIN 
                                   # J IS INDEX OF KEY                 #
                                   # K IS INDEX OF LITERAL             #
      IF KEYTYPE[J] EQ DT$NUM      # IF KEY IS NUMERIC                 #
      THEN
        BEGIN 
        P<DESATT1> = FROMATTRIB[J];  # POSITION TO ATTRIB TABLE        #
        IF DOVERPUN[0]             # IF KEY HAS SIGN OVER PUNCH        #
          AND OPERCODE NQ 1        # OPERATOR IS NOT *=*               #
        THEN
          BEGIN 
          RETURN;                  # EXIT, TREAT AS NON-KEY            #
          END 
        END 
  
      IF (KEYTYPE[J] EQ DT$DOUBLE  # IF DOUBLE                         #
        OR KEYTYPE[J] EQ 6)        # IF COMPLEX                        #
        AND OPERCODE NQ 1          # OPERATOR IS NOT *=*               #
      THEN
        BEGIN 
        RETURN;                    # MIP DOES NOT SORT THE SAME AS QU, #
                                   # HENCE EXIT, TREAT AS NON-KEY      #
        END 
  
      IF ENTRYTYPE[J] GR 1         # IF LITERAL MUST BE CONVERTED TO   #
        OR ENTRYTYPE[K] GR 1       # SAME TYPE AS KEY                  #
      THEN
        BEGIN 
        IF AKGRPID EQ 0            # IF NO GROUP ID ALLOCATED          #
        THEN
          BEGIN 
          AKGRPID = CMM$AGR (0);   # ALLOCATE CMM GROUP ID             #
          END 
  
                                   # ALLOCATE CM TO CONVERT LITERAL    #
        P<BB> = CMM$ALF ((NBRCHARS[J] + 9) / 10, 0, AKGRPID); 
        NBCHAR[0] = NBRCHARS[K];   # NO CHARS IN LITERAL               #
        FROMWORD[0] = FROMWORDADDR[K];  # ADDR OF LITERAL OR ADDR OF   #
                                        # ATTRIB TABLE DESCRIBING LIT  #
        FROMCHAR[0] = RELFROMCHAR[K];  # REL CHAR PTR OF LITERAL       #
        IF KEYTYPE[J] EQ DT$NUM    # IF NUMERIC, ALIAS COMP            #
          OR KEYTYPE[J] EQ DT$FIXED  # IF FIXED, ALIAS COMP-1          #
          OR KEYTYPE[J] EQ DT$INTEGER  # IF INTEGER                    #
        THEN
          BEGIN                    # PREPARE ATTRIB TABLE              #
          P<DESATT1> = FROMWORDADDR[J];  # POSITION TO KEY ATTRIB TABLE#
          TDEWPOS[0] = P<BB>;      # BEGINNING WORD POSITION           #
          TDECLSLG[0] = DECLSLG[0];  # LENGTH IN CHARACTERS            #
          TOVERPUN[0] = DOVERPUN[0];  # SIGN OVERPUNCH FLAG            #
          TDPOINT[0] = DPOINT[0];  # DECIMAL POINT FLAG                #
          TDPTLOC[0] = DPTLOC[0];  # DECIMAL POINT LOCATION            #
          TOWORD[0] = LOC(ATTRIBENTRY) - 1;  # ATTRIB TABLE            #
          END 
  
        ELSE                       # NO ATTRIB TABLE REQUIRED          #
          BEGIN 
          TOWORD[0] = P<BB>;       # BEGINNING WORD POSITION           #
          END 
  
                                   # CALCULATE CONVERT CODE TO CONVERT #
                                   # FROM LITERAL TYPE TO KEY TYPE     #
        CONVRTCODE[0] = B<KEYTYPE[J]*6,6>CCODE[KEYTYPE[K]]; 
        CONVERT (CVTPARAMS, RC);
        IF RC NQ 0                 # IF SOME ERROR                     #
        THEN
          BEGIN 
          RETURN;                  # EXIT, TREAT AS NON-KEY            #
          END 
        P2FWA[LITPTR] = P<BB>;     # ADDR OF CONVERTED VALUE           #
        END 
  
      P2ITEMTYPE[LITPTR] = 2;      # TELL BLP IT IS CHARACTER ITEM SO  #
                                   # IT WILL PROCESS AS A KEY          #
      END 
  
    IF UNIVERSAL GR O"77"          # IF NO UNIVERSAL DEFINED           #
      AND ALKEYENTRY[J]            # IF ALTERNATE KEY                  #
    THEN
      BEGIN 
      RETURN;                      # EXIT, NO PADDING REQUIRED         #
      END 
  
                                                                         BLPUNIV
    LITLG = P2LEN[LITPTR];                                               BLPUNIV
    AKEYLG = CHARLEN[AKEYPTR];                                           BLPUNIV
    M = AKEYLG + 1;                # PRESET POSITION TO START PADDING  #
                                   # IN CASE NO SEARCH FOR UNIVERSAL   #
    P<AA> = P2FWA[LITPTR];         # POSITION TO LITERAL               #
    IF UNIVERSAL LS O"100"         # IF UNIVERSAL DEFINED              #
    THEN
    BEGIN 
    IF LITLG GR AKEYLG             # IF LITERAL LONGER THAN KEY        #
    THEN
      BEGIN 
      LOOPLIMIT = AKEYLG;          # ONLY SEARCH LENGTH OF KEY         #
      END 
    ELSE
      BEGIN 
      LOOPLIMIT = LITLG;           # SEARCH ENTIRE LITERAL             #
      END 
# NOW LOOK FOR UNIVERSAL CHAR IN LITERAL#                                BLPUNIV
    WORDPTR = 0;                                                         BLPUNIV
    BITPTR = 0;                                                          BLPUNIV
    FOR M = 1 STEP 1
      UNTIL LOOPLIMIT 
    DO
    BEGIN                                                                BLPUNIV
      N = B<BITPTR,6>A[WORDPTR]; #PICK UP NEXT CHAR#                     BLPUNIV
      IF N EQ UNIVERSAL THEN GOTO FINDUNIV;                              BLPUNIV
      INCREPTR; #INCREMENT PTR#                                          BLPUNIV
    END                                                                  BLPUNIV
                                                                         BLPUNIV
    IF ALKEYENTRY[J]               # IF ALTERNATE KEY AND NO UNIV FOUND#
    THEN
      BEGIN 
      RETURN;                      # EXIT, NO PADDING REQUIRED         #
      END 
  
    M = AKEYLG + 1;                # START PADDING AT END OF MAJOR     #
                                   # KEY LENGTH                        #
    END 
                                                                         BLPUNIV
  FINDUNIV: #UNIVERSAL CHAR AT CHAR POSITION M#                          BLPUNIV
                                                                         BLPUNIV
                                                                         BLPUNIV
IF OPERCODE EQ 2   #-NQ- WITH UNIVERSAL CHAR, SCAN FILE#
  OR M EQ 1 THEN   #LITERAL START WITH UNIVERSAL CHAR,SCAN FILE#
    BEGIN                                                                BLPUNIV
      SCANALLAREA = TRUE;                                                BLPUNIV
                                                                         BLPUNIV
      RETURN;                                                            BLPUNIV
                                                                         BLPUNIV
    END                                                                  BLPUNIV
    IF ALTMAJKEY[J]                # IF MAJOR ALTERNATE KEY            #
    THEN
      BEGIN 
      AKEYLG = ALTKEYSIZE[J];      # SIZE OF ALTERNATE KEY OF WHICH    #
                                   # THIS IS MAJOR                     #
      CHARLEN[AKEYPTR] = AKEYLG;   # MAKE IT LOOK LIKE ALTERNATE KEY   #
      END 
    AREACOL = P<AREA$TABLE>;       # GIVE HIGHLOW THE AREA TABLE ADDRES#
    HIGHLOW; #GET HIGHEST AND LOWEST CHAR#                               BLPUNIV
    P2LEN[LITPTR] = AKEYLG; #HAVE TO PAD UP TO KEY LENGTH#               BLPUNIV
    N = (AKEYLG + 9)/10;                                                 BLPUNIV
    IF AKGRPID EQ 0                # IF NO GROUP ID ASSIGNED           #
    THEN
      BEGIN 
      AKGRPID = CMM$AGR(0);        # ALLOCATE GROUP ID                 #
      END 
    P<BB> = CMM$ALF(N, 0, AKGRPID); 
    P2FWA[LITPTR] = P<BB>;                                               BLPUNIV
    M = M-1; #BEFORE CHAR M, COPY FROM ORIGINAL LITERA, FROM M ON,#      BLPUNIV
             #PAD WITH HIGHEST OR LOWEST CHAR DEPEND ON OPERCODE#        BLPUNIV
                                                                         BLPUNIV
  PADCHAR: # #                                                           BLPUNIV
                                                                         BLPUNIV
    WORDPTR = 0;                                                         BLPUNIV
    BITPTR = 0;                                                          BLPUNIV
    IF LITLG LS M                  # IF PADDING WITH BLANKS REQUIRED   #
    THEN
      BEGIN 
      FOR N = 1 STEP 1
        UNTIL LITLG 
      DO
        BEGIN 
        B<BITPTR,6>B[WORDPTR] = B<BITPTR,6>A[WORDPTR]; # COPY LITERAL  #
        INCREPTR; 
      END 
  
      FOR N = LITLG + 1 STEP 1
        UNTIL M 
      DO
        BEGIN 
        B<BITPTR,6>B[WORDPTR] = O"55";  # PAD UP TO MAJOR KEY LENGTH   #
                                        # WITH BLANKS                  #
        INCREPTR; 
        END 
      END 
    ELSE
    BEGIN 
    FOR N = 1 STEP 1 UNTIL M DO #COPY FROM ORIGINAL LITERAL#             BLPUNIV
    BEGIN                                                                BLPUNIV
      B<BITPTR,6>B[WORDPTR] = B<BITPTR,6>A[WORDPTR];                     BLPUNIV
      INCREPTR;                                                          BLPUNIV
    END                                                                  BLPUNIV
    END 
#FOR -GT- OR -LE- PAD WITH HIGHEST CHAR, OTHERS WITH LOWEST CHAR#        BLPUNIV
    IF OPERCODE EQ 4 OR OPERCODE EQ 5 THEN CHAR = HIGHCHAR;              BLPUNIV
      ELSE CHAR = LOWCHAR;                                               BLPUNIV
    FOR N = M+1 STEP 1 UNTIL AKEYLG DO                                   BLPUNIV
    BEGIN                                                                BLPUNIV
      B<BITPTR,6>B[WORDPTR] = CHAR;                                      BLPUNIV
      INCREPTR;                                                          BLPUNIV
    END                                                                  BLPUNIV
#PADDING IS DONE, IF NOT FOR -EQ-, RETURN#                               BLPUNIV
                                                                         BLPUNIV
    IF OPERCODE NQ 1 THEN RETURN;                                        BLPUNIV
                                                                         BLPUNIV
# FOR -EQ- , CHANGE TO -GE- LOWBOUND -AND-  -LE- HIGHBOUND#              BLPUNIV
# AT THIS POINT, LOWBOUND IS IN BASED ARRAY BB#                          BLPUNIV
    OPCOD[P1PTR] = 11;             # LOWER BOUND LE KEY LE UPPER BOUND #
    N = (AKEYLG + 9)/10;                                                 BLPUNIV
    P<BB> = CMM$ALF(N, 0, AKGRPID);  # REQUEST SPACE FOR SETTING UP    #
                                     # HIGHBOUND                       #
    P2UBFWA[LITPTR] = P<BB>;       # SAVE FWA OF UPPER BOUND           #
# NOW GO BACK TO BUILD THE HIGHBOUND, SET OPERCODE TO LE SO HIGHCHAR#    BLPUNIV
# WILL BE USEDIN BUILDING THE IHGHBOUND#                                 BLPUNIV
    OPERCODE = 5;                                                        BLPUNIV
    GOTO PADCHAR;                                                        BLPUNIV
  END                                                                    BLPUNIV
  CONTROL EJECT;                                                         BLPUNIV
      XDEF PROC HIGHLOW;           # CALCULATE HIGH AND LOW CHARACTER  #
  PROC HIGHLOW; #LOCATE HIGHCHAR ANDLOWCHAR ACCORDING TO COLLATING SEQ#  BLPUNIV
  BEGIN                                                                  BLPUNIV
  BASED ARRAY COLSEQ;                                                    BLPUNIV
        ITEM COLWORD  U(0,0,60);
    ITEM I,HIGHVALUE;                                                    BLPUNIV
      ITEM HIGHWORD;
      ITEM LOWWORD; 
      ITEM LOOPCON B; 
      ITEM DUMMY2;
    IF HIGHCHAR NQ 0 OR LOWCHAR NQ 0 THEN                                BLPUNIV
                                                                         BLPUNIV
      RETURN; #HIGHCHAR AND LOWCHAR HAD BEEN SET#                        BLPUNIV
                                                                         BLPUNIV
    LOWCHAR = 0;                                                         BLPUNIV
    P<AREA$TABLE> = AREACOL;
      IF AT$COLSEQ EQ 0 THEN
    BEGIN #NO COLLATE SEQ EXISTS, HIGH IS 77B,LOW IS 0#                  BLPUNIV
      HIGHCHAR = O"77";                                                  BLPUNIV
                                                                         BLPUNIV
      RETURN;                                                            BLPUNIV
                                                                         BLPUNIV
    END                                                                  BLPUNIV
                                   # USE THE COLLATING TABLE IN -DCT-  #
                                   # FORMAT TO FIND THE HIGH AND LOW   #
                                   # CHARACTERS.  THE DISPLAY CODE     #
                                   # VALUE IS USED FOR THE ROW AND     #
                                   # COLUMN INDICES INTO THE -DCT-     #
                                   # TABLE. SEE THE -CRM FILE ORG.     #
                                   # USERS GUIDE FOR A COMPLETE        #
                                   # DESCRIPTION.                      #
      P<COLSEQ> = P<AREA$TABLE> + AT$COLSEQ;
      LOOPCON = TRUE; 
      FOR DUMMY2 = 0 STEP 1 WHILE LOOPCON DO
        BEGIN 
        IF DUMMY2 EQ 8             # IF END OF COLLATING SEQUENCE TABLE#
        THEN
          BEGIN 
          LOOPCON = FALSE;         # EXIT LOOP                         #
          TEST DUMMY2;
          END 
        FOR I = 0 STEP 1 UNTIL 7 DO 
          BEGIN 
          IF B<I*6,6>COLWORD[DUMMY2] EQ 0 THEN
            BEGIN 
            LOWCHAR = I;
            LOWWORD = DUMMY2; 
            END 
          IF B<I*6,6>COLWORD[DUMMY2] EQ O"77" THEN
            BEGIN 
            HIGHCHAR = I; 
            HIGHWORD = DUMMY2;
            END 
          END 
        END 
      B<57,3>LOWCHAR = LOWCHAR; 
      B<54,3>LOWCHAR = LOWWORD; 
      B<57,3>HIGHCHAR = HIGHCHAR; 
      B<54,3>HIGHCHAR = HIGHWORD; 
  END                                                                    BLPUNIV
  CONTROL EJECT;                                                         BLPUNIV
  PROC INCREPTR; #INCREMENT WORDPTR AND BITPTR#                          BLPUNIV
  BEGIN                                                                  BLPUNIV
    IF BITPTR EQ 54 THEN                                                 BLPUNIV
    BEGIN                                                                BLPUNIV
      BITPTR = 0;                                                        BLPUNIV
      WORDPTR = WORDPTR + 1;                                             BLPUNIV
    END                                                                  BLPUNIV
    ELSE BITPTR = BITPTR + 6;                                            BLPUNIV
  END                                                                    BLPUNIV
  CONTROL EJECT;                                                         IFKEY
  PROC SAVDUM;                                                           IFKEY
                             #PROC TO BUILD A T1 ENTRY FOR AN OPERATOR #
                             #ENTRY IN STACK# 
    BEGIN                                                                IFKEY
    T1PTR = T1PTR + 1;                                                   IFKEY
    T1WORD[T1PTR] = 0;                                                   IFKEY
    RSTADDR[T1PTR] = TOWORDADDR[PRGMSTACKPTR];                           IFKEY
    END                                                                  IFKEY
      CONTROL EJECT;                                                     IFKEY2 
                             #MAIN FLOW OF IFKEY# 
  SCANALLAREA = FALSE;                                                   IFKEY
  IF PKEY                          # IF PRIMARY KEY                    #
    OR ONEAKEY                     # IF EXACTLY ONE ALTERNATE KEY      #
  THEN
                             #ONLY PRIMARY KEY INVOLVES IN -IF-, CALL  #
                             #RGTABLE TO SET UP RANGE TABLE, THEN LOAD #
                             #(4X,0) TO EXECUTE#
    BEGIN                                                                IFKEY
    RGTABLE;                                                             IFKEY
    GOTO ENTER4X; 
    END                                                                  IFKEY
  
  IF CURRELLOC EQ 0                # IF NOT USING RELATIONS            #
  THEN
    BEGIN 
    FOR J = 1 STEP 1 WHILE AREASAVE[J] NQ 0 DO
      BEGIN 
      IF AREAINUSE[J]              # IF AN AREA IN USE                 #
      THEN
        BEGIN 
        P<AREA$TABLE> = AREASAVE[J];
        IF AT$DBPSRH               #   IS USING A DBP SEARCH EXIT,     #
        THEN
          BEGIN 
          SCANALLAREA = TRUE;      #   GO DO A FULL FILE PASS.         #
          GOTO ENTER4X; 
          END 
        END 
      END 
    END 
  ELSE
    BEGIN 
    P<REL$TAB> = CURRELLOC;        # ELSE, RELATION IS BEING USED.     #
    FOR J = 1 STEP 1 WHILE AREASAVE[J] NQ 0 DO
      BEGIN 
      IF AREAINUSE[J]              # IF THIS IS ROOT AREA,             #
        AND RT$ROOT[0] EQ AREASAVE[J] 
      THEN
        BEGIN 
        P<AREA$TABLE> = AREASAVE[J];
        IF AT$DBPSRH               #   AND IT IS USING DBP SEARCH,     #
        THEN
          BEGIN 
          SCANALLAREA = TRUE;      #   GO DO A FULL FILE PASS.         #
          GOTO ENTER4X; 
          END 
        END 
      END 
    END 
  
                             #START ALTERNATE KEY PROCESSING# 
  P<BASICTABLE> = BASTABLOC;                                             IFKEY
  FOR BASTABIND = 0 STEP 1 DO                                            IFKEY
                             #GO THROUGH BASIC TABLE, LOOK FOR -IF-#
    IF BASCODE[BASTABIND] EQ IFCODE                                      IFKEY
                             #FOR EACH -IF-, PICK UP THE STACK, GO# 
                             #THROUGH THE SAME PROCESS TO BUILD P1# 
                             #TABLE#
      THEN                                                               IFKEY
      BEGIN                                                              IFKEY
      IF P1PTR NQ 1 THEN OLDP1PTR = P1PTR; #SOME BLP ALREADY EXIST#      IFKEY
                             #SO SAVE THE P1PTR, AFTER PROCESSING OF   #
                             #THE CURRENT -IF-. IF P1PTR = OLDP1PTR,   #
                             #IT MEANS THAT THIS -IF- DOES NOT INVOLVE# 
                             #ALTERNATE, HENCE HAD TO GO PASS THE FILE# 
      T1PTR = 0;                                                         BLPUNIV
      P<PROGRAMSTACK> = BASCADDR[BASTABIND];                             QU30296
                                                                         IFKEY
      STARTSTACK: # #                                                    IFKEY
                                                                         IFKEY
      FOR PRGMSTACKPTR = 0 STEP 1 DO                                     IFKEY
        BEGIN                                                            IFKEY
        IF ENTRYTYPE[PRGMSTACKPTR] EQ 7                                  IFKEY
                             #7--OPERATOR STACK ENTRY#
          THEN                                                           IFKEY
          BEGIN                                                          IFKEY
          OPERCODE = OPCODE[PRGMSTACKPTR];                               IFKEY
          IF OPERCODE EQ O"70"                                           IFKEY
                             #END OF STACK# 
            THEN                                                         IFKEY
            BEGIN                                                        IFKEY
            IF PREVIOUS NQ -1                                            IFKEY
                             #PREVIOUS IS PRESET TO -1, WHEN A STACK   #
                             #ENTRY POINTS TO A 2ND STACK ADDR, THE 1ST#
                             #STACK ADDRESS AND PTR IS STORED IN ARRAY #
                             #PREVIST, AND PREVIOUS INCREMENTED BY 1,  #
                             #AND THE 2ND STACK BEING PICK UP AND      #
                             #PROCESSED BEFORE -IFKEY- WILL PICK BACK  #
                             #UP THE 1ST STACK TO CONTINUE PROCESS IT. #
                             #SO -PREVIOUS- NQ -1 IMPLIES THAT IS A    #
                             #HALF PROCESSED STACK, SO HAD TO PICK UP  #
                             #WHERE IT WAS LEFT AND CONTINUE PROCESSING#
              THEN                                                       IFKEY
              BEGIN                                                      IFKEY
              P<PROGRAMSTACK> = PREVADDR[PREVIOUS];                      IFKEY
              PRGMSTACKPTR = PREVPTR[PREVIOUS];                          IFKEY
              PREVIOUS = PREVIOUS - 1;                                   IFKEY
                                                                         IFKEY
              TEST PRGMSTACKPTR;                                         IFKEY
                                                                         IFKEY
              END                                                        IFKEY
                                                                         IFKEY
            GOTO CHKOR;                                                  IFKEY
                             #END OF STACK, CHECK IF THERE IS ANOTHER  #
                             #-IF-, IF SO, HAD TO PUT IN A EXTRA -OR-  #
                             #IN P1 TO LINK THE -IF-S # 
                                                                         IFKEY
            END                                                          IFKEY
          SAVDUM;                                                        IFKEY
                             #BUILD A CORRESPONDING T1 ENTRY FOR THIS#
                             #OPERATOR# 
          CHKT1;                                                         IFKEY
                             #COMPARE OPERANDS, SEE IF IT IS RST OF#
                             #PREVIOUS EXPRESSION#
          IF OPERCODE LS O"70"                                           IFKEY
            THEN                                                         IFKEY
                             #CONVERT OPCODE INTO BCP OPCODE# 
            BEGIN                                                        IFKEY
      M=B<54,3>OPERCODE;                                                 IFKEY2 
      N=B<57,3>OPERCODE*6;                                               IFKEY2 
      OPERCODE=B<N,6>CHANGCVD[M];                                        IFKEY2 
            END                                                          IFKEY
            ELSE                                                         IFKEY
            OPERCODE = 0;                                                IFKEY
                             #OPERCODE > O"70"--THE OPERATION IS       #
                             #FUNCTION CALLS, LIKE -MEAN-,-JULIAN,ETC.,#
                             #HENCE, BLP CANNOT HANDLE IT, SKIP IT# 
          IF OPERCODE EQ NEGATION                                        IFKEY
                             #FOR -NOT- # 
            THEN                                                         IFKEY
            BEGIN                                                        IFKEY
            IF J GR 0                                                    IFKEY
              THEN                                                       IFKEY
              BEGIN                                                      IFKEY
              M = J;                                                     BLPUNIV
              N = 0;                                                     BLPUNIV
                             #BUILD AN ENTRY FOR THE -NOT#
              BLDTYP3;                                                   IFKEY
              IF SCANALLAREA THEN GOTO ENTER4X;                          BLPUNIV
                                                                         IFKEY
              TEST PRGMSTACKPTR;                                         IFKEY
                                                                         IFKEY
              END                                                        IFKEY
              ELSE DUMFG[T1PTR] = TRUE;                                  IFKEY
                             #LE 0 MEANS THE OPERAND IS AN ITEM, SINCE #
                             #ALTERNATE KEY CANNOT BE LOGICAL TYPE,THIS#
                             #-NOT- RELATION IS NOT USED BY BLP, HENCE #
                             #NO -P1- ENTRY BUILT AND -DUMFG- SET ON   #
            END                                                          IFKEY
            ELSE                                                         IFKEY
            IF LOGICALOP                                                 IFKEY
                             #FOR -AND-, -OR-, -XOR- #
              THEN                                                       IFKEY
              BEGIN                                                      IFKEY
              M = BLPENTY[J];                                            IFKEY
              N = BLPENTY[K];                                            IFKEY
              IF J GR 0 AND K GR 0                                       IFKEY
                             #BOTH OPERANDS ARE RST OF PREVIOUS OPERATO#
                             #AND M,N ARE THE CORRESPONDING -P1- ENTRY #
                             #FOR THESE PREVIOUS OPERATORS# 
                THEN                                                     IFKEY
                BEGIN                                                    IFKEY
                IF NOT DUMFG[J] AND NOT DUMFG[K]                         IFKEY
                             #BOTH OPERANDS ARE RESULT OF PREVIOUS     #
                             #EXPRESSION THAT MAY AFFECT BLP RESULT,   #
                             #SO BUILD A TYPE 3 ENTRY TO LINK THEM     #
                  THEN                                                   IFKEY
                  BEGIN                                                  IFKEY
                  BLDTYP3;                                               IFKEY
                  IF SCANALLAREA THEN GOTO ENTER4X;                      BLPUNIV
                  END                                                    IFKEY
                  ELSE                                                   IFKEY
                  IF NOT DUMFG[J] OR NOT DUMFG[K]                        IFKEY
                    THEN                                                 IFKEY
      CHKANDOR; 
                    ELSE DUMFG[T1PTR] = TRUE;                            IFKEY
                END                                                      IFKEY
                ELSE                                                     IFKEY
                IF (J GR 0 AND NOT DUMFG[J]) OR                          IFKEY
                   (K GR 0 AND NOT DUMFG[K])                             IFKEY
                  THEN                                                   IFKEY
      CHKANDOR; 
                  ELSE DUMFG[T1PTR] = TRUE;                              IFKEY
                             #BOTH OPERAND ARE LOGICAL ITEM, THE RESULT#
                             #OF THIS LOGICAL OPERATOR DOES NOT AFFECT #
                             #BLP RESULT, NO -P1- ENTRY BUILT, AND     #
                             #DUMFG SET#
              END                                                        IFKEY
              ELSE                                                       IFKEY
              IF OPERCODE GR 0                                           IFKEY
                THEN                                                     IFKEY
                BEGIN #RELATIONAL#                                       IFKEY
                IF (J EQ -2 AND K EQ 0) OR (J EQ 0 AND K EQ -2)          IFKEY
                  THEN                                                   IFKEY
                  BEGIN                                                  IFKEY
                             #ALTERNATE KEY -OP- CONSTANT#
                             #BUILD TYPE 1 ENTRY FOR THE ALTERNATE KEY,#
                             #      TYPE 2 FOR THE CONSTANT,           #
                             #      TYPE 3 TO LINK THEM TOGETHER       #
                  IF J EQ -2 THEN                                        BLPUNIV
                  BEGIN                                                  BLPUNIV
                    J = PRGMSTACKPTR - 1;                                BLPUNIV
                    K = J - 1;                                           BLPUNIV
                  END                                                    BLPUNIV
                  ELSE                                                   BLPUNIV
                  BEGIN                                                  BLPUNIV
                    K = PRGMSTACKPTR - 1;                                BLPUNIV
                    J = K - 1;                                           BLPUNIV
                  END                                                    BLPUNIV
                  BLDTYP1(J);                                            IFKEY
                  BLDTYP2(K);                                            IFKEY
                  M = P1PTR - 1;                                         BLPUNIV
                  N = P1PTR;                                             BLPUNIV
                  BLDTYP3;                                               IFKEY
                  CHKUNIV;         # PAD LITERAL IF NECESSARY          #
                  IF SCANALLAREA THEN GOTO ENTER4X;                      BLPUNIV
                  END                                                    IFKEY
                  ELSE                                                   IFKEY
                  IF (J EQ -2 AND K GR 0 AND NOT DUMFG[K]) OR            IFKEY
                      (K EQ -2 AND J GR 0 AND NOT DUMFG[J])              IFKEY
                    THEN                                                 IFKEY
                    BEGIN                                                IFKEY
                             #ALTERNATE KEY -OP- (RESULT OF PREVIOUS   #
                             #EXPRESSION THAT AFFECTS BLP RESULT       #
                             #BUILD TYPE 1 ENTRY FOR ALTERNATE KEY,    #
                             #PICK UP THE TYPE 3 ENTRY FOR (RST OF EXP)#
                             #THEN BUILD TYPE 3 ENTRY TO LINK THEM# 
      IF J EQ -2 THEN M=PRGMSTACKPTR-1; ELSE M=PRGMSTACKPTR-2;           SAVCOR3
                    BLDTYP1(M);                                          IFKEY
                    IF J EQ -2                                           IFKEY
                      THEN                                               IFKEY
                      BEGIN                                              IFKEY
                      M = P1PTR;                                         IFKEY
                      N = BLPENTY[K];                                    IFKEY
                      END                                                IFKEY
                      ELSE                                               IFKEY
                      BEGIN                                              IFKEY
                      M = BLPENTY[J];                                    IFKEY
                      N = P1PTR;                                         IFKEY
                      END                                                IFKEY
                    BLDTYP3;                                             IFKEY
                    IF SCANALLAREA THEN GOTO ENTER4X;                    BLPUNIV
                    END                                                  IFKEY
                    ELSE                                                 IFKEY
                    DUMFG[T1PTR] = TRUE;                                 IFKEY
                             #THIS RELATIONAL OPERATION WONT AFFECT BLP#
                             #RESULT,NO ENTRY BUILD, DUMFG SET# 
                END                                                      IFKEY
                ELSE                                                     IFKEY
                BEGIN #ARITH OPERATION#                                  IFKEY
                IF CONSTOPERAND    # IF ALL OPERANDS ARE CONSTANTS     #
                                   # OR RESULTS OF EVALUATED EXPRESSNS #
                  THEN                                                   IFKEY
                  BEGIN                                                  IFKEY
                             #BUILD A DUMMY EXPRESSION STACK TO EVALUAT#
                             #THIS ARITH OPERATION# 
                  FOR M = PRGMSTACKPTR - 1 STEP - 1 
                    WHILE M GQ 0
                  DO
                    IF ENTRYTYPE[M] EQ 7 THEN GOTO PAUSE;                IFKEY
                  M = -1; 
                                                                         IFKEY
                  PAUSE: # #                                             IFKEY
                                                                         IFKEY
                  N= (PRGMSTACKPTR -M) * STKSIZE - 1; 
                  P<AA> = P<PROGRAMSTACK>  + (M + 1) * STKSIZE; 
                  FOR M = 0 STEP 1 UNTIL N DO                            IFKEY
                    DUMSTACK[M] = A[M];                                  IFKEY
                  DUMSTACK[N+1] = O"70000000000070000000";
                  DUMSTACK[N+2] = 0;
                  DUMSTACK[N+3] = 0;
                  DUMSTACK[N+4] = 0;
                  PROGSTACKLOC = LOC(DS);                                IFKEY
                  EXPEVAL(RC);     # EVALUATE EXPRESSION               #
                  END                                                    IFKEY
                  ELSE DUMFG[T1PTR] = TRUE;                              IFKEY
                             #THIS ARITH OPERATION WONT AFFECT BLP RST,#
                             #NO P1 ENTRY BUILD, DUMFG ON#
                END                                                      IFKEY
          END                                                            IFKEY
                             #END OF TYPE 7 ENTRY IN EXPRESSION STACK  #
          ELSE                                                           IFKEY
          IF ENTRYTYPE[PRGMSTACKPTR] EQ 3                                IFKEY
                             #THIS STACK ENTRY POINTS TO ANOTHER STACK,#
                             #SAVED CURRENT STACK ADDRESS AND PTR, GO  #
                             #PROCESSED THE OTHER STACK FIRST          #
            THEN                                                         IFKEY
            BEGIN                                                        IFKEY
            PREVIOUS = PREVIOUS + 1;                                     IFKEY
            PREVADDR[PREVIOUS] = P<PROGRAMSTACK>;                        IFKEY
            PREVPTR[PREVIOUS] = PRGMSTACKPTR;                            IFKEY
            P<PROGRAMSTACK> = EXPRESSTACK[PRGMSTACKPTR];                 IFKEY
                                                                         IFKEY
            GOTO STARTSTACK;                                             IFKEY
                                                                         IFKEY
            END                                                          IFKEY
          ELSE
            BEGIN 
            IF (ALKEYENTRY[PRGMSTACKPTR]  # IF ALTERNATE KEY           # QU30296
              OR ALTMAJKEY[PRGMSTACKPTR])  # IF MAJOR ALTERNATE KEY    # QU30296
              AND AREAORD[PRGMSTACKPTR] EQ LOWAREA  # KEY WITHIN LOW AR# QU30296
            THEN
              BEGIN 
              P<AREA$TABLE> = AREASAVE[AREAORD[PRGMSTACKPTR]];
              ATPTR = P<AREA$TABLE>;  # PASS AREA TABLE POINTER TO BLP #
              AREAORG = AT$FITFO;                                        IFKEY
              END 
            END 
        END                                                              IFKEY
                                                                         IFKEY
      CHKOR: # #                                                         IFKEY
                             #ONE EXP STACK HAS BEEN PROCESSED, CHECK  #
                             #IF THERE IS OTHER -IF- ALREADY PROCESSED #
                                                                         IFKEY
      IF P1PTR LS 2 OR OLDP1PTR EQ P1PTR                                 IFKEY
        THEN                                                             IFKEY
                             #NO -P1- ENTRY BUILD FOR THIS LAST -IF-,  #
                             #HAD TO PASS THE FILE# 
        BEGIN                                                            IFKEY
        SCANALLAREA = TRUE;                                              IFKEY
        GOTO ENTER4X; 
                                                                         IFKEY
        END                                                              IFKEY
      IF OLDP1PTR NQ 0                                                   IFKEY
        THEN                                                             IFKEY
        BEGIN                                                            IFKEY
                             #MORE THAN ONE -IF-, LINK THEM TOGETHER   #
                             #WITH A -OR-#
        OPERCODE = ORCODE;                                               IFKEY
        M = OLDP1PTR;                                                    BLPUNIV
        N = P1PTR;                                                       QU3A345
        BLDTYP3;                                                         IFKEY
        IF SCANALLAREA THEN GOTO ENTER4X;                                BLPUNIV
        OLDP1PTR = 0;                                                    IFKEY
        END                                                              IFKEY
      END #IF#                                                           IFKEY
      ELSE                                                               IFKEY
      IF BASCODE[BASTABIND] EQ ENDCOD                                    IFKEY
        THEN                                                             IFKEY
        BEGIN                                                            IFKEY
                             #END OF BASIC TABLE REACHED# 
                             #STORE INFO INTO FIRST TWO WORDS OF -P1-, #
                             #AS REQUIRED BY BLP# 
        P1FULL[P1PTR+1] = 0;                                             IFKEY
        P1FULL[0] = 0;                                                   IFKEY
        P1FULL[1] = 0;                                                   IFKEY
        AC[0] = 4;                                                       IFKEY
      AREALOC = P<AREA$TABLE>;
      BLPFITLOC = LOC(AT$AFITPOS);                                       IFKEY
      IF AT$COLSEQ NQ 0 THEN
        BEGIN 
        COLSEQ[1] = P<AREA$TABLE> + AT$COLSEQ;
        END 
      ELSE
        BEGIN 
        COLSEQ[1] = 3;
        END 
        KEYFWA[0] = CMM$ALF (63, 0, 0); 
        KEYLEN[0] = 63;                                                  IFKEY
                                                                         IFKEY
CALLBLP:  # LOAD OVERLAY 20-02 AND TRANSFER TO RM$BLP # 
      AREALOC = P<AREA$TABLE>;
      IF CDCSDBM                   # IF ACCESSING THROUGH CDCS         #
      THEN
        BEGIN 
        LOADOVL (0, O"20", 3);     # CDCS VERSION OF BLP               #
        END 
  
      ELSE                         # IF ACCESSING THROUGH CRM          #
        BEGIN 
        LOADOVL (0, O"20", 2);     # CRM VERSION OF BLP                #
        END 
      #-------------------------# 
  
  
ENTER4X:                           # LOAD OVERLAY 30/40/50             #
      INDEX = 0;                   # NOT *CREATE*, CALL CTL30/40/50    #
      IF CDCSDBM                   # IF ACCESSING THROUGH CDCS         #
      THEN
        BEGIN 
        LOADOVL (BASEX0, O"50", 0);  # LOAD QU5000, CDCS EXECUTION ONLY#
        END 
      ELSE
        BEGIN 
        IF REFERFILE EQ O"77"      # IF AREA IS TO BE UPDATED          #
        THEN
          BEGIN 
          LOADOVL (BASEX0, O"40", 0);  # QU4000, CRM UPDATE OVERLAY    #
          END 
        ELSE                       # IF AREA(S) ARE TO BE QUERIED      #
          BEGIN 
          LOADOVL (BASEX0, O"30", 0);  # QU3000, CRM QUERY OVERLAY     #
          END 
        END 
      #----------------------------------#
  
  
LOAD10:  #AN ERROR HAS BEEN FOUND.  RELEASE ACQUIRED SPACE AND         #
         # RETURN TO THE SYNTAX OVERLAY.                               #
                                                                         IFKEY
      IF KEYFWA[0] NQ 0 THEN
          BEGIN 
          CMM$FRF (KEYFWA[0]);
          END 
      LOADOVL(0, 1, 0); 
      #----------------------------------#
                                                                         IFKEY
      END                                                                IFKEY
  END                                                                    IFKEY
TERM                                                                     IFKEY
