*DECK EXPEVAL 
USETEXT TAREATB 
USETEXT TCRMDEF 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TPSTACK 
USETEXT TSBASIC 
          PROC EXPEV20; 
      BEGIN 
          XREF PROC CMOVE;
      XREF BASED ARRAY SAVDAREA;
        BEGIN 
        ITEM AREAINUSE   B(0,0,1);    # TRUE--THIS AREA WILL BE USED.  #
        ITEM RELORD      U(0,6,12);   # ORDINAL OF ASSOCIATED RELATION.#
        ITEM AREASAVE    U(0,42,18);  # ADDRESS OF AREA TABLE.         #
        ITEM AREASAVEWD  U(0,0,60); 
        END 
      BASED ARRAY OPERAND1;            # 1ST OPERAND ACCESS.           #
        ITEM I1,                       # INTEGER                       #
             R1 R,                     # REAL                          #
             D1 R(1,,60), 
          U1 U(0,0,60), 
             B1 B;                     # LOGICAL                       #
      BASED ARRAY OPERAND2; 
        ITEM I2,
             R2 R,
             D2 R(1,,60), 
          U2 U(0,0,60), 
             B2 B;
      BASED ARRAY RESULT;              # RESULT STORAGE PTR            #
        ITEM IR,                       # INTEGER                       #
             RR R,                     # REAL                          #
             DR R(1,,60), 
          UR U(0,0,60), 
             BR B;                     # LOGICAL                       #
      BASED ARRAY BASE; 
        ITEM BASEOPND U (00,42,18); 
      ARRAY EXPRSTACK[9];              # SPACE FOR SAVING STACK POSI-  #
        ITEM STACKADDR I(0,42,18),     # TION WHILE EVALUATING A SUB-  #
             PSTKPTR I(0,24,18);       # EXPRESSION.                   #
      XREF
        BEGIN 
        PROC DIAG;
        PROC CKININF;                  # CHECKS FOR INDEF. OR INFINITE #
        PROC CONVERT;                  # PERFORMS DATA TYPE CONVERSIONS#
        PROC FIGSUB;
        ITEM RECDORD I;            # RECORD ORDINAL USED BY THIS XMISSN#
        ITEM UNIVERSAL; 
        END 
      XREF ITEM RTBLCALL; #INDICATES CALL FROM NEXTGET# 
      STATUS CODE LSTHAN, GRTHAN, GEQL, LEQL, EQL, , NEQL,
                  ANDLOG, ORLOG, ALL; 
      ITEM
           BP1,BP2,                    # BIT POS PTRS FOR OPERANDS.    #
           I,J,K,                      # SCRATCH VARIABLES.            #
           L1,L2,                      # LENGTHS OF OPERANDS IN CHARS. #
           PREVIOUS,                   # INDEX TO EXPRSTACK ENTRY FOR  #
                                       # EXPRESSION CONTAINING A SUB-  #
                                       # EXPRESSION.                   #
           PSTACKPTR,                  # PTR TO PROGRAM STACK ENTRIES. #
           W1,W2;                      # WORD PTRS FOR OPERANDS.       #
      ITEM SVALLPSTPTR I;          # SAVE PSTACKPTR OF ALL/ANY ITEM    #
      ARRAY ATTR S(2);             # ATTRIBUTES OF INTEGER             #
                                   # USED FOR CONVERT                  #
        BEGIN 
        ITEM AWPOS I(0,18,18);     # ADDRESS OF VALUE                  #
        END 
          ARRAY C1[1:2]; ITEM C;
      ARRAY TRANSLATE[7]; 
        ITEM TRANSLTR I(0,0,60) = [O"77777777777744460000", 
                                   O"40414342111107100000", 
                                   O"77777777777764660000", 
                                   O"60616362101124260000", 
                                   O"77777777777711110000", 
                                   O"11111111202123220000", 
                                   O"77777777777711110000", 
                                   O"77777777777777770000"];
      ARRAY RSTKENTRY[2] S(3);
        ITEM RWORD1 I(0,0,60),
             RWORD2 I(1,0,60),
             RWORD3 I(2,0,60),
             CURRCODEC C(0,0,1),
             CURRCODE U(0,0,6), 
             CURRTYPE U(0,0,2), 
             CURROP U(0,2,4), 
             DUPVAL B(1,0,1), 
             UNIVORMAJKEY B(1,1,1),  # TRUE IF RGTABLE SHOULD PAD KEY  #
                                     # STARTING AT FIRST UNIVERSAL CHAR#
                                     # OR PAD MAJOR KEY UP TO FULL KEY #
                                     # LENGTH WITH HIGH OR LOW CHARACTE#
             LITFLAG B(1,5,1),
             RFROMCHAR U(1,6,6),   # RELATIVE BEGINNING CHAR POS OPND1 #
             NUMCHARS U(0,12,12), 
             OPND0 I(0,6,18), 
             OPND1 I(0,24,18),
             RSLT I(0,42,18), 
             PADCHARPOS U(1,15,9),   # CHARACTER POSITION TO START     #
                                     # PADDING WITH HIGH OR LOW CHAR   #
             STKORD I(1,24,18), 
             NEXTPTR I(1,42,18),
             CURRLOC U(2,42,18);   # ADDR OF THIS KEY"S PSTACK ENTRY   #
      XDEF ARRAY RGSTACK[0:69] S(3);  # ENOUGH ROOM FOR 63 3-WORD      #
                                      # ENTRIES FOLLOWED BY 21 ONE-WORD#
                                      # TEMPORARY RESULT WORDS, ONE    #
                                      # SUCH RESULT FOR EVERY 3 ENTRIES#
        ITEM RGSTACK1 I(0,0,60),
             RGSTACK2 I(1,0,60),
             RGSTACK3 I(2,0,60);
      XDEF ITEM RSTKPTR;
      XDEF ITEM RSTKERROR B;
      XDEF ITEM BLDRANGETBL B;
      XDEF ITEM POINTKNT; 
      XREF ITEM LOWAREA I;         # ORDINAL OF LOW AREA OF RELATION   # QU30296
      ITEM SKIPNOT B, 
           SKIPFLAG B,
           KEYFOUND B,
           ARGMTPOS;
      SWITCH OPERATION       # ACCESSES ROUTINES TO PERFORM OPERATIONS.#
             ADDINT,         #  0  INTEGER ADD                         #
             SUBTRACTINT,    #  1  INTEGER SUBTRACT                    #
             MULTIPLYINT,    #  2  INTEGER MULTIPLY                    #
             DIVIDEINT,      #  3  INTEGER DIVIDE                      #
             NEGATEINT,      #  4  INTEGER UNARY MINUS                 #
             EXPONENTINT,    #  5  INTEGER EXPONENTIATION              #
             EQINT,          #  6  INTEGER RELATIONAL OPERATORS:  EQ   #
             NEINT,          #  7                                 NE   #
             LTINT,          # 10                                 LT   #
             GTINT,          # 11                                 GT   #
             LEINT,          # 12                                 LE   #
             GEINT,          # 13                                 GE   #
             EQUIVALENCE,    # 14  LOGICAL EQUIVALENCE OPERATOR        #
             IMPLIES,        # 15  LOGICAL IMPLIES OPERATOR            #
             LOGAND,         # 16  LOGICAL AND OPERATOR                #
             LOGOR,          # 17  LOGICAL OR OPERATOR                 #
             ADDSP,          # 20  SINGLE PRECISION ADD                #
             SUBTRACTSP,     # 21  SINGLE PRECISION SUBTRACT           #
             MULTIPLYSP,     # 22  SINGLE PRECISION MULTIPLY           #
             DIVIDESP,       # 23  SINGLE PRECISION DIVIDE             #
             NEGATESP,       # 24  SINGLE PRECISION UNARY MINUS        #
             EXPONENTSP,     # 25  SINGLE PRECISION EXPONENTIATION     #
             EQSP,           # 26  SINGLE PRECISION RELATIONAL OPS: EQ #
             NESP,           # 27                                   NE #
             LTSP,           # 30                                   LT #
             GTSP,           # 31                                   GT #
             LESP,           # 32                                   LE #
             GESP,           # 33                                   GE #
             LOGXOR,         # 34  LOGICAL EXCLUSIVE OR OPERATOR       #
             LOGNOT,         # 35  LOGICAL NOT OPERATOR                #
             EQX,            # 36  ALPHA RELATIONAL OPERATOR: EQ       #
             NEX,            # 37  ALPHA RELATIONAL OPERATOR: NE       #
             ADDDP,          # 40  DOUBLE PRECISION ADD                #
             SUBTRACTDP,     # 41  DOUBLE PRECISION SUBTRACT           #
             MULTIPLYDP,     # 42  DOUBLE PRECISION MULTIPLY           #
             DIVIDEDP,       # 43  DOUBLE PRECISION DIVIDE             #
             NEGATEDP,       # 44  DOUBLE PRECISION UNARY MINUS        #
             EXPONENTDP,     # 45  DOUBLE PRECISION EXPONENTIATION     #
             EQDP,           # 46  DOUBLE PRECISION RELATIONAL OPS: EQ #
             NEDP,           # 47                                   NE #
             LTDP,           # 50                                   LT #
             GTDP,           # 51                                   GT #
             LEDP,           # 52                                   LE #
             GEDP,           # 53                                   GE #
             LTX,            # 54  ALPHA RELATIONAL OPERATORS: LT      #
             GTX,            # 55                              GT      #
             LEX,            # 56                              LE      #
             GEX,            # 57                              GE      #
             ADDCPLX,        # 60  COMPLEX ADD                         #
             SUBTRACTCPLX,   # 61  COMPLEX SUBTRACT                    #
             MULTIPLYCPLX,   # 62  COMPLEX MULTIPLY                    #
             DIVIDECPLX,     # 63  COMPLEX DIVIDE                      #
             NEGATECPLX,     # 64  COMPLEX UNARY MINUS                 #
             EXPONENTCPLX,   # 65  COMPLEX EXPONENTIATION              #
             EQCPLX,         # 66  COMPLEX RELATIONAL OPERATORS: EQ    #
             NECPLX,         # 67                                NE    #
             ENDOFOPS,       # 70 END OF POLISH STACKS                 #
             ABSOLCOMP,      # 71 ABSOLUTE OF COMPUTATIONAL ITEM       #
             ABSOLINT,       # 72 ABSOLUTE OF INTEGER ITEM             #
             ABSOLUNOR,      # 73 ABSOLUTE OF UNNORMALIZED ITEM        #
             ABSOLREL,       # 74 ABSOLUTE OF REAL ITEM                #
             JULIAN,         # 75 JULIAN                               #
             GREG,           # 76 GREG                                 #
             MASK;           # 77 MASK                                 #
      SWITCH STKENTRYTYPE    # DETERMINES ACTION BY STACK ENTRY TYPE   #
             RELMOVE, 
             RELMOVE,        # 1 DO NOTHING                            #
             RELCONVERT,     # 3 CALL CONVERT                          #
             EXPRESS,        # 3 EVALUATE SUB-EXPRESSION               #
             RELUNDETSUBS,   # 5 CALL UNDETSUBS                        #
             EXPRESS,        # 6 EVALUATE SUB-EXPRESSION               #
             EXPRESS, 
             OPERATOR;       # 7 ENTER OPERATION SWITCH WITH OPCODE    #
      SWITCH CKINTYPE        # ROUTINES TO CHECK FOR ILLEGAL OPERANDS  #
             GOTOOP,         # 0 NO CHECK NECESSARY                    #
             CKIN1,          # 1 TWO SP OPERANDS, SP RESULT            #
             CKIN2,          # 2 TWO SP OPERANDS, BOOL RESULT          #
             CKIN3,          # 3 TWO SP AND DP OPNDS, SP AND DP RESULT #
             CKIN4,          # 4 TWO SP AND DP OPNDS, BOOL RESULT      #
             CKIN5;          # 5 ONE SP OPERAND, SP RESULT             #
      ARRAY TZCONVERSION  [0:7];   # TABLE THAT MAPS OPERATIONS CODE   #
                                   # TO SWITCH VALUE FOR ROUTINES TO   #
                                   # CHECK FOR ILLEGAL OPERANDS.       #
        BEGIN 
        ITEM TZCODE I(0,0,60)  =  [O"00 00 00 00 00 00 00 00 0000", 
                                   O"00 00 00 00 00 00 00 00 0000", 
                                   O"01 01 01 01 01 01 02 02 0000", 
                                   O"02 02 02 02 00 00 00 00 0000", 
                                   O"03 03 03 03 03 03 04 04 0000", 
                                   O"04 04 04 04 00 00 00 00 0000", 
                                   O"03 03 03 03 03 03 04 04 0000", 
                                   O"00 00 00 05 05 00 00 00 0000"];
        END 
          ITEM II,JJ; 
