*DECK SELPATH 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TEXPRES 
USETEXT TIMFDEF 
USETEXT TOPTION 
USETEXT TPSTACK 
USETEXT TSBASIC 
PROC SELPATH (RECORDINFO, BESTRANGE, BESTPATHID); 
BEGIN 
  
  
ARRAY RECORDINFO S(2);    ITEM DUPALLOWLIST U(1,0,6), 
                                  FIRSTPATH U(0,24,9),
                                   PATHLIST U(1,6,54);
ITEM BESTPATHID;
ARRAY BESTRANGE[0:MAXRANGE];
  BEGIN 
    ITEM BESTWORD I(0,0,60);
    ITEM BESTCODE U(0,0, 2);
  END 
  
XREF FUNC COMPARE B;
XREF FUNC BITCOUNT I;        # COUNTS THE NUMBER OF 1-BITS IN A WORD   #
XREF PROC CONVERT;           # CONVERT FROM ONE DATA TYPE TO ANOTHER   #
XREF ITEM IMF$GRP I;         # GROUP-ID OF CMM BLOCK USED IN 60,0      #
  
ARRAY APILE[0:20];  ITEM PILE I(0,0,60);
ARRAY RANGES[0:MAXRANGE]; 
   BEGIN
    ITEM INTERVAL      B(00,00,01); 
    ITEM SPOT          B(00,01,01); 
    ITEM RANGECODE     U(00,00,02); 
    ITEM DUPLICUNIV    B(00,02,01);    # DUPLIC ALLOWED/UNIVER PRESENT #
    ITEM LITERAL       U(00,24,18);    # POINTER TO LITERAL ATTRIBUTES #
    ITEM KEYENTY       U(00,42,18);    # POINTER TO KEY ATTRIBUTES     #
      ITEM RANGEWORD   I(00,00,60); 
   END
  
ITEM KEYORDINAL I;
ITEM FINISHED B;                   # LOOP CONTROL                      #
ITEM BESTINTV I = 30;        # 30 INTERVALS MAXIMUM CAN BE HANDLED     #
ITEM BESTSPOT I = 30;        # 30 SPOTS MAXIMUM CAN BE HANDLED         #
ITEM BESTMAP I; 
ITEM BESTRNGPTR I;           # VALUE OF RANGEPTR FOR BEST MAP SO FAR   #
ITEM RANGEPTR;               # POINTER TO RANGE TABLE ENTRY            #
ITEM EXTRARANGES;            # ACCOUNTS FOR DUPLICATES ALLOWED AND     #
                             # FOR UNIVERSAL CHARACTER IN LITERALS.    #
ITEM J; 
ITEM K, L, N;                # WORKING VARIABLES                       #
ITEM X, Y;                   # DUMMY LOOP VARIABLES                    #
ITEM CODE;
ITEM ONES I = O"77777777777777777777";
ITEM ALLINTVS I = O"52525252525252525252";
ITEM ALLSPOTS I = O"25252525252525252525";
ITEM CHAROPCODE I;           # OPCODE RELATING KEY AND LITERAL AS IF   #
                             # BOTH WERE DATATYPE CHARACTER            #
  
DEF   BASCWDS  # 2 #;              # NO OF WORDS IN BASICTABLE ENTRY   #
DEF   CDEQ   #   36  # ;
DEF   CDNQ   #   37  # ;
DEF   CDLS   #   54  # ;
DEF   CDGR   #   55  # ;
DEF   CDLQ   #   56  # ;
DEF   CDGQ   #   57  # ;
  
                             # ARRAY TO CONVERT *LT* TO *GT*, ETC.     #
