*DECK EXPEV 
USETEXT TAREATB 
USETEXT TDESATT 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TOPTION 
USETEXT TPSTACK 
      PROC EXPEVAL (RC);           # NOTE THIS IS UPDATE DECK EXPEV    #
      BEGIN                                                              SAVCOR1
      XREF PROC CMOVE;                                                   EXPEV
                                                                         EXPEV
      XREF BASED ARRAY SAVDAREA;
        BEGIN 
        ITEM AREASAVE  U(0,42,18);
        END 
      BASED ARRAY OPERAND1;            # 1ST OPERAND ACCESS.           # SAVCOR1
        ITEM I1,                       # INTEGER                       # SAVCOR1
             R1 R,                     # REAL                          # SAVCOR1
             D1 R(1,,60),                                                SAVCOR1
          U1 U(0,0,60),                                                  SAVCOR1
             B1 B;                     # LOGICAL                       # SAVCOR1
      BASED ARRAY OPERAND2;                                              SAVCOR1
        ITEM I2,                                                         SAVCOR1
             R2 R,                                                       SAVCOR1
             D2 R(1,,60),                                                SAVCOR1
          U2 U(0,0,60),                                                  SAVCOR1
             B2 B;                                                       SAVCOR1
      BASED ARRAY RESULT;              # RESULT STORAGE PTR            # SAVCOR1
        ITEM IR,                       # INTEGER                       # SAVCOR1
             RR R,                     # REAL                          # SAVCOR1
             DR R(1,,60),                                                SAVCOR1
          UR U(0,0,60),                                                  SAVCOR1
             BR B;                     # LOGICAL                       # SAVCOR1
      BASED ARRAY BASE;                                                  SAVCOR1
        BEGIN 
        ITEM BASEOPND U (00,42,18); 
        ITEM BASEWORD I(00,00,60); # ENTIRE WORD                       #
        END 
      ARRAY EXPRSTACK[9];              # SPACE FOR SAVING STACK POSI-  # SAVCOR1
        ITEM STACKADDR I(0,42,18),     # TION WHILE EVALUATING A SUB-  # SAVCOR1
             PSTKPTR I(0,24,18);       # EXPRESSION.                   # SAVCOR1
      XREF                                                               SAVCOR1
        BEGIN                                                            SAVCOR1
        PROC DIAG;                                                       SAVCOR1
        PROC CKININF;                  # CHECKS FOR INDEF. OR INFINITE #
        PROC CONVERT;                  # PERFORMS DATA TYPE CONVERSIONS# SAVCOR1
          PROC FIGSUB;                                                   SAVCOR1
        END                                                              SAVCOR1
          XREF ITEM UNIVERSAL;  #UNIVERSAL CHARACTER CELL#               UNIVERS
      ITEM COLBLANK I;             # COLLATED VALUE OF BLANK           # QU3A346
      ITEM                                                               SAVCOR1
           BP1,BP2,                    # BIT POS PTRS FOR OPERANDS.    # SAVCOR1
           I,J,K,                      # SCRATCH VARIABLES.            # SAVCOR1
           L1,L2,                      # LENGTHS OF OPERANDS IN CHARS. # SAVCOR1
           PREVIOUS,                   # INDEX TO EXPRSTACK ENTRY FOR  # SAVCOR1
                                       # EXPRESSION CONTAINING A SUB-  # SAVCOR1
                                       # EXPRESSION.                   # SAVCOR1
           PSTACKPTR,                  # PTR TO PROGRAM STACK ENTRIES. # SAVCOR1
           W1,W2;                      # WORD PTRS FOR OPERANDS.       # SAVCOR1
      ITEM SVALLPSTPTR I;          # SAVE PSTACKPTR OF ALL/ANY ITEM    #
          ARRAY C1[1:2]; ITEM C;                                         SAVCOR1
      SWITCH OPERATION       # ACCESSES ROUTINES TO PERFORM OPERATIONS.# SAVCOR1
             ADDINT,         #  0  INTEGER ADD                         # SAVCOR1
             SUBTRACTINT,    #  1  INTEGER SUBTRACT                    # SAVCOR1
             MULTIPLYINT,    #  2  INTEGER MULTIPLY                    # SAVCOR1
             DIVIDEINT,      #  3  INTEGER DIVIDE                      # SAVCOR1
             NEGATEINT,      #  4  INTEGER UNARY MINUS                 # SAVCOR1
             EXPONENTINT,    #  5  INTEGER EXPONENTIATION              # SAVCOR1
             EQINT,          #  6  INTEGER RELATIONAL OPERATORS:  EQ   # SAVCOR1
             NEINT,          #  7                                 NE   # SAVCOR1
             LTINT,          # 10                                 LT   # SAVCOR1
             GTINT,          # 11                                 GT   # SAVCOR1
             LEINT,          # 12                                 LE   # SAVCOR1
             GEINT,          # 13                                 GE   # SAVCOR1
             EQUIVALENCE,    # 14  LOGICAL EQUIVALENCE OPERATOR        # SAVCOR1
             IMPLIES,        # 15  LOGICAL IMPLIES OPERATOR            # SAVCOR1
             LOGAND,         # 16  LOGICAL AND OPERATOR                # SAVCOR1
             LOGOR,          # 17  LOGICAL OR OPERATOR                 # SAVCOR1
             ADDSP,          # 20  SINGLE PRECISION ADD                # SAVCOR1
             SUBTRACTSP,     # 21  SINGLE PRECISION SUBTRACT           # SAVCOR1
             MULTIPLYSP,     # 22  SINGLE PRECISION MULTIPLY           # SAVCOR1
             DIVIDESP,       # 23  SINGLE PRECISION DIVIDE             # SAVCOR1
             NEGATESP,       # 24  SINGLE PRECISION UNARY MINUS        # SAVCOR1
             EXPONENTSP,     # 25  SINGLE PRECISION EXPONENTIATION     # SAVCOR1
             EQSP,           # 26  SINGLE PRECISION RELATIONAL OPS: EQ # SAVCOR1
             NESP,           # 27                                   NE # SAVCOR1
             LTSP,           # 30                                   LT # SAVCOR1
             GTSP,           # 31                                   GT # SAVCOR1
             LESP,           # 32                                   LE # SAVCOR1
             GESP,           # 33                                   GE # SAVCOR1
             LOGXOR,         # 34  LOGICAL EXCLUSIVE OR OPERATOR       # SAVCOR1
             LOGNOT,         # 35  LOGICAL NOT OPERATOR                # SAVCOR1
             EQX,            # 36  ALPHA RELATIONAL OPERATOR: EQ       # SAVCOR1
             NEX,            # 37  ALPHA RELATIONAL OPERATOR: NE       # SAVCOR1
             ADDDP,          # 40  DOUBLE PRECISION ADD                # SAVCOR1
             SUBTRACTDP,     # 41  DOUBLE PRECISION SUBTRACT           # SAVCOR1
             MULTIPLYDP,     # 42  DOUBLE PRECISION MULTIPLY           # SAVCOR1
             DIVIDEDP,       # 43  DOUBLE PRECISION DIVIDE             # SAVCOR1
             NEGATEDP,       # 44  DOUBLE PRECISION UNARY MINUS        # SAVCOR1
             EXPONENTDP,     # 45  DOUBLE PRECISION EXPONENTIATION     # SAVCOR1
             EQDP,           # 46  DOUBLE PRECISION RELATIONAL OPS: EQ # SAVCOR1
             NEDP,           # 47                                   NE # SAVCOR1
             LTDP,           # 50                                   LT # SAVCOR1
             GTDP,           # 51                                   GT # SAVCOR1
             LEDP,           # 52                                   LE # SAVCOR1
             GEDP,           # 53                                   GE # SAVCOR1
             LTX,            # 54  ALPHA RELATIONAL OPERATORS: LT      # SAVCOR1
             GTX,            # 55                              GT      # SAVCOR1
             LEX,            # 56                              LE      # SAVCOR1
             GEX,            # 57                              GE      # SAVCOR1
             ADDCPLX,        # 60  COMPLEX ADD                         # SAVCOR1
             SUBTRACTCPLX,   # 61  COMPLEX SUBTRACT                    # SAVCOR1
             MULTIPLYCPLX,   # 62  COMPLEX MULTIPLY                    # SAVCOR1
             DIVIDECPLX,     # 63  COMPLEX DIVIDE                      # SAVCOR1
             NEGATECPLX,     # 64  COMPLEX UNARY MINUS                 # SAVCOR1
             EXPONENTCPLX,   # 65  COMPLEX EXPONENTIATION              # SAVCOR1
             EQCPLX,         # 66  COMPLEX RELATIONAL OPERATORS: EQ    # SAVCOR1
             NECPLX,         # 67                                NE    # SAVCOR1
             ENDOFOPS,       # 70 END OF POLISH STACKS                 # SAVCOR1
             ABSOLCOMP,      # 71 ABSOLUTE OF COMPUTATIONAL ITEM       # SAVCOR1
             ABSOLINT,       # 72 ABSOLUTE OF INTEGER ITEM             # SAVCOR1
             ABSOLUNOR,      # 73 ABSOLUTE OF UNNORMALIZED ITEM        # SAVCOR1
             ABSOLREL,       # 74 ABSOLUTE OF REAL ITEM                # SAVCOR1
             JULIAN,         # 75 JULIAN                               # SAVCOR1
             GREG,           # 76 GREG                                 # SAVCOR1
             MASK;           # 77 MASK                                 # SAVCOR1
      SWITCH MINSWITCH       #SWITCH FOR MIN OR MAX ON DIFFERENT TYPES # SAVCOR1
             MINCHAR,        # 100 MIN FOR CHARACTER ITEM              # SAVCOR1
             MINNUM,         # 101 MIN FOR COMPUTATIONAL ITEM          # SAVCOR1
             MININT,         # 102 MIN FOR INTEGER ITEM                # SAVCOR1
             MINUNOR,        # 103 MIN FOR UNNORMALIZED ITEM           # SAVCOR1
             MINREAL,        # 104 MIN FOR REAL ITEM                   # SAVCOR1
             MINDBL,         # 105 MIN FOR DOUBLE PRECISION ITEM       # SAVCOR1
             MINCPX,         # 106 MIN FOR COMPLEX ITEM                # SAVCOR1
             MINLGL,         # 107 MIN FOR LOGICAL ITEM                # SAVCOR1
             MAXCHAR,        # 110 MAX FOR CHARACTER ITEM              # SAVCOR1
             MAXNUM,         # 111 MAX FOR COMPUTATIONAL ITEM          # SAVCOR1
             MAXINT,         # 112 MAX FOR INTEGER ITEM                # SAVCOR1
             MAXUNOR,        # 113 MAX FOR UNNORMALIZED ITEM           # SAVCOR1
             MAXREAL,        # 114 MAX FOR REAL ITEM                   # SAVCOR1
             MAXDBL,         # 115 MAX FOR DOUBLE PRECISION ITEM       # SAVCOR1
             MAXCPX,         # 116 MAX FOR COMPLEX ITEM                # SAVCOR1
             MAXLGL;         # 117 MAX FOR LOGICAL ITEM                # SAVCOR1
      SWITCH STKENTRYTYPE    # DETERMINES ACTION BY STACK ENTRY TYPE   # SAVCOR1
             RELMOVE,                                                    SAVCOR1
             RELMOVE,        # 1 DO NOTHING                            # SAVCOR1
             RELCONVERT,     # 3 CALL CONVERT                          # SAVCOR1
             EXPRESS,        # 3 EVALUATE SUB-EXPRESSION               # SAVCOR1
             RELUNDETSUBS,   # 5 CALL UNDETSUBS                        # SAVCOR1
             EXPRESS,        # 6 EVALUATE SUB-EXPRESSION               # SAVCOR1
             EXPRESS,                                                    SAVCOR1
             OPERATOR;       # 7 ENTER OPERATION SWITCH WITH OPCODE    # SAVCOR1
      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             #
          ITEM II,JJ;                                                    SAVCOR1
          ITEM DEUB,SVINDTBL;                                            SAVCOR1
        ARRAY ARAY[15];            # 4 * STKSIZE - 1                   #
          ITEM ARAW U(,,60),                                             SAVCOR1
               ARACD U(0,0,3),                                           SAVCOR1
               ARAOP U(0,24,18),                                         SAVCOR1
               ARADD U(0,42,18);                                         SAVCOR1
      ARRAY ATTR S(2);             # ATTRIBUTES OF INTEGER             #
                                   # USED FOR CONVERT                  #
        BEGIN 
        ITEM AWPOS I(0,18,18);     # ADDRESS OF VALUE                  #
        END 
      ARRAY NECONVERSION  [5];     # TABLE THAT MAPS CONVERSION CODE TO# QU3A072
                                   # OPCODE VALUE OF OPERATOR NE (").  # QU3A072
                                   # VALUES ARE: 7 IF RESULT OF        # QU3A072
                                   # CONVERSION IS INTEGER, 27 FLOATING# QU3A072
                                   # 34, LOGICAL, 37, CHARACTER,       # QU3A072
                                   # 47, DOUBLE, 67, COMPLEX           # QU3A072
        BEGIN                                                            QU3A072
        ITEM NECODE I(0,0,60) = [O"00 37 00 07 00 27 47 67 0000",        QU3A072
                                 O"00 00 07 00 27 47 67 00 0000",        QU3A072
                                 O"07 00 27 47 67 00 07 00 0000",        QU3A072
                                 O"27 47 67 00 07 00 27 47 0000",        QU3A072
                                 O"67 00 07 00 27 47 67 00 0000",        QU3A072
                                 O"07 00 27 47 67 34 00 00 0000"];       QU3A072
        END                                                              QU3A072
      ARRAY TZCONVERSION  [0:O"11"];  # 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", 
                                   O"00 00 00 01 01 03 03 00 0000", 
                                   O"00 00 00 01 01 03 03 00 0000"];
        END 
      XREF ITEM IPYMD;                                                   SAVCOR1
      XREF ITEM RTBLCALL; 
      XREF ITEM CURANY; 
      XREF ARRAY ACURANY;;
      ARRAY MMDDYY[5]; ITEM MDY I(,,60);                                 SAVCOR1
      BASED ARRAY YYDDMM; ITEM YDM I(,,60);                              SAVCOR1
          ITEM J1,J2,J3,J4,J5,J6;                                        SAVCOR1
          ITEM CUMU B;                                                   SAVCOR1
          ARRAY P S(2);                                                  SAVCOR1
            ITEM PPEDIT B(0,3,1),                                        SAVCOR1
                  PFROMCHAR U(0,4,4),                                    SAVCOR1
                  PNBCHAR U(0,12,12),                                    SAVCOR1
                  PFROMWORD U(0,24,18),                                  SAVCOR1
                  PFROMPTR U(1,24,18),                                   SAVCOR1
                  PCONVERTCODE U(1,0,6),                                 SAVCOR1
                  PWORD1 U(0,0,60),                                      SAVCOR1
                  PWORD2 U(1,0,60);                                      SAVCOR1
          ITEM FGALL B; ITEM FGANY B;                                    SAVCOR1
          BASED ARRAY BASE1;;                                            SAVCOR1
          ITEM ALLINDTBL I;        # SAVE ALL/ANY P<INDTBL>            #
          ITEM ALLUB I;            # SAVE ALL/ANY UB                   #
          ITEM UB, CURSUB;                                               SAVCOR1
          ITEM RC;                                                       SAVCOR1
          ITEM CHAR;
          ITEM WORD;
          ITEM DATALENGTH;
          ITEM STRINGLENGTH;
          ITEM STRINGSTART; 
          ITEM DATASTART; 
          ITEM SCANINDEX; 
          ITEM STRINGLOC; 
          ITEM FULLSTACK   B;      # FLAG FOR FULLSTACK REPEAT         #
          ITEM SAVEANY     I;      # SAVED ANY FLAGS                   #
          ITEM SAVEALL     I;      # SAVED ALL FLAGS                   #
          ITEM SAVEINDTBL  I;      # ORIGINAL INDTBL ADDR              #
          ITEM SVALL       B;      # FLAG MASK WITH ALL                #
          ITEM SVANY       B;      # FLAG MASK WITH ANY                #
          ITEM DATAITEMLOC; 
          ITEM SAVEWORD U;         # SKIPWORD SAVE WHEN ALL/ANY        #
          XREF FUNC SCAN; 
          XREF FUNC ITOJ; XREF FUNC XTOY; XREF PROC DTOD;                SAVCOR1
      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)#;        SAVCOR1
          BASED ARRAY COLSEQ2;
            BEGIN 
            ITEM COLWORD2  U(0,0,60); 
            END 
          BASED ARRAY COLSEQ;      # COLLATING SEQUENCE TABLE.         #
            BEGIN 
            ITEM COLWORD  U(0,0,60);
            END 