# TEMPORARY--WILL BE REPLACED BY VALUE IN AREA TABLE.                  #
          BASED ARRAY DESATT1;
             ITEM DECLASS I(1,12,6);
          ITEM DEUB,SVINDTBL; 
          ARRAY ARAY[7];
          ITEM ARAW U(,,60),
               ARACD U(0,0,3),
               ARAOP U(0,24,18),
               ARADD U(0,42,18);
          ITEM ZZZZZ = O"37370727274767000000"; 
      XREF ITEM IPYMD;
      ARRAY MMDDYY[5]; ITEM MDY I(,,60);
      BASED ARRAY YYDDMM; ITEM YDM I(,,60); 
          ITEM J1,J2,J3,J4,J5,J6; 
          ITEM CUMU B;
          ARRAY P S(2); 
            ITEM PPEDIT B(0,3,1), 
                  PFROMCHAR U(0,4,4), 
                  PNBCHAR U(0,12,12), 
                  PFROMWORD U(0,24,18), 
                  PFROMPTR U(1,24,18),
                  PCONVERTCODE U(1,0,6),
                  PWORD1 U(0,0,60), 
                  PWORD2 U(1,0,60); 
          ITEM FGALL B; ITEM FGANY B; 
          ITEM SKIPTEMP B;
          BASED ARRAY BASE1;; 
          ITEM UB, CURSUB;
          ITEM RC;
      ITEM WORDPOS I; 
      ITEM CHARPOS I; 
      ITEM COLBLANK I;             # COLLATED VALUE OF BLANK           # QU3A346
      ITEM ALLINDTBL I;            # SAVE ALL/ANY P<INDTBL>            #
      ITEM ALLUB I;                # SAVE ALL/ANY UB                   #
      ITEM TEMPRSLTADDR I;         # ADDRESS OF TEMPORARY RESULT WORD  #
                                   # WITHIN ARRAY RGSTACK              #
          XREF FUNC ITOJ; XREF FUNC XTOY; XREF PROC DTOD; 
      XREF PROC DADD;              # DOUBLE PRECISION ADD              #
      XREF PROC DSUB;              # DOUBLE PRECISION SUBTRACT         #
      XREF PROC DMULT;             # DOUBLE PRECISION MULTIPLY         #
      XREF PROC DDIV;              # DOUBLE PRECISION DIVISION         #
          DEF NOCHECK#UNIVERSAL GR O"77"#;
          DEF NOMATCH#(C[1] NQ UNIVERSAL AND C[2] NQ UNIVERSAL)#; 
          BASED ARRAY COLSEQ; 
            BEGIN 
            ITEM COLWORD U(0,0,60); 
            END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     ERRORSET                                                         #
#                                                                      #
#     EXECUTED ON ERROR CONDITION TO SET LOGICALRESLT TO FALSE AND     #
#     TO RESET INDTBL TO ITS ORGINAL VALUES.                           #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC ERRORSET;
      BEGIN 
      LOGICALRESLT = FALSE;        # SINCE ERROR, ASSUME FALSE         #
        P<INDTBL> = ALLINDTBL;
      IF FGALL                     # IF PROCESSING *ALL*               #
        OR FGANY                   # IF PROCESSING *ANY*               #
      THEN
        BEGIN 
        CONSUB[0] = FALSE;         # RESET INDTBL                      #
        INDCE[0] = 0; 
        IF FGALL
        THEN
          BEGIN 
          ALLFG[0] = TRUE;
          END 
        ELSE
          BEGIN 
          ANYFG[0] = TRUE;
          END 
        END 
      RETURN; 
      END 
  
      PROC RSTACKR; 
