*DECK RM$BLP
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TFIT
USETEXT TNUMOPT 
      PROC RM$BLP (IFTAB,RETCODE);
      BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#                      RM$BLP                                          #
#                                                                      #
#     THIS SET OF PROCEDURES USES THE BASED ARRAY PASSED AS A          #
#     PARAMETER TO BUILD A TREE.  EACH NODE OF THE TREE IS THEN USED   #
#     TO GET THE ALTERNATE KEYS AND FROM THAT OBTAIN THE PRIMARY KEYS  #
#     WHICH SATISFY THE CONDITIONS.  THE KEYS ARE STORED IN THE BUFFER #
#     XWS.  IF THE BUFFER IS FULL, THE KEYS ARE SORTED AND EITHER      #
#     WRITTEN DIRECTLY TO A FILE, OR MERGED WITH AN EXISTING FILE.     #
#     IF THE CONDITION CONTAINS AN *AND* OPERATOR, THE RIGHT           #
#     AND LEFT SONS ARE STORED IN SEPARATE BUFFERS.  THESE             #
#     BUFFERS ARE THEN SORTED AND MERGED WITH ONLY THE MATCHING        #
#     KEYS RETAINED AND MOVED TO THE STORAGE BUFFER.                   #
#                                                                      #
#     INPUT:  IFTABLE CONTAINING INFORMATION ABOUT CONDITION           #
#             RETURN TABLE                                             #
#                                                                      #
#     OUTPUT:  THE RETURN TABLE IS SET WITH A RETURN CODE, THE         #
#              NUMBER OF KEYS, ADDRESS OF BUFFER OR LFN OF FILE        #
#                                                                      #
#----------------------------------------------------------------------#
#     MAP OF THE FIRST PARAMETER PASSED TO BLP  # 
  
      BASED ARRAY P1; 
      ITEM PERR   B(0,0,1),  #  ERROR FLAG FOR ENTRY  # 
           AC     U(0,1,5),  #  ACTION CODE OR ENTRY TYPE  #
           KEYFWA U(0,6,18), #  ADDRESS OF WHERE TO PUT KEYS FOR USER  #
           KEYLEN U(0,24,18),#  LENGTH OF THE ABOVE AREA  # 
           FITADDR (0,42,18),#  ADDRESS OF USER-S INDEXED FIT          #
           COLSEQ U(1,6,18), #  ADDRESS OF COLLATING SEQUENCE TABLE OR #
                             # TYPE OF COLLATING TABLE  # 
           OPCODE U(0,6,6),  #  OPERATION CODE FOR A RELATION TABLE  #
           PARM1  U(0,12,18),#  INDEX TO THE FIRST PARAMETER  # 
           PARM2  U(0,30,18),#  INDEX TO SECOND PARAMETER  #
           KEYTYPE U(0,6,2), #  SYNBOLIC, INTEGER ETC.  # 
           WORDPOS U(0,9,9), #  WORD POSITION IN RECORD OF KEY  # 
           CHARPOS U(0,18,9),#  CHARACTER POSITION OF ALT KEY IN WORD  #
           CHARLEN U(0,27,9),#  LENGTH OF THE KEY  #
           ITEMTYPE U(0,36,6),# DATA ITEM - SYMBOLIC, INT, FILE-OF-KEYS#
           T1ITEMORD U(0,45,15),   # ITEM ORD IF CDCS AREA ITEM, ELSE 0#
           T2ITEMTYPE U(0,6,3), # CONSTANT TYPE - SYMBOLIC, INT, ETC.  #
           T2LEN  U(0,9,9),  #  LENGTH OF CONSTANT DEF                 #
           T2LOC  B(0,18,1), #  LOC OF DEF  0 - DIRECT, 1 - FWA        #
           T2CPOS U(0,20,4), #  CHARACTER POSITION OF DEF              #
           T1FULL U(0,0,60), #  THE WHOLE WORD .....  # 
           T2UBFWA I(0,24,18), #FWA OF UPPER BOUND                     #
           T2FWA  U(0,42,18);#  FWA OF DEF  # 
  
#     MAP OF THE SECOND PARAMETER PASSED TO BLP  #
  
      BASED ARRAY P2; 
      ITEM RCODE  U(0,0,6),  #  RETURN CODE TO USER  #
           EC     U(0,6,12), #  ERROR CODE TO USER  # 
           NUMREC U(0,18,24),#  NUMBER OF KEYS RETURNED  #
           P2FWA  U(0,42,18),#  FWA OF TABLE OF KEYS  # 
           P2LFN  U(1,0,42); #  LFN OF FILE-OF-KEYS  #
  
  
#     START OF XDEFS                                                   #
  
      XDEF ITEM ITEMORD  I;        # ITEM ORDINAL IF CDCS, ELSE 0      #
  
  
#     START OF XREFS                                                   #
  
      XREF ITEM ATPTR    I;        # AREA TABLE POINTER                #
      XREF ITEM CDCSDBM  B;        # TRUE IF IN CDCS DATA BASE MODE    #
      XREF ITEM EOP      I; 
      XREF ITEM RECDORD  I;        # RECORD ORDINAL USED BY THIS XMISSN#
  
      XREF ARRAY BLP$WSI ;;             # STORAGE AREA                 #
      XREF ARRAY BLP$FWS;;              # BIG FILE BUFFER              #
      XREF ARRAY RM$BLPA [1:5]  S(LFIT);;    # FIT FOR SCRATCH FILE    #
      XREF ARRAY RM$BLPB [0:99, 1:5];  # BUFFERS FOR SCRATCH FILES     #
        BEGIN 
        ITEM RMWSA       C(0,0,10); 
        ITEM RMWSAI      I(0,0,60); 
        END 
  
      XREF PROC CLOSEM; 
      XREF PROC DCREWND;
      XREF PROC GETN; 
      XREF PROC GETP; 
      XREF PROC OPENM;
      XREF PROC PUT;
      XREF PROC PUTP; 
      XREF PROC REWND;
      XREF PROC STARTM; 
      XREF PROC WEOR; 
  
  
#     START OF DEFS                                                    #
  
      DEF CASE     # GOTO #;
      DEF EOI      # O"100" #;
      DEF EOK      # O"10" #;      # FITFP RETURNED IF END-OF-KEYLIST  #
      DEF EQUAL    # 0 #; 
      DEF GREATER  # 1 #; 
      DEF LESS     # -1 #;
      DEF MAXSTT   # 50 #;
      DEF MAXTET   # 3 #; 
      DEF NFILES   # 5 #; 
      DEF NTMAX    # 50 #;
      DEF OPEQ     # 1 #; 
      DEF OPNE     # 2 #; 
      DEF OPLT     # 3 #; 
      DEF OPGT     # 4 #; 
      DEF OPLE     # 5 #; 
      DEF OPGE     # 6 #; 
      DEF OPAND    # 7 #; 
      DEF OPOR     # 8 #; 
      DEF OPXOR    # 9 #; 
      DEF OPNOT    # 10 #;
  
  
#     START OF ITEMS                                                   #
  
      ITEM BUF     I;              # LOOP VARIABLE                     #
      ITEM BINDEX  I;              # BUFFER INDEX                      #
      ITEM COMPRESULT;             # RESULT OF CALL TO *COMPARE*       #
      ITEM CURR    I;              # POINTER INTO EXPRESSION SUBTREE   #
      ITEM DUM     I; 
      ITEM DUMDUM  I; 
      ITEM DUMMY   I; 
      ITEM ERR     B; 
      ITEM FINALFILE  I;           # LAST FILE USED BY OVERFLOW        #
      ITEM FINIS   B;              # FINISH FLAG                       #
      ITEM FNO     I;              # FILE NUMBER                       #
      ITEM FWSL    I;              # FILE WS LENGTH                    #
      ITEM HEAD    I = 0;          # PTR TO HEAD OF EXPR TREE IN NEWTET#
      ITEM I       I; 
      ITEM IFTAB   I; 
      ITEM J       I; 
      ITEM K       I; 
      ITEM KEYINDEX I;             # INDEX OF KEY IN P1 ARRAY          #
      ITEM KEYLENGTH I; 
      ITEM KEYSIN  I;              # KEY COUNTER                       #
      ITEM L       I; 
      ITEM LBUF    I;              # LEFT BUFFER ADDRESS               #
      ITEM LFILE   I;              # LEFT FILE NUMBER                  #
      ITEM LINDEX I;               # LEFT FILE INDEX                   #
      ITEM LITINDEX I;             # INDEX OF LITERAL IN P1 ARRAY      #
      ITEM M       I; 
      ITEM N       I; 
      ITEM NEWSCR  I;              # NUM OF NEW SCRATCH FILE TO BE USED#
      ITEM NOAX    I;              # NUM OF NON-RELATIONAL OPS IN EXPR #
      ITEM NTSIZE  I; 
      ITEM NUMKEYS I;              # NUMBER OF KEYS RETURNED           #
      ITEM ONER    I = 1;          # STORE ONE KEY                     #
      ITEM OPER    I;              # CODE FOR OPCODE  0 = OR           #
                                   #                  1 = AND          #
                                   #                  2 = XOR          #
      ITEM OUTFILE I;              # FILE RETURNED FROM OVERFLOW       #
      ITEM P1PTR   I;              # POINTER TO INDEX THRU ARRAY P1    #
      ITEM RBUF    I;              # RIGHT BUFFER ADDRESS              #
      ITEM REL     I;              # TEMP OF STARTCODE (ALIAS FITREL)  #
      ITEM RETCODE I; 
      ITEM RFILE   I;              # RIGHT FILE NUMBER                 #
      ITEM RINDEX  I;              # RIGHT FILE INDEX                  #
      ITEM SAVEFITKL I;            # SAVE KEY LENGTH OF ALTERNATE KEY. #
                                   # CDCS WILL RESET FITKL TO LENGTH   #
                                   # OF SCHEMA PRIMARY KEY.            #
      ITEM SBUFL   I;              # LENGTH IN WORDS OF KEYLIST WSA    #
      ITEM SPOT    I;              # SCRATCH VARIABLE                  #
      ITEM WBUFC   I;              # BUFFER LENGTH - CHARACTERS        #
      ITEM WBUFL    I;             # MAXIMUM BUFFER INDEX - WORD PTR   #
      ITEM WSPTR   I;              # PTR TO NEXT FREE WORD IN *XWS*    #
  
  
#     START OF BASED ARRAYS                                            #
  
      BASED ARRAY BATEMP [0:0];    # TEMP FOR MOVING THINGS AROUND     #
        BEGIN 
        ITEM BAITEM      C(0,0,10); 
        END 
      BASED ARRAY MIPFIT S(LFIT);; # FIT FOR THE INDEX FILE            #
      BASED ARRAY UPPERBOUND;;
      BASED ARRAY XWS;             # ACCESS TO WORKING STORAGE AREA    #
        BEGIN 
        ITEM WS    U(0,0,60); 
        END 
      BASED ARRAY XWS1;            # ALTERNATE WSA                     #
        BEGIN 
        ITEM WS1   U(0,0,60); 
        END 
      BASED ARRAY XWS2;            # OTHER ALTERNATE AREA              #
        BEGIN 
        ITEM WS2   U(0,0,60); 
        END 
      BASED ARRAY FBUF;            # BIG FILE BUFFER                   #
        BEGIN 
        ITEM FWS     U(0,0,60); 
        END 
      BASED ARRAY OB1;             # FIRST OVERFLOW BUFFER             #
        BEGIN 
        ITEM OW1     U(0,0,60); 
        END 
  
      BASED ARRAY OB2;             # SECOND OVERFLOW BUFFER            #
        BEGIN 
        ITEM OW2    U(0,0,60);
        END 
      BASED ARRAY OB3;             # THIRD OVERFLOW BUFFER - STORAGE   #
        BEGIN 
        ITEM OW3    U(0,0,60);
        END 
  
  
  