CONTROL EJECT;                                                           EXPEV
      FUNC COMPARECHARS;                                                 SAVCOR1
          BEGIN                                                          SAVCOR1
 #                                                                       SAVCOR1
 0        COMPARECHARS - COMPARES TWO CHARACTER STRINGS AND RETURNS      SAVCOR1
                    RESULT. STRINGS ARE COMPARED CHAR BY CHAR UNTIL AN   SAVCOR1
                    INEQUALITY IS FOUND OR THE SHORTER STRING IS EXCEED- SAVCOR1
                    ED. WHEN AN INEQUALITY IS FOUND THE COLLATING SE-    SAVCOR1
                    QUENCE VALUES FOR THE CHARS ARE COMPARED AND THE     SAVCOR1
                    COMPARISON TERMINATES OR CONTINUES IF C.S. VALUES    SAVCOR1
                    ARE EQUAL. IF THE STRINGS ARE EQUAL FOR THE LENGTH   SAVCOR1
                    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.
 #                                                                       SAVCOR1
          W1 = 0;                      # INITIALIZE WORD PTRS FOR BOTH # SAVCOR1
          W2 = 0;                      # OPERANDS.                     # SAVCOR1
          BP1 = RELTOCHAR[PSTACKPTR-J] * 6; #INITIALIZE BIT POSIT. PTRS# SAVCOR1
          BP2 = RELTOCHAR[PSTACKPTR-I] * 6; #TO 1ST CHAR IN EACH OPERAN# SAVCOR1
          L1 = NBRCHARS[PSTACKPTR-J]; #GET LENGTHS OF OPERANDS#          SAVCOR1
          L2 = NBRCHARS[PSTACKPTR-I];                                    SAVCOR1
                                   # PICK UP COLLATING TABLE ADDRESS,  #
                                   # IF THERE IS ONE.  THIS IS A -DCT- #
                                   # TABLE, SO TO TRANSFORM A CHARACTER#
                                   # IT IS NECESSARY TO USE THE DISPLAY#
                                   # CODE VALUE AS ROW AND CHARACTER   #
                                   # POSITION IN THE TABLE. IF THERE   #
                                   # ARE TWO AREAS INVOLVED, THERE     #
                                   # MAY BE TWO COLLATING SEQ-         #
                                   # UENCES, SO CHECK FOR THEM         #
                                   # BOTH.  FOR A MORE DETAILED        #
                                   # DESCRIPTION OF THE -DCT- TABLE,   #
                                   # CHECK THE -CRM FILE ORG. USERS    #
                                   # GUIDE.                            #
          IF AREAORD[PSTACKPTR-J] NQ 0 THEN 
            BEGIN 
            P<AREA$TABLE> = AREASAVE[AREAORD[PSTACKPTR-J]]; 
            IF AT$COLSEQ NQ 0 THEN
              BEGIN 
              P<COLSEQ> = P<AREA$TABLE> + AT$COLSEQ;
              END 
            ELSE
              BEGIN 
              P<COLSEQ> = 0;
              END 
            END 
          IF AREAORD[PSTACKPTR-I] NQ 0 THEN 
            BEGIN 
            P<AREA$TABLE> = AREASAVE[AREAORD[PSTACKPTR-I]]; 
            IF AT$COLSEQ NQ 0 THEN
              BEGIN 
              P<COLSEQ2> = P<AREA$TABLE> + AT$COLSEQ; 
              END 
            ELSE
              BEGIN 
              P<COLSEQ2> = 0; 
              END 
            END 
                                   # IF ONE OF THE ITEMS HAS NO COL-   # QU3A346
                                   # LATING TABLE, USE THE EXISTING    # QU3A346
                                   # TABLE FOR TRANSFORMATION.  THIS   # QU3A346
                                   # WILL OCCUR IF AN AREA ITEM IS     # QU3A346
                                   # COMPARED WITH A LITERAL OR A      # QU3A346
                                   # DEFINED NAME.                     # QU3A346
          IF P<COLSEQ> EQ 0                                              QU3A346
            AND P<COLSEQ2> NQ 0                                          QU3A346
          THEN                                                           QU3A346
            BEGIN                                                        QU3A346
            P<COLSEQ> = P<COLSEQ2>;                                      QU3A346
            END                                                          QU3A346
          IF P<COLSEQ2> EQ 0                                             QU3A346
            AND P<COLSEQ> NQ 0                                           QU3A346
          THEN                                                           QU3A346
            BEGIN                                                        QU3A346
            P<COLSEQ2> = P<COLSEQ>;                                      QU3A346
            END                                                          QU3A346
          IF L1 LS L2 THEN             # SHORTER STRING DETERMINES NBR # SAVCOR1
            K = L1;                    # OF CHARACTER PAIR COMPARISONS.# SAVCOR1
          ELSE K = L2;                                                   SAVCOR1
          FOR I=1 STEP 1 UNTIL K DO    # COMPARE CHARACTER PAIRS, FROM # SAVCOR1
          BEGIN                        # LEFT, UNTIL INEQUALITY.       # SAVCOR1
          C[1] = B<BP1,6>I1[W1];                                         SAVCOR1
          C[2] = B<BP2,6>I2[W2];                                         SAVCOR1