ITEM CHNGOPCODE I = O"00 00 00 00 55 54 57 56 00 00"; 
ITEM EXPRLOC  I;                   # LOCATION OF PROGRAM STACK         #
ITEM KEYINDEX I;             # INDEX WITHIN PROGRAMSTACK OF KEY ENTRY  #
ITEM LITINDEX I;             # INDEX WITHIN PROGRAMSTACK OF LITERAL    #
ITEM ORIT     B;                   # FLAG *IF*S MUST BE *ORED* TOGETHER#
ITEM PRADDR   I;                   # PRIOR BASICTABLE ADDR IF *PRIORIF*#
ITEM PRIORIF  B;                   # FLAG PREVIOUS *IF* DIRECTIVE      #
ITEM RC I;                   # RETURN CODE FROM CONVERT                #
ITEM KEYID$RESET B;                # TRUE WHEN KEYID IS SET TO 0       #
                                   # BECAUSE OF SCAN AND KEYID EQ 1.   #
  
      ARRAY [6];             # ARRAY TO CONVERT OPCODE FROM NUMERIC    #
                             # DATATYPES TO CHARACTER DATATYPE         #
        BEGIN 
        ITEM CHANGCVD I(0,0,60) = 
          [O"00 00 00 00 00 00 36 37 00 00",
           O"54 55 56 57 00 00 00 00 00 00",
           O"00 00 00 00 00 00 36 37 00 00",
           O"54 55 56 57 00 00 36 37 00 00",
           O"00 00 00 00 00 00 36 37 00 00",
           O"54 55 56 57 54 55 56 57 00 00",
           O"00 00 00 00 00 00 36 37 00 00"]; 
        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 
  
      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 
  
      BASED ARRAY SPGSTACK  S(STKSIZE);  # PROGRAM STACK               #
        BEGIN 
        ITEM SENTRYTYPE   U(0, 0, 3);  # 1 = MOVE, 2 = CONVERT         #
        ITEM SRELFROMCHAR U(0, 4, 4);  # RELATIVE CHAR POS (0-9)       #
                                       # OF -FROM- FIELD               #
        ITEM SRELTOCHAR   U(0, 8, 4);  # RELATIVE CHAR POS (0-9)       #
                                       # OF -TO- FIELD                 #
        ITEM SNBRCHARS    U(0,12,12);  # SIZE OF FIELD IN CHARACTERS   #
        ITEM SFRMWORDADDR I(0,24,18);  # RELATIVE ADDR OF -FROM- FIELD #
        ITEM SOPCODE      I(0,26,16);  # CODED OPERATOR                #
        ITEM STOWORDADDR  I(0,42,18);  # ADDR OF -TO- FIELD            #
        ITEM SFRMWORDBASE I(1,24,18);  # PTR TO ADDRESS OF RECORD      #
                                       # CONTAINING -FROM- FIELD       #
        ITEM STOWORDBASE  I(1,42,18);  # PTR TO ADDRESS OF RECORD      #
                                       # CONTAINING -TO- FIELD         #
        ITEM SALTKEYSIZE  U(2, 9, 9);  # SIZE OF KEY IN CHARACTERS     #
        ITEM SRELORDINAL  U(2,18, 9);  # RELATIONAL ORDINAL            #
        ITEM SKEYBITRANK  U(2,27, 6);  # RANK IN BIT MAP               #
        ITEM SSKIPT       B(3, 0, 1);  # SKIP TRUE FLAG                #
        ITEM SSKIPF       B(3, 1, 1);  # SKIP FALSE FLAG               #
        ITEM SSKIPADDR    U(3, 6,18);  # SKIP ADDRESS                  #
        ITEM SPSTKWORD    U(0, 0,60);  # FULL WORD                     #
        ITEM SPSTKWORD1   U(1, 0,60);  # FULL WORD                     #
        ITEM SPSTKWORD2   U(2, 0,60);  # FULL WORD                     #
        ITEM SPSTKWORD3   U(3, 0,60);  # FULL WORD                     #
        END 
  
      BASED ARRAY TEMPA;;              # SCRATCH TEMPORARY ARRAY       #
  
DEF CALL # #; 
DEF OPERATOR # 7 # ;         # PROGRAM STACK ENTRY IS AN OPERATOR      #
DEF ENDOFSTACK #O"70"#;      # PROGRAM STACK OPERATOR IS -END OF STACK-#
DEF   CODEAND# O"16" # ;
DEF   CODEOR # O"17" # ;
DEF   CODEXOR# O"34" # ;
DEF   CODEEQ # O"36" # ;
DEF   CODENQ # O"37" # ;
DEF   CODELS # O"54" # ;
DEF   CODEGR # O"55" # ;
DEF   CODELQ # O"56" # ;
DEF   CODEGQ # O"57" # ;
  