#     START OF ARRAYS                                                  #
  
      ARRAY AFILES [1:NFILES];
        BEGIN                      # SCRATCH FILE NAMES                #
        ITEM AFILE C(0,0,7)=["ZZZZZQA", 
                             "ZZZZZQB", 
                             "ZZZZZQC", 
                             "ZZZZZQD", 
                             "ZZZZZQE"];
        ITEM BFILE B(0,42,1);      # T IF CORRESPONDING FILE BUSY      #
        END 
      ARRAY ALTKEY [0:25];         # HOLDING AREA FOR ALT KEY BEING    #
        BEGIN                      # PROCESSED                         #
        ITEM ALTITEM     C(0,0,10); 
        END 
      BASED ARRAY KEY1;            # FOR PRIMARY KEY COMPARISONS       #
        BEGIN 
        ITEM KEY1X  C(0,0,10);
        END 
      BASED ARRAY KEY2; 
        BEGIN 
        ITEM KEY2X C(0,0,10); 
        END 
      ARRAY NEWTETS [1:50];        # ARRAY TO HOLD EXPRESSION TREE     #
        BEGIN 
        ITEM LEFTF   B(0,0,1);     # T IF *LEFT* POINTS INTO *P1*      #
        ITEM LEFT    U(0,1,8);     # PTR TO LEFT CHILD OPERAND NODE    #
        ITEM UP      U(0,9,9);     # PTR TO PARENT RELATION (0 IF HEAD)#
        ITEM RIGHTF  B(0,18,1);    # T IF *RIGHT* POINTS INTO *P1*     #
        ITEM RIGHT   U(0,19,8);    # PTR TO RIGHT CHILD OPERAND NODE   #
        ITEM OLDPOS  U(0,27,9);    # PTR TO ORIGINAL POSITION IN *P1*  #
        ITEM DEPTH   U(0,36,9);    # DEPTH OF RELN NODE FROM HEAD      #
        ITEM PROCD   B(0,45,1);    # T IF NODE PROCESD (KEYLIST EXISTS)#
        ITEM OPCD    U(0,46,5);    # OPERATION CODE                    #
        ITEM RIGHTL  B(0,51,1);    # T IF *RIGHT* POINTS INTO *XSTT*   #
        ITEM LEFTL   B(0,52,1);    # T IF *LEFT* POINTS INTO *XSTT*    #
        ITEM LFLAG   B(0,53,1);    # STATE OF TRAVERSAL FLAG           #
        ITEM NTFULL  U(0,0,60);    # THE WHOLE WORD                    #
        END 
      ARRAY OPTT [0:12];           # TABLE TO TRANSLATE FROM BLP OPERAT#
                                   # TO ITS REVERSE OR TO *START* VERB #
                                   # RELATIONAL CODE                   #
        BEGIN 
        ITEM PARMREV     U(0,0,9) = [0,1,2,3,4,5,6,7,8,9,10,11,12]; 
        ITEM DMREV       U(0,9,9) = [0,2,1,6,5,4,3,8,7,0,0,12,11];
        ITEM TOSTART     U(0,18,9) = [0,1,4,5,6,2,3,0,0,0,0,7,8]; 
        ITEM GETRELATION I(0,27,9) # TRANSLATE OLD *FITREL* (*TOSTART*)#
                                   # VALUES TO THE NEW *FITREL* VALUES #
                                   # ACTUALLY PASSED TO MIP TO GET THE #
                                   # KEYLISTS.                         #
            = [0, 
               RELEQ,              # EQ                                #
               RELGT,              # LE                                #
               RELGE,              # GE                                #
               RELEQ,              # NE                                #
               RELGE,              # LT                                #
               RELGT,              # GT                                #
               RELEQ,              # LOWER BOUND LE KEY LE UPPER BOUND #
               RELGE,              # KEY LT LOWER BOUND OR KEY GT UP BD#
               4(0)]; 
        END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R M $ B L P                                                      #
#                                                                      #
#     *RM$BLP$ RETURNS A LIST OF PRIMARY KEYS THAT SATISFIES THE       #
#     ALTERNATE KEY EXPRESSION PASSED IN *IFTAB* (*P1*).  *IFSYNTAX*   #
#     AND *GETKEYS* ARE THE PROCS IT CALLS TO BUILD AN EXPRESSION TREE #
#     FROM *P1* AND GET THE PRIMARY KEYLIST FROM MIP THAT SATISFIES IT.#
#     POINTERS TO THE KEYLIST ARE RETURNED IN *RETCODE* (*P2*).        #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      P<AREA$TABLE> = ATPTR;       # POSITION TO AREA TABLE            #
      P<KEY$TBL> = AT$PKEYDPTR;    # POSITION TO KEY TABLE             #
      P<P1> = LOC(IFTAB); 
      P<P2> = LOC(RETCODE); 
      NOAX = 0; 
      ERR = FALSE;
      IF FITADDR NQ 0 
        AND FITADDR LS O"400000"
      THEN
        BEGIN 
        P<MIPFIT> = FITADDR;       #SET FIT ADDR IF IT IS REASONABLE   #
        P<FIT> = P<MIPFIT>; 
        END 
      ELSE
        BEGIN 
        EC[0] = 2**4;              # SOMETHING DRASTICALLY WRONG       #
        RETURN;                    # MUST BYPASS ALL NORMAL PROCESSING #
        END 
  
      FITNDX = TRUE;         #  SET FOR INDEX RETRIEVAL  #
      IF FITFO EQ FOAK THEN  # CHECK IF AN -AK- FILE  # 
        KEYLENGTH = 1;
      ELSE
        KEYLENGTH = ( FITKL + 9 ) / 10; 
  
      P1PTR = 1;
      IFSYNTAX;         #  GO CRACK INPUT AND CHECK FOR ERRORS  # 
      IF NOT ERR THEN GETKEYS;
      FOR I = 1 STEP 1             # FOR EACH SCRATCH FIT              #
        UNTIL NFILES
      DO
        BEGIN 
        P<FIT> = LOC(RM$BLPA[I]); 
        IF FITOC EQ OC$OPEN        # IF THIS FILE LEFT OPEN            #
        THEN
          BEGIN 
          CLOSEM(FIT, $DET$, EOP); # CLOSE AND RELEASE BUFFER SPACE    #
          END 
        END 
      RETURN;                      # EXIT FROM BLP TO CALLER           #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T E R R                                                      #
#                                                                      #
#     *SETERR* IS CALLED WHEN A SYNTAX ERROR IS ENCOUNTERED.  IN *P2*  #
#     IT SETS THE APPROPRIATE ERROR BIT AND THE RETURN CODE TO PASS    #
#     THE FILE.                                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SETERR(ERRNUM);
     BEGIN
      ITEM ERRNUM I;         # PARAMETER--ERROR CODE #
      ERR = TRUE; 
      EC[0] = EC[0] LOR 2**ERRNUM;   # OR IN NEW ERROR #
      PERR[P1PTR] = TRUE; 
      RCODE[0] = 1;          #  SET RETURN CODE TO PASS FILE  # 
      RETURN; 
     END
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I F S Y N T A X                                                  #
#                                                                      #
#     *IFSYNTAX* IS CALLED FROM *RM$BLP* TO BUILD AN EXPRESSION TREE   #
#     OUT OF THE *P1* TABLE (EACH NODE REPRESENTS ONE OPERATOR) AND    #
#     STORE IT IN THE ARRAY *NEWTETS*.  IN THE PROCESS, IT CHECKS EACH #
#     ENTRY IN *P1* FOR ERRORS, CALLING *SETERR* FOR EACH ERRONEOUS    #
#     ENTRY.                                                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC IFSYNTAX;
      BEGIN 
      SWITCH TET THEND, DATAITEM, CONST, CONDTABLE; 
      SWITCH NTET NTEND, NTVAR, NTCON, NTREL; 
      FOR DUM = 0 STEP 1 UNTIL 999 DO 
        BEGIN 
          P1PTR = P1PTR + 1;
        IF PERR[P1PTR] THEN 
          BEGIN 
          ERR = TRUE; 
          TEST DUM; 
          END 
        IF AC[P1PTR] GR MAXTET THEN 
          BEGIN 
          ERR = TRUE; 
          PERR[P1PTR] = TRUE; 
          TEST DUM; 
          END 
        CASE TET[AC[P1PTR]];
DATAITEM: 
        IF WORDPOS[P1PTR] GR 255 THEN 
          SETERR(0);
        IF CHARPOS[P1PTR] GR 9 THEN 
          SETERR(0);
        IF CHARLEN[P1PTR] GR 255 THEN 
          SETERR(0);
        TEST DUM; 
CONST:  
        IF T2ITEMTYPE[P1PTR] LQ 1 OR T2ITEMTYPE[P1PTR] GR 4 THEN
          BEGIN 
          SETERR (0); 
          TEST DUM; 
          END 
  
        IF T2ITEMTYPE[P1PTR] EQ 3 OR         # IF KEY IS NOT           #
           T2ITEMTYPE[P1PTR] EQ 4 THEN       # CHARACTER, RETURN AND   #
          BEGIN                              # PASS THE FILE.          #
          ERR = TRUE; 
          RCODE[0] = 1; 
          RETURN; 
          END 
        IF T2LEN[P1PTR] GR 255 THEN 
          BEGIN 
          SETERR (0); 
          TEST DUM; 
          END 
  
        IF T2LOC[P1PTR] THEN
           BEGIN
          IF T2FWA[P1PTR] EQ 0 OR T2FWA[P1PTR] GQ O"400000" THEN
            SETERR(0);
           END
         ELSE P1PTR = P1PTR + (T2LEN[P1PTR] + 9)/10;
        TEST DUM; 
CONDTABLE:  
        IF OPCODE[P1PTR] EQ 0 
          OR OPCODE[P1PTR] GQ 13
        THEN
          BEGIN 
          SETERR (0); 
          TEST DUM; 
          END 
  
        IF PARM1[P1PTR] EQ 0 OR PARM1[P1PTR] GQ 999 THEN
          BEGIN 
          SETERR (0); 
          TEST DUM; 
          END 
  
        IF (PARM2[P1PTR] EQ 0 AND OPCODE[P1PTR] NQ OPNOT ) OR 
        PARM2[P1PTR] GQ 999 THEN
          BEGIN 
          SETERR (0); 
          TEST DUM; 
          END 
  
        END 
      SETINTERR;        #  BOMB IF MORE THAN 999 ENTRIES  # 
THEND:  
      IF ERR THEN 
        RETURN;              #  NO SENSE DOING MORE WITH ERRORS  #
      FOR N = 1 STEP 1 UNTIL NTMAX DO 
        NTFULL[N] = 0;
      J = 0;
      FOR N = 0 STEP 1 UNTIL 1 DO 
        BEGIN 
        FOR M = 2 STEP 1 UNTIL P1PTR - 1 DO 
          BEGIN 
          CASE NTET[AC[M]]; 
NTEND:  
          M = P1PTR - 1;
          TEST M; 
NTVAR:  
          TEST M; 
NTCON:  
          IF NOT T2LOC[M] THEN
            M = M + (T2LEN[M] + 9) /10; 
          TEST M; 
NTREL:  
          IF N EQ 0 THEN
            BEGIN 
            IF OPCODE[M] LS 7 
              OR OPCODE[M] GR 10
            THEN
              BEGIN 
              J = J + 1;
              LEFTF[J] = TRUE;
              LEFT[J] = PARM1[M]; 
              RIGHTF[J] = TRUE; 
              RIGHT[J] = PARM2[M];
              OLDPOS[J] = M;
              OPCD[J] = OPCODE[M];
              END 
            END 
          ELSE
            BEGIN 
            IF OPCODE[M] GQ 7 
              AND OPCODE[M] LQ 10 
            THEN
              BEGIN 
              J = J + 1;
              OLDPOS[J] = M;
              LEFT[J] = PARM1[M]; 
              RIGHT[J] = PARM2[M];
              LEFTF[J] = TRUE;
              RIGHTF[J] = TRUE; 
              OPCD[J] = OPCODE[M];
              FOR L = 1 STEP 1 UNTIL J DO 
                BEGIN 
                IF OLDPOS[L] EQ PARM1[M] THEN 
                  BEGIN 
                  UP[L] = J;
                  LEFT[J] = L;
                  LEFTF[J] = FALSE; 
                  END 
                IF OLDPOS[L] EQ PARM2[M] THEN 
                  BEGIN 
                  UP[L] = J;
                  RIGHT[J] = L; 
                  RIGHTF[J] = FALSE;
                  END 
                END 
              END 
            END 
          END 
        IF NOAX EQ 0 THEN 
          NOAX = J; 
        END 
      NTSIZE = J; 
 # MAKE SURE ONLY ONE HEAD #
      FOR M = 1 STEP 1 UNTIL NTSIZE DO
        IF UP[M] EQ 0 THEN
          IF HEAD EQ 0 THEN 
            HEAD = M; 
          ELSE
            ERR = TRUE; 
 # NOW SET DEPTH FOR EACH ENTRY # 
      FOR M = 1 STEP 1 UNTIL NTSIZE DO
        BEGIN 
        I = M;
        FOR K = 0 STEP 1
          UNTIL NTSIZE - 1
        DO
          BEGIN 
          IF UP[I] EQ 0 THEN
            BEGIN 
            DEPTH[M] = K; 
            TEST M; 
            END 
          ELSE
            I = UP[I];
        END 
      END 
      IF NOT ERR THEN 
        ELIMNOTS; 
      RETURN; 
      END                          # PROC *IFSYNTAX*                   #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E L I M N O T S                                                  #
#                                                                      #
#     *ELIMNOTS*, CALLED BY *IFSYNTAX*, TRAVERSES THE EXPRESSION TREE  #
#     FROM THE BOTTOM UP SEARCHING FOR *NOT*S.  IF ONE IS FOUND,       #
#     *REVERSE* IS CALLED TO REVERSE THE OPERATORS IN THE *NOT* NODE-S #
#     SUBTREE AND *ELIM* IS CALLED TO ELIMINATE THE *NOT* NODE FROM    #
#     THE TREE ALTOGETHER.                                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC ELIMNOTS;
        BEGIN 
  
# TRAVERSE IN POSTORDER SO 'NOT' ELIMINATION IS NOT RECURSIVE # 
  
# INITIALIZATION #
  
        CURR = HEAD;
        FOR DUMMY=0 WHILE CURR NQ 0 DO
          BEGIN 
  
# FOLLOW LEFT LINKS DOWN TO A LEAF #
  
          FOR DUMMY=0 WHILE NOT LEFTF[CURR] DO
            BEGIN 
            LFLAG[CURR] = TRUE; 
            CURR = LEFT[CURR];
          END 
  
# AT THE BOTTOM, BACK UP ONE NODE # 
  
          CURR = UP[CURR];
          IF RIGHT[CURR] EQ 0 OR RIGHTF[CURR] THEN   # MARK A NULL #
            LFLAG[CURR] = FALSE;     # RIGHT SUBTREE AS TRAVERSED # 
  
# VISIT NODES AS FAR UP AS ALL SUBTREES HAVE ALREADY BEEN 
  TRAVERSED # 
  
          FOR DUMMY=0 WHILE NOT LFLAG[CURR] AND CURR NQ 0 DO
            BEGIN 
            IF OPCD[CURR] EQ OPNOT THEN 
              BEGIN 
              REVERSE;       # REVERSE OPERATORS IN ITS SUBTREE # 
              ELIM;          # ELIMINATE THIS NODE #
              END 
            CURR = UP[CURR];
            IF RIGHT[CURR] EQ 0 OR RIGHTF[CURR] THEN
              LFLAG[CURR] = FALSE;
            END 
  