#  IF THERE IS NO UNIVERSAL CHARACTER PRESENT, USE THE EXISTING  #       SAVCOR1
#  COLLATING SEQUENCE TO DETERMINE THE RELATIONSHIP.             #       SAVCOR1
          IF NOCHECK OR NOMATCH THEN                                     SAVCOR1
            BEGIN                                                        SAVCOR1
                                   # TRANSFORM THE CHARACTERS ACCORD-  #
                                   # ING TO THE COLLATING TABLE(S).    #
            IF P<COLSEQ> NQ 0 THEN
              BEGIN 
              WORD = B<54,3>C[1]; 
              CHAR = B<57,3>C[1]; 
              C[1] = C<CHAR,1>COLWORD[WORD];
              END 
            IF P<COLSEQ2> NQ 0 THEN 
              BEGIN 
              WORD = B<54,3>C[2]; 
              CHAR = B<57,3>C[2]; 
              C[2] = C<CHAR,1>COLWORD2[WORD]; 
              END 
                                   # IF ONE OF THE ITEMS HAS NO COL-   #
                                   # LATING TABLE, USE THE EXISTING    #
                                   # TABLE FOR TRANSFORMATION. THIS    #
                                   # WILL OCCUR IF AN AREA ITEM IS     #
                                   # COMPARED WITH A LITERAL OR A      #
                                   # DEFINED NAME.                     #
            IF C[1] NQ C[2] THEN                                         SAVCOR1
              BEGIN                                                      SAVCOR1
              COMPARECHARS = C[1] - C[2];                                SAVCOR1
              RETURN;                                                    SAVCOR1
              END                                                        SAVCOR1
            END                                                          SAVCOR1
            ELSE                                                         SAVCOR1
            BEGIN                                                        SAVCOR1
            IF I EQ K THEN                                               SAVCOR1
              BEGIN                                                      SAVCOR1
              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                                                        SAVCOR1
            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                                                          SAVCOR1
          IF BP1 EQ 54 THEN                                              SAVCOR1
            BEGIN                                                        SAVCOR1
            BP1 = 0;                                                     SAVCOR1
            W1 = W1 + 1;                                                 SAVCOR1
            END                                                          SAVCOR1
          ELSE BP1 = BP1+6;                                              SAVCOR1
          IF BP2 EQ 54 THEN                                              SAVCOR1
            BEGIN                                                        SAVCOR1
            BP2 = 0;                                                     SAVCOR1
            W2 = W2 + 1;                                                 SAVCOR1
            END                                                          SAVCOR1
          ELSE BP2 = BP2 +6;                                             SAVCOR1
       END                                                               SAVCOR1
           IF L1 EQ L2 THEN                                              SAVCOR1
            BEGIN                                                        SAVCOR1
            COMPARECHARS = 0;                                            SAVCOR1
            RETURN;                                                      SAVCOR1
            END                                                          SAVCOR1
          IF L2 GR L1 THEN                                               SAVCOR1
          BEGIN K = -1;                                                  SAVCOR1
          L1 = L2;                                                       SAVCOR1
          P<COLSEQ> = P<COLSEQ2>;                                        QU3A346
                    BP1 = BP2;                                           SAVCOR1
                    W1 = W2;                                             SAVCOR1
                    P<BASE> = P<OPERAND2>;                               SAVCOR1
          END                                                            SAVCOR1
          ELSE                                                           SAVCOR1
          BEGIN                                                          SAVCOR1
                    K = 1;                                               SAVCOR1
                    P<BASE > = P<OPERAND1>;                              SAVCOR1
          END                                                            SAVCOR1
          IF P<COLSEQ> NQ 0                                              QU3A346
          THEN                                                           QU3A346
            BEGIN                                                        QU3A346
            COLBLANK = C<5,1>COLWORD[5];                                 QU3A346
            END                                                          QU3A346
          ELSE                                                           QU3A346
            BEGIN                                                        QU3A346
            COLBLANK = O"55";                                            QU3A346
            END                                                          QU3A346
          FOR I=I STEP 1 UNTIL L1 DO                                     SAVCOR1
          BEGIN                                                          SAVCOR1
            C[1] = B<BP1,6>BASEWORD[W1];                                 QU3A346
            IF P<COLSEQ> NQ 0                                            QU3A346
            THEN                                                         QU3A346
              BEGIN                                                      QU3A346
              WORD = B<54,3>C[1];                                        QU3A346
              CHAR = B<57,3>C[1];                                        QU3A346
              C[1] = C<CHAR,1>COLWORD[WORD];                             QU3A346
              END                                                        QU3A346
            IF C[1] NQ COLBLANK                                          QU3A346
              AND B<BP1,6>BASEWORD[W1] NQ UNIVERSAL 
            THEN
            BEGIN                      # IF NON-BLANK CHAR IS FOUND THE# SAVCOR1
                COMPARECHARS = K;                                        SAVCOR1
              RETURN;                                                    SAVCOR1
            END                                                          SAVCOR1
            IF BP1 EQ 54 THEN                                            SAVCOR1
            BEGIN                                                        SAVCOR1
              BP1 = 0;                                                   SAVCOR1
              W1 = W1 + 1;                                               SAVCOR1
            END                                                          SAVCOR1
            ELSE BP1 = BP1 + 6;                                          SAVCOR1
          END                                                            SAVCOR1
          COMPARECHARS = 0;            # STRINGS ARE EQUAL.            # SAVCOR1
          RETURN;                                                        SAVCOR1
          END                                                            SAVCOR1
  
#----------------------------------------------------------------------#
#                                                                      #
#     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         #
      IF FGALL                     # IF PROCESSING *ALL*               #
        OR FGANY                   # IF PROCESSING *ANY*               #
      THEN
        BEGIN 
        P<INDTBL> = ALLINDTBL;
        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 
  
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#                     PROC SKIPPER                                     #
#                                                                      #
#  THIS PROCEDURE DETERMINES WHETHER THE RESULT OF A LOGICAL OR        #
#  RELATIONAL OPERAND PROCESSING SHOULD CAUSE A PORTION OF THE         #
#  PROGRAM STACK TO BE SKIPPED                                         #
#                                                                      #
# ENTRY CONDITIONS:  AS THE STACK IS BUILT IN EXPANAL, FLAGS SKIPF     #
#  AND SKIPT ARE SET DEPENDING UPON WHETHER THE LOGICAL OPERATOR       #
#  IS *AND* OR *OR*.  THE SKIPADDR IS SET AT THE SAME TIME AND         #
#  IS THE NEW VALUE TO BE ASSIGNED TO PSTACKPTR.                       #
#                                                                      #
#  THE OPERATOR PROCESSING MUST BE COMPLETE AND THE RESULT (TRUE       #
#  OR FALSE) MUST BE STORED IN BR[0].                                  #
#                                                                      #
# PROCESSING:  IF SKIPADDR IS NOT ZERO THEN IF BR[0] IS TRUE           #
#  AND SKIPT IS SET OR BR[0] IS FALSE AND SKIPF IS SET, THEN           #
#  PSTACKPTR IS SET TO SKIPADDR, THE POINTER TO ARRAY RESULT           #
#  IS SET FROM THE NEW STACK ENTRY , BR[0] IS SET TO THE  RESULT       #
#  OF THE SKIP AND THE ENTIRE PROCESS IS REPEATED UNTIL THERE          #
#  IS NO MATCH.                                                        #
#                                                                      #
# EXIT CONDITION:  PSTACKPTR IS POINTING TO THE NEXT ENTRY             #
#  IN THE PROGRAM STACK WHICH IS TO BE EVALUATED.                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC SKIPPER; 
      BEGIN 
      ITEM DUMDUM     I;           # LOOP COUNTER                      #
      ARRAY FLAGS S(1); 
        BEGIN 
        ITEM MATCH    B(0,0,1);    # LOOP CONTROL                      #
        ITEM BRSAVE   B(0,1,1);    # PREVIOUS BR[0]                    #
        END 
  
      MATCH = TRUE; 
  
      BRSAVE = FALSE; 
      FOR DUMDUM = 0 STEP 1 
        WHILE MATCH 
      DO
        BEGIN 
        IF SKIPADDR[PSTACKPTR] EQ 0 
        THEN
          BEGIN                    # NO PROCESSING REQUIRED            #
          MATCH = FALSE;
          END 
        ELSE
          BEGIN 
                                   # IF RESULT IS TRUE AND SO IS       #
                                   # SKIPT OR RESULT IS FALSE          #
                                   # AND SKIPF IS SET THEN JUMP        #
                                   # TO ENTRY AT SKIPADDR              #
          IF (BR[0] AND SKIPT[PSTACKPTR]) 
            OR (NOT BR[0] AND SKIPF[PSTACKPTR]) 
          THEN
            BEGIN 
            BRSAVE = BR[0]; 
            PSTACKPTR = SKIPADDR[PSTACKPTR];
            P<RESULT> = TOWORDADDR[PSTACKPTR];
            BR[0] = BRSAVE; 
            END                    # END MATCH FOUND  # 
          ELSE
            BEGIN 
            MATCH = FALSE;
            END 
          END                      # END SKIPADDR NQ 0                 #
        END                        # END FOR LOOP                      #
  
        RETURN; 
      END                          # END PROC SKIPPER                  #
  
