*DECK DB$QUAL 
USETEXT RELCMTX 
USETEXT CDCSCTX 
      PROC DB$QUAL; 
      BEGIN 
 #
  *   DB$QUAL                                    PAGE 1 
  *   M L MOORE                                  DATE 11/09/75
  *   M D SAXE  (REVISION FOR 2.0)               DATE 09/24/76
  DC  PURPOSE 
      THIS PROCEDURE PROCESSES THE QUALIFICATION STACK IN CSRLNQUL TO 
      DETERMINE IF A RECORD IS QUALIFIED. 
  
  DC  LANGUAGE
      SYMPL 
  
  DC  ENTRY CONDITIONS
      CST RELATION WORK BLOCK PTR IS SET FOR THE CURRENT RELATION, IN 
        ORDER TO OBTAIN THE ADDRESS OF THE CST QUALIFICATION STACK
      RUN-UNIT STATUS BLOCK POINTER (RSB) IS SET TO THE CURRENT RELATION
        , IN ORDER TO OBTAIN THE ADDRESS OF THE DATA-NAME BUFFER AND
        QAL STACK BUFFER (DNSBUFA AND STACK)
      RSB RELATION CONTROL BLOCK POINTER IS SET FOR THE CURRENT RELATION
        , IN ORDER TO OBTAIN THE ADDRESS OF THE RSB RELATION QUALIFICAT-
        ION TABLE (RSNQTAB) 
      USER FPT IS SET FOR THE CURRENT RANK
  
  DC  EXIT CONDITIONS 
      RCQUAL / DB$MFPCM = TRUE IF RECORD SATISFIES QUALIFICATION CRITERA
                          FALSE IF NOT
      ERRSTAT IS NON-ZERO IF A CONVERSION ERROR OR QUALTAB FORMAT 
           ERROR (ERRSTAT = 46B IF ILLEGAL OPERATOR CODE) OCCURRED. 
  
  DC  CALLING ROUTINES
      DB$MFP - QUALTEST PROC
  
  DC  CALLED ROUTINES 
      DB$CMPR  -  COMPARE STACK VALUES FOR RELATIONAL OPERATORS 
  
  DC  NON-LOCAL VARIABLES 
        THE FOLLOWING VARIABLES IN DB$RMCM ARE MODIFIED IN ORDER
      TO MAKE A CALL TO DB$CMPR  -  COMPBCP, COMPBWP, P<DCTABLE>, 
      LITLENG, TCLASS [0], TGIBBP, TGIFWA, TSIZE [0]. 
  
  DC  DESCRIPTION 
      THE QUALIFICATION STACK IS A REVERSE POLISH STACK.  IT IS 
      PROCESSED BY THE USE OF A LOCAL STACK ( FOR WHICH THE BUFFER IS 
      ALLOCATED BY INVOKE ), USING THE FOLLOWING METHOD.
           1) AN ENTRY IS POPPED OFF THE CST QUALIFICATION STACK
                (CSRLNQUL)
           2) IF THE ENTRY IS FOR A DBI OR A LITERAL, A CORRESPONDING 
      ENTRY IS GENERATED AND PUSHED INTO THE LOCAL STACK. 
           3)  IF THE ENTRY IS A DATA NAME, STORE THE ATTRIBUTE POINTER 
      FOR THE LOCAL STACK.  THEN THE ENTRY FOR THE DATA NAME IS PUSHED
      INTO THE LOCAL STACK. 
           4) IF THE ENTRY IS FOR AN OPERATOR, THE PROCEDURE TO BE
      FOLLOWED DEPENDS ON THE OPERATOR. 
              A)  FOR -NOT- OPERATOR, THE TRUE/FALSE FLAG ON THE TOP
      ENTRY OF THE LOCAL STACK IS FLIPPED TO THE OPPOSITE VALUE.
      CONTROL GOES TO STEP 5 BY MEANS OF A TEST STATEMENT.
              B)  FOR -AND-, -OR-, OR -XOR- OPERATORS, THE INDICATED
      LOGICAL OPERATION IS PERFORMED ON THE TRUE/FALSE FLAGS OF THE 
      TOP TWO ENTRIES IN THE LOCAL STACK.  THE RESULT IS SAVED TO BE
      USED IN GENERATING AN ENTRY FOR THE LOCAL STACK.
              C)  FOR -EQ-, -NQ-, -LQ-, -GR-, -LS-, OR -LQ- OPERATORS,
      THE PROC DB$CMPR IS CALLED TO PERFORM A COMPARISON BETWEEN THE
      VALUES INDICATED BY THE TOP TWO ENTRIES IN THE LOCAL STACK.  THE
      SECOND ENTRY IN THE STACK IS ALWAYS ASSUMED TO BE FOR A DBI.  THE 
      FIRST ENTRY MAY BE FOR A DBI, LITERAL, OR DATANAME.  IF THE CLASS 
      FOR THE SECOND ENTRY INDICATES A DISPLAY-CODED VALUE, THE CLASS 
      FOR THE COMPARISON OPERATION WILL BE SET TO ALPHANUMERIC.  THE
      RESULT OF THE COMPARISON AND THE RELATIONAL OPERATION TO BE 
      PERFORMED ARE COMBINED TO DETERMINE A TRUE/FALSE VALUE TO BE USED 
      WHEN GENERATING AN ENTRY FOR THE LOCAL STACK. 
              D)  A NEW ENTRY FOR THE LOCAL STACK IS GENERATED, USING 
      THE TRUE/FALSE FLAG GENERATED IN EITHER B OR C ABOVE.  THE TOP TWO
      ENTRIES ARE POPPED OFF THE STACK AND THE NEW ENTRY IS PUSHED INTO 
      THE STACK.
           5)  STEPS 1 THROUGH 4 ARE PERFORMED FOR ALL ENTRIES IN THE 
      QUAL STACK. WHEN ALL ENTRIES IN THE STACK FOR THIS RANK HAVE
      BEEN PROCESSED, THE FLAG RCQUAL IS SET TO THE VALUE OF THE TRUE/
      FALSE FLAG IN THE TOP ENTRY OF THE LOCAL STACK.  AN EXIT IS MADE. 
         THE LOCAL STACK IS ALLOCATED BY THE CST BUILDER. 
      THE LOCAL STACK FORMAT IS - 
         BIT 0 = TRUE / FALSE FLAG
         BITS 39-41 = ENTRY TYPE, COPIED FROM QALTYP IN THE 
                      QUALTAB STACK 
         BITS 42-59 = A POINTER TO THE ATTRIBUTE ENTRY IN THE 
                      QUALTAB STACK, OR, FOR DATA-NAMES, THE
                      ABSOLUTE ADDRESS IN THE USERS PROGRAM.
 #
  
    CONTROL NOLIST;          #CALLS TO COMMON DECKS                    #
                             #MFPDFCLS, MFPCOMDCLS, RELCMDCLS          #
                             #CSTARDCLS, RMCOMDCLS                     #