# IF NOT DONE, START THE SAME THING DOWN RIGHT SUBTREE #
  
          IF CURR NQ 0 THEN 
            BEGIN 
            LFLAG[CURR] = FALSE;
            CURR = RIGHT[CURR]; 
            END 
          END 
      END                          # PROC *ELIMNOTS*                   #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E V E R S E                                                    #
#                                                                      #
#     *REVERSE* IS CALLED BY *ELIMNOTS* TO REVERSE THE OPERATORS OF    #
#     ALL NODES IN THE EXPRESSION TREE (ARRAY *NEWTETS*) OCCURRING     #
#     BELOW A *NOT* NODE.                                              #
#                                                                      #
#     IN: CURR = INDEX OF *NOT* NODE IN *NEWTETS*                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC REVERSE; 
        BEGIN 
        ITEM NCURR I;        # POINTER INTO EXPRESSION SUBTREE #
        NCURR = CURR; 
        FOR DUMMY=0 STEP 1 WHILE TRUE DO
          BEGIN 
          FOR DUMMY=0 WHILE NOT LEFTF[NCURR] DO 
            BEGIN 
            LFLAG[NCURR] = TRUE;
            NCURR = LEFT[NCURR];
            END 
          FOR DUMMY=0 WHILE NOT LFLAG[NCURR] DO 
            BEGIN 
            OPCD[NCURR] = DMREV[OPCD[NCURR]]; 
            DEPTH[NCURR] = DEPTH[NCURR] - 1;
            IF OPCD[NCURR] EQ 0 THEN
              SETERR(5);
            NCURR = UP[NCURR];
            IF NCURR EQ CURR THEN 
              RETURN; 
  
            IF RIGHTF[NCURR] THEN 
              BEGIN 
              LFLAG[NCURR] = FALSE; 
              SETERR(6);
              END 
            END 
          LFLAG[NCURR] = FALSE; 
          NCURR = RIGHT[NCURR]; 
          END 
        END   # REVERSE # 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E L I M                                                          #
#                                                                      #
#     *ELIM* IS CALLED BY *ELIMNOTS* TO ELIMINATE A *NOT* NODE FROM    #
#     THE EXPRESSION TREE AFTER *REVERSE* HAS REVERSED THE OPERATORS   #
#     OF ALL ITS SUBORDINATE NODES.                                    #
#                                                                      #
#     IN: CURR = INDEX OF *NOT* NODE IN *NEWTETS*                      #
#     OUT: CURR = INDEX OF *NOT*-S CHILD NODE                          #
#                                                                      #
#----------------------------------------------------------------------#
  
        PROC ELIM;
          BEGIN 
          ITEM CURRUP I;     # UP[CURR] # 
          ITEM CURRDOWN I;   # LEFT[CURR]--ITS ONLY CHILD # 
          CURRUP = UP[CURR];
          CURRDOWN = LEFT[CURR];
          UP[CURRDOWN] = CURRUP;
          IF LEFT[CURRUP] EQ CURR THEN
            LEFT[CURRUP] = CURRDOWN;
          ELSE
            RIGHT[CURRUP] = CURRDOWN; 
          CURR = CURRDOWN;
          END   # ELIM #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U P K A                                                    #
#                                                                      #
#     STORE KEY VALUE INTO ARRAY ALTKEY.                               #
#     ON INPUT                                                         #
#     KEYINDEX = INDEX OF KEY IN P1 ARRAY                              #
#     LITINDEX = INDEX OF LITERAL IN P1 ARRAY                          #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SETUPKA; 
      BEGIN 
      IF T2LOC[LITINDEX]           # IF T2FWA CONTAINS ADDR OF LITERAL #
      THEN
        BEGIN 
        P<UPPERBOUND> = T2UBFWA[LITINDEX];  # POSITION TO UPPER BOUND  #
                                            # IN CASE THIS IS A RANGE  #
        P<BATEMP> = T2FWA[LITINDEX];  # POSITION TO KEY VALUE          #
        END 
  
      ELSE
        BEGIN 
        P<BATEMP> = LOC(T1FULL[LITINDEX + 1]);  # POSITION TO KEY VALUE#
        END 
  
      IF ITEMTYPE[KEYINDEX] EQ 2   # IF ALPHANUMERIC KEY               #
      THEN
        BEGIN 
        FOR N = 0 STEP 1           # INITIALIZE KEY AREA TO BLANKS     #
          UNTIL CHARLEN[KEYINDEX] / 10
        DO
          BEGIN 
          ALTITEM[N] = "          ";
          END 
        END 
  
      FOR N = 0 STEP 1             # COPY KEY VALUE TO ALTKEY ARRAY    #
        UNTIL (T2LEN[LITINDEX] + T2CPOS[LITINDEX] - 1) / 10 
      DO
        BEGIN 
        ALTITEM[N] = BAITEM[N]; 
        END 
      RETURN; 
      END                          # END PROC    S E T U P K A         #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T U P S T A R T                                              #
#                                                                      #
#     *SETUPSTART* IS CALLED FROM *GETLIST* TO STORE THE VALUE OF THE  #
#     ALTERNATE KEY IN THE *FITKA* LOCATION.  FIRST IT FINDS THE KEY   #
#     AND LITERAL IN THE *P1* ARRAY, AND THEN IT PASSES THESE POINTERS #
#     ALONG WITH THE OPCODE TO *SETUPKA* TO DO THE ACTUAL STORING.     #
#                                                                      #
#     IN: I = INDEX INTO *XSTT* OF CURRENT OPERATOR NODE               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SETUPSTART;
      BEGIN 
  
      P<FIT> = P<MIPFIT>; 
      REL = 0;                     # START BY ASSUMING AN ERROR        #
      IF AC[LEFT[I]] EQ 1 THEN  #  DATA ITEM  # 
        BEGIN 
        IF AC[RIGHT[I]] NQ 2 THEN  # NOT CONSTANT  #
          RETURN; 
        REL = TOSTART[OPCD[I]];    # CONVERT TO START CODE             #
        K = RIGHT[I];        #  PTR TO CONSTANT  #
        L = LEFT[I];         #  PTR TO DATA ITEM  # 
        END 
      ELSE
        BEGIN 
        IF AC[RIGHT[I]] NQ 1 THEN  #  NOT DATA ITEM  #
          RETURN; 
        IF AC[LEFT[I]] NQ 2 THEN  #  NOT CONSTANT  #
          RETURN; 
        REL = TOSTART[PARMREV[OPCD[I]]];  # REVERSE OPCD AND CONVERT   #
                                          # TO START CODE.             #
        K = LEFT[I];         #  PTR TO CONSTANT  #
        L = RIGHT[I];        #  PTR TO DATA ITEM  # 
        END 
      FITKA = LOC(ALTKEY);
      KEYINDEX = L;                # INDEX OF KEY IN P1 ARRAY          #
      LITINDEX = K;                # INDEX OF LITERAL IN P1 ARRAY      #
      SETUPKA;                     # STORE KEY VALUE INTO KA           #
      FITKP = T2CPOS[K];           # CHAR POSN OF LIT IN *ALTKEY*      #
      FITRKW = WORDPOS[L];
      FITRKP = CHARPOS[L];
      FITKL = CHARLEN[L]; 
      SAVEFITKL = CHARLEN[L];      # LENGTH OF ALTERNATE KEY           #
      ITEMORD = T1ITEMORD[L];      # SAVE ITEM ORDINAL                 #
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F E T C H                                                        #
#                                                                      #
#     *FETCH* IS USED TO TEST FOR END OF BUFFER CONDITIONS             #
#     AND TO READ FROM SCRATCH FILES.  IT IS CALLED BY *OVERFLOW*      #
#     AND *MERGELISTS*                                                 #
#                                                                      #
#     IN:  FFNUM = FILE NUMBER, MUST BE 0 IF NO FILE                   #
#          WSBUF = LOCATION OF FILE BUFFER                             #
#          INDEX = POINTER TO CURRENT KEY IN BUFFER                    #
#                                                                      #
#     OUT: INDEX = POINTER TO NEXT AVAILABLE KEY                       #
#          WSBUF CLEARED OUT IF NO MORE KEYS ON FILE                   #
#          NEXTFREE = INDEX OF NEXT FREE WORD IN BUFFER                #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC FETCH (FFNUM,WSBUF,INDEX, NEXTFREE); 
      BEGIN 
      ITEM FFNUM       I;          # FILE NUMBER - 0 IF NONE           #
      ITEM INDEX       I;          # POINTER TO NEXT KEY               #
      ITEM NEXTFREE    I;          # INDEX OF NEXT FREE WORD           #
      ITEM WSBUF       I;          # BUFFER TO RETRIEVE FROM           #
      ITEM SAVEFIT     I; 
  
      BASED ARRAY VAL;             # WS ARRAY                          #
        BEGIN 
        ITEM VALX  C(0,0,10); 
        ITEM VALI  I(0,0,60); 
        END 
  
      SAVEFIT = P<FIT>; 
      P<VAL> = WSBUF; 
      INDEX = INDEX + KEYLENGTH;   # POINT TO NEXT KEY                 #
  
      IF INDEX GR WBUFL            # SEE IF AT END OF BUFFER           #
        OR VALI[INDEX] EQ 0 
      THEN
        BEGIN 
        IF FFNUM NQ 0              # IS FILE BEING USED                #
        THEN
          BEGIN 
          P<FIT> = LOC(RM$BLPA[FFNUM]);  # POINT TO PROPER FIT         #
  
          FOR DUMMY = 0 STEP 1     # CLEAR OUT BUFFER                  #
            UNTIL WBUFL + 1 
          DO
            BEGIN 
            VALI[DUMMY] = 0;
            END 
  
          IF FITFP NQ EOI THEN
            BEGIN 
            FITES = 0;             # PREPARE TO READ                   #
            GETP (FIT, VAL, WBUFC, EOP);
            END 
  
          NEXTFREE = FITPTL / 10; 
          INDEX = 0;               # START AT BEGINNING OF BUF         #
          END 
        END 
  
      P<FIT> = SAVEFIT; 
      RETURN; 
  
      END                          # PROC *FETCH*                      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     F I N A L O U T                                                  #
#                                                                      #
#     *FINALOUT* IS CALLED FROM *GETKEYS* TO SET THE *P2* RETURN ARRAY #
#     TO INDICATE THE SIZE AND LOCATION OF THE RETURNED KEYLIST.  AT   #
#     THIS POINT, THE LIST WILL BE EITHER IN MAIN STORAGE OR ON A      #
#     OR ON A SCRATCH FILE.  IF IN MAIN STORAGE, IT WILL BE SORTED AND #
#     IF IT WILL FIT INTO THE USER-S BUFFER, IT WILL BE                #
#     TRANSFERRED, ELSE COPIED TO A FILE.  THE  LFN OF THE             #
#     FILE WILL BE RETURNED TO THE USER.  *RCODE* TELLS WHERE          #
#     THE LIST WILL BE RETURNED.                                       #
#                                                                      #
#     IN:  BINDEX = POINTER TO NEXT FREE WORD IN MAIN STORAGE          #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC FINALOUT;
      BEGIN 
      IF FINALFILE EQ 0            # IF ALL IN MAIN STORAGE            #
      THEN
        BEGIN 
        SORTIT (BINDEX, P<XWS>);   # SORT KEYS IN MAIN STORAGE         #
        IF NUMKEYS LQ SBUFL - 1    # IF WILL FIT IN CALLER BUF         #
                                   # WITH A WORD OF ZEROS              #
        THEN
          BEGIN 
          P<XWS1> = KEYFWA[0];     # POSN TO RETURN BUFFER             #
                                   # POINTER TO STORAGE BUFFER         #
                                   # ALREADY SET                       #
          FOR N = 0 STEP 1
            UNTIL BINDEX - 1
          DO
            BEGIN 
            WS1[N] = WS[N];        # XFER KEYS TO RETURN BUFFER        #
            END 
  
          WS1[BINDEX] = 0;         # END BUFFER WITH ZEROS             #
          RCODE = 2;               # CODE KEYLIST IN BUFFER            #
          NUMREC[0] = NUMKEYS;     # NUMBER OF KEYS RETURNED           #
          P2FWA[0] = KEYFWA[0];    # ADDRESS OF LIST                   #
          END 
  
        ELSE                       # IN MEMORY BUT WON-T FIT           #
          BEGIN 
          OVERFLOW (0, BINDEX, P<XWS>, FINALFILE);
          END 
        END 
  
      IF BFILE[FINALFILE]          # PROCESS RESULTS STORED IN FILE    #
      THEN
        BEGIN 
        IF BINDEX NQ 0             # ARE KEYS STILL IN MAIN STORAGE    #
        THEN
          BEGIN 
          SORTIT (BINDEX, P<XWS>); # SORT THE KEYS                     #
          OVERFLOW (FINALFILE, BINDEX, P<XWS>, OUTFILE);
          FINALFILE = OUTFILE;
          END 
  
        RCODE = 3;                 # TELL USER ABOUT FILE              #
        NUMREC[0] = NUMKEYS;
        P2LFN[0] = AFILE[FINALFILE];    # NAME OF FILE                 #
        END 
  
      RETURN; 
  
      END                          # PROC *FINALOUT*                   #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     G E T K E Y S                                                    #