CONTROL EJECT;
          XREF PROC UPBUN;                                               SAVCOR1
          PROC ALLANY;                                                   SAVCOR1
          BEGIN CURSUB = 1;                                              SAVCOR1
          UPBUN(INDTBL,UB,FROMWORDBASE[PSTACKPTR],J);                    SAVCOR1
          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               #
            RC = J;                # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            GOTO RETURNEXP;        # JUMP INTO OUTER PROC EXPEVALUATE  #
            END 
          INDCE[0] = 1; CONSUB[0] = TRUE;                                SAVCOR1
          RETURN;                                                        SAVCOR1
          END                                                            SAVCOR1
 #                                                                       SAVCOR1
 0        EXPEVAL - EVALUATES EXPRESSIONS BY INTERPRETING THE CONTENTS   SAVCOR1
                    OF A PROGRAM STACK GIVEN AS A PARAMETER. THE ENTRY-  SAVCOR1
                    TYPE FIELD OF EACH ENTRY IN THE PROGRAM STACK IS     SAVCOR1
                    USED TO ENTER A SWITCH VECTOR AND PERFORM THE TASKS  SAVCOR1
                    NECESSARY FOR THAT STACK ENTRY - CONVERSION, EVALU-  SAVCOR1
                    ATION OF A SUBSCRIPTED ITEM, ARITHMETIC OPERATION,   SAVCOR1
                    ETC. THE FINAL STACK ENTRY WILL INDICATE WHAT IS TO  SAVCOR1
                    BE DONE WITH THE EXPRESSION RESULTS.                 SAVCOR1
 #                                                                       SAVCOR1
          P<PROGRAMSTACK> = PROGSTACKLOC;# SET BASE TO CURRENT PROGRAM # SAVCOR1
                                       # STACK ADDRESS.                # SAVCOR1
          FGALL = FALSE;                                                 SAVCOR1
          FGANY = FALSE;                                                 SAVCOR1
          CURSUB = 0; 
          FULLSTACK = FALSE;
          SVALL = FALSE;
          SVANY = FALSE;
          SAVEANY = 0;
          SAVEALL = 0;
          PREVIOUS = -1;               # SET FOR MAIN EXPRESSION.      # SAVCOR1
          RC = 0;                  # INITIALIZE RETURN CODE TO ZERO    #
       EVALEXPRESS: 
          FOR PSTACKPTR = 0 STEP 1  # INTERPRET EACH                   #
          DO                       # PROGRAM STACK ENTRY               #
            BEGIN 
            IF FULLSTACK           # WAS MASK IN STACK                 #
            THEN
              BEGIN 
              IF OPCODE[PSTACKPTR] EQ O"70"  # IS IT END OF STACK      #
              THEN
                BEGIN 
                # SEE IF FINAL RESULTS FOUND OR ALL SUBS DONE          #
                IF (SVALL AND NOT BR[0])
                  OR (SVANY AND BR[0])
                  OR CURSUB EQ ALLUB
                THEN
                  BEGIN 
                  FULLSTACK = FALSE;
                  SVALL = FALSE;
                  SVANY = FALSE;
                  CURANY = CURSUB;
                  P<INDTBL> = SAVEINDTBL; 
                  FOR I = 0 STEP 1 UNTIL ALLUB
                  DO
                    BEGIN 
                    IF B<I,1>SAVEALL EQ 1 
                    THEN
                      BEGIN 
                      ALLFG[I] = TRUE;
                      END 
                    IF B<I,1>SAVEANY EQ 1 
                    THEN
                      BEGIN 
                      ANYFG[I] = TRUE;
                      END 
                    END 
                  END 
                ELSE
                  BEGIN 
                  P<INDTBL> = ALLINDTBL;
                  CURSUB = CURSUB + 1;
                  INDCE[0] = CURSUB;
                  PSTACKPTR = 0;
                  END 
                END 
              END 
              IF (FGALL OR FGANY) 
                AND ENTRYTYPE[PSTACKPTR - 1] EQ 7 
              THEN
                BEGIN 
                # IF MASK IS OPERATOR ENTIRE STACK MUST BE REPEATED    #
                IF OPCODE[PSTACKPTR - 1] EQ O"77" 
                THEN
                  BEGIN 
                  FULLSTACK = TRUE;  # SET FOR MASK FOUND              #
                  IF FGALL         # WAS ALL SUBSCRIPT FOUND           #
                  THEN
                    BEGIN 
                    FGALL = FALSE;
                    SVALL = TRUE; 
                    END 
                  ELSE
                    BEGIN 
                    FGANY = FALSE;  # IT WAS ANY AS SUBSCRIPT          #
                    SVANY = TRUE; 
                    END 
                  END              # END OP = 77                       #
                ELSE
                  BEGIN 
                    IF (FGALL AND NOT BR[0])
                      OR (FGANY AND BR[0])
                      OR CURSUB EQ ALLUB
                    THEN
                      BEGIN 
                      P<INDTBL> = SAVEINDTBL; 
                      ALLUB = TBLGS[0] - 1;  # LENGTH OF INDEX TABLE   #
                      FOR I = 0 STEP 1 UNTIL ALLUB
                      DO
                        BEGIN 
                        IF B<I,1>SAVEALL EQ 1 
                        THEN
                          BEGIN 
                          ALLFG[I] = TRUE;
                          END 
                        IF B<I,1>SAVEANY EQ 1 
                        THEN
                          BEGIN 
                          ANYFG[I] = TRUE;
                          END 
                        END 
                      IF FGALL
                      THEN
                        BEGIN 
                        FGALL = FALSE;
                        END 
                      ELSE
                        BEGIN 
                        FGANY = FALSE;
                        CURANY = CURSUB;
                        END 
                                   # IN ORDER TO AVOID SKIPPING        #
                                   # WHILE PROCESSING *ALL* OR *ANY*   #
                                   # UNTIL RESULTS ARE FOUND, THE      #
                                   # SKIPADDR AND FLAGS WERE CLEARED   #
                                   # AND SAVED.  NOW THAT THE RESULTS  #
                                   # ARE KNOWN OR THE LAST SUBSCRIPT   #
                                   # USED, RESTORE SKIP INFORMATION    #
                                   # AND THEN CALL SKIPPER.            #
                      PSTACKPTR = PSTACKPTR - 1;
                      PSTKWORD3[PSTACKPTR] = SAVEWORD;
                      SAVEWORD = 0; 
                      SKIPPER;
                      TEST PSTACKPTR; 
                      END 
                    ELSE
                BEGIN 
                P<INDTBL> = ALLINDTBL;
                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                                                      SAVCOR1
              END                  # END FGALL/FGANY AND ENTRY EQ 7    #
          END                                                            SAVCOR1
          GOTO STKENTRYTYPE[ENTRYTYPE[PSTACKPTR]];                       SAVCOR1
      ABSMOVE:                         # NO NEED TO MOVE, ENTRY MERELY # SAVCOR1
      RELMOVE:                         # DOCUMENTS DATA LOCATION.      # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      ABSCONVERT:                                                        SAVCOR1
      RELCONVERT:                                                        SAVCOR1
            P<BASE> = LOC(PSTKWORD[PSTACKPTR]);                          SAVCOR1
           CONVERT(BASE,I);                                              SAVCOR1
          IF I NQ 0 THEN               # IF ERROR IN CONVERSION, THEN  # SAVCOR1
          BEGIN                        # QUIT.                         # SAVCOR1
            DIAG(I);                                                     SAVCOR1
            RC = I;                # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RETURN;                                                      SAVCOR1
          END                                                            SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      ABSUNDETSUBS:                                                      SAVCOR1
      RELUNDETSUBS:                                                      SAVCOR1
          P<BASE> = LOC(PSTKWORD[PSTACKPTR]);                            SAVCOR1
          P<INDTBL> = EXPRESSTACK[PSTACKPTR];                            SAVCOR1
          SAVEINDTBL = P<INDTBL>;  # SAVE ORIGINAL ADDR                #
          UB = TBLGS[0] - 1;                                             SAVCOR1
              IF CURSUB EQ 0
                OR NOT FULLSTACK
              THEN
                BEGIN 
          FOR I = 0 STEP 1 UNTIL UB DO                                   SAVCOR1
          BEGIN IF DEPNDFG[I] THEN UB=UB-1;                              SAVCOR1
                IF ALLFG[I]                                              SAVCOR1
                                                                         SAVCOR1
                  THEN                                                   SAVCOR1
                  BEGIN                                                  SAVCOR1
                  FGALL = TRUE;                                          SAVCOR1
                  ALLANY;                                                SAVCOR1
                  B<I,1>SAVEALL = 1;
                  ALLFG[I] = FALSE;                                      SAVCOR1
                  GOTO NOCHK;                                            SAVCOR1
                  END                                                    SAVCOR1
                                                                         SAVCOR1
                  ELSE                                                   SAVCOR1
                  IF ANYFG[I]                                            SAVCOR1
                    THEN                                                 SAVCOR1
                    BEGIN                                                SAVCOR1
                    FGANY = TRUE;                                        SAVCOR1
                    ANYFG[I] = FALSE;                                    SAVCOR1
                    CONSUB[0] = FALSE;
                    ALLANY;                                              SAVCOR1
                    B<I,1>SAVEANY = 1;
                    GOTO NOCHK;                                          SAVCOR1
                    END                                                  SAVCOR1
              END 
          END                                                            SAVCOR1
        NOCHK: # #                                                       SAVCOR1
          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);                                                SAVCOR1
          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                   #
            RC = I;                # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RETURN; 
            END 
          TEST PSTACKPTR;   #****** TEMPORARY *************************# SAVCOR1
      EXPRESS:                                                           SAVCOR1
          PREVIOUS = PREVIOUS + 1;                                       SAVCOR1
          STACKADDR[PREVIOUS] = P<PROGRAMSTACK>;# SAVE PTRS.           # SAVCOR1
          PSTKPTR[PREVIOUS] = PSTACKPTR;                                 SAVCOR1
          P<PROGRAMSTACK> = EXPRESSTACK[PSTACKPTR];                      SAVCOR1
          GOTO EVALEXPRESS;                                              SAVCOR1
      OPERATOR:                                                          SAVCOR1
          K = OPCODE[PSTACKPTR];                                         SAVCOR1
                                   # BECAUSE SKIPPER MIGHT BE CALLED   #
                                   # PROCESSING ARRAYS WHERE *ALL* OR  #
                                   # *ANY* HAVE BEEN SPECIFIED, CLEAR  #
                                   # SKIP INFORMATION AND SAVE IT.     #
                                   # THIS INFORMATION WILL BE          #
                                   # RESTORED WHEN RESULTS ARE         #
                                   # KNOWN.                            #
        IF FGALL OR FGANY 
          OR SVALL OR SVANY 
        THEN
          BEGIN 
          SAVEWORD = PSTKWORD3[PSTACKPTR];
          PSTKWORD3[PSTACKPTR] = 0; 
          END 
  
          IF (K LS O"70"           # ARITHMETIC OR LOGICAL OPERATOR    #
              AND K NQ O"4"        # NOT *INTEGER UNARY MINUS*         #
              AND K NQ O"24"       # NOT *SINGLE PRECISION UNARY MINUS*#
              AND K NQ O"35"       # NOT *NOT*                         #
              AND K NQ O"47"       # NOT *DOUBLE PRECISION UNARY MINUS*#
              AND K NQ O"64")      # NOT *COMPLEX UNARY MINUS          #
            OR (K GR O"76"         # MASK OR MIN OR MAX                #
              AND K LS O"120") OR 
            (K GR O"147" AND K LS O"170") THEN                           SAVCOR1
            #MORE THAN 1 PARAMETER IS EXPECTED#                          SAVCOR1
          BEGIN                                                          SAVCOR1
          P<BASE> = TOWORDBASE[PSTACKPTR-2];# FIND BASE OF REFERENCE   # SAVCOR1
          IF P<BASE> EQ 0 THEN         # FOR OPERANDS: EITHER RA+0 OR  # SAVCOR1
            I = 0;                     # A BASED ARRAY WHICH POINTS TO # SAVCOR1
          ELSE I = BASEOPND[0];        # A WORKING STORAGE AREA.       # SAVCOR1
          P<OPERAND1> = TOWORDADDR[PSTACKPTR-2] + I;#INITIALIZE PTRS TO# SAVCOR1
          END                                                            SAVCOR1
          P<BASE> = TOWORDBASE[PSTACKPTR-1];                             SAVCOR1
          IF P<BASE> EQ 0 THEN                                           SAVCOR1
            J = 0;                                                       SAVCOR1
          ELSE J = BASEOPND[0];                                          SAVCOR1
          P<OPERAND2> = TOWORDADDR[PSTACKPTR-1] + J;#OPNDS AND RESULT. # SAVCOR1
          P<RESULT> = TOWORDADDR[PSTACKPTR];                             SAVCOR1
          IF K LS O"120"
          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                #
            SKIPPER;
            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                #
            SKIPPER;
            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;                                                  SAVCOR1
          IF K LS O"100" THEN                                            SAVCOR1
            GOTO OPERATION[K]; #SWITCH TO OPCODE ROUTINE#                SAVCOR1