#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
#  THIS PROC WRITES 2-WORD ENTRIES TO THE ARRAY RANGESTACK IN HIGH #
#  CORE.  THE OPCODE FIELD OF EACH ENTRY CONTAINS A CODE DETERMINED#
#  BY THE RELATION OR BOOLEAN WHICH INITIATED THE CALL TO RSTACKR. #
#  THE CODE CONSISTS OF A 2-BIT TYPE FIELD AND A 4-BIT OP FIELD.   #
#    TYPES:        00  BOOLEAN OR ALL                     # 
#                  01  CHARACTER OR DISPLAY NUMERIC                #
#                  10  INTEGER                                     #
#                  11 FLOATING POINT                               #
#    OPS:          0000      LT                                    #
#                  0001      GT                                    #
#                  0010      GE                                    #
#                  0011      LE                                    #
#                  0100      EQ                                    #
#                  0110      NE                                    #
#                  0111      AND                                   #
#                  1000      OR                                    #
#                  1001      ALL--PASS WHOLE FILE                  #
        BEGIN 
        ITEM FIRSTWORD, 
             PSTACKPTR1,
             OPNDINDEX, 
             WRITINDEX; 
        ITEM KEYINDEX I;           # INDEX IN PROGRAMSTACK OF KEY ENTRY#
        ITEM PADHIGHORLOW B;       #TRUE IF CHARACTERS WILL BE REPLACED#
        ITEM WORDPTR I;            # WORD INDEX                        #
        ITEM BITPTR I;             # BIT WITHIN WORD AT WORDPTR        #
        ITEM CHARPOS I;            # CHARACTER POSITION OF 1ST UNIV    #
        ITEM COMPARELEN I;         # NO OF CHARACTERS TO SCAN FOR      #
                                   # UNIVERSAL CHARACTER               #
  
        FIRSTWORD=2;         #INITIALIZE FOR ONE-WORD ENTRY            #
        RSLT[2]=TOWORDADDR[PSTACKPTR]; #INITIALIZE RESULT-FIELD ADDR   #
        IF NOT ONEAKEY             # IF ACCESSING BY PRIMARY KEY       #
          AND AT$FITFO EQ FODA     # IF DIRECT ACCESS                  #
          AND CURROP[2] NQ CODE"EQL"  # IF NOT *EQUAL*                 #
          AND CURROP[2] NQ CODE"ORLOG"   # AND NOT *OR*                #
        THEN                                                             EXPEVAL
          BEGIN 
          CURRCODE[2] = CODE"ALL";
          END 
        ELSE
          BEGIN 
          IF AT$FITFO EQ FOSQ                                            EXPEVAL
            AND (NOT AT$SORTSEQ    # NOT SORTED SEQUENTIAL             # QU3A347
              OR AT$SSQDESC)       # OR SORTED SEQ. DESCENDING         # QU3A347
          THEN                                                           EXPEVAL
            BEGIN                                                        EXPEVAL
            CURRCODE[2] = CODE"ALL";
            END 
        ELSE
        BEGIN 
  
        IF SKIPFLAG 
          THEN               # IF SKIPFLAG=TRUE, WRITE -ALL- TO STACK  #
          BEGIN 
          CURRCODE[2]=CODE"ALL";
          SKIPFLAG=FALSE; 
          END 
  
          ELSE               # ELSE, PROCESS OPERATOR                  #
          BEGIN              # IDENTIFY RELATIONALS VS. BOOLEANS       #
          IF CURROP[2] LQ CODE"NEQL"
            THEN             # OPERATOR IS RELATIONAL OP               #
            BEGIN 
            PSTACKPTR1=PSTACKPTR+1; 
                             # LOOK-AHEAD FOR -NOT- OPERATOR           #
            IF ENTRYTYPE[PSTACKPTR1] EQ 7 AND OPCODE[PSTACKPTR1] EQ 29
              THEN
              BEGIN       # IF NEXT OP IS -NOT-, COMPLEMENT CURROP #
              CURRCODE[2] = CURRCODE[2] LXR O"02";
              RSLT[2]=TOWORDADDR[PSTACKPTR1]; 
              SKIPNOT = TRUE; 
              END 
            IF CURROP[2] EQ CODE"NEQL" THEN KEYFOUND = FALSE; 
  
            # IF PRIMARY KEY IS AN ARGUMENT OF THIS RELATIONAL OP,     #
            #   THEN WRITE AN ENTRY FOR THE OPERATOR (NORMALIZED)      #
            #   ELSE WRITE -ALL-                                       #
  
            IF KEYFOUND      # IE., PRIMARY KEY IS ONE OF ITS ARGS     #
              THEN           #  THEN -NORMALIZE- IF NECESSARY          #
              BEGIN 
              IF ARGMTPOS LQ 0
                THEN      # AS BILL WOULD SAY,             #
                BEGIN     # SOMETHING IS ROTTEN IN DENMARK #
                RSTKERROR = TRUE; 
                RETURN; 
                END 
              IF ARGMTPOS EQ 2     # IF NON-KEY IS 1ST OPERAND         #
              THEN
                BEGIN 
                KEYINDEX = PSTACKPTR - 1;  # KEY IS 2ND OPERAND        #
                IF CURROP[2] LQ CODE"LEQL"  # IF LT, GT, GE, OR LE     #
                THEN
                  BEGIN 
                  CURRCODE[2] = CURRCODE[2] LXR O"01";  # CONVERT LT   #
                                                        # TO GT, ETC   #
                  END 
                END 
              ELSE                 # IF NON-KEY IS 2ND OPERAND         #
                BEGIN 
                KEYINDEX = PSTACKPTR - 2;  # KEY IS 1ST OPERAND        #
                END 
              OPNDINDEX = PSTACKPTR - ARGMTPOS;  # LOCATE NON-KEY ARG  #
              NUMCHARS[2] = NBRCHARS[OPNDINDEX];
                                                                        000260
              # CERTAIN CONDITIONS CAUSE A PASS THROUGH THE ENTIRE     #000270
              # FILE. THESE CONDITIONS ARE:                            #000280
              #   (1)  KEY NUMERIC AND COMPARED ITEM NOT FLOATING      #000290
              #        POINT AND NOT BEING CONVERTED TO F.P.           #000300
              #   (2)  SIGNED NUMERIC KEY                              #000310
              #   (3)  OPERATOR NOT *EQ*                               #000320
                                                                        000330
              IF KEYTYPE[KEYINDEX] EQ 1                                 000340
                AND (((CONVERTCODE[OPNDINDEX] NQ 18                     000350
                  AND CONVERTCODE[OPNDINDEX] NQ 12)                     000360
                  AND KEYTYPE[OPNDINDEX] NQ 4)                          000370
                  OR (OVERSIGN[KEYINDEX]                                000380
                      AND CURROP[2] NQ CODE"EQL"))                      000390
              THEN
                BEGIN 
                CURRCODE[2] = CODE"ALL";
                END 
              ELSE
                BEGIN 
                RFROMCHAR[2] = RELFROMCHAR[OPNDINDEX];  # REMEMBER BCP #
                OPND1[2] = TOWORDADDR[OPNDINDEX]; 
                END 
  
              PADHIGHORLOW = FALSE;  # ASSUME NO PADDING REQUIRED      #
              IF LITBITS[PSTACKPTR] NQ 0  # IF EITHER OPERAND IS LITERL#
                AND UNIVERSAL LS O"100"   # IF UNIVERSAL DEFINED       #
                AND CURRTYPE[2] EQ 1      # IF CHARACTER OR DIS NUMERIC#
              THEN
                BEGIN 
                WORDPTR = 0;       # START SEARCHING FIRST WORD        #
                BITPTR = 0;        # START SEARCHING FIRST CHARACTER   #
                P<OPERAND1> = TOWORDADDR[OPNDINDEX];  # POSITION TO LIT#
                IF NUMCHARS[2] GR NBRCHARS[KEYINDEX]  # IF LIT GT KEY  #
                THEN
                  BEGIN 
                  COMPARELEN = NBRCHARS[KEYINDEX];  # ONLY SEARCH LENGH#
                                                    # OF KEY           #
                  END 
                ELSE
                  BEGIN 
                  COMPARELEN = NUMCHARS[2];  # SEARCH ENTIRE LITERAL   #
                  END 
                FOR CHARPOS = 0 STEP 1
                  UNTIL COMPARELEN - 1
                DO
                  BEGIN 
                  IF B<BITPTR,6>I1[WORDPTR] EQ UNIVERSAL
                  THEN
                    BEGIN 
                    PADHIGHORLOW = TRUE;  # UNIV CHAR MUST BE REPLACED #
                    GOTO UNIVFOUND;  # EXIT LOOP, SAVING CHARPOS       #
  
                    END 
                  IF BITPTR EQ 54  # IF END OF WORD                    #
                  THEN
                    BEGIN 
                    BITPTR = 0;    # POSITION TO NEXT WORD             #
                    WORDPTR = WORDPTR + 1;
                    END 
                  ELSE
                    BEGIN 
                    BITPTR = BITPTR + 6;  # POSITION TO NEXT CHARACTER #
                    END 
                  END              # END OF CHARPOS LOOP               #
  