#                                                                      #
#     *GETKEYS* IS CALLED FROM *RM$BLP* TO GET A LIST OF PRIMARY KEYS  #
#     FOR EACH VALUE OF THE ALTERNATE KEYS IN THE GIVEN EXPRESSION.    #
#     IT MERGES THESE LISTS ACCORDING TO THE OPERATORS IN THE          #
#     EXPRESSION TREE, ENDING UP WITH ONE KEYLIST, EITHER IN MEMORY    #
#     OR ON A FILE, DEPENDING UPON ITS LENGTH.                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC GETKEYS; 
      BEGIN 
      ITEM N,K,J; 
      ITEM  MOM         I;
      ITEM  MORE$NODES  B;
  
      P<XWS> = LOC(BLP$WSI);
                                   # WSA LENGTH IN KEY MULTIPLES       #
      SBUFL = KEYLEN[0] / KEYLENGTH;  # NO. KEYS IN RETURN BUFFER      #
  
                                   # SET THE MAXIMUM INDEX INTO WS     #
                                   # SUBTRACT 1 BECAUSE WE BEGIN WITH  #
                                   # ZERO. SUBTRACT ANOTHER BECAUSE WE #
                                   # MUST ALWAYS HAVE ROOM FOR ONE     #
                                   # WORD OF ZEROS AT THE END          #
      WBUFL = (BLPWSA - 1) / KEYLENGTH * KEYLENGTH - 1; 
      WBUFC = (WBUFL + 1) * 10; 
      FWSL = BLPBUF / KEYLENGTH * KEYLENGTH;  # BIG BUFFER SIZE        #
      NUMKEYS = 0;
      FINALFILE = 0;
      WSPTR = 0;
      BINDEX = 0; 
  
      FOR N = 0 STEP 1
        UNTIL WBUFL + 1 
      DO
        WS[N] = 0;
  
      IF NTSIZE EQ NOAX THEN #  THERE IS ONLY ONE CONDITION PRESENT  #
        BEGIN 
        I = HEAD; 
        GETLIST (BINDEX, P<XWS>, FINALFILE);
        IF ERR THEN RETURN; 
  
        FINALOUT;                  # ONLY ONE CONDITION SO OUT         #
        RETURN; 
        END                        # END IF ONLY ONE CONDITION         #
  
                                   # CLEAR OUT OLDPOS.  WILL BE USED   #
                                   # FOR FILE NUMBER OF FILE CONTAINING#
                                   # VALUES FOR THIS NODE              #
      FOR J = 1 STEP 1
        UNTIL NTSIZE
      DO
        BEGIN 
        OLDPOS[J] = 0;
        END 
  
      LBUF = CMM$ALF(BLPWSA, 0, 0);  # GET SPACE FOR LEFT BUFFER       #
      RBUF = CMM$ALF(BLPWSA, 0, 0);  # AND RIGHT BUFFER                #
  
      MORE$NODES = TRUE;
      MOM = NTSIZE;                # START TREE TRAVERSAL AT HEAD NODE #
  
      FOR J = J WHILE MORE$NODES DO 
        BEGIN 
                                   # MOVE DOWN LEFT BRANCH FIRST IF IT #
                                   # DOESN'T POINT TO P1 & HASN'T BEEN #
                                   # PROCESSED ALREADY                 #
        IF NOT LEFTF [LEFT [MOM]] 
          AND NOT PROCD [LEFT [MOM]] THEN 
          BEGIN 
          MOM = LEFT [MOM]; 
          TEST J; 
          END 
                                   # IF LEFT BRANCH NOT AVAILABLE, GO  #
                                   # DOWN RIGHT IF POSSIBLE            #
        IF NOT RIGHTF [RIGHT [MOM]] 
          AND NOT PROCD [RIGHT [MOM]] THEN
          BEGIN 
          MOM = RIGHT [MOM];
          TEST J; 
          END 
                                   # IF NEITHER CHILD NEEDS PROCESSING,#
        K = MOM;                   # PROCESS MOTHER NODE               #
        LFILE = 0;
        RFILE = 0;
        FINALFILE = 0;
        NUMKEYS = 0;               # START COUNT NEW FOR NODE          #
  
                                   # SET A CODE FOR OPCODES SO THAT    #
                                   # WILL NOT HAVE TO CONSTANTLY       #
                                   # EVALUATE A SUBSCRIPTED ITEM       #
        IF OPCD[K] EQ OPOR
        THEN
          BEGIN 
          OPER = 0; 
          END 
        ELSE                       # NOT AN *OR* OPERTION              #
          BEGIN 
          IF OPCD[K] EQ OPAND      # IF *AND*                          #
          THEN
            BEGIN 
            OPER = 1; 
            END 
          ELSE                     # MIGHT BE *XOR*                    #
            BEGIN 
            IF OPCD[K] EQ OPXOR 
            THEN
              BEGIN 
              OPER = 2; 
              END 
            END                    # *XOR* TEST                        #
          END                      # END NOT *OR*                      #
                                   # IF *LEFT* POINTS INTO *NEWTETS*   #
        IF NOT LEFTL[K] 
          AND NOT LEFTF[K]
        THEN
          BEGIN 
          I = LEFT[K];             # POINT TO LEFT SON                 #
  
    # IF INTERMEDIATE RESULTS ALREADY ON FILE, USE THEM.               #
  
          IF OPCD[I] GQ OPAND 
            AND OPCD[I] LQ OPXOR
          THEN
            BEGIN 
            LFILE = OLDPOS[I];     # USE VALUES ON FILE                #
            END 
  
    # ELSE, GET KEYLIST FOR LEFT NODE.                                 #
  
          ELSE
            BEGIN 
            IF OPER GR 0           # *AND* AND *XOR* NEED SPECIAL      #
            THEN                   # HANDLING                          #
              BEGIN 
              LINDEX = 0;          # START AT BEGINNING OF BUFFER      #
              GETLIST (LINDEX, LBUF, LFILE);
              IF ERR
              THEN
                BEGIN 
                RETURN; 
                END 
              END                  # END IF *AND* OR *XOR*             #
  
            ELSE                   # OPERATION IS *OR*                 #
              BEGIN 
              GETLIST (BINDEX, P<XWS>, FINALFILE);
              IF ERR
              THEN
                BEGIN 
                RETURN; 
                END 
              END 
            END                    # END OF GETTING LEFT KEYLIST       #
                                   # LEFT CHILD NOW IN *XSTT*          #
          LEFTL[K] = TRUE;
          PROCD[LEFT[K]] = TRUE;
          END 
                                   # IF *RIGHT* POINTS INTO *NEWTETS*  #
        IF NOT RIGHTL[K] AND NOT RIGHTF[K] THEN 
          BEGIN 
          I = RIGHT[K];            # POINT TO RIGHT SON                #
  
    # IF INTERMEDIATE RESULTS ALREADY ON FILE, USE THEM.               #
  
          IF OPCD[I] GQ OPAND 
            AND OPCD[I] LQ OPXOR
          THEN
            BEGIN 
            RFILE = OLDPOS[I];     # USE VALUES ON FILE                #
            END 
  
    # ELSE, GET KEYLIST FOR RIGHT NODE.                                #
  
          ELSE
            BEGIN 
            IF OPER GR 0           # SPECIAL HANDLING FOR *AND*, *XOR* #
            THEN
              BEGIN 
              RINDEX = 0;          # START AT BEGINNING OF BUFFER      #
              GETLIST (RINDEX, RBUF, RFILE);
              IF ERR
              THEN
                BEGIN 
                RETURN; 
                END 
              END                  # END IF *AND* OR *XOR*             #
  
            ELSE                   # OPERATION IS *OR*                 #
              BEGIN 
              GETLIST (BINDEX, P<XWS>, FINALFILE);
              IF ERR
              THEN
                BEGIN 
                RETURN; 
                END 
              END 
            END                    # END OF GETTING RIGHT KEYLIST      #
                                   # RIGHT CHILD NOW IN *XSTT*         #
            RIGHTL[K] = TRUE; 
            PROCD[RIGHT[K]] = TRUE; 
            END 
  
    # IF BOTH RIGHT AND LEFT SONS EXIST, MERGE THEIR KEYLISTS.         #
  
      IF RIGHTL[K]
        AND LEFTL[K]
      THEN
        BEGIN 
        IF OPER GR 0               # IF *AND* OR *XOR*                 #
        THEN
          BEGIN 
          BINDEX = 0;              # START STORE AT BEGINNING          #
          NUMKEYS = 0;             # NEW COUNT OF KEYS                 #
          FINALFILE = 0;           # MAKE SURE NEW FILE IS USED        #
          MERGELISTS;              # SELECT ONLY MATCHES FOR *AND*     #
                                   # AND NON-MATCHES FOR *XOR*         #
          IF DEPTH[K] NQ 0         # IF NOT LAST NODE                  #
          THEN
            BEGIN 
            CHECKIT;               # WRITE IT TO A FILE                #
            END 
          END 
  
        ELSE                       # MUST BE *OR*                      #
          BEGIN 
  
    # IF BOTH RFILE AND LFILE ARE SET, BOTH SONS ARE ON INTERMEDIATE   #
    # RESULT FILES AND THERE WILL BE NOTHING IN THE BUFFERS.           #
  
          IF RFILE GR 0 
            AND LFILE GR 0
          THEN
            BEGIN 
            BINDEX = 0; 
            NUMKEYS = 0;           # START NEW COUNT OF KEYS           #
  
    # ADD LEFT AND THEN RIGHT SONS.  COMBINE CALLS STORE WHICH IN TURN #
    # SORTS AND CALLS OVERFLOW TO MERGE THEM.                          #
  
            COMBINE (LBUF, LFILE);
            COMBINE (RBUF, RFILE);
            CHECKIT;               # MAKE SURE NOTHING LEFT IN BUFFER  #
            END 
  
    # IF NEITHER IS AN INTERMEDIATE RESULT, AND IF NOT LAST NODE,      #
    # WRITE ANY KEYS IN MAIN STORAGE TO FINALFILE.                     #
  
          ELSE
            BEGIN 
            IF RFILE EQ 0 
              AND LFILE EQ 0
              AND DEPTH[K] NQ 0 
            THEN
              BEGIN 
              CHECKIT;
              END 
  
    # IF RIGHT SON ON FILE, MERGE IT WITH MAIN STORAGE, AND MAYBE ONTO #
    # OVERFLOW FILE.                                                   #
  
            ELSE
              BEGIN 
              IF RFILE NQ 0        # RIGHT SON ON FILE                 #
              THEN
                BEGIN 
                COMBINE (RBUF, RFILE);
                CHECKIT;
                END 
  
    # IF IT'S THE LEFT SON ON FILE, DO THE SAME FOR IT.                #
  
              ELSE
                BEGIN 
                IF LFILE NQ 0 
                THEN
                  BEGIN 
                  COMBINE (LBUF, LFILE);
                  CHECKIT;
                  END 
                END 
              END 
            END 
          END                      # END IF *OR*                       #
  
        IF ERR
        THEN
          BEGIN 
          RETURN; 
          END 
  
    # THE RESULTS FOR THIS NODE ARE ON OVERFLOW'S OUTPUT FILE.         #
  
        OLDPOS[K] = FINALFILE;
        PROCD[K] = TRUE;
        END                        # END IF BOTH SONS EXIST            #
  
      MOM = UP [K]; 
      IF MOM EQ 0 THEN
        BEGIN 
        MORE$NODES = FALSE; 
        END 
      END                          # END *J* LOOP                      #
  
  
      CMM$FRF(LBUF);               # FREE LEFT BUFFER                  #
      CMM$FRF(RBUF);               # AND RIGHT ONE                     #
      FINALOUT; 
      RETURN; 
      END  # GETKEYS  # 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     G E T L I S T                                                    #
#                                                                      #
#     *GETLIST* IS CALLED FROM *GETKEYS* TO GET THE LIST OF PRIMARY    #
#     KEYS FOR A GIVEN NODE OF THE EXPRESSION TREE.  IT CALLS          #
#     *SETUPSTART* TO STORE THE ALTERNATE KEY VALUE IN THE *FITKA*     #
#     AREA.  THEN IT ALLOCATES AN ENTRY IN *XSTT* FOR THIS NODE AND    #
#     CALLS ONE OF THE *GETLISTXX* PROCS TO DO THE ACTUAL GET.         #
#                                                                      #
#     OUT: I = INDEX IN *XSTT* OF NODE                                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC GETLIST (TOIDX, TOBUF, TOFILE);
      BEGIN 
  
      ITEM TOIDX        I;         # NEXT AVAIL WORD IN TOBUF          #
      ITEM TOBUF        I;         # LOCATION OF DESTINATION OF KEYS   #
      ITEM TOFILE       I;         # NUMBER OF OVERFLOW FILE           #
  
      BASED ARRAY XTWS;            # ACCESS TO WORKING STORAGE AREA    #
        BEGIN 
        ITEM TWS        U(0,0,60);
        END 
  
      SWITCH GOGETEM GTI, GEQ, GLE, GGE, GNE, GLT, GGT, GGELE, GLTGT; 
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O V E K E Y S                                                  #
#                                                                      #
#     *MOVEKEYS* IS CALLED BY ALL OF THE *GETLISTXX* ROUTINES TO DO A  #
#     CRM GETN AND CALL *STORE* TO MOVE THE KEYS GOTTEN FROM THE       #
#     *FITWSA* TO THE INTERNAL WSA.                                    #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MOVEKEYS;
      BEGIN 
  