IF K LS O"120" THEN 
          BEGIN CUMU = FALSE;                                            SAVCOR1
                IF EDITFLAG[PSTACKPTR] THEN                              SAVCOR1
                BEGIN CUMU = TRUE;                                       SAVCOR1
                      J6 = P<OPERAND2>;                                  SAVCOR1
                END                                                      SAVCOR1
                GOTO MIN;                                                SAVCOR1
          END                                                            SAVCOR1
                   #MIN AND MAX#                                         SAVCOR1
          IF K EQ O"314" THEN GOTO DECODE;                               SAVCOR1
          IF K EQ O"313" THEN GOTO DECODING;                             SAVCOR1
          IF K EQ O"300" THEN GOTO SCANNING;   # SCAN FUNCTION #
          IF K EQ O"120" THEN IR[0] = IR[0] + 1;                         SAVCOR1
                 #INCREMENT FOR -COUNT- FUNCTION#                        SAVCOR1
         ELSE                                                            SAVCOR1
               #FIRST TIME FOR THIS CUMULATIVE FUNCTION,                 SAVCOR1
                SO JUST MOVE PARAMETER TO RESULT LOCATION#               SAVCOR1
          BEGIN                                                          SAVCOR1
          J1 = RELFROMCHAR[PSTACKPTR - 1];
          J2 = NBRCHARS[PSTACKPTR - 2]; 
          J3 = RELFROMCHAR[PSTACKPTR - 2];
          IF K EQ O"151"           # IF MIN FOR COMPUTATIONAL          #
            OR K EQ O"161"         # IF MAX FOR COMPUTATIONAL          #
          THEN
            BEGIN 
            J2 = 10;               # ALREADY CONVERTED TO FLOATING     #
            J3 = 0; 
            END 
          CMOVE(OPERAND1, J3, J2, RESULT, 0); 
          CMOVE(OPERAND1, J3, J2, OPERAND2, J1);
          EDITFLAG[PSTACKPTR] = TRUE;                                    SAVCOR1
          I = K - O"50";                                                 SAVCOR1
          OPCODE[PSTACKPTR] = I;                                         SAVCOR1
          IF B<57,3>I LQ 1     #FOR NUMERIC ITEM#                        SAVCOR1
          THEN BEGIN I = 1; J = 2; CUMU = FALSE; GOTO MIN;               SAVCOR1
               END                                                       SAVCOR1
         END                                                             SAVCOR1
          TEST PSTACKPTR;    #TEMPORARY FOR CUMMULATIVE FUNCTIONS      # SAVCOR1
      ABSOLCOMP: #71#                                                    SAVCOR1
                  #ABSOLUTE FOR COMPUTATIONAL#                           SAVCOR1
          I = NBRCHARS[PSTACKPTR-1];                                     SAVCOR1
                    #NB OF CHARS#                                        SAVCOR1
          J = I / 10;                                                    SAVCOR1
                    #NB OF WORDS#                                        SAVCOR1
          CMOVE(OPERAND2,RELFROMCHAR[PSTACKPTR-1],I,RESULT,0);           SAVCOR1
                 #MOVE PARAMETER TO RESULT LOCATION FIRST#               SAVCOR1
          I = I - 1;               # POSITION OF LAST CHARACTER        #
          J = I / 10;              # WORD OF LAST CHARACTER            #
          I = I - J * 10;                                                SAVCOR1
          K = B<I*6,6>UR[J];
             #THEN PICK UP LAST CHAR#                                    SAVCOR1
          IF K EQ O"66" THEN K = O"72";                                  SAVCOR1
            #IF -0 THEN CHANGE TO +0#                                    SAVCOR1
          ELSE                                                           SAVCOR1
          IF K GR O"11" AND K LS O"23" THEN K = K - O"11";               SAVCOR1
              #IF NEGATIVE,CHANGE TO POSITIVE#                           SAVCOR1
          B<I*6,6>UR[J] = K;
          TEST PSTACKPTR;                                                SAVCOR1
      ABSOLINT: #72#                                                     SAVCOR1
               #ABSOLUTE FOR INTEGER NUMBER#                             SAVCOR1
      ABSOLUNOR: #73#                                                    SAVCOR1
      ABSOLREL:  #74#                                                    SAVCOR1
               #ABSOLUTE FOR FLOATING POINT#                             SAVCOR1
         IF I2[0] LS 0 THEN IR[0]=-I2[0];                                SAVCOR1
         ELSE IR[0]= I2[0];                                              SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      JULIAN: #75#                                                       SAVCOR1
          J = 0;                                                         SAVCOR1
                #RESET NB OF DIGITS TO 0#                                SAVCOR1
         IF CONVERTCODE[PSTACKPTR-1] EQ 1 THEN BEGIN                     SAVCOR1
               #PARAMETER IS IN CHAR MODE#                               SAVCOR1
          K = RELFROMCHAR[PSTACKPTR-1];  # STARTING CHAR POSITION      #
          CMOVE(OPERAND2,K,10,RESULT,0);  # ALLIGN ARGUMENT            #
          FOR I = 0 STEP 1 UNTIL 9 DO                                    SAVCOR1
          BEGIN                                                          SAVCOR1
              K = C<I,1>UR[0] - O"33";  # PICK UP A CHAR               #
              IF K GQ 0 AND K LS 10 THEN                                 SAVCOR1
              BEGIN                                                      SAVCOR1
                  MDY[J] = K;                                            SAVCOR1
                #IF BETWEEN 0 TO 9, STORE THAT DIGIT#                    SAVCOR1
                  IF J EQ 5 THEN GOTO GET6DIGIT;                         SAVCOR1
              #ENOUGH DIGIT HAVE BEEN FOUND, GO PROCESS THE JULIAN       SAVCOR1
               DATE, ELSE INCREMENT NB OF DIGITS FOUND#                  SAVCOR1
                  J = J + 1;                                             SAVCOR1
              END                                                        SAVCOR1
          END                                                            SAVCOR1
      IF J EQ 5 AND IPYMD LS O"400000" THEN                              SAVCOR1
             #IF ONLY 5 DIGIT IS FOUND, FIRST DIGIT IS A SUPPRESSED 0#   SAVCOR1
      BEGIN FOR J = 5 STEP -1 UNTIL 1 DO MDY[J] = MDY[J-1];              SAVCOR1
             #SHIFT ALL THE DIGITS TO MAKE ROOM FOR THE SUPPRESSED 0#    SAVCOR1
            MDY[0] = 0;                                                  SAVCOR1
            GOTO GET6DIGIT;                                              SAVCOR1
      END                                                                SAVCOR1
          DIAG(906);                                                     SAVCOR1
          RC = 906;                # PARAMETER FOR JULIAN IN ERROR     #
                                   # MOVE ERROR CODE TO RETURNCODE     #
          ERRORSET; 
             #NOT ENOUGH DIGITS HAD BEEN FOUND,ERROR IN FUNCTION PARAM#  SAVCOR1
          RETURN;                                                        SAVCOR1
          END                                                            SAVCOR1
         ELSE                                                            SAVCOR1
         BEGIN I = U2[0];                                                SAVCOR1
             #PARAMETER IS IN INTEGER FORM,SO GET ALL THE 6 DIGITS       SAVCOR1
               NEEDED BY CONVERTING OCTAL TO DECIMAL#                    SAVCOR1
               FOR J = 5 STEP -1 UNTIL 0 DO                              SAVCOR1
               BEGIN K = I / 10;                                         SAVCOR1
                     MDY[J] = I - K*10;                                  SAVCOR1
                     I = K;                                              SAVCOR1
               END                                                       SAVCOR1
         END                                                             SAVCOR1
      GET6DIGIT:                                                         SAVCOR1
                #ALL 6 DIGITS HAD BEEN LOCATED#                          SAVCOR1
      K = 0;                                                             SAVCOR1
      P<YYDDMM>= LOC(J1);                                                SAVCOR1
      FOR J = 42 STEP 3 UNTIL 59 DO                                      SAVCOR1
                #SHIFTING THE 6 DIGITS AROUND(ACCORDING TO               SAVCOR1
                 THE DEFAULT ORDER OF MONTH,DAY,AND YEAR TO              SAVCOR1
                 PUT IT IN A ORDER OF MMDDYY)#                           SAVCOR1
      BEGIN II = B<J,3>IPYMD;                                            SAVCOR1
            YDM[II] = MDY[K];                                            SAVCOR1
            K = K + 1;                                                   SAVCOR1
      END                                                                SAVCOR1
                #USING THE DIGITS TO CALCULATE THE JULIAN DATE#          SAVCOR1
          IF J5 LS 7                   # ADJUST FOR YEAR 2000 # 
          THEN
            BEGIN 
            J5 = J5 + 10; 
            END 
          J1 = J1 * 10 + J2;                                             SAVCOR1
          J2 = J3 * 10 + J4 - 32075;                                     SAVCOR1
          J3 = (J1 - 14) / 12;                                           SAVCOR1
          J4 = J5 * 10 + J6 + 6700 + J3;                                 SAVCOR1
          J5 = J1 - 2 - J3 * 12;                                         SAVCOR1
          J6 = (J4 + 100) / 100;                                         SAVCOR1
          J1 = (1461 * J4) / 4;                                          SAVCOR1
          J3 = (367 * J5) / 12;                                          SAVCOR1
          J4 = (3 * J6) / 4;                                             SAVCOR1
          IR[0] = J1 + J2 + J3 - J4;                                     SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      GREG:                                                              SAVCOR1
             #FOR GREG,USE THE PARAMETER TO CALCULATE THE 6              SAVCOR1
              DIGITS REPRESENTING THE MMDDYY#                            SAVCOR1
          J4 = I2[0] + 68569;                                            SAVCOR1
          J5 = (4 * J4) / 146097;                                        SAVCOR1
          J4 = J4 - (146097 * J5 + 3) / 4;                               SAVCOR1
          J3 = (4000 * (J4 + 1)) / 1461001;                              SAVCOR1
          J4 = J4 - (1461 * J3) / 4 + 31;                                SAVCOR1
          J1 = (80 * J4) / 2447;                                         SAVCOR1
          J2 = J4 - (2447 * J1) / 80;                                    SAVCOR1
          J4 = J1 / 11;                                                  SAVCOR1
          J1 = J1 + 2 - 12 * J4;                                         SAVCOR1
          J3 = J3 + J4;                                                  SAVCOR1
          J5 = J3 / 10;                                                  SAVCOR1
          J6 = J3 - J5 * 10;                                             SAVCOR1
          J3 = J2 / 10;                                                  SAVCOR1
          J4 = J2 - J3 * 10;                                             SAVCOR1
          I = J1 / 10;                                                   SAVCOR1
          J2 = J1 - I * 10;                                              SAVCOR1
          J1 = I;                                                        SAVCOR1
          J = 0;                                                         SAVCOR1
          IF J5 GQ 10                  # ADJUST FOR YEAR 2000 # 
          THEN
            BEGIN 
            J5 = J5 - 10; 
            END 
      P<YYDDMM> = LOC(J1);                                               SAVCOR1
      FOR K = 42 STEP 3 UNTIL 59 DO                                      SAVCOR1
      BEGIN II = B<K,3>IPYMD;                                            SAVCOR1
            MDY[J] = YDM[II];                                            SAVCOR1
             #SHIFTING THE DIGITS TO MAJKE IT IN THE ORDER AS            SAVCOR1
              THE DEFAULT ORDER OF MONTH DAY AND YEAR#                   SAVCOR1
            J = J + 1;                                                   SAVCOR1
      END                                                                SAVCOR1
      J = 0;                                                             SAVCOR1
          UR[0] = "          ";                                          SAVCOR1
             #BLANK OUT RESULT FIRST#                                    SAVCOR1
          FOR I = 1 STEP 3 UNTIL 8 DO                                    SAVCOR1
          BEGIN                                                          SAVCOR1
             #CONVERTING THE DIGITS INTO DISPLAY CODE, AND PUT           SAVCOR1
              IN RESULT#                                                 SAVCOR1
              C<I,1>UR[0] = MDY[J] + O"33";                              SAVCOR1
              C<I+1,1>UR[0] = MDY[J+1] + O"33";                          SAVCOR1
              J = J + 2;                                                 SAVCOR1
          END                                                            SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MASK: #77#                                                         SAVCOR1
          P<BASE> = TOWORDBASE[PSTACKPTR-3];                             SAVCOR1
          IF P<BASE> EQ 0 THEN J = 0;                                    SAVCOR1
          ELSE J = BASEOPND[0];                                          SAVCOR1
           JJ = NBRCHARS[PSTACKPTR-1];                                   SAVCOR1
           J1 = TOWORDADDR[PSTACKPTR-3]+J;                               SAVCOR1
          II = P<OPERAND1>;                                              SAVCOR1
        REPEA: # #                                                       SAVCOR1
          J3 = RELFROMCHAR[PSTACKPTR - 2];
          CMOVE(OPERAND1, J3, 10, J4, 0);  # J4 = BACKGROUND FIELD     #
          J3 = RELFROMCHAR[PSTACKPTR - 1];
          CMOVE(OPERAND2, J3, 10, J5, 0);  # J5 = MASK                 #
          P<OPERAND1> = J1; 
          J3 = RELFROMCHAR[PSTACKPTR - 3];
          CMOVE(OPERAND1, J3, 10, J6, 0);  # J6 = MASKED FIELD         #
          I = J4 LAN (LNO J5);
          J = J6 LAN J5;
          UR[0] = I LOR J;                                               SAVCOR1
          IF JJ LS 11 THEN                                               SAVCOR1
               #FINAL MASK#                                              SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
          J1 = J1 + 1;                                                   SAVCOR1
          II = II + 1;                                                   SAVCOR1
          JJ = JJ - 10;                                                  SAVCOR1
          P<OPERAND1> = II;                                              SAVCOR1
          P<OPERAND2> = P<OPERAND2> + 1;                                 SAVCOR1
          P<RESULT> = P<RESULT> + 1;                                     SAVCOR1
          GOTO REPEA;                                                    SAVCOR1
      SCANNING:    # 300 #
          JJ = EXPRESSTACK[PSTACKPTR];  # NO OF OPERANDS               #
          SCANINDEX = PSTACKPTR - JJ; 
  