#----------------------------------------------------------------------#
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F I N D I F                                                      #
#                                                                      #
#     FINDIF SEARCHES THE BASICTABLE FOR AN -IF- DIRECTIVE.  WHEN      #
#     FOUND, THE FLAG -PRIORIF- IS SET, THE TABLE POSITION IS          #
#     STORED, AND THE -IF- EXPRESSION STACK ADDRESS IS PASSED          #
#     BACK IN ITEM -EXPRLOC-.  FINDIF WILL EITHER START ITS SEARCH     #
#     AT THE INITIAL POSITION OF BASICTABLE (PRIORIF = FALSE) OR       #
#     AT ENTRY + 1 OF THE PREVIOUS -IF- DIRECTIVE (PRIORIF = TRUE).    #
#                                                                      #
#----------------------------------------------------------------------#
      PROC FINDIF;
      BEGIN 
      EXPRLOC = 0;
  
      IF PRIORIF                   # IF EARLIER -IF- WAS FOUND         #
      THEN
        BEGIN 
        P<BASICTABLE> = PRADDR;    # START WHERE WE LEFT OFF           #
        END 
      ELSE                         # IF FIRST TIME THROUGH             #
        BEGIN 
        P<BASICTABLE> = BASTABLOC; # START AT INITIAL POSITION         #
        END 
  
      FOR BASTABIND = 0 STEP 1     # FOR EACH DIRECTIVE IN TRANSMISSION#
      DO
        BEGIN 
        CODE = BASCODE[BASTABIND]; # CODE FOR THIS DIRECTIVE           #
  
        IF CODE EQ ENDCODE         # IF END OF BASICTABLE              #
        THEN
          BEGIN 
          RETURN;                  # EXIT WITH EXPRLOC=0, NO -IF- FOUND#
          END 
  
        IF CODE EQ CONTCODE        # IF OVERFLOW ENTRY                 #
        THEN
          BEGIN 
                                   # ADVANCE TO NEXT BLOCK OF TABLE    #
          P<BASICTABLE> = BASCLAST[BASTABIND];
          BASTABIND = -1; 
          TEST BASTABIND; 
          END 
  
        IF CODE EQ IFCODE          # IF FOUND AN -IF- DIRECTIVE        #
        THEN
          BEGIN 
          EXPRLOC = BASCADDR[BASTABIND];   # SAVE LOC OF ITS EXPR STACK#
          PRIORIF = TRUE; 
                                   # STORE ADDR OF NEXT TABLE          #
          P<BASICTABLE> = P<BASICTABLE> + ( BASTABIND + 1 ) * BASCWDS;
  
          IF BASCODE[0] EQ CONTCODE  # IF OVERFLOW ENTRY               #
          THEN
            BEGIN 
            PRADDR = BASCLAST[0];  # ADVANCE TO NEXT BLOCK             #
            END 
          ELSE
            BEGIN 
            PRADDR = P<BASICTABLE>; 
            END 
  
          RETURN;                  # PASS -EXPRLOC- BACK TO SELPATH    #
          END 
  
        END                        # END -BASTABIND- LOOP              #
  
      END                          # PROC *FINDIF*                     #
      CONTROL EJECT;
  
PROC LOCATEUNIV;      # SEARCHES A UNIVERSAL CHARACTER IN A LITERAL    #
BEGIN 
XREF ITEM UNIVERSAL I;       # UNIVERSAL CHARACTER.  OFF IF = O"100".  #
BASED ARRAY ASTRING;    ITEM STRING C(0,0,99);
ITEM LIMIT I;                      # NUMBER OF CHARS TO SEARCH FOR     #
                                   # UNIVERSAL = MIN(NBR CHARS IN LIT, #
                                   #                 NBR CHARS IN KEY) #
  
                     # ALTKEYSIZE OF LITERAL IS SET TO SIZE OF LITERAL.#
                     # IT REMAINS UNCHANGED IF UNIVERSAL IS OFF        #
                     # OR IF THE UNIVERSAL CHARACTER IS NOT IN THE LIT.#
                     # ELSE, ALTKEYSIZE BECOMES THE NUMBER OF LEFTMOST #
                     # CHARACTERS PRECEDING THE UNIVERSAL CHARACTER.   #
          ALTKEYSIZE[LITINDEX] = NBRCHARS[LITINDEX];
                                   # IF LITERAL IS LARGER THAN KEY     #
          IF NBRCHARS[LITINDEX] GR NBRCHARS[KEYINDEX] 
          THEN
            BEGIN 
            LIMIT = NBRCHARS[KEYINDEX];  # SEARCH NBR CHARS IN KEY     #
            END 
  
          ELSE
            BEGIN 
            LIMIT = NBRCHARS[LITINDEX];  # SEARCH ALL CHARS IN LITERAL #
            END 
  
          IF UNIVERSAL LS O"100"       # UNIVERSAL IS ON               #
            AND KEYTYPE[KEYINDEX] EQ DT$CHAR  # KEYTYPE IS CHARACTER   #
          THEN
            BEGIN 
            P<ASTRING> = TOATTRIB[LITINDEX];
            FOR L = 0 STEP 1
              UNTIL NBRCHARS[LITINDEX] - 1
            DO
            BEGIN 
              IF C<L, 1> STRING EQ UNIVERSAL THEN 
              BEGIN 
                ALTKEYSIZE[LITINDEX] = L; 
                RETURN; 
              END 
            END 
          END 
          RETURN; 