UNIVFOUND:  
                IF PADHIGHORLOW    # IF UNIVERSAL FOUND                #
                THEN
                  BEGIN 
                  UNIVORMAJKEY[2] = TRUE;  # TELL RGTABLE TO REPLACE   #
                                           # UNIVERSAL CHARACTER       #
                  PADCHARPOS[2] = CHARPOS;  # STARTING CHARACTER       #
                  IF CHARPOS EQ 0  # IF 1ST CHARACTER IS UNIVERSAL     #
                    OR (AT$FITFO EQ FODA  # IF DIRECT ACCESS           #
                      AND NOT ONEAKEY)  # ACCESSING BY PRIMARY KEY     #
                  THEN
                    BEGIN 
                    CURRCODE[2] = CODE"ALL";  # MUST SCAN ENTIRE FILE  #
                    END 
                  END 
                END                # END OF SEARCH FOR UNIVERSAL       #
  
              IF (PRMAJKEY[KEYINDEX]  # IF MAJOR PRIMARY KEY           #
                OR ALTMAJKEY[KEYINDEX])  # IF MAJOR ALTERNATE KEY      #
                AND NOT PADHIGHORLOW  # IF MAJOR HAS NO UNIVERSAL      #
                AND AREAORD[KEYINDEX] EQ LOWAREA  # KEY WITHIN LOW AREA# QU30296
              THEN
                BEGIN 
                PADHIGHORLOW = TRUE;
                UNIVORMAJKEY[2] = TRUE;  # TELL RGTABLE TO PAD MAJOR   #
                                         # NEXT CHARACTER AFTER LENGTH #
                                         # OF MAJOR KEY                #
                PADCHARPOS[2] = NBRCHARS[KEYINDEX]; 
                END 
              CURRLOC[2] = P<PROGRAMSTACK> + STKSIZE * KEYINDEX;
              IF PADHIGHORLOW      # IF UNIVERSAL OR MAJOR             #
                AND CURROP[2] EQ CODE"EQL"
                                   # IF *EQ*, EXPAND TO *LE* AND *GE*. #
                                   # RGTABLE WILL PAD *LE* HIGH AND    #
                                   # *GE* LOW.                         #
              THEN
                BEGIN 
              POINTKNT = POINTKNT + 2;  # TWO MORE KEY REFERENCES      #
                FIRSTWORD = 0;     # THREE ENTRIES                     #
                RWORD1[0] = RWORD1[2];  # COPY 1ST WORD TO 1ST ENTRY   #
                RWORD1[1] = RWORD1[2];  # COPY 1ST WORD TO 2ND ENTRY   #
                RWORD2[0] = RWORD2[2];  # COPY 2ND WORD TO 1ST ENTRY   #
                RWORD2[1] = RWORD2[2];  # COPY 2ND WORD TO 2ND ENTRY   #
                RWORD3[0] = RWORD3[2];  # COPY 3RD WORD TO 1ST ENTRY   #
                RWORD3[1] = RWORD3[2];  # COPY 3RD WORD TO 2ND ENTRY   #
                CURROP[0] = CODE"GEQL";  # *GE*                        #
                CURROP[1] = CODE"LEQL";  # *LE*                        #
                RSLT[0] = TEMPRSLTADDR;  # STORE RESULT IN TEMP CELL   #
                CURRCODE[2] = CODE"ANDLOG";  # BUILD *AND* TO JOIN     #
                                             # *GE* AND *LE*           #
                OPND0[2] = TEMPRSLTADDR;  # ADDRESS OF 1ST OPERAND     #
                OPND1[2] = RSLT[1];  # ADDRESS OF 2ND OPERAND          #
                RSLT[2] = RSLT[1];  # ADDRESS OF RESULT                #
                TEMPRSLTADDR = TEMPRSLTADDR + 1;
                                   # NO RANGE CHECK BECAUSE RANGE CHECK#
                                   # ON RSTKPTR BELOW WILL HANDLE THIS #
                END 
              ELSE
                BEGIN 
                POINTKNT = POINTKNT + 1;  # ONE MORE KEY REFERENCE     #
                END 
              END 
  
              ELSE CURRCODE[2] = CODE"ALL"; # WRITE -ALL- TO STK #
  
            END 
  
            ELSE           # OPERATOR IS LOGICAL OP                    #
            BEGIN 
            PSTACKPTR1 = PSTACKPTR + 1;  # LOOK-AHEAD FOR *NOT*        #
            IF ENTRYTYPE[PSTACKPTR1] EQ 7 
              AND OPCODE[PSTACKPTR1] EQ 29
            THEN                   # IF NEXT ENTRY IS *NOT*            #
              BEGIN 
              CURRCODE[2] = CODE"ALL";   # FORCE A FILEPASS            #
              END 
            IF CURRCODE[2] NQ CODE"ALL" 
              THEN
              BEGIN        # STORE PTRS TO OPERANDS                    #
              OPND0[2] = TOWORDADDR[PSTACKPTR-2]; 
              OPND1[2] = TOWORDADDR[PSTACKPTR-1]; 
              END 
            END 
          END              # END OF - SKIPFLAG=FALSE - BRANCH          #
        END 
      END 
  
        IF (RSTKPTR + 3 - FIRSTWORD) LQ 62
          THEN
          BEGIN 
          FOR WRITINDEX=FIRSTWORD STEP 1 UNTIL 2
            DO
            BEGIN 
            RSTKPTR = RSTKPTR + 1;
            RGSTACK1[RSTKPTR] = RWORD1[WRITINDEX];
            RGSTACK2[RSTKPTR] = RWORD2[WRITINDEX];
            RGSTACK3[RSTKPTR] = RWORD3[WRITINDEX];
            END 
          END 
  
          ELSE RSTKERROR = TRUE; # ERROR - STACK OVERFLOW # 
  
        KEYFOUND = FALSE;      # CLEAN UP BEFORE LEAVING               #
        ARGMTPOS = 3; 
        RETURN; 
        END 
      FUNC COMPARECHARS;
          BEGIN 
 #
 0        COMPARECHARS - COMPARES TWO CHARACTER STRINGS AND RETURNS 
                    RESULT. STRINGS ARE COMPARED CHAR BY CHAR UNTIL AN
                    INEQUALITY IS FOUND OR THE SHORTER STRING IS EXCEED-
                    ED. WHEN AN INEQUALITY IS FOUND THE COLLATING SE- 
                    QUENCE VALUES FOR THE CHARS ARE COMPARED AND THE
                    COMPARISON TERMINATES OR CONTINUES IF C.S. VALUES 
                    ARE EQUAL. IF THE STRINGS ARE EQUAL FOR THE LENGTH
                    OF THE SHORTER STRING, THEY ARE EQUAL IF THE LAST 
                    CHARACTER IN THE SHORTER STRING IS A UNIVERSAL
                    CHARACTER OR IF THE LONGER STRING CONTAINS ONLY 
                    BLANKS OR UNIVERSAL CHARACTERS IN THE EXCESS
                    CHARACTERS. OTHERWISE, THE LONGER STRING IS THE 
                    GREATER. RETURNED RESULT IS >0 IF OP1>OP2, <0 IF
                    OP1<OP2, OR =0 IF OP1=OP2.
 #
          W1 = 0;                      # INITIALIZE WORD PTRS FOR BOTH #
          W2 = 0;                      # OPERANDS.                     #
          BP1 = RELTOCHAR[PSTACKPTR-J] * 6; #INITIALIZE BIT POSIT. PTRS#
          BP2 = RELTOCHAR[PSTACKPTR-I] * 6; #TO 1ST CHAR IN EACH OPERAN#
          L1 = NBRCHARS[PSTACKPTR-J]; #GET LENGTHS OF OPERANDS# 
          L2 = NBRCHARS[PSTACKPTR-I]; 
          IF L1 LS L2 THEN             # SHORTER STRING DETERMINES NBR #
            K = L1;                    # OF CHARACTER PAIR COMPARISONS.#
          ELSE K = L2;
          FOR I=1 STEP 1 UNTIL K DO    # COMPARE CHARACTER PAIRS, FROM #
          BEGIN                        # LEFT, UNTIL INEQUALITY.       #
          C[1] = B<BP1,6>I1[W1];
          C[2] = B<BP2,6>I2[W2];
#  IF THERE IS NO UNIVERSAL CHARACTER PRESENT, USE THE EXISTING  #
#  COLLATING SEQUENCE TO DETERMINE THE RELATIONSHIP.             #
          IF NOCHECK OR NOMATCH THEN
            BEGIN 
            WORDPOS = B<54,3>C[1];  # USE COLLATING SEQUENCE TO GET THE#
            CHARPOS = B<57,3>C[1];  # SORT POSITION OF THIS CHARACTER. #
            C[1] = B<CHARPOS*6,6>COLWORD[WORDPOS];
            WORDPOS = B<54,3>C[2];
            CHARPOS = B<57,3>C[2];
            C[2] = B<CHARPOS*6,6>COLWORD[WORDPOS];
            IF C[1] NQ C[2] THEN
              BEGIN 
              COMPARECHARS = C[1] - C[2]; 
              RETURN; 
              END 
            END 
            ELSE
            BEGIN 
            IF I EQ K THEN
              BEGIN 
              IF L1 EQ L2                # IF OPERAND LENGTHS ARE EQUAL#
                OR (L1 LS L2             # OR OP 1 IS SHORTER THAN OP 2#
                  AND C[1] EQ UNIVERSAL) # AND THE LAST CHARACTER IN   #
                                         # OP 1 IS A UNIVERSAL CHAR.   #
                OR (L2 LS L1             # OR OP 2 IS SHORTER THAN OP 1#
                  AND C[2] EQ UNIVERSAL) # AND THE LAST CHARACTER IN   #
                                         # OP 2 IS A UNIVERSAL CHAR.   #
              THEN                       # THEN                        #
                BEGIN 
                COMPARECHARS = 0;        # EQUALITY IS ASSUMED         #
                RETURN; 
                END 
              END 
            IF RTBLCALL EQ 1 THEN    # IF THIS IS A CALL FROM    #
              BEGIN                  # -NEXTGET-, STOP COMPARING #
              COMPARECHARS = 0;      # WHEN THE FIRST UNIVERSAL  #
              RETURN;                # CHARACTER IS FOUND.       #
              END 
            END 
          IF BP1 EQ 54 THEN 
            BEGIN 
            BP1 = 0;
            W1 = W1 + 1;
            END 
          ELSE BP1 = BP1+6; 
          IF BP2 EQ 54 THEN 
            BEGIN 
            BP2 = 0;
            W2 = W2 + 1;
            END 
          ELSE BP2 = BP2 +6;
       END
           IF L1 EQ L2 THEN 
            BEGIN 
            COMPARECHARS = 0; 
            RETURN; 
            END 
          COLBLANK = C<5,1>COLWORD[5];                                   QU3A346
          IF L2 GR L1 THEN             # IF THE LENGTHS ARE NOT EQUAL, #
            GOTO L2SEARCH;             # SEARCH THE LONGER FOR NON-BLNK#
          FOR I=I STEP 1 UNTIL L1 DO
          BEGIN 
            C[1] = B<BP1,6>I1[W1];                                       QU3A346
            WORDPOS = B<54,3>C[1];                                       QU3A346
            CHARPOS = B<57,3>C[1];                                       QU3A346
            C[1] = B<CHARPOS*6,6>COLWORD[WORDPOS];                       QU3A346
            IF C[1] NQ COLBLANK AND                                      QU3A346
               B<BP1,6>I1[W1] NQ UNIVERSAL THEN 
            BEGIN                      # IF NON-BLANK CHAR IS FOUND THE#
              COMPARECHARS = 1;        # 1ST OPERAND IS THE GREATER.   #
              RETURN; 
            END 
            IF BP1 EQ 54 THEN 
            BEGIN 
              BP1 = 0;
              W1 = W1 + 1;
            END 
            ELSE BP1 = BP1 + 6; 
          END 
          COMPARECHARS = 0;            # STRINGS ARE EQUAL.            #
          RETURN; 
      L2SEARCH: 
          FOR I=I STEP 1 UNTIL L2 DO
          BEGIN 
            C[2] = B<BP2,6>I2[W2];                                       QU3A346
            WORDPOS = B<54,3>C[2];                                       QU3A346
            CHARPOS = B<57,3>C[2];                                       QU3A346
            C[2] = B<CHARPOS*6,6>COLWORD[WORDPOS];                       QU3A346
            IF C[2] NQ COLBLANK AND                                      QU3A346
               B<BP2,6>I2[W2] NQ UNIVERSAL THEN 
            BEGIN                      # IF NON-BLANK CHAR IS FOUND THE#
              COMPARECHARS = -1;       # 2ND OPERAND IS THE GREATER.   #
              RETURN; 
            END 
            IF BP2 EQ 54 THEN 
            BEGIN 
              BP2 = 0;
              W2 = W2 + 1;
            END 
            ELSE BP2 = BP2 + 6; 
          END 
          COMPARECHARS = 0;            # STRINGS ARE EQUAL.            #
          RETURN; 
          END 
          XREF PROC UPBUN;
          PROC ALLANY;
          BEGIN CURSUB = 1; 
          UPBUN(INDTBL,UB,FROMWORDBASE[PSTACKPTR],J);                   001000
          P<BASE1> = P<BASE>; 
          SVALLPSTPTR = PSTACKPTR; # SAVE PSTACKPTR OF ALL/ANY ITEM    #
          P<INDTBL> = P<INDTBL> + I;  # SAVE ALL/ANY P<INDTBL>         #
          ALLUB = UB;              # SAVE ALL/ANY UB                   #
          ALLINDTBL = P<INDTBL>;   # SAVE ALL/ANY P<INDTBL>            #
          IF J NQ 0 THEN           # IF ERROR DETECTED                 #
            BEGIN 
            DIAG(J);               # ISSUE ERROR MESSAGE               #
            ERRORSET; 
            GOTO RETURNEXP;        # JUMP INTO OUTER PROC EXPEV20      #
            END 
          INDCE[0] = 1; CONSUB[0] = TRUE; 
          RETURN; 
          END 