#     P<FIT> SET TO P<MIPFIT> BY GETKEYS                               #
  
      P<FBUF> = LOC(BLP$FWS);      # MAY HAVE BEEN RESET               #
      FOR DUMMY = 0 STEP 1
        UNTIL FWSL - 1
      DO
        BEGIN 
        FWS[DUMMY] = 0;            # CLEAR FILE BUFFER                 #
        END 
  
      IF FITPTL EQ 0 THEN GETN (FIT, EOP);
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
        KT$SCLEN[RECDORD] = FITKL; # SCHEMA KEY LENGTH IN CHARS        #
        KEYLENGTH = (FITKL + 9) /  10;  # SCHEMA KEY LENGTH IN WORDS   #
        FITKL = SAVEFITKL;         # RESET TO LENGTH OF ALTERNATE KEY  #
        END 
  
      IF FITPTL EQ 0 THEN RETURN;  # NO KEYS THIS TIME                 #
  
      KEYSIN = FITPTL;             # AFTER GETN, PTL IS NUM OF KEYS    #
      IF OPER EQ 0                 # MAINTAIN COUNT OF KEYS FOR *OR*   #
      THEN
        BEGIN 
        NUMKEYS = NUMKEYS + KEYSIN; 
        END 
  
      STORE (P<FBUF>, KEYSIN, TOIDX, TOBUF, TOFILE);
      P<FIT> = P<MIPFIT>; 
      IF ERR
      THEN
        BEGIN 
        RETURN; 
        END 
  
      FITPTL = 0; 
      END 
CONTROL EJECT;
#     THESE THREE SMALL PROCS INTERFACE BETWEEN MIP AND GETLIST TO     #
#     DO THE ACTUAL WORK OF BUILDING THE KEYLISTS.                     #
#                                                                      #
#     THEIR USE IS STRICTLY INTERNAL TO GETLIST.                       #
#                                                                      #
#     P<FIT> IS SET BY GETLIST AND PRESERVED BY THESE ROUTINES.        #
#                                                                      #
#     THERE ARE ONLY THREE VARIANTS OF PROCESSING OF THE MIP STUFF     #
#     NEEDED TO BUILD ALL THE LISTS.  SEE EACH PROC FOR MORE DETAILS.  #
#                                                                      #
#     THERE ARE FOUR THINGS NECESSARY TO KNOW ABOUT MIP TO UNDERSTAND  #
#     ANY OF THIS PROCESSING --                                        #
#       -GET WITH KEY POSITIONS THE FILE TO THE FIRST KEY WHICH        #
#         SATISFIES *REL* AND RETURNS THE FIRST PART OF THE LIST.      #
#         STARTM DOES THE SAME BUT DOES NOT RETURN ANY KEYS.           #
#       -GETN WITH KEY RETURNS KEYS >>UNTIL<< *REL* IS SATISFIED.      #
#       -GETN WITHOUT KEY (FITKA=0) WILL RETURN KEYS UNTIL EOI.        #
#       -*FITREL* AND *FITKA* ARE CHANGED AS NECESSARY AFTER THE FIRST #
#         -GET- IN ORDER TO CONTINUE GETTING THE REST OF THE KEYS      #
#         DESIRED ON SUBSEQUENT -GETN-S.                               #
  
  
      PROC GETLISTEQ; 
      BEGIN 
  
#     GET THE COMPLETE KEYLIST FOR (ONLY) ONE ALT KEY.                 #
  
      STARTM(FIT, EOP);            # POSITION THE FILE (GET NO KEYS)   #
      IF FITES EQ UNKNWNALTKEY
        OR FITKNE                  # ONE OF THESE SHOULD CATCH AN ERROR#
      THEN
        BEGIN 
        RETURN; 
        END 
      FITREL = RELGT;              # NOW GET REST OF KEYS UNTIL *EOK*  #
      MOVEKEYS;                    # GET KEYS BEFORE CHECKING FOR EOK  #
  
      FOR DUM=0 
        WHILE FITFP NQ EOK
        AND FITFP NQ EOI
      DO
        BEGIN 
        IF ERR
        THEN
          BEGIN 
          RETURN;                  # QUIT PROCESSING IF ERROR          #
          END 
        MOVEKEYS; 
        END 
      END 
  
  
      CONTROL EJECT;
      PROC GETLISTLT; 
      BEGIN 
  
#     GET ALL KEYS FROM THE BEGINNING OF THE FILE UNTIL *FITREL* IS    #
#     SATISFIED.                                                       #
#                                                                      #
#     REWIND THE FILE AND THEN START DOING -GETN-S WITH KEY.           #
#     THE TRICK IS TO DO -GETN-S WITH KEY AND REL OF EQ OR GT UNTIL MET#
  
      IF CDCSDBM                   # IF CDCS DATA BASE MODE            #
      THEN
        BEGIN 
        DCREWND (FIT);             # CALL CDCS TO REWIND INDEX FILE    #
        END 
  
      ELSE                         # IF CRM DATA BASE MODE             #
        BEGIN 
        REWND (FIT);               # CALL CRM TO REWIND THE FILE       #
        END 
  
      MOVEKEYS;                    # GET KEYS BEFORE CHECKING FOR EOK  #
      FOR DUM=0 
        WHILE FITFP NQ EOK
        AND FITFP NQ EOI
      DO
        BEGIN 
        IF ERR
        THEN
          BEGIN 
          RETURN;                  # STOP PROCESSING IF ERROR OCCURRED #
          END 
        MOVEKEYS;                  # MOVEKEYS DOES THE -GETN-S         #
        END 
      END 
  
  
      CONTROL EJECT;
      PROC GETLISTGT; 
      BEGIN 
  
#     GET ALL KEYS FROM *FITREL* TO THE END OF THE FILE.               #
  
      STARTM(FIT, EOP);            # POSITION THE FILE (GET NO KEYS)   #
      FITKA = 0;                   # NOW DO -GETN-S WITHOUT KEY TO EOI #
  
      FOR DUM=0 
        WHILE FITFP NQ EOI
      DO
        BEGIN 
        MOVEKEYS; 
        IF ERR
        THEN
          BEGIN 
          RETURN;                  # HANG IT UP AND GO HOME EARLY...   #
          END 
        END 
      END 
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#     GETGELE                                                          #
#                                                                      #
#     GET ALL RECORDS SUCH THAT VALUE AT FITKA LE KEY LE VALUE AT      #
#     P<UPPERBOUND>.                                                   #
#                                                                      #
#     IN THE FUTURE, ALL INSTANCES OF KEY WITHIN RANGE SHOULD BE       #
#     HANDLED IN THIS EFFICIENT MANNER.  AT THE PRESENT TIME           #
#     THIS FUNCTION IS ONLY USED FOR MAJ ALTERNATE KEY OR ALTERNATE    #
#     KEY WITH UNIVERSAL WHERE THE LOWER BOUND IS MAJOR PADDED LOW AND #
#     UPPER BOUND IS MAJOR PADDED HIGH.                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC GETGELE; 
      BEGIN 
      STARTM(FIT, EOP);            # POSITION THE FILE AT LOWER BOUND  #
      FITKA = P<UPPERBOUND>;       # RESET KA TO UPPER BOUND           #
      FITREL = RELGT;              # GET ALL KEYS UNTIL *EOK*          #
      MOVEKEYS; 
      FOR DUM = 0 
        WHILE FITFP NQ EOK
        AND FITFP NQ EOI
      DO
        BEGIN 
        IF ERR
        THEN
          BEGIN 
          RETURN; 
          END 
        MOVEKEYS; 
        END 
      RETURN; 
      END 
  
      CONTROL EJECT;               # MAIN BODY OF *GETLIST*            #
  
      P<XTWS> = TOBUF;
  
      SETUPSTART; 
      P<FIT> = P<MIPFIT>; 
      P<FBUF> = LOC(BLP$FWS); 
      FITPTL = 0; 
      FITMRL = FWSL * 10; 
      FITWSA = LOC(BLP$FWS);
  
#     GO GET THE ACTUAL KEYLISTS  --  SEE *GETLISTXX* FOR DETAILS      #
  
      FITRL = 0;                   # JUST TO BE SAFE....               #
      FITREL = GETRELATION[REL];   # SET *FITREL* APPROPRIATELY FOR GET#
      CASE GOGETEM[REL];           # GO TO APPROPRIATE PROCESSOR...    #
  
GEQ:  
      GETLISTEQ;                   # DO -GET- WITH RELEQ               #
      GOTO ENDMOVES;
  
GNE:  
      GETLISTLT;                   # FIRST GET ALL KEYS *LT*           #
      SETUPKA;                     # RESET KA BECAUSE MIP MAY HAVE     #
                                   # CHANGED IT                        #
      FITREL = RELGT; 
      GETLISTGT;                   # THEN GET ALL KEYS *GT*            #
      GOTO ENDMOVES;
  
GGT:  
      GETLISTGT;                   # DO -GET-S WITH RELGT              #
      GOTO ENDMOVES;
  
GGE:  
      GETLISTGT;                   # DO -GET-S UNTIL RELGE             #
      GOTO ENDMOVES;
  
GLT:  
      GETLISTLT;                   # DO -GETN-S WITH KEY UNTIL RELEQ   #
      GOTO ENDMOVES;
  
GLE:  
      GETLISTLT;                   # DO -GETN-S WITH KEY UNTIL RELGT   #
      GOTO ENDMOVES;
  
GGELE:  
      GETGELE;                     # GET KEYS WITHIN RANGE             #
      GOTO ENDMOVES;
  
GLTGT:  
      GETLISTLT;                   # GET KEYS LESS THAN LOWER BOUND    #
      FITREL = RELGT; 
      FITKA = P<UPPERBOUND>;
      GETLISTGT;                   # GET KEYS GREATER THAN UPPER BOUND #
      GOTO ENDMOVES;
  
GTI:  
      SETINTERR;
      RETURN; 
ENDMOVES: 
      IF ERR THEN 
        RETURN;                    # NO PROCESSING IF ERROR IN MOVEKEYS#
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M E R G E L I S T S                                              #
#                                                                      #
#     *MERGELISTS* IS CALLED BY *GETKEYS* WHEN KEYLISTS HAVE BEEN      #
#     OBTAINED FOR BOTH SUBTREES OF THE CURRENT NODE AND THE           #
#     OPERATOR IS *AND* OR *XOR*.  BOTH BUFFERS ARE SORTED AND IF      #
#     NECESSARY MERGED WITH EXISTING KEYS ON THE FILE.  THE            #
#     KEYS ARE THEN OBTAINED ONE AT A TIME FROM EACH BUFFER            #
#     AND COMPARED.  ONLY KEYS THAT ARE EQUAL ARE SAVED FOR *AND*      #
#     WHILE ONLY UNEQUAL KEYS ARE SAVE *XOR*.  BOTH                    #
#     SCRATCH FILES ARE RELEASED.                                      #
#                                                                      #
#     IN: LEFT NODE VALUES ARE IN LBUF BUFFER AND LFILE                #
#        RIGHT NODE VALUES ARE IN RBUF BUFFER AND RFILE                #
#     OUT:  VALUES ARE STORED IN FILE FINALFILE                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC MERGELISTS;
      BEGIN 
  
      ITEM TEMP         I;         # TEMPORARY VARIABLE                #
  
    # SORT LEFT BUFFER.                                                #
  
      IF LINDEX NQ 0
      THEN
        BEGIN 
        SORTIT (LINDEX, LBUF);
        END 
  
    # IF LEFT BUFFER HAD OVERFLOWED TO FILE AND KEYS REMAIN IN LEFT    #
    # BUFFER, MERGE FILE AND BUFFER.                                   #
  
      IF LFILE NQ 0 
      THEN
        BEGIN 
        IF LINDEX NQ 0
        THEN
          BEGIN 
          OVERFLOW (LFILE, LINDEX, LBUF, FNO);
          LFILE = FNO;
          END 
  
        LINDEX = WBUFL + 1;        # TELL *FETCH* TO READ FROM FILE    #
        END                        # END IF LEFT NODE ON FILE          #
  
    # IF LEFT KEYLIST IS ENTIRELY IN BUFFER, TELL *FETCH* TO READ FROM #
    # CORE.                                                            #
  
      ELSE
        BEGIN 
        LINDEX = - KEYLENGTH; 
        END 
  
    # SORT RIGHT BUFFER.                                               #
  
      IF LINDEX NQ 0
      THEN
        BEGIN 
        SORTIT (LINDEX, LBUF);
        END 
  
    # IF RIGHT BUFFER HAD OVERFLOWED TO FILE AND KEYS REMAIN IN RIGHT  #
    # BUFFER, MERGE FILE AND BUFFER.                                   #
  
      IF RFILE NQ 0 
      THEN
        BEGIN 
        IF RINDEX NQ 0
        THEN
          BEGIN 
          OVERFLOW (RFILE, RINDEX, RBUF, FNO);
          RFILE = FNO;
          END 
  
        RINDEX = WBUFL + 1;        # TELL *FETCH TO READ FROM FILE     #
        END                        # END IF RIGHT NODE ON FILE         #
  
    # IF RIGHT KEYLIST IS ENTIRELY IN BUFFER, TELL *FETCH* TO READ FROM#
    # CORE.                                                            #
  
      ELSE
        BEGIN 
        RINDEX = -KEYLENGTH;
        END 
                                   #  XWS1 AND KEY1 ARE FOR LEFT SONS  #
                                   #  XWS2 AND KEY2 ARE FOR RIGHT SONS #
      P<XWS1> = LBUF; 
      P<XWS2> = RBUF; 
      P<KEY1> = P<XWS1>;
      P<KEY2> = P<XWS2>;
      FETCH (LFILE, P<XWS1>, LINDEX, TEMP); 
      FETCH (RFILE, P<XWS2>, RINDEX, TEMP); 
  
      FOR BUF = 0 
        WHILE KEY1X[0] NQ 0 
          AND KEY2X[0] NQ 0 
      DO
        BEGIN                      # LOOP THRU ENTIRE LISTS            #
        COMPARE(KEY1,KEY2);        # COMPARE THE TWO KEYS              #
        IF COMPRESULT EQ LESS      # IF LEFT LESS THAN RIGHT           #
        THEN
          BEGIN 
          IF OPER EQ 2             # IF *XOR*, STORE LESSER KEY        #
          THEN
            BEGIN 
            STORE (P<KEY1>, ONER, BINDEX, P<XWS>, FINALFILE); 
            NUMKEYS = NUMKEYS + 1;
            END 
  
    # POINT TO NEXT LEFT KEY                                           #
  
          FETCH (LFILE, P<XWS1>, LINDEX, TEMP); 
          P<KEY1> = P<XWS1> + LINDEX; 
          TEST BUF; 
          END                      # END IF COMPARE LESS               #
  
        IF COMPRESULT EQ GREATER   # IF RIGHT LESS THAN LEFT           #
        THEN
          BEGIN 
          IF OPER EQ 2             # IF *XOR*, STORE LESSER KEY        #
          THEN
            BEGIN 
            STORE (P<KEY2>, ONER, BINDEX, P<XWS>, FINALFILE); 
            NUMKEYS = NUMKEYS + 1;
            END 
  
    # POINT TO NEXT RIGHT KEY                                          #
  
          FETCH (RFILE, P<XWS2>, RINDEX, TEMP); 
          P<KEY2> = P<XWS2> + RINDEX; 
          TEST BUF; 
          END                      # END IF COMPARE GREATER            #
  
    # TO GET HERE, COMPARE MUST BE EQUAL. STORE KEY IF *AND*.          #
  
        IF OPER EQ 1
        THEN
          BEGIN 
          P<FBUF> = P<KEY2>;
          STORE (P<KEY2>, ONER, BINDEX, P<XWS>, FINALFILE); 
          NUMKEYS = NUMKEYS + 1;
          END 
  
        IF ERR
        THEN
          BEGIN 
          RETURN; 
          END 
  
    # POINT TO NEW KEY FROM EACH NODE                                  #
  
        FETCH (LFILE, P<XWS1>, LINDEX, TEMP); 
        FETCH (RFILE, P<XWS2>, RINDEX, TEMP); 
        P<KEY1> = P<XWS1> + LINDEX; 
        P<KEY2> = P<XWS2> + RINDEX; 
  
        END                        # END OF BUF LOOP                   #
  
                                   # IF *XOR*, STORE ANY KEYS LEFTOVER #
      IF OPER EQ 2 THEN            # IN ONE OF THE BUFFERS.            #
        BEGIN 
        FOR BUF = 0 
          WHILE KEY1X [0] NQ 0     # IF KEYS REMAIN IN LEFT BUFFER     #
        DO
          BEGIN 
          STORE (P<KEY1>, ONER, BINDEX, P<XWS>, FINALFILE); 
          FETCH (LFILE, P<XWS1>, LINDEX, TEMP); 
          P<KEY1>  = P<XWS1> + LINDEX;
          NUMKEYS = NUMKEYS + 1;
          END 
  
        FOR BUF = 0 
          WHILE KEY2X [0] NQ 0     # IF KEYS REMAIN IN RIGHT BUFFER    #
        DO
          BEGIN 
          STORE (P<KEY2>, ONER, BINDEX, P<XWS>, FINALFILE); 
          FETCH (RFILE, P<XWS2>, RINDEX, TEMP); 
          P<KEY2> = P<XWS2> + RINDEX; 
          NUMKEYS = NUMKEYS + 1;
          END 
  
        END  # IF XOR # 
  
      BFILE[LFILE] = FALSE;        # SET FILES NOT BUSY                #
      BFILE[RFILE] = FALSE; 
  
      FOR BUF = 0 STEP 1
        UNTIL WBUFL + 1 
      DO
        BEGIN 
        WS1[BUF] = 0;              # CLEAR BUFFERS                     #
        WS2[BUF] = 0; 
        END 
      END                          # END PROC MERGLISTS                #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     O V E R F L O W                                                  #