#         THE COMPARISON FIELD, OR DATAITEM, IS DESCRIBED IN           #
#         PROGRAMSTACK[SCANINDEX].  THE NECESSARY INFORMATION, LENGTH  #
#         ADDRESS OF THE FIELD, STARTING BIT POSITION, ETC., IS        #
#         EXTRACTED HERE.                                              #
  
          DATASTART = RELTOCHAR[SCANINDEX] * 6; 
          W1 = 0; 
          W2 = 0; 
          P<BASE> = TOWORDBASE[SCANINDEX];  # SEE IF THE ADDRESS #
          IF P<BASE> EQ 0 THEN J1 = 0;          # IS RELATIVE OR ABS #
          ELSE J1 = BASEOPND[0];
          DATAITEMLOC = TOWORDADDR[SCANINDEX] + J1; 
          DATALENGTH = NBRCHARS[SCANINDEX]; 
            # THE STRING TO BE USED IN THE COMPARISON IS DESCRIBED #
            # IN PROGRAMSTACK ENTRY SCANINDEX+I, WHERE I = 1 THRU      #
            # NO OF OPERANDS - 1.  THE INFORMATION ABOUT EACH STRING   #
            # IS EXTRACTED, AND A CALL TO -SCAN- IS MADE #
            # FOR EACH STRING.  IF A NON-ZERO RESULT IS # 
            # RETURNED, THE SCAN STOPS AND A VALUE OF -FALSE- # 
            # IS RETURNED.  IF THE LOOP EXPIRES WITH A ZERO # 
            # RESULT, A VALUE OF -TRUE- IS RETURNED.  # 
          FOR II = 1 STEP 1 UNTIL JJ - 1 DO 
            BEGIN 
            STRINGSTART = RELTOCHAR[SCANINDEX + II] * 6;
            P<BASE> = TOWORDBASE[SCANINDEX + II]; 
            IF P<BASE> EQ 0 THEN J1 = 0;
            ELSE J1 = BASEOPND[0];
            STRINGLOC = TOWORDADDR[SCANINDEX + II] + J1;
            STRINGLENGTH = NBRCHARS[SCANINDEX + II];
            IF SCAN(W1, W2, STRINGSTART, DATASTART, STRINGLOC,
                     DATAITEMLOC, STRINGLENGTH, DATALENGTH) EQ 0
              THEN BR[0] = TRUE;
            ELSE
              BEGIN 
              BR[0] = FALSE;
              SKIPPER;
              TEST PSTACKPTR; 
              END 
            TEST II;
            END 
            SKIPPER;
          TEST PSTACKPTR; 
      MIN: #100 - 117#             #ALWAYS KEEP MIN(MAX) IN OP2        # SAVCOR1
          JJ = 1;                                                        SAVCOR1
          II = OPCODE[PSTACKPTR] - O"100";                               SAVCOR1
         J1 = 0;                                                         SAVCOR1
      PICKMIN: # #                                                       SAVCOR1
          GOTO MINSWITCH[II];                                            SAVCOR1
      MINALL: # #                                                        SAVCOR1
          J = J + 1;                                                     SAVCOR1
          IF J GR PSTACKPTR-EXPRESSTACK[PSTACKPTR] THEN                  SAVCOR1
            GOTO MINDONE;                                                SAVCOR1
          IF ENTRYTYPE[PSTACKPTR-J] EQ 7 THEN GOTO MINDONE;              SAVCOR1
          P<BASE> = TOWORDBASE[PSTACKPTR-J];                             SAVCOR1
          IF P<BASE> EQ 0 THEN I = 0;                                    SAVCOR1
          ELSE I = BASEOPND[0];                                          SAVCOR1
          P<OPERAND1> = TOWORDADDR[PSTACKPTR - J] + I;                   SAVCOR1
          I = JJ;                                                        SAVCOR1
          GOTO PICKMIN;                                                  SAVCOR1
      MINDONE: # #                                                       SAVCOR1
          JJ = PSTACKPTR - JJ;                                           SAVCOR1
          IF II EQ 1               # MIN FOR COMPUTATIONAL             #
            OR II EQ O"11"         # MAX FOR COMPUTATIONAL             #
          THEN
            BEGIN 
            J2 = 10;               # LENGTH OF FLOATING                #
            J3 = 0;                # STARTING CHAR OF FLOATING         #
            END 
          ELSE
            BEGIN 
            J2 = NBRCHARS[JJ];
            J3 = RELFROMCHAR[JJ]; 
            END 
          CMOVE(OPERAND2,J3,J2,RESULT,J1); #MOVE TO RESULT LOCATION#
          IF CUMU THEN                                                   SAVCOR1
          BEGIN P<OPERAND1> = J6;                                        SAVCOR1
          CMOVE(OPERAND2,J3,J2,OPERAND1,0); #MOVE TO 2ND OPERAND #
          END                                                            SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MINCHAR: #100#                                                     SAVCOR1
          IF COMPARECHARS LS 0 THEN GOTO MOVEMIN; #OP2 > OP1, MOVE MIN # SAVCOR1
          GOTO MINALL;                            #IN OP2              # SAVCOR1
      MININT: #102#                                                      SAVCOR1
          IF I1[0] LS I2[0] THEN GOTO MOVEMIN;                           SAVCOR1
                                   #OP1 < OP2, MOVE TO OP2#              SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
     MINNUM: #101#   #SINCE THE OPERAND IS CONVERTED TO FLOATING
                     IT IS TREATED AS MINON FLOATING NUMBER#
      MINUNOR: #103#                                                     SAVCOR1
      MINREAL: #104#                                                     SAVCOR1
          IF R1[0] LS R2[0] THEN GOTO MOVEMIN;                           SAVCOR1
                                   #OP1 < OP2, MOVE TO OP2 #             SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      MINDBL: #105#                                                      SAVCOR1
      MINCPX: #106#                                                      SAVCOR1
          IF R1[0] LS R2[0] OR (R1[0] EQ R2[0] AND D1[0] LS D2[0]) THEN  SAVCOR1
              GOTO MOVEMIN;  #OP1 < OP2, MOVE TO OP2#                    SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      MINLGL: #107#                                                      SAVCOR1
          IF NOT B1[0]
            OR NOT B2[0]
          THEN
            BEGIN                  # SMALLEST POSSIBLE VALUE 0         #
            BR[0] = FALSE;
            SKIPPER;
            TEST PSTACKPTR; 
            END 
          GOTO MINALL;                                                   SAVCOR1
      MAXCHAR: #110#                                                     SAVCOR1
          IF COMPARECHARS GR 0 THEN GOTO MOVEMIN; #OP1>OP2, MOVE TO OP2# SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      MAXINT: #112#                                                      SAVCOR1
          IF I1[0] GR I2[0] THEN GOTO MOVEMIN;                           SAVCOR1
                                  #OP1 > OP2, MOVE TO OP2#               SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      MAXNUM: #111#   #TREATED AS MAX ON FLOATING NUMBER# 
      MAXUNOR: #113#                                                     SAVCOR1
      MAXREAL: #114#                                                     SAVCOR1
          IF R1[0] GR R2[0] THEN GOTO MOVEMIN;                           SAVCOR1
          GOTO MINALL;             #OP1 > OP2, MOVE TO OP2#              SAVCOR1
      MAXDBL: #115#                                                      SAVCOR1
      MAXCPX: #116#                                                      SAVCOR1
          IF R1[0] GR R2[0] OR (R1[0] EQ R2[0] AND D1[0] GR D2[0]) THEN  SAVCOR1
              GOTO MOVEMIN;                                              SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      MAXLGL: #117#                                                      SAVCOR1
          IF B1[0]
            OR B2[0]
          THEN
            BEGIN                  # MAX POSSIBLE VALUE IS 1 - TRUE    #
            BR[0] = TRUE; 
            SKIPPER;
            TEST PSTACKPTR; 
            END 
          GOTO MINALL;                                                   SAVCOR1
        DECODE: #314#                                                    SAVCOR1
          SVINDTBL = P<INDTBL>;                                          SAVCOR1
          DEUB = UB;                                                     SAVCOR1
          OPCODE[PSTACKPTR] = O"313";                                    SAVCOR1
          II = EXPRESSTACK[PSTACKPTR] ;                                  SAVCOR1
          J2 = 1;                                                        SAVCOR1
          J3 = II - 1;                                                   SAVCOR1
          J1 = 0;                                                        SAVCOR1
        DECODING: #313#                                                  SAVCOR1
        P<INDTBL> = P<PROGRAMSTACK> + (PSTACKPTR-II+J1) * STKSIZE;
          J1 = J1 + 2;                                                   SAVCOR1
          J2 = (J2 - 1) * UB + CURSUB;                                   SAVCOR1
          IF J1 GR J3 THEN GOTO ENDECOD;                                 SAVCOR1
          # BUILD PROGRAMSTACK USING ARAY                              #
          FOR J = 0 STEP 1 UNTIL 7  # FIRST TWO STACK ENTRIES          #
          DO
            BEGIN 
            ARAW[J] = INDTBLWD[J];
            END 
          P<DESATT1> = B<24,18>INDTBLWD[0]; 
                                   # FORCE -NOTHING- ACTION FOR 2ND    #
          ARACD[STKSIZE*1] = 1;    # PARAM SINCE VALUE REMAINS CONSTANT#
          # BUILD LAST TWO STACK ENTRIES                               #
          ARACD[STKSIZE*2] = 7;    # ENTRY 2 IS OPERATOR               #
          ARADD[STKSIZE*2] = INDCE[0];
          ARACD[STKSIZE*3] = 7;    # ENTRY 3 IS END-OF-STACK           #
          ARADD[STKSIZE*3] = INDCE[0];
          ARAOP[STKSIZE*3] = O"70"; 
          P<INDTBL> = B<6,18>INDTBLWD[1];  # LOCATE 1ST INDICE TABL    #
          ALLFG[0] = TRUE;         # SET *ALL* FLAG                    #
          CONSUB[0] = FALSE;                                             SAVCOR1
          FGALL = FALSE;                                                 SAVCOR1
          FGANY = FALSE;                                                 SAVCOR1
          PREVIOUS = PREVIOUS + 1;                                       SAVCOR1
          STACKADDR[PREVIOUS] = P<PROGRAMSTACK>;                         SAVCOR1
          PSTKPTR[PREVIOUS] = PSTACKPTR - 1;                             SAVCOR1
          P<PROGRAMSTACK> = LOC(ARAY);                                   SAVCOR1
          WORD = CVTCODE1[0];      # UPPER 3 BITS OF CONVERTCODE       # QU3A072
          CHAR = CVTCODE2[0];      # LOWER 3 BITS OF CONVERTCODE       # QU3A072
          OPCODE[2] = C<CHAR,1>NECODE[WORD];  # VALUE OF NE (")        # QU3A072
          GOTO EVALEXPRESS;                                              SAVCOR1
        ENDECOD: # #                                                     SAVCOR1
          OPCODE[PSTACKPTR] = O"314";                                    SAVCOR1
          P<INDTBL> = SVINDTBL;                                          SAVCOR1
          IF J2 LQ DEUB THEN                                             SAVCOR1
          BEGIN INDCE[0] = J2;                                           SAVCOR1
                TOWORDADDR[PSTACKPTR-1] = TOWORDADDR[PSTACKPTR];         SAVCOR1
                P<BASE> = LOC(PSTKWORD[PSTACKPTR-1]);                    SAVCOR1
                IF CONVERTCODE[PSTACKPTR - 1] 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 - 1]; 
                  TOWORDADDR[PSTACKPTR - 1] = LOC(ATTR) - 1;
                  END 
                FIGSUB(BASE,I);                                          SAVCOR1
                IF CONVERTCODE[PSTACKPTR - 1] EQ O"20"
                THEN
                  BEGIN 
                  TOWORDADDR[PSTACKPTR - 1] = AWPOS[0]; 
                  END 
                IF I NQ 0 THEN     # IF ERROR DETECTED                 #
                  BEGIN 
                  DIAG(I);         # ISSUE ERROR MESSAGE               #
                  RC = I;          # MOVE ERROR CODE TO RETURNCODE     #
                  ERRORSET; 
                  RETURN; 
                  END 
          END                                                            SAVCOR1
          ELSE
            BEGIN 
            DIAG(42);              # ERROR IN SUBSCRIPT DIMENSIONING   #
            RC = 42;               # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RETURN; 
            END 
          ALLFG[0] = TRUE;                                               SAVCOR1
          CONSUB[0] = FALSE;                                             SAVCOR1
          INDCE[0] = 0;                                                  SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MOVEMIN: # #                                                       SAVCOR1
          P<OPERAND2> = P<OPERAND1>;                                     SAVCOR1
          JJ = J;                                                        SAVCOR1
          GOTO MINALL;                                                   SAVCOR1
      ENDOFOPS:                                                          SAVCOR1
          IF PREVIOUS LS 0 THEN                                          SAVCOR1
          BEGIN                                                          SAVCOR1
            IF LOGICALRESLT THEN                                         SAVCOR1
              LOGICALRESLT = BR[0];                                      SAVCOR1
            RETURN;                    # MAIN EXPRESSION COMPLETE.     # SAVCOR1
          END                                                            SAVCOR1
          P<PROGRAMSTACK> = STACKADDR[PREVIOUS];                         SAVCOR1
          PSTACKPTR = PSTKPTR[PREVIOUS];# RESET PTRS.                  # SAVCOR1
          PREVIOUS = PREVIOUS - 1;                                       SAVCOR1
          SKIPPER;                 # SEE IF CONDITION NEEDS SKIPPING.  #
          TEST PSTACKPTR;                                                SAVCOR1
      ADDINT:                                                            SAVCOR1
          IR[0] = I1[0] + I2[0];       # ADD TWO INTEGER VALUES.       # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      SUBTRACTINT:                                                       SAVCOR1
          IR[0] = I1[0] - I2[0];       # SUBTRACT INT2 FROM INT1.      # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MULTIPLYINT:                                                       SAVCOR1
          IR[0] = I1[0] * I2[0];       # MULTIPLY TWO INTEGERS.        # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      DIVIDEINT:                                                         SAVCOR1
          IF I2[0] EQ 0 THEN       # IF DIVISOR EQ 0                   #
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            RC = 945;              # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            IR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          IR[0] = I1[0] / I2[0];       # DIVIDE INT1 BY INT2.          # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      NEGATEINT:                                                         SAVCOR1
          IR[0] = -I2[0];              # UNARY MINUS OPERATION.        # SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EXPONENTINT:                                                       SAVCOR1
          IR[0] = ITOJ(I1[0],I2[0]);                                     SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EQINT:                                                             SAVCOR1
          IF I1[0] EQ I2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      NEINT:                                                             SAVCOR1
          IF I1[0] NQ I2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LTINT:                                                             SAVCOR1
          IF I1[0] LS I2[0] THEN
            BEGIN 
            BR[0] = TRUE; 
            END 
          ELSE
            BEGIN 
            BR[0] = FALSE;
            END 
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      GTINT:                                                             SAVCOR1
          IF I1[0] GR I2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LEINT:                                                             SAVCOR1
          IF RTBLCALL NQ 0 THEN    # CALL FROM NEXTGET                 #
            BEGIN 
            RTBLCALL = I1[0] - I2[0]; 
            END 
          ELSE
            BEGIN 
            IF I1[0] LQ I2[0] THEN
              BEGIN 
              BR[0] = TRUE; 
              END 
            ELSE
              BEGIN 
              BR[0] = FALSE;
              END 
          SKIPPER;
            END 
          TEST PSTACKPTR;                                                SAVCOR1
      GEINT:                                                             SAVCOR1
          IF I1[0] GQ I2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      EQUIVALENCE:                                                       SAVCOR1
          IF (I1[0] EQ 0 AND I2[0] EQ 0) OR (I1[0] NQ 0 AND              SAVCOR1
          I2[0] NQ 0) THEN IR[0] = -1;                                   SAVCOR1
          ELSE IR[0] = 0;                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      IMPLIES:                                                           SAVCOR1
          IR[0] = I1[0] LIM I2[0];                                       SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      LOGAND:                                                            SAVCOR1
          BR[0] = B1[0] AND B2[0];                                       SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LOGOR:                                                             SAVCOR1
          BR[0] = B1[0] OR B2[0];                                        SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      ADDSP:                                                             SAVCOR1
          RR[0] = R1[0] + R2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      SUBTRACTSP:                                                        SAVCOR1
          RR[0] = R1[0] - R2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MULTIPLYSP:                                                        SAVCOR1
          RR[0] = R1[0] * R2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      DIVIDESP:                                                          SAVCOR1
          IF R2[0] EQ 0 THEN
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            RC = 945;              # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          RR[0] = R1[0] / R2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      NEGATESP:                                                          SAVCOR1
          RR[0] = -R2[0];                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EXPONENTSP:                                                        SAVCOR1
          IF R1[0] LS 0            # ILLEGAL ARGUMENT                  #
          THEN
            BEGIN 
            DIAG(948);             # ILLEGAL ARGUMENT TO EXPONENTIATION#
            RC = 948;              # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          IR[0] = XTOY(R1[0],R2[0]);                                     SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EQSP:                                                              SAVCOR1
          IF R1[0] EQ R2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      NESP:                                                              SAVCOR1
          IF R1[0] NQ R2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LTSP:                                                              SAVCOR1
          IF R1[0] LS R2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      GTSP:                                                              SAVCOR1
          IF R1[0] GR R2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LESP:                                                              SAVCOR1
          IF RTBLCALL NQ 0                                               SAVCOR3
            THEN IF R1[0] LQ R2[0]                                       SAVCOR3
                   THEN IF R1[0] LS R2[0]                                SAVCOR3
                          THEN RTBLCALL = -1;                            SAVCOR3
                          ELSE RTBLCALL = 0;                             SAVCOR3
                   ELSE RTBLCALL = 1;                                    SAVCOR3
            ELSE
              BEGIN 
              IF R1[0] LQ R2[0] 
                   THEN BR[0] = TRUE;                                    SAVCOR3
                   ELSE BR[0] = FALSE;                                   SAVCOR3
              SKIPPER;
              END 
          TEST PSTACKPTR;                                                SAVCOR1
      GESP:                                                              SAVCOR1
          IF R1[0] GQ R2[0] THEN                                         SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LOGXOR:                                                            SAVCOR1
          IR[0] = I1[0] LXR I2[0];                                       SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      LOGNOT:                                                            SAVCOR1
          BR[0] = NOT B2[0];                                             SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      EQX:                                                               SAVCOR1
          IF COMPARECHARS EQ 0 THEN                                      SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      NEX:                                                               SAVCOR1
          IF COMPARECHARS NQ 0 THEN                                      SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      ADDDP:                                                             SAVCOR1
          DADD(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR;                                                SAVCOR1
      SUBTRACTDP:                                                        SAVCOR1
          DSUB(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR;                                                SAVCOR1
      MULTIPLYDP:                                                        SAVCOR1
          DMULT(OPERAND1,OPERAND2,RESULT);
          TEST PSTACKPTR;                                                SAVCOR1
      DIVIDEDP:                                                          SAVCOR1
          IF R2[0] EQ 0 
          THEN
            BEGIN 
            DIAG(945);             # DIVISION BY ZERO IS ILLEGAL       #
            RC = 945;              # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            DR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          DDIV(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR;                                                SAVCOR1
      NEGATEDP:                                                          SAVCOR1
          RR[0] = -R2[0];                                                SAVCOR1
          DR[0] = -D2[0];                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EXPONENTDP:                                                        SAVCOR1
          IF R1[0] LS 0            # ILLEGAL ARGUMENT                  #
          THEN
            BEGIN 
            DIAG(948);             # ILLEGAL ARGUMENT TO EXPONENTIATION#
            RC = 948;              # MOVE ERROR CODE TO RETURNCODE     #
            ERRORSET; 
            RR[0] = 0;             # SET RESULT TO ZERO                #
            DR[0] = 0;             # SET RESULT TO ZERO                #
            TEST PSTACKPTR; 
            END 
          DTOD(OPERAND1,OPERAND2,RESULT); 
          TEST PSTACKPTR;                                                SAVCOR1
      EQDP:                                                              SAVCOR1
      EQCPLX:                                                            SAVCOR1
          IF R1[0] EQ R2[0] AND                                          SAVCOR1
             D1[0] EQ D2[0] THEN                                         SAVCOR1
               BR[0] = TRUE;                                             SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      NEDP:                                                              SAVCOR1
      NECPLX:                                                            SAVCOR1
          IF R1[0] NQ R2[0] OR                                           SAVCOR1
             D1[0] NQ D2[0] THEN                                         SAVCOR1
               BR[0] = TRUE;                                             SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LTDP:                                                              SAVCOR1
          IF R1[0] LS R2[0] OR                                           SAVCOR1
             R1[0] EQ R2[0] AND D1[0] LS D2[0] THEN                      SAVCOR1
               BR[0] = TRUE;                                             SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      GTDP:                                                              SAVCOR1
          IF R1[0] GR R2[0] OR                                           SAVCOR1
             R1[0] EQ R2[0] AND D1[0] GR D2[0] THEN                      SAVCOR1
               BR[0] = TRUE;                                             SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LEDP:                                                              SAVCOR1
          IF R1[0] LS R2[0] OR                                           SAVCOR1
             R1[0] EQ R2[0] AND D1[0] LS D2[0] THEN                      SAVCOR1
              BEGIN 
               BR[0] = TRUE;                                             SAVCOR1
              SKIPPER;
              END 
          ELSE GOTO EQDP;                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      GEDP:                                                              SAVCOR1
          IF R1[0] GR R2[0] OR                                           SAVCOR1
             R1[0] EQ R2[0] AND D1[0] GR D2[0] THEN                      SAVCOR1
              BEGIN 
               BR[0] = TRUE;                                             SAVCOR1
              SKIPPER;
              END 
          ELSE GOTO EQDP;                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      LTX:                                                               SAVCOR1
          IF COMPARECHARS LS 0 THEN                                      SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      GTX:                                                               SAVCOR1
          IF COMPARECHARS GR 0 THEN                                      SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          SKIPPER;
          TEST PSTACKPTR;                                                SAVCOR1
      LEX:                                                               SAVCOR1
          IF RTBLCALL NQ 0                                               SAVCOR3
            THEN RTBLCALL = COMPARECHARS;                                SAVCOR3
          ELSE
            BEGIN 
            IF COMPARECHARS LQ 0
                   THEN BR[0] = TRUE;                                    SAVCOR3
                   ELSE BR[0] = FALSE;                                   SAVCOR3
            SKIPPER;
            END 
          TEST PSTACKPTR;                                                SAVCOR1
      GEX:                                                               SAVCOR1
          IF COMPARECHARS GQ 0 THEN                                      SAVCOR1
            BR[0] = TRUE;                                                SAVCOR1
          ELSE BR[0] = FALSE;                                            SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      ADDCPLX:                                                           SAVCOR1
          RR[0] = R1[0] + R2[0];                                         SAVCOR1
          DR[0] = D1[0] + D2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      SUBTRACTCPLX:                                                      SAVCOR1
          RR[0] = R1[0] - R2[0];                                         SAVCOR1
          DR[0] = D1[0] - D2[0];                                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      MULTIPLYCPLX:                                                      SAVCOR1
          RR[0] = R1[0] * R2[0] - (D1[0] * D2[0]);                       SAVCOR1
          DR[0] = R1[0] * D2[0] + R2[0] * D1[0];                         SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      DIVIDECPLX:                                                        SAVCOR1
          ITEM D R;                                                      SAVCOR1
          D = R2[0] * R2[0] + D2[0] * D2[0];                             SAVCOR1
          IF D EQ 0 THEN
            BEGIN 
            DIAG(945);             # DIVISION BY 0 ILLEGAL             #
            RC = 945;              # MOVE ERROR CODE TO RETURNCODE     #
            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;                        SAVCOR1
          DR[0]=(R1[0]*(-D2[0])+R2[0]*D1[0])/D;                          SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      NEGATECPLX:                                                        SAVCOR1
          RR[0] = -R2[0];                                                SAVCOR1
          DR[0] = -D2[0];                                                SAVCOR1
          TEST PSTACKPTR;                                                SAVCOR1
      EXPONENTCPLX:                                                      SAVCOR1
          DIAG(948);               # ILLEGAL ARGUMENT TO EXPONENTIATION#
          RC = 948;                # MOVE ERROR CODE TO RETURNCODE     #
          ERRORSET; 
          RR[0] = 0;               # SET RESULT TO ZERO                #
          DR[0] = 0;               # SET RESULT TO ZERO                #
          TEST PSTACKPTR; 
          END                          # END OF PROGRAM STACK LOOP.    # SAVCOR1
 RETURNEXP:                        # THIS CODE ONLY ACCESSED BY        #
                                   # GOTO RETURNEXP                    #
                                   # THIS OCCURS WHEN AN ERROR IS FOUND#
                                   # WITHIN AN INTERNAL PROC           #
      RETURN;                      # EXIT EXPEVALUATE                  #
      END                                                                SAVCOR1
      TERM;                                                              SAVCOR1