CONTROL EJECT;
 #
          EXPEV20 - EVALUATES EXPRESSIONS BY INTERPRETING THE CONTENTS
                    OF A PROGRAM STACK GIVEN AS A PARAMETER. THE ENTRY- 
                    TYPE FIELD OF EACH ENTRY IN THE PROGRAM STACK IS
                    USED TO ENTER A SWITCH VECTOR AND PERFORM THE TASKS 
                    NECESSARY FOR THAT STACK ENTRY - CONVERSION, EVALU- 
                    ATION OF A SUBSCRIPTED ITEM, ARITHMETIC OPERATION,
                    ETC. THE FINAL STACK ENTRY WILL INDICATE WHAT IS TO 
                    BE DONE WITH THE EXPRESSION RESULTS.
 #
          P<PROGRAMSTACK> = PROGSTACKLOC;# SET BASE TO CURRENT PROGRAM #
                                       # STACK ADDRESS.                #
          IF BLDRANGETBL
            THEN
            BEGIN 
            TEMPRSLTADDR = LOC(RGSTACK) + 189;  # 189 = 63 ENT * 3 WRDS#
            KEYFOUND = FALSE; 
            RSTKERROR = FALSE;
            SKIPTEMP = TRUE;       # ASSUME ALL TEMPORARY OPERANDS     #
            SKIPFLAG = FALSE; 
            SKIPNOT = FALSE;
            ARGMTPOS = 3; 
            END 
          FGALL = FALSE;
          FGANY = FALSE;
          PREVIOUS = -1;               # SET FOR MAIN EXPRESSION.      #
       EVALEXPRESS: 
      FOR PSTACKPTR=0 STEP 1 DO                    # INTERPRET EACH    #
          BEGIN                        # ENTRY IN THE PROGRAM STACK.   #
          IF BLDRANGETBL
            THEN             # THIS IS A RANGE-TABLE BUILDING PASS #
            BEGIN            # BEGIN RANGE-BUILDING-PASS CODE # 
  
            IF RSTKERROR
              THEN
              BEGIN 
              BLDRANGETBL = FALSE;
              RETURN; 
              END 
            IF SKIPNOT       # IF THIS ENTRY IS FOR A -NOT- WHICH HAS # 
              THEN           # ALREADY BEEN PROCESSED BY THE LOOK-    # 
              BEGIN          # AHEAD FEATURE OF PROC RSTACKR,         # 
              SKIPNOT=FALSE; #  THEN SKIP OVER IT.                    # 
              TEST PSTACKPTR; 
              END 
  
            IF KEYFOUND      # BOOKKEEPING. SEE RSTACKR FOR USAGE     # 
              THEN ARGMTPOS = ARGMTPOS - 1; 
  
 #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
 #                                                                     #
 #  IDENTIFY ENTRYTYPE OF CURRENT ENTRY IN EXPRESSION STACK.           #
 #                                                                     #
 #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
  
            IF ENTRYTYPE[PSTACKPTR] EQ 7
              THEN           # THE ENTRY IS FOR AN OPERATOR           # 
  
              BEGIN 
              IF OPCODE[PSTACKPTR] GQ O"100"
                THEN           # UNDIGESTIBLE OP FOR RANGE-BUILDING.  # 
                BEGIN          # LOP OFF THE AFFECTED BRANCH AT A     # 
                SKIPFLAG=TRUE; # RELATIONAL OR BOOLEAN NODE.          # 
                TEST PSTACKPTR; 
                END 
  
 #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
 #                                                                     #
 # ONLY ARITHOPS,LOGOPS,RELOPS,OR ENDOFOPS OPERATORS REACH THIS POINT  #
 #  IN THE RANGE-BUILDING CODE.                                        #
 #                                                                     #
 # PROCESSING PROCEEDS AS FOLLOWS --                                   #
 #  1. THE EXPRESSION STACK OPCODE IS TRANSLATED TO A CODE MEANINGFUL  #
 #     TO PROC RSTACKR.                                                #
 #  2. RELOPS AND LOGOPS ARE NOT EXECUTED BY EXPEVAL. INSTEAD, THEY    #
 #     INITIATE A CALL TO -RSTACKR- TO WRITE AN ENTRY TO RSTACK.       #
 #  3. ARITHMETIC OPERATORS ARE --                                     #
 #     A. SKIPPED, WITHOUT EXECUTION, IF SKIPFLAG = TRUE               #
 #     B. SKIPPED, WITHOUT EXECUTION, AND SET SKIPFLAG = TRUE          #
 #        IF ONE OF THEIR OPERANDS IS THE PRIMARY KEY                  #
 #     C. EXECUTED, IF NEITHER (A) NOR (B) APPLY                       #
 #                                                                     #
 #XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX#
  
              RWORD1[2] = 0;
              RWORD2[2] = O"00000000000000777776";
              RWORD3[2] = 0;
              CURRCODEC[2]= 
                 C<DIGIT2[PSTACKPTR],1>TRANSLTR[DIGIT1[PSTACKPTR]]; 
              IF CURRCODE[2] LQ O"66" AND NOT SKIPTEMP THEN RSTACKR;
              SKIPTEMP = TRUE;     # ASSUME ALL TEMPORARY OPERANDS     #
              IF KEYFOUND 
                THEN
                BEGIN 
                KEYFOUND=FALSE; 
                SKIPFLAG=TRUE;
                END 
              IF OPCODE[PSTACKPTR] NQ O"70" AND  #END OF STACK #
                 (SKIPFLAG OR CURRCODE[2] LQ O"66") 
                THEN TEST PSTACKPTR;
              END 
  
              ELSE
              BEGIN 
              IF SKIPFLAG          # IF NOT LOOKING AT OPERANDS        #
              THEN
                BEGIN 
                SKIPTEMP = FALSE;  # ASSUME NOT ALL TEMPORARY OPERANDS #
                                   # SO RSTACKR WILL BE CALLED         #
                TEST PSTACKPTR; 
                END 
  
              IF ENTRYTYPE[PSTACKPTR] NQ 3
                THEN
                IF WORDBASES[PSTACKPTR] NQ 0
                THEN
  