#                                                                      #
#     *OVERFLOW* IS CALLED BY *STORE*, *MERGELISTS* AND *FINALOUT*     #
#     TO FLUSH THE INPUT BUFFER TO A SCRATCH FILE.  IF IT IS THE FIRST #
#     OVERFLOW FOR THE CURRENT NODE, A NEW SCRATCH FILE IS ALLOCATED.  #
#     OTHERWISE, THE BUFFER AND THE EXISTING SCRATCH FILE ARE MERGED   #
#     ONTO ANOTHER FILE, AND THE OLD SCRATCH IS RELEASED.  THE INPUT   #
#     BUFFER AND ITS INDEX ARE ZEROED OUT BEFORE RETURN.               #
#                                                                      #
#     IN:  FNUM = FILE TO BE MERGED                                    #
#          BPTR = POINTER TO NEXT FREE WORD IN INPUT BUFFER            #
#          FRBUF= LOCATION OF INPUT BUFFER                             #
#     OUT: ACTF = FILE CONTAINING OUTPUT                               #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC OVERFLOW (FNUM, BPTR, FRBUF, ACTF);
      BEGIN 
      ITEM ACTF   I;               # OUTPUT FILE NUMBER                #
      ITEM BPTR   I;               # NEXT FREE WORD IN INPUT BUFFER    #
      ITEM FNUM   I;               # INPUT FILE NUMBER                 #
      ITEM FRBUF  I;               # INPUT BUFFER LOCATION             #
  
                                   # LOCAL VARIABLES                   #
      ITEM KEYSLEFT   I;           # KEYS LEFT IN SOURCE BUFFER        #
      ITEM NEXTFREE   I;           # NEXT FREE WORD IN FILE BUFFER     #
      ITEM OB1IDX     I;           # INDEX TO INPUT BUFFER             #
      ITEM OB2IDX     I;           # INDEX TO FILE BUFFER              #
      ITEM OB3IDX     I;           # INDEX TO WORKING STORAGE BUFFER   #
      ITEM SAVEFIT    I;
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O R E X                                                      #
#                                                                      #
#     *STOREX* DOES THE SAME THING AS PROC *STORE* BUT IS CALLED       #
#     ONLY FROM *OVERFLOW*.  IT IS NEEDED TO PREVENT RECURSIVE         #
#     CALLS.  ONE OR MORE KEYS ARE STORED IN THE WORKING STORAGE       #
#     BUFFER.  IF THE LENGTH WILL NOT FIT IN THE BUFFER, *SORTIT*      #
#     IS CALLED TO SORT THE BUFFER AND THEN IT IS WRITTEN OUT TO NEW   #
#     SCRATCH FILE.    NO MERGE IS NEEDED SINCE *OVERFLOW* IS          #
#     PUTTING THE BUFFER IN ORDER AS IT GOES ALONG                     #
#                                                                      #
#       IN:  FRBUF = LOCATION OF SOURCE BUFFER                         #
#            XINKEYS = NUMBER OF KEYS TO TRANSFER                      #
#            P<OB3> IS ASSUMED SET TO WORKING STORAGE BUFFER           #
#            OB3IDX IS NEXT FREE WORD IN WORKING STORAGE BUFFER        #
#                                                                      #
#       OUT: OB3IDX = INDEX INTO NEXT FREE WORD OF WORKING STORAGE     #
#            LOCATION IN FRBUF OF TRANSFERRED KEYS CLEARED OUT         #
#            KEYS POSSIBLY WRITTEN TO FILE ACTF                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC STOREX (FRBUF, XINKEYS); 
      BEGIN 
                                   # INPUT PARAMETERS                  #
      ITEM FRBUF     I;            # LOCATION OF FROM BUFFER           #
      ITEM XINKEYS   I;            # NUMBER OF KEYS COMING IN          #
  
                                   # LOCAL VARIABLES                   #
      ITEM XILOOP    I;            # SCRATCH VARIABLE                  #
      ITEM XINDEX    I;            # TEMPORARY INDEX                   #
      ITEM XINDX     I;            # TEMPORARY INDEX                   #
      ITEM XKEYSNUM  I;            # NUMBER OF KEYS TO STORE           #
      ITEM XLASTINDEX  I;          # LAST WORD TO BE MOVED             #
      ITEM XSAVENUM  I;            # SCRATCH VARIABLE                  #
      BASED ARRAY XFWS;            # ACCESS TO SOURCE BUFFER           #
        BEGIN 
        ITEM FWS     U(0,0,60); 
        END 
  
      XKEYSNUM = XINKEYS;          # SO WONT CHANGE INPUT              #
      P<XFWS> = FRBUF;
  
      FOR XILOOP = XILOOP 
        WHILE XKEYSNUM GR 0 
      DO
        BEGIN 
                                   # SEE IF THERE IS ROOM IN THE BUFFER#
                                   # TO STORE TOTAL NUMBER OF KEYS     #
        XLASTINDEX = XKEYSNUM * KEYLENGTH + OB3IDX - 1; 
        IF XLASTINDEX GR WBUFL
        THEN
          BEGIN 
                                   # SEE HOW MANY SPACES ARE LEFT      #
          XLASTINDEX = WBUFL; 
          XSAVENUM = WBUFL - OB3IDX + 1; # NUMBER OF WORDS BEING MOVED #
          XKEYSNUM = XKEYSNUM - (XSAVENUM / KEYLENGTH);  # KEYS LEFT   #
          END 
        ELSE
          BEGIN 
          XKEYSNUM = 0;            # CAN MOVE THEM ALL                 #
          XSAVENUM = 0; 
          END 
  
    # MOVE AS MANY KEYS AS POSSIBLE TO WORKING STORAGE. CLEAR OUT      #
    # SOURCE BUFFER ALONG THE WAY.                                     #
  
        XINDEX = 0; 
        FOR XINDX = OB3IDX STEP 1 
          UNTIL XLASTINDEX
        DO
          BEGIN 
          OW3 [XINDX] = FWS [XINDEX]; 
          FWS [XINDEX] = 0; 
          XINDEX = XINDEX + 1;
          END 
  
    # IF WORKING STORAGE IS FULL, ZERO OUT ITS LAST WORD, SORT IT, AND #
    # WRITE IT TO THE NEW SCRATCH FILE.  RESET INDEXES TO CONTINUE     #
    # COPYING SOURCE BUFFER TO WORKING STORAGE.                        #
  
        IF XLASTINDEX EQ WBUFL
        THEN
          BEGIN 
          OB3IDX = WBUFL + 1; 
          OW3 [OB3IDX] = 0; 
          SORTIT (OB3IDX, P<OB3>);
          WRITEIT (OB3IDX, P<OB3>, ACTF); 
          XLASTINDEX = -1;
          P<XFWS> = P<XFWS> + XSAVENUM; 
          END 
        END                        # END XILOOP FOR ALL INPUT KEYS     #
  
      OB3IDX = XLASTINDEX + 1;
      RETURN; 
  
      END                          # END PROC *STOREX*                 #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     T R Y C O P Y                                                    #