*CALL MFPDFDCLS 
*CALL MFPCMDCLS 
*CALL RMCOMDCLS 
      CONTROL LIST; 
  
  
# DEFS FOR THE QALTYP FIELD TO DEFINE THE QUALTAB ENTRY TYPE #
      DEF  NTRYDBINOMAP#1#; 
      DEF  NTRYDBIMAP#2#; 
      DEF  NTRYDNAME#3#;
      DEF  NTRYLIT#4#;
      DEF  NTRYOP#5#; 
  
# DEFS DEFINING THE OPERATOR CODES FOR THE QUALTAB STACK ENTRY #
      DEF  OPEQ#1#; 
      DEF  OPNQ#2#; 
      DEF  OPGQ#3#; 
      DEF  OPLQ#4#; 
      DEF  OPGR#5#; 
      DEF  OPLS#6#; 
      DEF  OPAND#7#;
      DEF  OPOR#8#; 
      DEF  OPXOR#9#;
      DEF  OPNOT#10#; 
  
      XREF
        BEGIN 
        PROC DB$CMPR; 
        PROC DB$FLOP;        # GENERATE FLOW POINT                     #
        ARRAY DB$MDCA;;      # DISPLAY TO ASCII COLLATING SEQUENCE #
        ARRAY DB$MDCC;;      # DISPLAY TO COBOL COLLATING SEQUENCE #
        ARRAY DB$MDCU;;      # DISPLAY TO USER COLLATING SEQUENCE # 
        ARRAY DB$MDCX;;      # DISPLAY TO DISPLAY COLLATING SEQUENCE #
        END 
  
  
#     LOCAL VARIABLES                                                  #
      ITEM  I, J;            # TEMPORARY VARIABLES   #
      ITEM NEXTSTK;          # NEXT AVAILABLE WD IN LOCAL STACK # 
      ITEM OPERCD;           # TEMP STORAGE FOR OPERATOR CODE # 
      ITEM DNSBUFA;          #ABS ADDRESS OF MFP DATA-NAME SAVE BUFFER.#
      ITEM QALTABA;          #ABS ADDRESS OF START OF QUALTABS.        #
  