#     DETERMINE IF THE ENTRY IS A KEY WHICH WE CAN USE FOR             #
#     RETRIEVAL PURPOSES.  THE FOLLOWING CONDITIONS MUST BE MET.       #
#     1.  KEY IS WITHIN THE LOW AREA OF THE RELATION.                  #
#     2.  ENTRYTYPE MUST BE LQ 2 ( ABS OR REL MOVE, OR ABS CONVERT )   #
#     3.  CONVERTCODE MUST BE 0 ( NO CONVERT )                         #
#                          OR 14 ( NUM TO SINGLE )                     #
#                          OR 22 ( INT TO SINGLE )                     #
#                          OR 30 ( FIXED TO SINGLE )                   #
#     THE KEY TYPE IS THEN EXAMINED AND ONE OF THE FOLLOWING           #
#     CONDITIONS MUST BE MET.                                          #
#     1.  PRIMARY KEY                                                  #
#     2.  PRIMARY MAJOR KEY AND IT WAS STATED FIRST IN THE EXPRESSION  #
#     3.  ALTERNATE KEY OR MAJOR ALTERNATE KEY AND IT WAS STATED       #
#           FIRST IN THE EXPRESSION OR WAS DESIGNATED FOR RETRIEVAL    #
  
                BEGIN 
                SKIPTEMP = FALSE;  # NON TEMPORARY OPERAND             #
                P<AREA$TABLE> = AREASAVE[AREAORD[PSTACKPTR]]; 
  
                IF ENTRYTYPE[PSTACKPTR] LQ 2
                  AND ( CONVERTCODE[PSTACKPTR] EQ 0 
                        OR CONVERTCODE[PSTACKPTR] EQ O"14"
                        OR CONVERTCODE[PSTACKPTR] EQ O"22"
                        OR CONVERTCODE[PSTACKPTR] EQ O"30" )
                THEN
                  BEGIN 
                  IF PRKEYENTRY[PSTACKPTR]
                    OR ( PRMAJKEY[PSTACKPTR]
                         AND PKEY ) 
                    OR ( ( ALKEYENTRY[PSTACKPTR]
                           OR ALTMAJKEY[PSTACKPTR] )
                         AND ONEAKEY )
                  THEN
                    BEGIN 
                    IF AREAORD[PSTACKPTR] EQ LOWAREA
                    THEN
                      BEGIN 
                      IF (RECDORD NQ 0  # IF SAME RECORD ORDINAL       #
                        AND RECDORD EQ RECDORDINAL[PSTACKPTR])
                        OR RECDORD EQ 0  # IF NOT INITIALIZED YET      #
                      THEN
                        BEGIN 
                        RECDORD = RECDORDINAL[PSTACKPTR]; 
                        KEYFOUND = TRUE;
                        P<COLSEQ> = P<AREA$TABLE> + AT$COLSEQ[0]; 
                        END 
                      ELSE           # DIFFERENT RECORD ORDINALS       #
                        BEGIN 
                        DIAG(378);   # KEYS FROM > 1 RECORD NAME       #
                        SKIPFLAG = TRUE;
                        END 
                      END 
                    ELSE
                      BEGIN 
                      TEST PSTACKPTR; 
                      END 
                    END 
                  ELSE
                    BEGIN 
                    SKIPFLAG = TRUE;
                    END 
                  TEST PSTACKPTR; 
                  END 
                END 
  
                ELSE
                BEGIN 
                IF FROMWORDADDR[PSTACKPTR] NQ TOWORDADDR[PSTACKPTR] 
                  OR NBRCHARS[PSTACKPTR] EQ 0 
                THEN
                  BEGIN 
                  SKIPTEMP = FALSE;  # NON-TEMPORARY OPERAND           #
                  END 
                END 
              END 
            END 
          IF (FGALL OR FGANY) AND ENTRYTYPE[PSTACKPTR-1] EQ 7 THEN
          BEGIN 
          P<INDTBL> = ALLINDTBL;
          IF (FGALL AND NOT BR[0])
            OR (FGANY AND BR[0])
            OR CURSUB EQ ALLUB
          THEN
                 BEGIN CONSUB[0] = FALSE; 
                       INDCE[0] = 0;
                       IF FGALL THEN BEGIN FGALL=FALSE; ALLFG[0]=TRUE;
                            END 
          ELSE
      BEGIN  FGANY = FALSE; 
             ANYFG[0] = TRUE; 
      END 
                END 
                ELSE
                BEGIN 
                CURSUB = CURSUB + 1;
                INDCE[0] = CURSUB;
                IF CONVERTCODE[SVALLPSTPTR] EQ O"20"
                THEN
                                   # IF CONVERTING FROM INTEGER TO     #
                                   # INTEGER, FIGSUB AND CONVERT NEED  #
                                   # ATTRIBUTE TABLE, BUT EXPEVAL NEEDS#
                                   # ADDRESS, HENCE THE SWITCH         #
                  BEGIN 
                  AWPOS[0] = TOWORDADDR[SVALLPSTPTR]; 
                  TOWORDADDR[SVALLPSTPTR] = LOC(ATTR) - 1;
                  END 
                FIGSUB(BASE1, I); 
                IF CONVERTCODE[SVALLPSTPTR] EQ O"20"
                THEN
                  BEGIN 
                  TOWORDADDR[SVALLPSTPTR] = AWPOS[0]; 
                  END 
                PSTACKPTR = PSTACKPTR - 1;
                END 
          END 
          GOTO STKENTRYTYPE[ENTRYTYPE[PSTACKPTR]];
      ABSMOVE:                         # NO NEED TO MOVE, ENTRY MERELY #
      RELMOVE:                         # DOCUMENTS DATA LOCATION.      #
          TEST PSTACKPTR; 
      ABSCONVERT: 
      RELCONVERT: 
            P<BASE> = LOC(PSTKWORD[PSTACKPTR]);                         017500
           CONVERT(BASE,I);                                             017510
          IF I NQ 0 THEN               # IF ERROR IN CONVERSION, THEN  #
          BEGIN                        # QUIT.                         #
            DIAG(I);
            ERRORSET; 
            RETURN; 
          END 
          TEST PSTACKPTR; 
      ABSUNDETSUBS: 
      RELUNDETSUBS: 
          P<BASE> = LOC(PSTKWORD[PSTACKPTR]); 
          P<INDTBL> = EXPRESSTACK[PSTACKPTR]; 
          UB = TBLGS[0] - 1;
          FOR I = 0 STEP 1 UNTIL UB DO
          BEGIN IF DEPNDFG[I] THEN UB=UB-1; 
                IF ALLFG[I] 
  
                  THEN
                  BEGIN 
                  IF BLDRANGETBL
                    THEN
                    BEGIN 
                    SKIPFLAG = TRUE;
                    TEST PSTACKPTR; 
                    END 
                  FGALL = TRUE; 
                  ALLANY; 
                  ALLFG[I] = FALSE; 
                  GOTO NOCHK; 
                  END 
  
                  ELSE
                  IF ANYFG[I] 
                    THEN
                    BEGIN 
                    IF BLDRANGETBL
                      THEN
                      BEGIN 
                      SKIPFLAG = TRUE;
                      TEST PSTACKPTR; 
                      END 
                    FGANY = TRUE; 
                    ANYFG[I] = FALSE; 
                    ALLANY; 
                    GOTO NOCHK; 
                    END 
          END 
        NOCHK: # #
          IF CONVERTCODE[PSTACKPTR] EQ O"20"
          THEN
                                   # IF CONVERTING FROM INTEGER TO     #
                                   # INTEGER, FIGSUB AND CONVERT NEED  #
                                   # ATTRIBUTE TABLE, BUT EXPEVAL NEEDS#
                                   # ADDRESS, HENCE THE SWITCH         #
            BEGIN 
            AWPOS[0] = TOWORDADDR[PSTACKPTR]; 
            TOWORDADDR[PSTACKPTR] = LOC(ATTR) - 1;
            END 
          FIGSUB(BASE,I); 
          IF CONVERTCODE[PSTACKPTR] EQ O"20"
          THEN
            BEGIN 
            TOWORDADDR[PSTACKPTR] = AWPOS[0]; 
            END 
          IF I NQ 0 THEN           # IF ERROR DETECTED                 #
            BEGIN 
            DIAG(I);               # ISSUE ERROR MSG                   #
            ERRORSET; 
            RETURN; 
            END 
          TEST PSTACKPTR;   #****** TEMPORARY *************************#
      EXPRESS:  
          PREVIOUS = PREVIOUS + 1;
          STACKADDR[PREVIOUS] = P<PROGRAMSTACK>;# SAVE PTRS.           #
          PSTKPTR[PREVIOUS] = PSTACKPTR;
          P<PROGRAMSTACK> = EXPRESSTACK[PSTACKPTR];                     002070
          GOTO EVALEXPRESS; 
      OPERATOR: 
          K = OPCODE[PSTACKPTR];
          IF K LS O"70" OR K GR O"76" THEN
            #MORE THAN 1 PARAMETER IS EXPECTED#                         007370
          BEGIN 
          P<BASE> = TOWORDBASE[PSTACKPTR-2];# FIND BASE OF REFERENCE   #
          IF P<BASE> EQ 0 THEN         # FOR OPERANDS: EITHER RA+0 OR  #
            I = 0;                     # A BASED ARRAY WHICH POINTS TO #
          ELSE I = BASEOPND[0];        # A WORKING STORAGE AREA.       #
          P<OPERAND1> = TOWORDADDR[PSTACKPTR-2] + I;#INITIALIZE PTRS TO#
          END 
          P<BASE> = TOWORDBASE[PSTACKPTR-1];
          IF P<BASE> EQ 0 THEN
            J = 0;
          ELSE J = BASEOPND[0]; 
          P<OPERAND2> = TOWORDADDR[PSTACKPTR-1] + J;#OPNDS AND RESULT. #
          P<RESULT> = TOWORDADDR[PSTACKPTR];
          IF K LS O"100"
          THEN                     # SELECT PROPER CHECKING ROUTINE    #
            BEGIN 
            I = B<53,4>K;          # UPPER 4 BITS OF OPERATION         #
            J = B<57,3>K;          # LOWER 3 BITS OF OPERATION         #
            I = C<J,1>TZCODE[I];   # SWITCH VALUE                      #
            GOTO CKINTYPE[I];      # ENTER ROUTINE                     #
  
            END 
          ELSE
            BEGIN 
            GOTO GOTOOP;           # NO CHECKING NECESSARY             #
  
            END 
CKIN1:             # TWO SP OPERANDS, SP RESULT                        #
          CKININF(R1[0], R2[0], I);  # CHECK IF OPERANDS ILLEGAL       #
          IF I NQ 0                # IF ERROR                          #
          THEN
            BEGIN 
            RR[0] = 0.0;           # SET RESULT                        #
            TEST PSTACKPTR;        # SKIP ACTUAL OPERATION             #
  
            END 
          GOTO GOTOOP;             # GO PERFORM OPERATION              #
  
CKIN2:             # TWO SP OPERANDS, BOOLEAN RESULT                   #
          CKININF(R1[0], R2[0], I);  # CHECK IF OPERANDS ILLEGAL       #
          IF I NQ 0                # IF ERROR                          #
          THEN
            BEGIN 
            BR[0] = FALSE;         # SET BOOLEAN RESULT                #
            TEST PSTACKPTR;        # SKIP ACTUAL OPERATION             #
  
            END 
          GOTO GOTOOP;             # GO PERFORM OPERATION              #
  
CKIN3:             # TWO SP AND DP OPERANDS, SP AND DP RESULTS         #
          CKININF(R1[0], R2[0], I);  # CHECK IF UPPER PARTS ILLEGAL    #
          IF I EQ 0                # IF UPPER PARTS OK                 #
          THEN
            BEGIN 
            CKININF(D1[0], D2[0], I);  # CHECK IF LOWER PARTS ILLEGAL  #
            END 
          IF I NQ 0                # IF ANY OF 4 VALUES ILLEGAL        #
          THEN
            BEGIN 
            RR[0] = 0.0;           # SET SP AND DP RESULTS             #
            DR[0] = 0.0;
            TEST PSTACKPTR;        # SKIP ACTUAL OPERATION             #
  
            END 
          GOTO GOTOOP;             # GO PERFORM OPERATION              #
  