#                                                                      #
#     PROC TRYCOPY IS AN *OVERFLOW* INTERNAL PROCEDURE.  IT MAKES      #
#     AN ATTEMPT TO COPY THE EXISTING FILE AND ADD ON THE INPUT BUFFER #
#     VALUES IF ALL DATA IS IN ORDER.                                  #
#                                                                      #
#     IN:   ASSUMED THAT BUFFERS HAVE BEEN ALLOCATED                   #
#                                                                      #
#     OUT:  COPY IS COMPLETE AS FAR AS IT CAN GO.                      #
#           FETCH OF KEYS FROM FILE TO FILE BUFFER HAS BEEN DONE       #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC TRYCOPY; 
      BEGIN 
  
      OB2IDX = WBUFL + 1;          # FORCE FETCH TO READ FROM FILE     #
      FETCH (FNUM, P<OB2>, OB2IDX, NEXTFREE); 
  
      P<KEY1> = P<OB1>;            # POINT TO FIRST KEY IN INPUT BUF   #
      FINIS = FALSE;
  
    # COMPARE LAST KEY IN FILE BUFFER TO FIRST KEY IN INPUT BUFFER     #
  
      FOR DUMDUM = DUMDUM 
        WHILE NOT FINIS 
      DO
        BEGIN 
        P<KEY2> = P<OB2> + NEXTFREE - KEYLENGTH;
        COMPARE (KEY1, KEY2); 
  
    # IF THE LAST KEY IN THE FILE BUFFER IS LESS THAN THE FIRST KEY IN #
    # INPUT BUFFER, CAN COPY FILE BUFFER TO NEW FILE.                  #
  
        IF COMPRESULT EQ GREATER
        THEN
          BEGIN 
  
    # IF FULL BUFFER READ AND NOTHING IS STORED IN WORKING STORAGE     #
    # BUFFER, CAN WRITE DIRECTLY TO NEW SCRATCH FILE.                  #
  
          IF NEXTFREE GR WBUFL
            AND OB3IDX EQ 0 
          THEN
            BEGIN 
            WRITEIT (NEXTFREE, P<OB2>, ACTF); 
            END 
  
    # IF FILE BUFFER NOT FULL OR WORKING STORAGE NOT EMPTY, CALL       #
    # STOREX TO SHUFFLE KEYS FROM FILE BUFFER TO WORKING STORAGE TO    #
    # NEW SCRATCH FILE.                                                #
  
          ELSE
            BEGIN 
            KEYSLEFT = NEXTFREE / KEYLENGTH;
            STOREX (P<OB2>, KEYSLEFT);
            END 
  
    # READ A NEW SET OF KEYS FROM FILE.                                #
  
          OB2IDX = WBUFL + 1; 
          FETCH (FNUM, P<OB2>, OB2IDX, NEXTFREE); 
          P<KEY2> = P<OB2>; 
  
    # IF END OF FILE, AND NOTHING IN WORKING STORAGE, WRITE INPUT      #
    # BUFFER STRAIGHT TO NEW SCRATCH FILE.                             #
  
          IF KEY2X[0] EQ 0
          THEN
            BEGIN 
            FINIS = TRUE;          # SAY FINISHED WITH FILE            #
            IF OB3IDX EQ 0
            THEN
              BEGIN 
              WRITEIT (BPTR, P<OB1>, ACTF); 
              END 
  
    # IF SOMETHING LEFT IN WORKING STORAGE, CALL STOREX TO SHUFFLE     #
    # KEYS FROM INPUT BUFFER TO WORKING STORAGE TO NEW SCRATCH FILE,   #
    # AND WRITEIT TO EMPTY LAST KEYS OUT OF WORKING STORAGE.           #
  
            ELSE
              BEGIN 
              KEYSLEFT = BPTR / KEYLENGTH;
              STOREX (P<OB1>, KEYSLEFT);
              IF OB3IDX GR 0
              THEN
                BEGIN 
                WRITEIT (OB3IDX, P<OB3>, ACTF); 
                END 
              END 
            END                    # END IF END OF FILE                #
          END                      # END IF FILE LESS THAN INPUT       #
  
    # IF LAST KEY IN FILE BUFFER IS GREATER THAN FIRST KEY IN INPUT    #
    # BUFFER, GIVE UP WITHOUT DOING ANYTHING.                          #
  
        ELSE
          BEGIN 
          FINIS = TRUE; 
          END 
        END                        # END DUMDUM LOOP                   #
  
      RETURN; 
      END                          # END PROC TRYCOPY                  #
  
      CONTROL EJECT;               # MAIN BODY OF *OVERFLOW*           #
  
      SAVEFIT = P<FIT>; 
      FINIS = FALSE;
      FOR NEWSCR = 1 STEP 1        # FIND NON-BUSY FILE TO USE         #
        WHILE NEWSCR LQ NFILES
          AND NOT FINIS 
      DO
        BEGIN 
        IF NOT BFILE[NEWSCR]       # IF FILE NOT BUSY                  #
        THEN
          BEGIN 
          BFILE[NEWSCR] = TRUE;    # WILL BE USING THIS ONE            #
          FINIS = TRUE; 
          ACTF = NEWSCR;           # RETURN FILE NUMBER                #
          END 
        END 
  
      IF NOT FINIS
      THEN
        BEGIN 
        SETINTERR;                 # NO FILES AVAILABLE                #
        RETURN; 
        END 
  
      P<FIT> = LOC(RM$BLPA[ACTF]); # POSN TO FILE-S FIT                #
      FITLFN = AFILE[ACTF];        # SAVE LFN                          #
  
      IF FITOC NQ OC$OPEN          # IF FILE NEVER OPENED              #
      THEN
        BEGIN 
        FITES = 0;                 # CLEAR ERROR STATUS                #
        FITBBH = TRUE;             # ALLOCATE BUFFERS BELOW HHA        #
        OPENM(FIT, $IO$, EOP);     # OPEN THE FILE                     #
        END 
      ELSE
        BEGIN 
        REWND(FIT);                # JUST REWIND THE FILE              #
        END 
  
      P<OB1> = FRBUF;              # OB1 IS INPUT BUFFER               #
      IF FNUM EQ 0                 # FIRST TIME TO FILE                #
      THEN
        BEGIN 
        OW1 [BPTR] = 0;            # SET LAST WORD TO ZERO             #
        FITES = 0;                 # CLEAR ERROR STATUS                #
        PUT (FIT, OB1, BPTR * 10, EOP);  # WRITE FROMBUF TO FILE       #
        FITES = 0;
        REWND(FIT);                # REWIND FILE                       #
  
        FOR DUMDUM = 0 STEP 1 
          UNTIL BPTR
        DO
          BEGIN 
          OW1 [DUMDUM] = 0;        # CLEAR INPUT BUFFER                #
          END 
  
        BPTR = 0; 
        P<FIT> = SAVEFIT; 
        RETURN; 
        END                        # END FIRST TIME TO FILE            #
  
    # MERGE INPUT BUFFER AND EXISTING FILE.  FIRST ASSIGN TWO MORE     #
    # BUFFERS, ONE TO USE AS A FILE BUFFER AND THE OTHER AS A WORKING  #
    # STORAGE BUFFER.                                                  #
  
      P<OB2> = CMM$ALF(BLPWSA, 0, 0);  # FILE BUFFER                   #
      P<OB3> = CMM$ALF(BLPWSA, 0, 0);  # WORKING STORAGE BUFFER        #
      OB1IDX = 0; 
      OB2IDX = 0; 
      OB3IDX = 0; 
  
      P<FIT> = LOC(RM$BLPA[FNUM]); # SET FIT TO INPUT FILE             #
      REWND(FIT);                  # AND REWIND IT                     #
  
      TRYCOPY;                     # SEE IF FILE CAN BE COPIED         #
  
    # AT THIS POINT, IF THE FILE HAS BEEN COPIED AND INPUT BUFFER      #
    # ADDED ON, BOTH BUFFERS HAVE BEEN ZEROED SO THE PROCESSING WILL   #
    # GO THROUGH ONLY THE FIRST TEST OF THE DUMDUM LOOP AND THEN EXIT. #
    # IF A MERGE IS NEEDED, KEYS ARE IN BOTH THE INPUT BUFFER AND THE  #
    # FILE BUFFER. THE FILE BUFFER CONTAINS THE KEYS WHERE RECOGNITION #
    # THAT COPY WAS NOT POSSIBLE. THERE MAY OR MAY NOT HAVE BEEN PARTS #
    # OF THE FILE COPIED.                                              #
  
      FINIS = FALSE;
  
      FOR DUMDUM = DUMDUM 
        WHILE NOT FINIS 
      DO
        BEGIN 
        P<KEY1> = P<OB1> + OB1IDX;
        P<KEY2> = P<OB2> + OB2IDX;
  
    # IF BOTH INPUT BUFFER AND FILE ARE FINISHED AND KEYS ARE LEFT IN  #
    # WORKING STORAGE, WRITE THEM TO NEW SCRATCH FILE.                 #
  
        IF KEY1X[0] EQ 0
          AND KEY2X[0] EQ 0 
        THEN
          BEGIN 
          IF OB3IDX GR 0
          THEN
            BEGIN 
            OW3 [OB3IDX] = 0;      # ZERO OUT LAST WORD                #
            WRITEIT (OB3IDX, P<OB3>, ACTF); 
            END 
          FINIS = TRUE; 
          TEST DUMDUM;
          END 
  
    # IF KEYS ARE LEFT IN FILE BUT NOT IN INPUT BUFFER, CALL STOREX    #
    # TO SHUFFLE KEYS FROM FILE BUFFER TO WORKING STORAGE (TO NEW      #
    # SCRATCH FILE) AND FETCH TO READ MORE FROM FILE TO FILE BUFFER.   #
  
        IF KEY1X[0] EQ 0
        THEN
          BEGIN 
          KEYSLEFT = (NEXTFREE - OB2IDX) / KEYLENGTH; 
          STOREX (P<KEY2>, KEYSLEFT); 
          OB2IDX = WBUFL + 1; 
          FETCH (FNUM, P<OB2>, OB2IDX, NEXTFREE); 
          TEST DUMDUM;
          END 
  
    # IF KEYS ARE LEFT IN INPUT BUFFER BUT NOT IN FILE, CALL STOREX    #
    # TO SHUFFLE KEYS FROM INPUT BUFFER TO WORKING STORAGE (TO NEW     #
    # SCRATCH FILE).                                                   #
  
        IF KEY2X[0] EQ 0
        THEN
          BEGIN 
          KEYSLEFT = (BPTR - OB1IDX) / KEYLENGTH; 
          STOREX (P<KEY1>, KEYSLEFT); 
          OB1IDX = WBUFL + 1; 
          TEST DUMDUM;
          END 
  
    # IF KEYS ARE LEFT IN BOTH FILE AND INPUT BUFFER, COMPARE AND      #
    # DECIDE WHICH ONE TO STORE.                                       #
  
    # IF EQUAL, STORE ONE AND GET THE NEXT KEY FROM BOTH SOURCES.      #
  
        COMPARE (KEY1,KEY2);
        IF COMPRESULT EQ EQUAL
        THEN
          BEGIN 
          STOREX (P<KEY1>, ONER); 
          OB1IDX = OB1IDX + KEYLENGTH;
          KEY2X[0] = 0; 
          FETCH (FNUM, P<OB2>, OB2IDX, NEXTFREE); 
          TEST DUMDUM;
          END 
  
    # IF INPUT KEY LESS THAN FILE KEY, STORE INPUT KEY AND GET NEXT    #
    # KEY FROM INPUT BUFFER.                                           #
  
        IF COMPRESULT EQ LESS 
        THEN
          BEGIN 
          STOREX (P<KEY1>, ONER); 
          OB1IDX = OB1IDX + KEYLENGTH;
          TEST DUMDUM;
          END 
  
    # IF FILE KEY LESS THAN INPUT KEY, STORE FILE KEY AND GET NEXT KEY #
    # FROM FILE (BUFFER).                                              #
  
        ELSE
          BEGIN 
          STOREX (P<KEY2>, ONER); 
          FETCH (FNUM, P<OB2>, OB2IDX, NEXTFREE); 
          END 
        END                        # END DUMDUM LOOP                   #
  
                                   # CLEAR INPUT BUFFER                #
      FOR DUMDUM = 0 STEP 1 
        UNTIL WBUFL + 1 
      DO
        BEGIN 
        OW1[DUMDUM] = 0;
        END 
                                   # FREE ANY ACQUIRED CMM             #
      CMM$FRF(P<OB2>);
      CMM$FRF(P<OB3>);
  
      BPTR = 0; 
      BFILE[FNUM] = FALSE;         # SET INPUT FILE UNUSED             #
      P<FIT> = LOC(RM$BLPA[ACTF]); # POINT TO OUTPUT FILE FIT          #
      WEOR(FIT,EOP);               # WRITE END OF RECORD               #
      REWND(FIT);                  # AND REWIND IT                     #
  
      P<FIT> = SAVEFIT; 
      RETURN;                      # ALL THROUGH                       #
      END                          # END PROC *OVERFLOW*               #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T I N T E R R                                                #
#                                                                      #
#     *SETINTERR* IS CALLED WHEN AN INTERNAL ERROR OCCURS WHICH        #
#     REQUIRES A FILEPASS.  THE ERROR AND RETURN CODE IN *P2* ARE      #
#     SET TO INDICATE THIS.                                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SETINTERR; 
      BEGIN 
      EC[0] = 2**5; 
      ERR = TRUE; 
      RCODE[0] = 1;          #  SET RETURN CODE TO PASS FILE  # 
      RETURN; 
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S T O R E                                                        #
#                                                                      #
#     *STORE* IS CALLED BY *MOVEKEYS*, AND *MERGLISTS* TO STORE ONE OR #
#     MORE KEYS IN A WORKING STORAGE BUFFER.  IF THE LENGTH WILL NOT   #
#     FIT IN THE BUFFER, *SORTIT* WILL BE CALLED TO SORT THE BUFFER    #
#     AND *OVERFLOW* WILL BE CALLED TO WRITE THE BUFFER TO A FILE OR   #
#     MERGE IT WITH AN EXISTING FILE THEREBY CREATING A NEW FILE.      #
#                                                                      #
#     IN: FRBUF = LOCATION OF INPUT BUFFER                             #
#         INKEYS = NUMBER OF KEYS IN INPUT BUFFER                      #
#         TOIDX  = INDEX INTO WORKING STORAGE BUFFER                   #
#         TOBUF  = LOCATION OF WORKING STORAGE BUFFER                  #
#                                                                      #
#    OUT: LOCATIONS IN FRBUF OF TRANSFERRED KEYS CLEARED OUT           #
#         TOIDX = INDEX INTO NEXT FREE WORD OF WORKING STORAGE BUFFER  #
#         TOFILE = NUMBER OF OVERFLOW FILE                             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC STORE (FRBUF, INKEYS, TOIDX, TOBUF, TOFILE); 
      BEGIN 
      ITEM FRBUF        I;         # LOCATION OF INPUT BUFFER          #
      ITEM INKEYS       I;         # NUMBER OF KEYS COMING IN          #
      ITEM TOIDX        I;         # INDEX INTO WORKING STORAGE BUFFER #
      ITEM TOBUF        I;         # LOCATION OF WORKING STORAGE       #
      ITEM TOFILE       I;         # NUMBER OF OVERFLOW FILE           #
  
                                   # LOCAL VARIABLES                   #
      ITEM ILOOP   I;              # SCRATCH VARIABLE                  #
      ITEM INDEX   I;              # TEMORARY INDEX                    #
      ITEM INDX    I;              # TEMPORARY INDEX                   #
      ITEM KEYSNUM I;              # NUMBER OF KEYS TO STORE           #
      ITEM LASTINDEX  I;           # POINTER TO LAST WORD TO MOVE      #
      ITEM SAVENUM I;              # SCRATCH VARIABLE                  #
  
      BASED ARRAY XFWS;            # ACCESS TO INPUT BUFFER            #
        BEGIN 
        ITEM FWS        U(0,0,60);
        END 
      BASED ARRAY XTWS;            # ACCESS TO WORKING STORAGE         #
        BEGIN 
        ITEM TWS        U(0,0,60);
        END 
  
      KEYSNUM = INKEYS;            # SO WONT CHANGE INPUT              #
      P<XFWS> = FRBUF;
      P<XTWS> = TOBUF;
  
      FOR ILOOP = ILOOP 
        WHILE KEYSNUM GR 0
      DO
        BEGIN 
  
    # DETERMINE IF THERE IS ROOM IN WORKING STORAGE FOR ALL OF THE     #
    # KEYS.  IF NOT, SET SAVENUM TO NUMBER OF WORDS THAT WILL FIT.     #
    # SET LASTINDEX TO INDEX OF LAST WORD TO BE TRANSFERRED.           #
  
        LASTINDEX = KEYSNUM * KEYLENGTH + TOIDX - 1;
        IF LASTINDEX GR WBUFL 
        THEN
          BEGIN 
          LASTINDEX = WBUFL;
          SAVENUM = WBUFL - TOIDX + 1;
          KEYSNUM = KEYSNUM - (SAVENUM / KEYLENGTH);
          END 
        ELSE                       # CAN MOVE ALL KEYS                 #
          BEGIN 
          KEYSNUM = 0;
          SAVENUM = 0;
          END 
  
    # MOVE AS MANY KEYS AS POSSIBLE TO WORKING STORAGE. CLEAR OUT      #
    # INPUT BUFFER ALONG THE WAY.                                      #
  
        INDEX = 0;
        FOR INDX = TOIDX STEP 1 
          UNTIL LASTINDEX 
        DO
          BEGIN 
          TWS[INDX] = FWS[INDEX]; 
          FWS [INDEX] = 0;
          INDEX = INDEX + 1;
          END 
  
    # IF WORKING STORAGE IS FULL, ZERO OUT ITS LAST WORD, SORT IT, AND #
    # WRITE IT TO THE NEW SCRATCH FILE.  RESET INDEXES TO CONTINUE     #
    # COPYING INPUT BUFFER TO WORKING STORAGE.                         #
  
        IF LASTINDEX EQ WBUFL 
        THEN
          BEGIN 
          TOIDX = WBUFL + 1;
          TWS [TOIDX] = 0;
          SORTIT (TOIDX, P<XTWS>);
          OVERFLOW (TOFILE, TOIDX, P<XTWS>, OUTFILE); 
          TOFILE = OUTFILE; 
          LASTINDEX = -1; 
          P<XFWS> = P<XFWS> + SAVENUM;
          END 
  
        END 
  
      TOIDX = LASTINDEX + 1;
      RETURN; 
      END                          # END PROC *STORE*                  #
  
      CONTROL EJECT;
  