# THE FOLLOWING ARRAY DEFINES THE LOCAL STACK FOR DB$QUAL # 
# ENTRY 0 IS ALWAYS OPEN FOR BUILDING A NEW ENTRY         # 
      BASED ARRAY STACK;
        ITEM  STACKTF   B(0,0,1),    # TRUE/FALSE FLAG    # 
              STACKTYP  U(0,39,3),   # ENTRY TYPE ( = QALTYP ) #
              STACKATP  U(0,42,18),  # ATTR PTR OR ABS ADDR    #
              STACKWD   U(0,0,60);   # FULL WORD               #
  
  
  
  
#  ******   BEGINNING OF DB$QUAL CODE   ******  # 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("QUAL   "); 
      CONTROL ENDIF;
  
#   SET UP BASED ARRAYS, INITIALIZE VARIABLES   # 
      P<CSRLNBLK> = LOC(CSFIXED) + RSNCSPTR[0]; 
      QALTABA = P<CSRLNBLK> + CSNQULPT[0];
      DNSBUFA = P<RSB> + RSFDNPTR[0]; 
      P<RSNQTAB> = RSNQTPTR[0] + LOC(RSB) + CSNSQLPT[0];
      P<CSRLNQUL> = CSNSQLPT[0] + QALTABA;                              1830
      P<STACK> = P<RSB> + RSFQSPTR[0];
      NEXTSTK = 1;
  
# BEGIN LOOP THRU THE QUALIFICATION STACK                              #
  
      FOR I=0 STEP 1 UNTIL CSNQSLEN[0] - 1 DO                           1890
        BEGIN 
        STACKWD [0] = 0;     # INITIALIZE NEW LOCAL STACK ENTRY # 
        IF CSNQTYPE[I] NQ NTRYOP                                        1920
  
# PROCESS STACK ENTRIES FOR OPERANDS - LITERALS, DBIS, DATANAMES #
  
          THEN               #PROCESS ALL STACK ENTRIES WHICH # 
          BEGIN              #WILL REQUIRE A LOCAL STACK ENTRY #
          IF CSNQTYPE[I] LQ NTRYDBIMAP                                  1980
            OR CSNQTYPE[I] EQ NTRYLIT                                   1990
            THEN STACKATP[0] = CSNQATPT[I];  # STORE ATTR POINTER      #2000
  
# STORE ATTRIBUTE POINTER FOR DATA NAME VALUE                          #
  
          IF CSNQTYPE[I] EQ NTRYDNAME                                   2070
            THEN
            BEGIN 
            STACKATP[0] = RSNQDNBP[I] - 1 + DNSBUFA;                    2510
            END 
          STACKTYP [0] = CSNQTYPE[I];                                   2530
  
# PUSH NEW ENTRY IN STACK 0 WORD INTO STACK # 
  
          FOR J = NEXTSTK  STEP -1  UNTIL 1   DO
            STACKWD [J] = STACKWD [J - 1];
          NEXTSTK = NEXTSTK + 1;      # INCREMENT STACK SIZE #
          END                  # OF NON-OPERATOR ENTRY PROCESSING # 
  
# PROCESS STACK ENTRIES FOR OPERATORS                       # 
  
        ELSE
          BEGIN                # PROCESS OPERATOR ENTRIES # 
          OPERCD = CSNQOPER[I];                                         2660
          IF OPERCD LQ 0  OR  OPERCD GR OPNOT 
            THEN             # SET ERRSTAT IF OPERATOR CODE # 
            BEGIN            # IS NOT LEGAL, AND ..RETURN.. # 
            ERRSTAT = O"46";
            RETURN; 
  
            END 
          IF OPERCD GQ OPAND   #PROCESS LOGICAL OPERATORS # 
            THEN
            BEGIN 
            IF OPERCD EQ OPNOT   # PROCESS NOT OPERATOR#
              THEN
              BEGIN 
              STACKTF [1] = NOT STACKTF [1];
              TEST I;          # GOTO END OF QUALTAB STACK LOOP#
  
              END 
# OTHER LOGICAL OPERATORS - GENERATE NEW STACK ENTRY WHICH IS # 
# THE RESULT OF THE LOGICAL OPERATION PERFORMED ON THE TOP   #
# TWO ENTRIES OF THE LOCAL STACK.   # 
  
            IF OPERCD EQ OPAND
              THEN STACKTF [0] = STACKTF [1] AND STACKTF [2]; 
            IF OPERCD EQ OPOR 
              THEN STACKTF [0] = STACKTF [1] OR  STACKTF[2];
            IF OPERCD EQ OPXOR  AND  ( ( STACKTF [1] AND  NOT 
               STACKTF [2] )  OR  ( NOT STACKTF [1] AND STACKTF [2] ) ) 
              THEN STACKTF [0] = TRUE;
            END                # OF LOGICAL OPERATOR PROCESSING # 
          ELSE
            BEGIN              # PROCESS RELATIONAL OPERATORS # 
            P<CSRLNATR> = STACKATP[2] + QALTABA;                        2980
  