CKIN4:             # TWO SP AND DP OPERANDS, BOOLEAN RESULT            #
          CKININF(R1[0], R2[0], I);  # CHECK IF UPPER PARTS ILLEGAL    #
          IF I EQ 0                # IF UPPER PARTS OK                 #
          THEN
            BEGIN 
            CKININF(D1[0], D2[0], I);  # CHECK IF LOWER PARTS ILLEGAL  #
            END 
          IF I NQ 0                # IF ANY OF 4 VALUES ILLEGAL        #
          THEN
            BEGIN 
            BR[0] = FALSE;         # SET BOOLEAN RESULT                #
            TEST PSTACKPTR;        # SKIP ACTUAL OPERATION             #
  
            END 
          GOTO GOTOOP;             # GO PERFORM OPERATION              #
  
CKIN5:             # ONE SP OPERAND, SP RESULT                         #
          CKININF(0, R2[0], I);    # CHECK IF OPERAND ILLEGAL          #
          IF I NQ 0                # IF ERROR                          #
          THEN
            BEGIN 
            RR[0] = 0.0;           # SET RESULT                        #
            TEST PSTACKPTR;        # SKIP ACTUAL OPERATION             #
  
            END 
GOTOOP: 
          I = 1; J = 2; 
          IF OPCODE[PSTACKPTR] LS O"100" THEN 
          GOTO OPERATION[OPCODE[PSTACKPTR]];# SWITCH TO OPCODE ROUTINE.#
          TEST PSTACKPTR;    #TEMPORARY FOR CUMMULATIVE FUNCTIONS      #
      ABSOLCOMP: #71# 
                  #ABSOLUTE FOR COMPUTATIONAL#                          007460
          I = NBRCHARS[PSTACKPTR-1];
                    #NB OF CHARS#                                       007480
          J = I / 10; 
                    #NB OF WORDS#                                       007500
          CMOVE(OPERAND2,RELFROMCHAR[PSTACKPTR-1],I,RESULT,0);
                 #MOVE PARAMETER TO RESULT LOCATION FIRST#              007520
          I = I - J * 10; 
          K = C<I,1>UR[J];
             #THEN PICK UP LAST CHAR#                                   007540
          IF K EQ O"66" THEN K = O"72"; 
            #IF -0 THEN CHANGE TO +0#                                   007560
          ELSE
          IF K GR O"11" AND K LS O"23" THEN K = K - O"11";
              #IF NEGATIVE,CHANGE TO POSITIVE#                          007580
          C<I,1>UR[J] = K;
          TEST PSTACKPTR; 
      ABSOLINT: #72#
               #ABSOLUTE FOR INTEGER NUMBER#                            007600
          IF I2[0] LS 0 THEN IR[0] = - I2[0]; 
                        ELSE IR[0] = I2[0]; 
          TEST PSTACKPTR; 
      ABSOLUNOR: #73# 
      ABSOLREL:  #74# 
               #ABSOLUTE FOR FLOATING POINT#                            007620
         IF I2[0] LS 0 THEN IR[0]=-I2[0];                               017640
         ELSE IR[0]= I2[0];                                             017650
          TEST PSTACKPTR; 
      JULIAN: #75#
          J = 0;
                #RESET NB OF DIGITS TO 0#                               007660
         IF CONVERTCODE[PSTACKPTR-1] EQ 1 THEN BEGIN                    017310
               #PARAMETER IS IN CHAR MODE#                              007640
          FOR I = 0 STEP 1 UNTIL 9 DO 
          BEGIN 
              K = C<I,1>U2[0] - O"33";
                #PICK UP ONE CHAR#                                      007680
              IF K GQ 0 AND K LS 10 THEN
              BEGIN 
                  MDY[J] = K; 
                #IF BETWEEN 0 TO 9, STORE THAT DIGIT#                   007700
                  IF J EQ 5 THEN GOTO GET6DIGIT;
              #ENOUGH DIGIT HAVE BEEN FOUND, GO PROCESS THE JULIAN      007720
               DATE, ELSE INCREMENT NB OF DIGITS FOUND#                 007730
                  J = J + 1;
              END 
          END 
      IF J EQ 5 AND IPYMD LS O"400000" THEN 
             #IF ONLY 5 DIGIT IS FOUND, FIRST DIGIT IS A SUPPRESSED 0#  007750
      BEGIN FOR J = 5 STEP -1 UNTIL 1 DO MDY[J] = MDY[J-1]; 
             #SHIFT ALL THE DIGITS TO MAKE ROOM FOR THE SUPPRESSED 0#   007770
            MDY[0] = 0; 
            GOTO GET6DIGIT; 
      END 
          DIAG(906);                                                    000430
          ERRORSET; 
             #NOT ENOUGH DIGITS HAD BEEN FOUND,ERROR IN FUNCTION PARAM# 007790
          RETURN; 
          END                                                           017330
         ELSE                                                           017340
         BEGIN I = U2[0];                                               017350
             #PARAMETER IS IN INTEGER FORM,SO GET ALL THE 6 DIGITS      007810
               NEEDED BY CONVERTING OCTAL TO DECIMAL#                   007820
               FOR J = 5 STEP -1 UNTIL 0 DO                             017360
               BEGIN K = I / 10;                                        017370
                     MDY[J] = I - K*10;                                 017380
                     I = K;                                             017390
               END                                                      017400
         END                                                            017410
      GET6DIGIT:  
                #ALL 6 DIGITS HAD BEEN LOCATED#                         007840
      K = 0;
      P<YYDDMM>= LOC(J1); 
      FOR J = 42 STEP 3 UNTIL 59 DO 
                #SHIFTING THE 6 DIGITS AROUND(ACCORDING TO              007860
                 THE DEFAULT ORDER OF MONTH,DAY,AND YEAR TO             007870
                 PUT IT IN A ORDER OF MMDDYY)#                          007880
      BEGIN II = B<J,3>IPYMD; 
            YDM[II] = MDY[K]; 
            K = K + 1;
      END 
                #USING THE DIGITS TO CALCULATE THE JULIAN DATE#         007900
          IF J5 LS 7                   # ADJUST FOR YEAR 2000 # 
          THEN
            BEGIN 
            J5 = J5 + 10; 
            END 
          J1 = J1 * 10 + J2;
          J2 = J3 * 10 + J4 - 32075;
          J3 = (J1 - 14) / 12;
          J4 = J5 * 10 + J6 + 6700 + J3;
          J5 = J1 - 2 - J3 * 12;
          J6 = (J4 + 100) / 100;
          J1 = (1461 * J4) / 4; 
          J3 = (367 * J5) / 12; 
          J4 = (3 * J6) / 4;
          IR[0] = J1 + J2 + J3 - J4;
          TEST PSTACKPTR; 
      GREG: 
             #FOR GREG,USE THE PARAMETER TO CALCULATE THE 6             007920
              DIGITS REPRESENTING THE MMDDYY#                           007930
          J4 = I2[0] + 68569; 
          J5 = (4 * J4) / 146097; 
          J4 = J4 - (146097 * J5 + 3) / 4;
          J3 = (4000 * (J4 + 1)) / 1461001; 
          J4 = J4 - (1461 * J3) / 4 + 31; 
          J1 = (80 * J4) / 2447;
          J2 = J4 - (2447 * J1) / 80; 
          J4 = J1 / 11; 
          J1 = J1 + 2 - 12 * J4;
          J3 = J3 + J4; 
          J5 = J3 / 10; 
          J6 = J3 - J5 * 10;
          J3 = J2 / 10; 
          J4 = J2 - J3 * 10;
          I = J1 / 10;
          J2 = J1 - I * 10; 
          J1 = I; 
          J = 0;
          IF J5 GQ 10                  # ADJUST FOR YEAR 2000 # 
          THEN
            BEGIN 
            J5 = J5 - 10; 
            END 
      P<YYDDMM> = LOC(J1);
      FOR K = 42 STEP 3 UNTIL 59 DO 
      BEGIN II = B<K,3>IPYMD; 
            MDY[J] = YDM[II]; 
             #SHIFTING THE DIGITS TO MAJKE IT IN THE ORDER AS           007950
              THE DEFAULT ORDER OF MONTH DAY AND YEAR#                  007960
            J = J + 1;
      END 
      J = 0;
          UR[0] = "          "; 
             #BLANK OUT RESULT FIRST#                                   007980
          FOR I = 1 STEP 3 UNTIL 8 DO 
          BEGIN 
             #CONVERTING THE DIGITS INTO DISPLAY CODE, AND PUT          008000
              IN RESULT#                                                008010
              C<I,1>UR[0] = MDY[J] + O"33"; 
              C<I+1,1>UR[0] = MDY[J+1] + O"33"; 
              J = J + 2;
          END 
          TEST PSTACKPTR; 
      MASK: #77#
          P<BASE> = TOWORDBASE[PSTACKPTR-3];
          IF P<BASE> EQ 0 THEN J = 0; 
          ELSE J = BASEOPND[0]; 
           JJ = NBRCHARS[PSTACKPTR-1];
           J1 = TOWORDADDR[PSTACKPTR-3]+J;
          II = P<OPERAND1>; 
        REPEA: # #
          I = U1[0] LAN  (LNO U2[0]); 
               #U1----BACKGROUND FIELD,U2----MASK#                      008030
           P<OPERAND1> = J1;
          J = U1[0] LAN  U2[0]; 
               #U1----MASKED FIELD, U2----MASK#                         008050
          UR[0] = I LOR J;
          IF JJ LS 11 THEN
               #FINAL MASK#                                             008070
          TEST PSTACKPTR; 
          J1 = J1 + 1;
          II = II + 1;
          JJ = JJ - 10; 
          P<OPERAND1> = II; 
          P<OPERAND2> = P<OPERAND2> + 1;
          P<RESULT> = P<RESULT> + 1;
          GOTO REPEA; 
      ENDOFOPS: 
          IF PREVIOUS LS 0 THEN 
          BEGIN 
            IF LOGICALRESLT THEN
              LOGICALRESLT = BR[0]; 
            IF BLDRANGETBL AND RSTKPTR LS 0 THEN
              RSTKERROR = TRUE;    # NO STACK EXISTS #
            RETURN;                    # MAIN EXPRESSION COMPLETE.     #
          END 
          P<PROGRAMSTACK> = STACKADDR[PREVIOUS];
          PSTACKPTR = PSTKPTR[PREVIOUS];# RESET PTRS.                  #
          PREVIOUS = PREVIOUS - 1;
          TEST PSTACKPTR; 
      ADDINT: 
          IR[0] = I1[0] + I2[0];       # ADD TWO INTEGER VALUES.       #
          TEST PSTACKPTR; 
      SUBTRACTINT:  
          IR[0] = I1[0] - I2[0];       # SUBTRACT INT2 FROM INT1.      #
          TEST PSTACKPTR; 
      MULTIPLYINT:  
          IR[0] = I1[0] * I2[0];       # MULTIPLY TWO INTEGERS.        #
          TEST PSTACKPTR; 
      DIVIDEINT:  
          IF I2[0] EQ 0 THEN       # IF DIVISOR EQ 0                   #
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            ERRORSET; 
            IR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          IR[0] = I1[0] / I2[0];       # DIVIDE INT1 BY INT2.          #
          TEST PSTACKPTR; 
      NEGATEINT:  
          IR[0] = -I2[0];              # UNARY MINUS OPERATION.        #
          TEST PSTACKPTR; 
      EXPONENTINT:  
          IR[0] = ITOJ(I1[0],I2[0]);
          TEST PSTACKPTR; 
      EQINT:  
          IF I1[0] EQ I2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      NEINT:  
          IF I1[0] NQ I2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LTINT:  
          IF I1[0] LS I2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      GTINT:  
          IF I1[0] GR I2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LEINT:  
          IF RTBLCALL NQ 0
            THEN RTBLCALL = I1[0] - I2[0];
            ELSE IF I1[0] LQ I2[0]
                   THEN BR[0] = TRUE; 
                   ELSE BR[0] = FALSE;
          TEST PSTACKPTR; 
      GEINT:  
          IF I1[0] GQ I2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      EQUIVALENCE:  
          IF (I1[0] EQ 0 AND I2[0] EQ 0) OR (I1[0] NQ 0 AND             002120
          I2[0] NQ 0) THEN IR[0] = -1;                                  002130
          ELSE IR[0] = 0;                                               002140
          TEST PSTACKPTR; 
      IMPLIES:  
          IR[0] = I1[0] LIM I2[0];
          TEST PSTACKPTR; 
      LOGAND: 
          BR[0] = B1[0] AND B2[0];
          TEST PSTACKPTR; 
      LOGOR:  
          BR[0] = B1[0] OR B2[0]; 
          TEST PSTACKPTR; 
      ADDSP:  
          RR[0] = R1[0] + R2[0];
          TEST PSTACKPTR; 
      SUBTRACTSP: 
          RR[0] = R1[0] - R2[0];
          TEST PSTACKPTR; 
      MULTIPLYSP: 
          RR[0] = R1[0] * R2[0];
          TEST PSTACKPTR; 
      DIVIDESP: 
          IF R2[0] EQ 0 THEN
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          RR[0] = R1[0] / R2[0];
          TEST PSTACKPTR; 
      NEGATESP: 
          RR[0] = -R2[0]; 
          TEST PSTACKPTR; 
      EXPONENTSP: 
          IF R1[0] LS 0            # ILLEGAL ARGUMENT                  #
          THEN
            BEGIN 
            DIAG(948);             # ILLEGAL ARGUMENT TO EXPONENTIATION#
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          IR[0] = XTOY(R1[0],R2[0]);
          TEST PSTACKPTR; 
      EQSP: 
          IF R1[0] EQ R2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      NESP: 
          IF R1[0] NQ R2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LTSP: 
          IF R1[0] LS R2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      GTSP: 
          IF R1[0] GR R2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LESP: 
          IF RTBLCALL NQ 0
            THEN IF R1[0] LQ R2[0]
                   THEN IF R1[0] LS R2[0] 
                          THEN RTBLCALL = -1; 
                          ELSE RTBLCALL = 0;
                   ELSE RTBLCALL = 1; 
            ELSE IF R1[0] LQ R2[0]
                   THEN BR[0] = TRUE; 
                   ELSE BR[0] = FALSE;
          TEST PSTACKPTR; 
      GESP: 
          IF R1[0] GQ R2[0] THEN
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LOGXOR: 
          IR[0] = I1[0] LXR I2[0];
          TEST PSTACKPTR; 
      LOGNOT: 
          BR[0] = NOT B2[0];
          TEST PSTACKPTR; 
      EQX:  
          IF COMPARECHARS EQ 0 THEN 
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      NEX:  
          IF COMPARECHARS NQ 0 THEN 
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      ADDDP:  
          DADD(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR; 
      SUBTRACTDP: 
          DSUB(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR; 
      MULTIPLYDP: 
          DMULT(OPERAND1,OPERAND2,RESULT);
          TEST PSTACKPTR; 
      DIVIDEDP: 
          IF R2[0] EQ 0 
          THEN
            BEGIN 
            DIAG(945);             # DIVISION BY ZERO IS ILLEGAL       #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            DR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          DDIV(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR; 
      NEGATEDP: 
          RR[0] = -R2[0]; 
          DR[0] = -D2[0]; 
          TEST PSTACKPTR; 
      EXPONENTDP: 
          IF R1[0] LS 0            # ILLEGAL ARGUMENT                  #
          THEN
            BEGIN 
            DIAG(948);             # ILLEGAL ARGUMENT TO EXPONENTIATION#
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            DR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          DTOD(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR; 
      EQDP: 
      EQCPLX: 
          IF R1[0] EQ R2[0] AND 
             D1[0] EQ D2[0] THEN
               BR[0] = TRUE;
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      NEDP: 
      NECPLX: 
          IF R1[0] NQ R2[0] OR
             D1[0] NQ D2[0] THEN
               BR[0] = TRUE;
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LTDP: 
          IF R1[0] LS R2[0] OR
             R1[0] EQ R2[0] AND D1[0] LS D2[0] THEN 
               BR[0] = TRUE;
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      GTDP: 
          IF R1[0] GR R2[0] OR
             R1[0] EQ R2[0] AND D1[0] GR D2[0] THEN 
               BR[0] = TRUE;
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LEDP: 
          IF R1[0] LS R2[0] OR
             R1[0] EQ R2[0] AND D1[0] LS D2[0] THEN 
               BR[0] = TRUE;
          ELSE GOTO EQDP; 
          TEST PSTACKPTR; 
      GEDP: 
          IF R1[0] GR R2[0] OR
             R1[0] EQ R2[0] AND D1[0] GR D2[0] THEN 
               BR[0] = TRUE;
          ELSE GOTO EQDP; 
          TEST PSTACKPTR; 
      LTX:  
          IF COMPARECHARS LS 0 THEN 
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      GTX:  
          IF COMPARECHARS GR 0 THEN 
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      LEX:  
          IF RTBLCALL NQ 0
            THEN RTBLCALL = COMPARECHARS; 
            ELSE IF COMPARECHARS LQ 0 
                   THEN BR[0] = TRUE; 
                   ELSE BR[0] = FALSE;
          TEST PSTACKPTR; 
      GEX:  
          IF COMPARECHARS GQ 0 THEN 
            BR[0] = TRUE; 
          ELSE BR[0] = FALSE; 
          TEST PSTACKPTR; 
      ADDCPLX:  
          RR[0] = R1[0] + R2[0];
          DR[0] = D1[0] + D2[0];
          TEST PSTACKPTR; 
      SUBTRACTCPLX: 
          RR[0] = R1[0] - R2[0];
          DR[0] = D1[0] - D2[0];
          TEST PSTACKPTR; 
      MULTIPLYCPLX: 
          RR[0] = R1[0] * R2[0] - (D1[0] * D2[0]);
          DR[0] = R1[0] * D2[0] + R2[0] * D1[0];
          TEST PSTACKPTR; 
      DIVIDECPLX: 
          ITEM D R; 
          D = R2[0] * R2[0] + D2[0] * D2[0];
          IF D EQ 0 THEN
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            DR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          RR[0]=(R1[0]*R2[0]-(D1[0]*(-D2[0])))/D; 
          DR[0]=(R1[0]*(-D2[0])+R2[0]*D1[0])/D; 
          TEST PSTACKPTR; 
      NEGATECPLX: 
          RR[0] = -R2[0]; 
          DR[0] = -D2[0]; 
          TEST PSTACKPTR; 
      EXPONENTCPLX: 
          DIAG(948);               # ILLEGAL ARGUMENT TO EXPONENTIATION#
          ERRORSET; 
          RR[0] = 0;               # SET RESULT TO ZERO                #
          DR[0] = 0;               # SET RESULT TO ZERO                #
          TEST PSTACKPTR; 
          END                          # END OF PROGRAM STACK LOOP.    #
 RETURNEXP:                        # THIS CODE ONLY ACCESSED BY        #
                                   # GOTO RETURNEXP                    #
                                   # THIS OCCURS WHEN AN ERROR IS FOUND#
                                   # WITHIN AN INTERNAL PROC           #
      RETURN;                      # EXIT EXPEV20                      #
      END 
      TERM; 