END 
#----------------------------------------------------------------------#
CONTROL EJECT;
  
                 # INITIALISATION CODE.                                #
  
                                               # PRESET OUTPUT PARAMS  #
          BESTWORD[0] = O"40000000000000000000";  # SCAN RECORD POPULAT#
          BESTWORD[1] = 0;                        # END OF TABLE       #
          BESTPATHID = 0; 
  
          PRADDR = 0; 
          PRIORIF = FALSE;
          FINDIF;                  # SAVE LOC OF P-STACK IF *IF* EXISTS#
  
          IF EXPRLOC EQ 0 THEN RETURN;
                               #-----#
  
          IF PATHLIST EQ 0 THEN B<0,9> PATHLIST = FIRSTPATH;
  
          BESTINTV = MAXRANGE + 1;
          BESTSPOT = MAXRANGE + 1;
  
                 # FOR EACH OF THE ACCESS PATH MENTIONED IN THE        #
                 # EXPRESSION STACK, DO THE FOLLOWING STEPS.           #
  
          FOR J=0 STEP 9 WHILE B<J,9> PATHLIST NQ 0 AND J LQ 54  DO 
          BEGIN 
            KEYORDINAL = B<J,9>PATHLIST;
  
  
                 # ACCUMULATE IN ARRAY LASTRANGE THE POINTERS TO       #
                 # KEY-LITERAL RELATION FROM THE EXPRESSION STACK.     #
  
          EXTRARANGES = 0;
          RANGEPTR = 0; 
          P<PROGRAMSTACK> = EXPRLOC;
          FINISHED = FALSE; 
                             #*** TEMP - WORKS FOR REGULAR STACK ONLY  #
          FOR Y = Y                # LOOP THROUGH ENTIRE PROG STACK    #
            WHILE NOT FINISHED
          DO
            BEGIN 
            IF ENTRYTYPE EQ OPERATOR  # IF END OF PROGRAM STACK        #
                AND OPCODE EQ ENDOFSTACK
            THEN
              BEGIN 
              FINDIF;              # CHECK FOR ANOTHER -IF- DIRECTIVE  #
  
              IF EXPRLOC EQ 0      # IF NOT FOUND                      #
              THEN
                BEGIN 
                FINISHED = TRUE;   # EXIT LOOP                         #
                END 
              ELSE                 # IF ANOTHER -IF- FOUND             #
                BEGIN 
                P<PROGRAMSTACK> = EXPRLOC;  # POSITN TO ITS PSTACK     #
                END 
              TEST Y; 
              END 
  
            IF ENTRYTYPE[0] GR 2   # IF NOT OPERAND                    #
              OR ENTRYTYPE[1] GR 2  # IF NOT OPERAND                   #
              OR ENTRYTYPE[2] NQ OPERATOR  # IF NOT OPERATOR           #
            THEN
              BEGIN 
              RETURN;              # SELPATH DOES NOT UNDERSTAND       #
                                   # THIS *IRREGULAR* PROGRAM STACK    #
                                   # SO RETURN AND SCAN ENTIRE         #
                                   # RECORD POPULATION                 #
              END 
  
  
            KEYID$RESET = FALSE;   # ASSUME NOT SCAN.                  #
  
            IF OPCODE[2] EQ O"300"    # IF OPCODE IS SCAN, TREAT IT    #
                                      # LIKE A NON-KEY ITEM.           #
            THEN
              BEGIN 
              KEYID[0] = 0; 
              KEYID$RESET = TRUE; 
              END 
  
            IF KEYID[0] EQ KEYORDINAL  # IF SEARCH KEY FROM THIS PATH  #
              AND TOWORDBASE[1] EQ 0   # IF NON-DATABASE ITEM          #
              AND FROMWORDBASE[1] EQ 0 # IF NON-DATABASE ITEM          #
            THEN
              BEGIN 
              KEYINDEX = 0; 
              LITINDEX = 1; 
              END 
  
            ELSE
              BEGIN 
              IF KEYID[1] EQ KEYORDINAL  # IF SEARCH KEY FROM THIS PATH#
                AND TOWORDBASE[0] EQ 0   # IF NON-DATABASE ITEM        #
                AND FROMWORDBASE[0] EQ 0 # IF NON-DATABASE ITEM        #
              THEN
                BEGIN 
                KEYINDEX = 1; 
                LITINDEX = 0; 
                END 
  
              ELSE                 # SKIP OVER NON-KEY ITEMS           #
                BEGIN 
                P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                TEST Y; 
                END 
              END 
  
            P<SPGSTACK> = EXPRLOC; # POSITION TO TOP OF PROG STACK     #
            FOR L = 0 STEP 4       # SCAN PSTK FROM TOP TO CURRENT POS #
              WHILE P<SPGSTACK> LS P<PROGRAMSTACK>
            DO
              BEGIN 
                                   # IF LITERAL IS TEMPORARY RESULT    #
              IF FROMWORDADDR[LITINDEX] EQ STOWORDADDR[2] 
              THEN
                BEGIN 
                KEYID[KEYINDEX] = 0;  # SELPATH DOES NOT UNDERSTAND    #
                                     # THIS *IRREGULAR* PROGRAMSTACK   #
                                     # SO TREAT THIS KEY AS NON-KEY    #
                P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                TEST Y; 
                END 
  
              P<SPGSTACK> = P<SPGSTACK> + 3 * STKSIZE;
              END 
  
            IF KEYTYPE[KEYINDEX] EQ DT$CHAR  # IF CHARACTER KEY        #
            THEN
              BEGIN 
              LOCATEUNIV;          # SEARCH FOR UNIVERSAL IN LITERAL   #
              IF ALTKEYSIZE[LITINDEX] EQ 0  # IF LIT STARTS WITH UNVRSL#
              THEN
                BEGIN 
                KEYID[KEYINDEX] = 0;  # TREAT THIS KEY AS NON-KEY      #
                P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                TEST Y; 
                END 
  
              RANGEWORD[RANGEPTR] = 0;
              KEYENTY[RANGEPTR] = P<PROGRAMSTACK> + STKSIZE * KEYINDEX; 
              LITERAL[RANGEPTR] = P<PROGRAMSTACK> + STKSIZE * LITINDEX; 
                                   # IF UNIVERSAL PRESENT              #
              IF ALTKEYSIZE[LITINDEX] LS NBRCHARS[LITINDEX] 
                OR B<J/9,1>DUPALLOWLIST EQ 1  # DUPLICATES ALLOWED     #
              THEN
                BEGIN 
                DUPLICUNIV[RANGEPTR] = TRUE;
                EXTRARANGES = EXTRARANGES + 1;
                END 
  
              IF KEYINDEX EQ 1     # IF LIT *OPERAND* KEY              #
                AND OPCODE[2] GR CODENQ  # CODE IS LS, LQ, GR, GQ      #
                AND OPCODE[2] LS ENDOFSTACK 
                                   # IF NO AUX PSTACK ALLOCATED        #
                AND EXPRESSTACK[2] EQ 0 
              THEN
                BEGIN 
                                   # ALLOCATE ONE WORD FOR AUX PSTACK  #
                                   # (FIRST WORD OF OPERATOR ENTRY)    #
                P<SPGSTACK> = CMM$ALF (1, FIXED$LWA, IMF$GRP);
                                   # CONVERT LT TO GT, ETC             #
                SOPCODE = B<DIGIT2[2]*6,6>CHNGOPCODE; 
                                   # SAVE ADDR OF AUX PROGRAMSTACK     #
                EXPRESSTACK[2] = P<SPGSTACK> - 2 * STKSIZE; 
                END 
              END 
  
            ELSE                   # IF SOME TYPE OF NUMERIC KEY       #
              BEGIN 
              IF EXPRESSTACK[2] NQ 0  # IF CONVERSIONS ALREADY DONE    #
              THEN
                BEGIN 
                                   # RANGES POINTS TO AUX PSTACK       #
                KEYENTY[RANGEPTR] = EXPRESSTACK[2]; 
                LITERAL[RANGEPTR] = EXPRESSTACK[2] + STKSIZE; 
                END 
  
              ELSE
                BEGIN 
                IF KEYTYPE[KEYINDEX] EQ DT$LOGICAL
                THEN
                  BEGIN 
                  KEYID[KEYINDEX] = 0;  # TREAT LOGICAL KEY AS NON-KEY #
                  P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                  TEST Y; 
                  END 
  
                                   # CONVERT OPCODE TO CHARACTER OPCODE#
                CHAROPCODE = 0; 
                IF OPCODE[2] LS ENDOFSTACK
                THEN
                  BEGIN 
                  CHAROPCODE = B<DIGIT2[2]*6,6>CHANGCVD[DIGIT1[2]]; 
                  END 
  
                IF KEYINDEX EQ 1   # IF LIT *OPERAND* KEY              #
                  AND CHAROPCODE GR CODENQ  # CODE IS LT, LE, GT, GE   #
                THEN
                  BEGIN 
                                   # CONVERT LT TO GT, ETC             #
                  L = B<57,3>CHAROPCODE;
                  CHAROPCODE = B<L*6,6>CHNGOPCODE;
                  END 
  
                IF CHAROPCODE EQ 0 # IF NOT LEGAL OPCODE               #
                  OR (CHAROPCODE GR CODENQ  # IF NOT *EQ* OR *NE*      #
                  AND ((KEYTYPE[KEYINDEX] GR DT$NUM)
                    OR (KEYTYPE[KEYINDEX] EQ DT$NUM  # IF SIGNED NUMERC#
                      AND OVERSIGN[KEYINDEX]))) 
                THEN
                  BEGIN 
                                   # TREAT AS NON-KEY BECAUSE IMF      #
                                   # SORTS IN DIFFERENT ORDER THAN QU. #
                                   # IMF SORTS EVERYTHING AS UNSIGNED  #
                                   # BINARY.                           #
                  KEYID[KEYINDEX] = 0;
                  P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                  TEST Y; 
                  END 
  
                                   # ALLOCATE 3 ENTRY PROGRAMSTACK.    #
                                   # FIRST ENTRY IS KEY.  SECOND ENTRY #
                                   # IS LITERAL ALREADY CONVERTED TO   #
                                   # SAME DATA TYPE AS KEY.  THIRD     #
                                   # ENTRY IS CHARACTER TYPE OPERATOR. #
                P<SPGSTACK> = CMM$ALF(STKSIZE * 3,FIXED$LWA,IMF$GRP); 
                SPSTKWORD[0] = PSTKWORD[KEYINDEX];  # COPY TO AUX PSTAK#
                SPSTKWORD1[0] = PSTKWORD1[KEYINDEX];
                SPSTKWORD2[0] = PSTKWORD2[KEYINDEX];
                SPSTKWORD3[0] = PSTKWORD3[KEYINDEX];
                SPSTKWORD[1] = PSTKWORD[LITINDEX];
                SPSTKWORD1[1] = PSTKWORD1[LITINDEX];
                SPSTKWORD2[1] = PSTKWORD2[LITINDEX];
                SPSTKWORD3[1] = PSTKWORD3[LITINDEX];
                SPSTKWORD[2] = PSTKWORD[2]; 
                SPSTKWORD1[2] = PSTKWORD1[2]; 
                SPSTKWORD2[2] = PSTKWORD2[2]; 
                SPSTKWORD3[2] = PSTKWORD3[2]; 
                SALTKEYSIZE[1] = NBRCHARS[KEYINDEX];
                SNBRCHARS[1] = NBRCHARS[KEYINDEX];
                SRELFROMCHAR[1] = 0;
                SFRMWORDBASE[1] = 0;
                SOPCODE[2] = CHAROPCODE;
                IF ENTRYTYPE[KEYINDEX] GR 1  # IF LITERAL MUST BE      #
                                             # CONVERTED TO SAME TYPE  #
                                             # AS KEY                  #
                  OR ENTRYTYPE[LITINDEX] GR 1 
                THEN
                  BEGIN            # ALLOCATE CM TO CONVERT LITERAL    #
                  P<TEMPA> = CMM$ALF ((NBRCHARS[KEYINDEX] + 9) / 10,
                                       FIXED$LWA, IMF$GRP); 
                                   # NBR CHARS IN LITERAL              #
                  NBCHAR[0] = NBRCHARS[LITINDEX]; 
                                   # ADDR OF LITERAL OR ADDR OF        #
                                   # ATTRIB TABLE DESCRIBING LITERAL   #
                  FROMWORD[0] = FROMWORDADDR[LITINDEX]; 
                                   # REL CHAR PTR OF LITERAL           #
                  FROMCHAR[0] = RELFROMCHAR[LITINDEX];
                  IF KEYTYPE[KEYINDEX] EQ DT$NUM  # IF NUMERIC, COMP   #
                    OR KEYTYPE[KEYINDEX] EQ DT$INTEGER  # IF INTEGER  # 
                  THEN
                    BEGIN 
                                   # PREPARE ATTRIB TABLE              #
                                   # POSITION TO KEY ATTRIBUTE TABLE   #
                    P<DESATT1> = FROMWORDADDR[KEYINDEX];
                    TDEWPOS[0] = P<TEMPA>;  # BEGINNING WORD POSITION  #
                    TDECLSLG[0] = DECLSLG[0];  # LENGTH IN CHARS       #
                    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  #
                    STOWORDADDR[0] = DEWPOS[0]; 
                    SFRMWORDADDR[0] = DEWPOS[0];
                    END 
  
                  ELSE             # NO ATTRIB TABLE REQUIRED          #
                    BEGIN 
                    TOWORD[0] = P<TEMPA>;  # BEGINNING WORD POSITION   #
                    END 
  
                                   # CALCULATE CONVERT CODE TO CONVERT #
                                   # FROM LITERAL TYPE TO KEY TYPE     #
                  CONVRTCODE[0] = B<KEYTYPE[KEYINDEX]*6,6>
                                  CCODE[KEYTYPE[LITINDEX]]; 
                  CONVERT (CVTPARAMS, RC);
                  IF RC NQ 0       # IF SOME ERROR                     #
                  THEN
                    BEGIN 
                    KEYID[KEYINDEX] = 0;  # TREAT AS NON-KEY           #
                    P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
                    TEST Y; 
                    END 
  
                  SFRMWORDADDR[1] = P<TEMPA>; 
                  STOWORDADDR[1] = P<TEMPA>;
                  SENTRYTYPE[0] = 1;  # NO CONVERSION REQUIRED         #
                  SENTRYTYPE[1] = 1;
                                   # IF KEY MUST BE CONVERTED IN       #
                                   # STANDARD PROGRAM STACK            #
                  IF ENTRYTYPE[KEYINDEX] GR 1 
                  THEN
                    BEGIN 
                                   # MOVE -FROM- ATTRIBS TO -TO- FIELDS#
                    SRELTOCHAR[0] = SRELFROMCHAR[0];
                    STOWORDADDR[0] = SFRMWORDADDR[0]; 
                    STOWORDBASE[0] = SFRMWORDBASE[0]; 
                    END 
                END                # END CONVERTING LITERAL            #
  
                EXPRESSTACK[2] = P<SPGSTACK>; 
                KEYENTY[RANGEPTR] = P<SPGSTACK>;
                LITERAL[RANGEPTR] = P<SPGSTACK> + STKSIZE;
                END                # END OF BUILDING AUX PSTACK        #
  
              IF B<J/9,1>DUPALLOWLIST EQ 1  # IF DUPLICATES ALLOWED    #
              THEN
                BEGIN 
                DUPLICUNIV[RANGEPTR] = TRUE;
                EXTRARANGES = EXTRARANGES + 1;
                END 
              END                  # END IF NUMERIC KEY                #
  
            RANGEPTR = RANGEPTR + 1;
            IF RANGEPTR GR MAXRANGE 
            THEN
              BEGIN 
              RETURN; 
              END 
  
            IF KEYID$RESET         # RESET KEYID TO 1 IF NEEDED.       #
            THEN
              BEGIN 
              KEYID[0] = 1; 
              END 
  
            P<PROGRAMSTACK> = P<PROGRAMSTACK> + STKSIZE * 3;
            END 
  
  
                 # SORT THE KEY-LITERAL POINTERS ACCORDING TO THE      #
                 # COLLATING SEQUENCE OF THE LITERALS.                 #
  
          N = RANGEPTR - 1; 
          FOR X=X WHILE N GR 0  DO
          BEGIN 
            K = 0;
            L = N;
            FOR Y=Y WHILE K LS L  DO
            BEGIN 
              IF COMPARE(LITERAL [K], CODELS, LITERAL [L])
                          THEN K = K + 1; 
                          ELSE L = L - 1; 
            END 
            RANGEWORD [K]  ==  RANGEWORD [N]; 
            N = N - 1;
          END 
  
  
                 # WRITE INTO THE KEY ENTRIES OF THE STACK THE         #
                 # COLLATED ORDER OF THE ASSOCIATED LITERAL.           #
  
          FOR X=0 STEP 1 UNTIL RANGEPTR - 1  DO 
          BEGIN 
            P<PROGRAMSTACK> = KEYENTY[X]; 
            KEYBITRANK = 2 * X + 1; 
          END 
  
  
                 # BUILD A BIT MAP, OR PATTERN, OF INTERVALS AND SPOTS #
                 # BY INTERPRETING THE EXPRESSION STACK.               #
  
          N = 0;
                             #*** TEMP - WORKS FOR REGULAR STACK ONLY  #
          PRADDR = 0; 
          PRIORIF = FALSE;
  
          FINDIF;                  # FIND THE FIRST -IF- DIRECTIVE     #
          P<PROGRAMSTACK> = EXPRLOC;  # POSITION TO ITS PROGRAMSTACK   #
  
          ORIT = FALSE;            # ASSUME SINGLE -IF- TRANSMISSION   #
          FINISHED = FALSE; 
          FOR Y = Y 
            WHILE NOT FINISHED     # LOOP THROUGH EACH ENTIRE PGRMSTK  #
          DO
            BEGIN 
  
            IF ENTRYTYPE[0] EQ OPERATOR  # IF END OF STACK             #
              AND OPCODE[0] EQ ENDOFSTACK 
            THEN
              BEGIN 
  
              IF ORIT              # IF MULTIPLE -IF-S                 #
              THEN
                BEGIN 
                                   # -OR- THE STACKS TOGETHER          #
                N = N -1; 
                PILE[N-1] = PILE[N-1] LOR PILE[N];
                END 
  
              FINDIF;              # CHECK FOR ANOTHER -IF-            #
  
              IF EXPRLOC EQ 0      # IF NOT FOUND                      #
              THEN
                BEGIN 
                FINISHED = TRUE;   # EXIT LOOP                         #
                END 
              ELSE                 # IF ANOTHER -IF- FOUND             #
                BEGIN 
                P<PROGRAMSTACK > = EXPRLOC;  # POSTN TO ITS PSTACK     #
                ORIT = TRUE;       # INDICATE -IF-S NEED BE -ORED-     #
                END 
  
              TEST Y; 
              END 
            CODE = OPCODE[2];      # GET OP CODE IN OPERATOR ENTRY     #
  
            KEYID$RESET = FALSE;   # ASSUME NOT SCAN.                  #
  
            IF CODE EQ O"300"      # IF OPCODE IS SCAN, TREAT IT       #
                                   # LIKE A NON-KEY ITEM.              #
            THEN
              BEGIN 
              KEYID[0] = 0; 
              KEYID$RESET = TRUE; 
              END 
  
            IF (KEYID[0] EQ KEYORDINAL
                AND FROMWORDBASE[1] EQ 0
                AND TOWORDBASE[1] EQ 0) 
              OR (KEYID[1] EQ KEYORDINAL
                AND FROMWORDBASE[0] EQ 0
                AND TOWORDBASE[0] EQ 0) 
            THEN
              BEGIN 
              IF EXPRESSTACK[2] NQ 0  # IF AUX PSTACK EXISTS           #
              THEN
                BEGIN 
                P<SPGSTACK> = EXPRESSTACK[2]; 
                CODE = SOPCODE[2];  # TAKE OPCODE FROM AUX PSTACK      #
                X = SKEYBITRANK[0]; 
                END 
  
              ELSE
                BEGIN 
                CODE = OPCODE[2];  # TAKE OPCODE FROM REGULAR PSTACK   #
                IF KEYID[0] EQ KEYORDINAL  # IF KEY *OPERATOR* LIT     #
                  AND TOWORDBASE[1] EQ 0
                THEN
                  BEGIN 
                  X = KEYBITRANK[0];
                  END 
  
                ELSE               # IF LIT *OPERATOR* KEY             #
                  BEGIN 
                  X = KEYBITRANK[1];
                  END 
                END 
  
              PILE[N] = 0;
              IF CODE EQ CODELS 
              OR CODE EQ CODELQ 
              OR CODE EQ CODENQ THEN B<0,X>PILE[N] = ONES;
              IF CODE EQ CODEEQ 
              OR CODE EQ CODEGQ 
              OR CODE EQ CODELQ THEN B<X,1>PILE[N] = ONES;
              IF CODE EQ CODEGR 
              OR CODE EQ CODEGQ 
              OR CODE EQ CODENQ THEN B<X+1,59-X>PILE[N] = ONES; 
              N = N + 1;
            END 
            ELSE
            BEGIN 
              IF  CODE NQ CODEAND 
              AND CODE NQ CODEOR
              AND CODE NQ CODEXOR THEN
              BEGIN 
                PILE[N] = ONES; 
                N = N + 1;
              END 
              ELSE
              BEGIN 
              N = N - 1;
              IF CODE EQ CODEAND THEN PILE[N-1] = PILE[N-1] LAN PILE[N];
              ELSE
              IF CODE EQ CODEOR  THEN PILE[N-1] = PILE[N-1] LOR PILE[N];
              ELSE
              IF CODE EQ CODEXOR THEN PILE[N-1] = PILE[N-1] LXR PILE[N];
              END 
            END 
  
            IF KEYID$RESET         # RESET KEYID TO 1 IF NEEDED.       #
            THEN
              BEGIN 
              KEYID[0] = 1; 
              END 
  
            P<PROGRAMSTACK> = P<PROGRAMSTACK> + 3 * STKSIZE;
          END 
  
          FOR X=0 STEP 1 UNTIL RANGEPTR 
                                     DO  RANGECODE[X] = B<2*X,2>PILE[0];
  
          FOR N = 0 STEP 1 WHILE RANGEWORD [N] NQ 0  DO 
          BEGIN 
            IF DUPLICUNIV [N] AND SPOT [N]  THEN
            BEGIN 
              FOR L = RANGEPTR STEP -1 UNTIL N  DO
                                   RANGEWORD [L+1] = RANGEWORD [L]; 
              DUPLICUNIV [N+1] = FALSE; 
              SPOT [N+1] = TRUE;
              INTERVAL [N+1] = TRUE;
              RANGEPTR = RANGEPTR + 1;
            END 
          END 
  
          RANGEPTR = RANGEPTR + 1;
          RANGEWORD[RANGEPTR] = 0;      # END OF TABLE                 #
  
                 # CHOOSE THE BEST BIT PATTERN.                        #
  
          X = BITCOUNT(PILE[0] LAN ALLINTVS) + EXTRARANGES; 
          Y = BITCOUNT(PILE[0] LAN ALLSPOTS); 
  
          IF (J EQ 0)                                # 1ST TIME AROUND #
          OR (X LS BESTINTV)                         # LESS INTERVALS  #
          OR (X EQ BESTINTV AND Y LS BESTSPOT)  THEN # LESS SPOTS      #
          BEGIN 
            BESTINTV = X; 
            BESTSPOT = Y; 
            BESTMAP = PILE[0];     # SAVE BIT MAP FOR LATER USE        #
            BESTRNGPTR = RANGEPTR;  # SAVE VALUE OF RANGEPTR           #
            BESTPATHID = KEYORDINAL;
            FOR X=0 STEP 1 UNTIL RANGEPTR 
                                       DO BESTWORD[X] = RANGEWORD[X]; 
          END 
  
          END 
  
          X = BITCOUNT (B<0,BESTRNGPTR * 2 - 1>BESTMAP);
          IF X EQ 0 THEN
          BEGIN 
            BESTWORD[0] = 0;       # NO RANGE AT ALL                   #
            BESTWORD[1] = 0;       # END OF TABLE                      #
          END 
          IF X GR MAXRANGE THEN    # RECORD POPULATION MUST BE SCANNED #
          BEGIN 
            BESTWORD[0] = O"40000000000000000000";  # POPULATION SCAN  #
            BESTWORD[1] = 0;       # END OF TABLE                      #
          END 
  
          RETURN; 
          #-----# 
END 
TERM