# SET UP PARAMETERS FOR DB$CMPR CALL, WITH TARGET VALUE IN #
# SECOND STACK ENTRY...THIS IS DBI TO LEFT OF OPERATOR     #
  
            TGIBBP = 6 * CSNAIBCP[0];                                   3030
            TGIFWA = FPFITWSA[0] + CSNAIBWP[0]; 
            TSIZE = 6 * CSNASIZE[0];
  
#     DEFAULT ALL DISP CODE TYPES TO ALPHANUMERIC.                     #
  
            IF CSNACLAS[0] LQ DCDOUBLE                                  3060
              THEN TCLASS = ALPHANUMERIC; 
            ELSE TCLASS = CSNACLAS[0];
            IF STACKTYP [1] LQ NTRYDBIMAP 
              THEN             # COMPARISON VALUE (TO RIGHT OF #
              BEGIN            # OPERATOR) IS A DBI            #
              P<CSRLNATR> = STACKATP[1] + QALTABA;                      3120
              COMPBWP = FPFITWSA[0] + CSNAIBWP[0];
              COMPBCP = CSNAIBCP[0];                                    3140
              LITLENG = (CSNASIZE[0] + 9) / 10;                         3150
              END 
            IF STACKTYP [1] EQ NTRYDNAME
              THEN             # COMPARISON VALUE IS DATANAME # 
              BEGIN 
              COMPBWP = STACKATP [1]; 
              LITLENG = (CSNASIZE[0] + 9) / 10;                         3210
              COMPBCP = 0;
              END 
            IF STACKTYP [1] EQ NTRYLIT
              THEN             # COMPARISON VALUE IS LITERAL #
              BEGIN 
              COMPBWP = STACKATP [1] + 1 + QALTABA; 
              P<CSRLNATR> = STACKATP[1] + QALTABA;                      3280
              LITLENG = CSNALENG[0];                                    3290
              COMPBCP = 0;
              END 
            IF RSNCOLAT[0] EQ DFCOLASC           # IF DISPLAY - ASCII#
              THEN P<DCTABLE> = LOC(DB$MDCA);    # DISPLAY TO ASCII # 
              ELSE IF RSNCOLAT[0] EQ DFCOLCOB    # IF DISPLAY - COBOL#
                     THEN P<DCTABLE> = LOC(DB$MDCC);       # COBOL #
                     ELSE IF RSNCOLAT[0] EQ DFCOLDIS       # IF DISPL#
                            THEN P<DCTABLE> = LOC(DB$MDCX);# DISPLAY #
                            ELSE P<DCTABLE> = LOC(DB$MDCU);# USER # 
            XCALL DB$CMPR;
  
# SET TRUE-FALSE FLAG IN STACK NEW ENTRY ACCORDING TO OPERATOR #
# PLUS RESULTS OF COMPARISON.  NOTE THAT FLAG IS INITIALLY FALSE #
  
            IF  ( OPERCD EQ OPEQ   AND   HILOEQ EQ 0 )  OR
                ( OPERCD EQ OPNQ   AND   HILOEQ NQ 0 )  OR
                ( OPERCD EQ OPGR   AND   HILOEQ EQ 1 )  OR
                ( OPERCD EQ OPLS   AND   HILOEQ EQ -1)  OR
                ( OPERCD EQ OPGQ   AND   HILOEQ NQ -1)  OR
                ( OPERCD EQ OPLQ   AND   HILOEQ NQ 1 )
              THEN STACKTF [0] = TRUE;
            END                # OF RELATIONAL OPERATOR PROCESSING #
  
# POP TOP TWO ENTRIES IN STACK, PUSH IN WORD 0 OF STACK AS NEW ENTRY #
  
          STACKWD[1] = STACKWD [0]; 
          FOR J = 3  STEP 1  UNTIL NEXTSTK  DO
            STACKWD [J - 1] = STACKWD [J];
          NEXTSTK = NEXTSTK - 1;
          END                  # OF OPERATOR PROCESSING # 
        END                  # OF QUALTAB LOOP #
      RCQUAL = STACKTF [1];    # SET FLAG FOR RETURN #
      RETURN; 
  
      END 
      TERM