#----------------------------------------------------------------------#
#                                                                      #
#     S O R T I T                                                      #
#                                                                      #
#     *SORTIT* IS CALLED TO SORT THE KEYS IN A BUFFER                  #
#                                                                      #
#     IN:  BUFLOC   = LOCATION OF BUFFER TO SORT                       #
#          NEXTWORD = POINTER TO NEXT FREE WORD                        #
#                                                                      #
#     OUT:  SORTED BUFFER                                              #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SORTIT (NEXTWORD, BUFLOC); 
      BEGIN 
                                   # INPUT PARAMETER                   #
      ITEM NEXTWORD   I;           # POINTER TO NEXT FREE WORD         #
      ITEM BUFLOC     I;           # LOCATION OF BUFFER                #
  
                                   # LOCAL VARIABLES                   #
      ITEM COMPLETE   B;           # COMPLETION FLAG                   #
      ITEM JUMPER     I;           # SCRATCH VARIABLE                  #
      ITEM LASTCOMP   I;           # PTR TO 1ST WORD OF LAST           #
                                   # ALLOWABLE KEYONE                  #
      ITEM LASTWORD   I;           # PTR TO LAST WORD OF BUFFER        #
                                   # AFTER DUPLICATE ELIMINATED        #
      ITEM LOOPER     I;           # LOOP VARIABLE                     #
      ITEM NEXTKEY    I;           # SCRATCH VARIABLE                  #
      ITEM STEPPER    I;           # LOOP VARIABLE                     #
      ITEM TOTKEY     I;           # LAST WORD WHEN EXCHANGING         #
  
      BASED ARRAY KEYONE;          # ARRAYS USED FOR COMPARISON        #
        BEGIN 
        ITEM SKEY1   U(0,0,60); 
        END 
  
      BASED ARRAY KEYTWO; 
        BEGIN 
        ITEM SKEY2   U(0,0,60); 
        END 
  
      BASED ARRAY XTWS;            # ACCESS TO WORKING STORAGE AREA    #
        BEGIN 
        ITEM TWS     U(0,0,60); 
        END 
  
      P<XTWS> = BUFLOC; 
      COMPLETE = FALSE;            # PRIME THE PUMP                    #
      LASTCOMP = NEXTWORD - 2 * KEYLENGTH;  # SET LOOP LIMIT           #
  
      FOR DUMDUM = 0
        WHILE NOT COMPLETE
      DO
        BEGIN 
        COMPLETE = TRUE;          # ASSUME WILL COMPLETE THIS TIME     #
        FOR LOOPER = 0 STEP KEYLENGTH 
          UNTIL LASTCOMP
        DO
          BEGIN 
                                   # POINT TO ADJACENT KEYS            #
          JUMPER = LOOPER + KEYLENGTH;  # POINTER TO SECOND KEY        #
          P<KEYONE> = LOC(TWS[LOOPER]); 
          P<KEYTWO> = LOC(TWS[JUMPER]); 
  
          COMPARE(KEYONE, KEYTWO);  # COMPARE THE TWO KEYS             #
  
          IF COMPRESULT EQ LESS    # IF FIRST LESS THAN SECOND         #
          THEN
            BEGIN 
            TEST LOOPER;           # ALREADY IN ORDER                  #
            END 
  
          IF COMPRESULT EQ GREATER  # KEY2 GREATER THAN KEY2           #
          THEN
            BEGIN 
            TOTKEY = LOOPER + KEYLENGTH - 1;  # SET LOOP LIMIT         #
            FOR STEPPER = LOOPER STEP 1 
              UNTIL TOTKEY
            DO
              BEGIN 
              TWS[STEPPER] == TWS[JUMPER];  # EXCHANGE THE TWO KEYS    #
              JUMPER = JUMPER + 1;
              END 
  
            COMPLETE = FALSE; 
            TEST LOOPER;
            END 
  
          IF COMPRESULT EQ EQUAL   # DUPLICATES FOUND, COVER ONE       #
          THEN
            BEGIN 
            COMPLETE = FALSE; 
                                   # POINT PAST BOTH DUPLICATES THEN   #
                                   # MOVE ALL KEYS UP ELIMINATING      #
                                   # ONE DUPLICATE                     #
            NEXTKEY = JUMPER + KEYLENGTH; 
            LASTWORD = LASTCOMP + KEYLENGTH - 1;
            FOR STEPPER = JUMPER STEP 1 
              UNTIL LASTWORD
            DO
              BEGIN 
              TWS[STEPPER] = TWS[NEXTKEY];
              NEXTKEY = NEXTKEY + 1;
              END 
  
            LASTCOMP = LASTCOMP - KEYLENGTH;  # POINTER LESS ONE KEY   #
            TWS[LASTWORD + 1] = 0; # MAKE LAST WORD ZERO               #
            END 
          END                      # END LOOPER                        #
        END                        # END DUMDUM                        #
      NEXTWORD = LASTCOMP + 2 * KEYLENGTH;
  
      RETURN; 
      END                          # END SORTIT                        #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C H E C K I T                                                    #
#                                                                      #
#     *CHECKIT* IS CALLED TO DETERMINE WHETHER ANY KEYS ARE            #
#     LEFT IN MAIN STORAGE.  WHEN THIS IS TRUE THE BUFFER              #
#     WILL BE SORTED AND THEN OVERFLOW CALLED TO MERGE THESE KEYS WITH #
#     THOSE ON FINALFILE, WRITING THEM TO A NEW FINALFILE.             #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CHECKIT; 
      BEGIN 
  
      IF WS[0] NQ 0                # IF KEYS IN MAIN STORAGE           #
      THEN
        BEGIN 
        SORTIT(BINDEX, P<XWS>);    # SORT THEM                         #
        OVERFLOW (FINALFILE, BINDEX, P<XWS>, OUTFILE);
        FINALFILE = OUTFILE;       # SAVE FILE NUMBER                  #
        END 
      END                          # END PROC CHECKIT                  #
  
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C O M B I N E                                                    #
#                                                                      #
#     *COMBINE READS A DESIGNATED FILE INTO A RELATED BUFFER AND       #
#     THEN MOVES THE KEYS TO MAIN STORAGE.  AS MAIN STORAGE FILLS      #
#     IT IS SORTED AND THEN A CALL IS MADE TO *OVERFLOW* TO EITHER     #
#     WRITE DIRECTLY TO A FILE (FIRST CALL) OR MERGE THE KEYS WITH     #
#     KEYS FROM AN EXISTING FILE.                                      #
#                                                                      #
#     IN:   BUFLOC  = BUFFER TO USE FOR READING FILE                   #
#           FILENUM = INPUT FILE                                       #
#           *BINDEX* IS SET TO NEXT AVAILABLE WORD IN MAIN WS          #
#                                                                      #
#     OUT:  BUFLOC CLEARED OUT                                         #
#           ALL KEYS READ FROM FILENUM                                 #
#           MAIN WS POSSIBLE STILL CONTAINS KEYS                       #
#           BINDEX = INDEX TO NEXT FREE WORD IN MAIN WS                #
#           SORTED KEYS WRITTEN TO FINALFILE                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC COMBINE (BUFLOC, FILENUM); 
      BEGIN 
  
      ITEM BUFLOC       I;         # LOCATION OF FILE BUFFER           #
      ITEM FILENUM      I;         # NUMBER OF FILE TO COMBINE         #
  
      ITEM SAVEFIT      I;
      BASED ARRAY XFWS;;           # ACCESS TO FILE BUFFER             #
  
      P<XFWS> = BUFLOC; 
  
    # POINT TO PROPER FILE'S FIT                                       #
  
      SAVEFIT = P<FIT>; 
      P<FIT> = LOC (RM$BLPA [FILENUM]); 
      REWND (FIT);
      FITES = 0;                   # CLEAR ERROR BIT                   #
      FITPTL = -1;
  
      FOR DUM = 0 
        WHILE FITFP NQ EOI
          AND FITPTL NQ 0 
      DO
        BEGIN 
        GETP (FIT, XFWS, WBUFC, EOP); 
        IF FITPTL NQ 0             # IF KEYS RETURNED                  #
        THEN
          BEGIN 
                                   # AFTER GETP, PTL = NUMBER OF CHARS #
                                   # SO MUST DIVIDE BY 10 AND THEN BY  #
                                   # KEYLENGTH.                        #
          KEYSIN = (FITPTL / 10) / KEYLENGTH; 
          NUMKEYS = NUMKEYS + KEYSIN; 
          STORE (P<XFWS>, KEYSIN, BINDEX, P<XWS>, FINALFILE); 
          END 
        END 
  
        P<FIT> = SAVEFIT; 
        BFILE [FILENUM] = FALSE;   # SET INPUT FILE NOT BUSY           #
        RETURN; 
      END                          # END PROC COMBINE                  #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C O M P A R E                                                    #
#                                                                      #
#     *COMPARE* IS CALLED BY *OVERFLOW* AND *MERGELISTS* TO DO A       #
#     WORD BY WORD COMPARE OF THE TWO PARAMETERS PASSED IT.            #
#     *COMPRESULT* RETURNS THE RESULT OF THE COMPARE.                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC COMPARE (PARM1, PARM2);
      BEGIN 
      ITEM IDX   I;                # LOOP VARIABLE                     #
      ARRAY PARM1 [1:1];
       ITEM PARM1X C(0,0,10); 
      ARRAY PARM2 [1:1];
       ITEM PARM2X C(0,0,10); 
  
      COMPRESULT = EQUAL; 
      FOR IDX = 1 STEP 1
        UNTIL KEYLENGTH 
      DO
        BEGIN 
        IF PARM1X[IDX] EQ PARM2X[IDX] 
        THEN
          BEGIN 
          TEST IDX; 
          END 
        IF PARM1X[IDX] LS PARM2X[IDX] THEN
          COMPRESULT = LESS;
        IF PARM1X[IDX] GR PARM2X[IDX] THEN
          COMPRESULT = GREATER; 
        RETURN; 
        END                        # END IDX LOOP                      #
      END  #  COMPARE  #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     W R I T E I T                                                    #
#                                                                      #
#     *WRITEIT* WRITES A BUFFER TO A SCRATCH FILE AND CLEARS THE       #
#     BUFFER.                                                          #
#                                                                      #
#     IN: PTR    = INDEX TO NEXT FREE WORD IN BUFFER                   #
#         FRBUF  =  LOCATION OF BUFFER                                 #
#         TOFILE =  NUMBER OF SCRATCH FILE                             #
#                                                                      #
#    OUT: PTR = 0                                                      #
#         FRBUF CLEARED OUT                                            #
#         TOFILE = NUMBER OF FILE CONTAINING KEYS                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC WRITEIT (PTR, FRBUF, TOFILE);
      BEGIN 
  
      ITEM FRBUF        I;         # LOCATION OF BUFFER TO WRITE       #
      ITEM PTR          I;         # INDEX TO NEXT FREE WORD           #
      ITEM TOFILE       I;         # NUMBER OF FILE TO WRITE TO        #
      ITEM SAVEFIT      I;
      ITEM WRD          I;         # LOOP VARIABLE                     #
  
      BASED ARRAY XTWS;            # ACCESS TO SOURCE BUFFER           #
        BEGIN 
        ITEM TWS        U(0,0,60);
        END 
  
      P<XTWS> = FRBUF;
      SAVEFIT = P<FIT>; 
      P<FIT> = LOC (RM$BLPA [TOFILE]);
      FITES = 0;
      FITRL = 0;
      PUTP(FIT, XTWS, PTR * 10, EOP); 
  
      FOR WRD = 0 STEP 1
        UNTIL WBUFL + 1 
      DO
        BEGIN 
        TWS[WRD] = 0;              # CLEAR BUFFER                      #
        END 
      PTR = 0;
  
      P<FIT> = SAVEFIT; 
      RETURN; 
      END                          # END PROC WRITEIT                  #
  
     END    #  BLP  # 
      TERM; 
