*DECK EXPANAL 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TOPTION 
USETEXT TPSTACK 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC EXPANAL; 
          BEGIN                             # BEGIN "EXPRESS" PROC     #
  
      BASED ARRAY MOVER  S(STKSIZE); # FINAL PROGRAM STACK             #
        BEGIN 
        ITEM MWORD         U(0,0,60); 
        ITEM MWORD2        U(1,0,60); 
        ITEM MWORD3        U(2,0,60); 
        ITEM MWORD4        U(3,0,60); 
        END 
      BASED ARRAY ATTRIB;          # ATTRIBUTE TABLE FOR LITERAL INTEGR#
        BEGIN 
        ITEM ATTRCLS  U(0,12,6);   # DATATYPE                          #
        ITEM ATTRWP   I(0,18,18);  # BEGINNING WORD POSITION           #
        ITEM ATTRBP   U(0,36,6);   # BEGINNING BIT POSITION            #
        ITEM ATTRSIZE I(0,42,18);  # USESIZE OF ITEM                   #
        ITEM ATTDPTLC I(1,21,6);   # CHAR POS OF POINT RELATIVE        #
                                   # TO THE END OF THE FIELD           #
                                   # >0 = POINT TO LEFT                #
                                   # <0 = POINT TO RIGHT               #
        END 
      ARRAY [7];
        ITEM INTSIZE I(,24,18) = [5(10),2(20),10],
             PICSIZE I(,42,18) = [10,19,19,15,16,20,33,1];              003630
  
      ARRAY AMVEVFROM [1];         # BIT IS SET IF FROMPTR IN MOVE     #
                                   # TABLE OR PROGRAM STACK CONTAINS   #
                                   # ATTRIBUTE TABLE ADDRESS FOR       #
                                   # CORRESPONDING CONVERT CODE        #
        BEGIN 
        ITEM MVEVFROM I(0,0,60) = [O"00077777700000000000",    #NO EDIT#
                                   O"20177777704020140000"];   # EDIT  #
        END 
  
      ITEM
           DATAPTR,                    # PTR TO TOP OF TEMPORARY STACK #
                                       # OF OPERANDS.                  #
           ERRFLAG,                    # FLAG INDICATING VALID EXPRESS.#
           I,J,K,L,M,                  # SCRATCH VARIABLES.            #
           LOGOPFLAG,                  # FLAG = 1 ONCE A LOGICAL OPERA-#
                                       # TOR HAS BEEN FOUND IN A CONDI-#
                                       # TIONAL EXPRESSION.            #
           NRFUNCPARAMS,               # TALLY OF PARAMS IN A FUNC CALL#
           OPPTR,                      # PTR TO TOP OF TEMPORARY STACK #
                                       # OF OPERATORS: OPSTACK.        #
           PSTACKPTR,                  # PTR TO NEXT ENTRY ON PROGRAM  #
                                       # STACK.                        #
           SAVEDADDR,                 # SPACE FOR RESULT OF 1ST HALF  # 
                                      # OF RELATIONAL EXPRESSION WHICH# 
                                      # MUST BE RESERVED.             # 
           SAVEDRELOP,                 # RELATIONAL OPERATOR SAVED FOR #
                                       # DUPLICATION BETWEEN LOGICAL   #
                                       # OPERATORS.                    #
           SAVEDOPND1,                 # 1ST AND 2ND WORDS OF DATASTACK#
           SAVEDOPND2,                 # ENTRY SAVED FOR DUPLICATION IF#
                                       # HALF OF A RELATION IS ABSENT  #
           SAVEDOPND3,
           UNMATCHEDLP;                # TALLY OF CURRENTLY UNMATCHED  #
                                       # LEFT PARENS (NESTED DEATH).   #
      DEF OPSTACKLENG #51#;            # LENGTH OF TEMPORARY OP STACK. #
      DEF DATASTKLENG #103#;           # LENGTH OF TEMPORARY DATA STK. #
      ARRAY OPSTACK[OPSTACKLENG];      # TEMPORARY HOLDING STACK FOR   #
        ITEM OP I(0,51,9),             # OPERATORS.                    #
             PRIORITY I(0,0,9),        # PRECEDENCE OF OPERATOR.       #
             NBROPERANDS I(0,27,9),    # NBR OF OPERANDS IN DATASTACK  #
                                       # FOR THIS OPERATOR.            #
              OPWORD U(0,0,60); 
      ARRAY DATASTACK[DATASTKLENG]  S(4);#TEMPORARY HOLDING STACK FOR  #
          ITEM                         # OPERANDS.                     #
        DTYPE U(0,0,3),                # ITEMS AND VALUE RANGES CORRES-#
        FIGSUBCODE U(0,4,4),           # POND TO SIMILAR ITEMS IN THE  #
        FROMCHARPTR U(0,4,4),          # PROGRAMSTACK ARRAY.           #
        TOCHARPTR U(0,8,4), 
        NRCHARS U(0,12,12),            # LENGTH OF CHAR TYPE OPERANDS. #
        TOWORDPTR I(0,42,18), 
        EDITMURAL B(0,3,1),            # FLAG FOR MURAL PRESENT.      # 
          SUBSC  B(1,6,1),
          IDXTBL U(1,7,17), 
        FROMWORDPTR I(0,24,18), 
        USAGE I(1,0,6),                # USAGE OF DATA ITEMS - MAY OR  #
                                       # MAY NOT = DATATYPE.           #
        FROMBASELOC I(1,24,18),        # LOC OF PTR TO RECORD.         #
               DATALTEKEY B(1,43,1),    #ON FOR ALTERNATE KEY-FIELD    # XXXX 
        DATAPRKEY B(1,42,1),
        DATALITAL B(1,44,1),      # OPERAND IS A LITERAL #
          DATAOVERSIGN  B(1,45,1),  #ON FOR SIGNED ALTERNATE KEY #
        DATAPRMAJ B(1,46,1),       # TRUE IF MAJOR PRIMARY KEY         #
        DATAALTMAJ B(1,47,1),      # TRUE IF MAJOR ALTERNATE KEY       #
        DATAALTSIZE U(1,48,9),     # SIZE OF ALTERNATE KEY OF WHICH    #
                                   # THIS IS MAJOR                     #
        DATAREAITEM B(1,57,1),     # TRUE IF AREA ITEM                 #
        DATAKEYEXCL B(1,58,1),     # TRUE IF PART/ALL OF EXCLUDED KEY  #
        DDATARECDORD U(2,33,12),   # RECORD ORDINAL IF CDCS AREA ITEM  #
                                   # 1 IF CRM AREA ITEM, ELSE 0        #
        DDATAITEMORD U(2,45,15),   # ITEM ORD IF CDCS AREA ITEM, ELSE 0#
        PSTKLOC   U(3,0,15),       # POINTER TO OPERATOR               #
        DSTKWORD4 U(3,0,60),
        DSTKWORD2 U(1,0,60),
        DSTKWORD3 U(2,0,60),
        DSTKWORD  U(0,0,60);
      ARRAY [5];
        ITEM LOGOPS C(,,10) = ["EQUIVALENT","IMPLIES","AND","OR","XOR", 
                               "NOT"];
          ITEM FIRSTTYPE, FIRSTLENGTH, MAXPARAM;
          ITEM HADLAST B;                                               000770
          ITEM HADANY B   ;                                             000780
          ITEM HADALL B;                                                000790
          ITEM HADNEXT B;                                               000800
          ITEM NN;
      ITEM NONEWOP B;              # TRUE IF OPERATOR CALLED BY        #
                                   # CHKLOGOPFLAG TO STACK AN OPERATOR #
                                   # FROM OPSTACK TO PROGRAM STACK, BUT#
                                   # CLXNUM DOES NOT CONTAIN ANOTHER OP#
                                   #------X R E F S--------------------#
                                   #                                   #
      XREF ITEM EOTTERM I;         # NEG IF EOT CAN END CURRENT STATE  #
      XREF ITEM ESTDBEG I;         # BEGINNING OF ITEMS IN -ESTD-      #
      XREF ITEM ESTDEND I;         # END OF ITEMS IN -ESTD-            #
      XREF ITEM ESTDLEN I;         # NUM OF ITEMS IN -ESTD-            #
      XREF ITEM SAMINPUT     B;    # TRUE IF -SAME- LIST IN -QUIWSA-   #
      XREF ITEM SAMPTR  I;         # PTR TO FIRST WORD OF NEW -SAME-   #
      XREF ITEM STATE   I;         # SUBSCRIPT INTO THE STATE TABLE    #
      XREF ITEM SUB100  B;         # TRUE IF -OLDLEX- PTS INTO PREVIOUS#
                                   # SET OF 100 CHARS (IE, -CT100-     #
                                   # INCREMENTED IN MID-WORD)          #
      XREF ITEM SVCT100 I;         # ADD TO -LEXPTR- TO GET NUMBER OF  #
                                   # CHARS SCANNED SO FAR              #
      XREF ITEM SVEOTTERM    I;    # EOT STATUS OF ORIGINAL -QUIWSA-   #
      XREF ITEM SVOLDLEX     I;    # SAVE -LEXPTR- VALUE BEFORE SCAN   #
      XREF ITEM SVQUIRL I;         # LENGTH OF ORIGINAL -QUIWSA-       #
      XREF ITEM SVQUIWSA     I;    # PTR TO ORIGINAL -QUIWSA-          #
      XREF ITEM SVSTATE I;         # STATE ORIG -QUIWSA- WAS LEFT IN   #
      XREF ITEM SVSTATRANS   I;    # PTR TO ORIGINAL STATE TABLE       #
  
      XREF BASED ARRAY STATETRANS [0];;  # PTR TO CURRENT STATE TABLE  #
      XREF BASED ARRAY SVESTD;;    # TEMP HOLD FOR ORIGINAL -ESTD-     #
  
      XREF PROC LEXINIT;           # INITIALIZE SCAN TO START OF QUIWSA#
      XREF PROC MOVE;              # WHOLE WORD MOVE                   #
      XREF ITEM PRIMKEY B;         # TRUE IF PRIMARY KEY OR MAJOR      #
                                   # PRIMARY KEY IS USED IN CONDITION  #
      XREF ITEM ALTERKEY B;        # TRUE IF ALTERNATE KEY OR MAJOR    #
                                   # ALTERNATE KEY IS USED IN CONDITION#
      XREF ITEM CURFUNC B;         # TRUE IF CURRENT ITEM IS A FUNCTION#
      XREF ITEM IMFDBM B;          # TRUE IF IMF DATA BASE MODE        #
      XREF ITEM KEYORDINAL I; 
          XREF PROC CURTT;                                              019750
      XREF PROC RECYES;            # RETURN STDYES IF RECORDING        #
      XREF PROC RECNO;
      XREF BEGIN
          PROC DIAG;
          END 
          XREF FUNC SAVATTR;
          ITEM AAREAITM B;
          ITEM CHKLITAL;
           ITEM DDESITM B;
      ITEM BOOFLAG B;              # TRUE IF EXPR IS BOOLEAN,          #
                                   # FALSE IF EXPR IS ARITH            #
      ITEM CALCULATEK B;           # TRUE, MUST CALCULATE HIGHEST DATA # QU3A072
                                   # TYPE, K                           # QU3A072
      ITEM EDITBIT I;              # INDEX INTO AMVEVFROM ARRAY        #
                                   # TRUE IF EDITTING, ELSE FALSE      #
      ITEM TEMPUSAGE I;                                                  QU3A072
      ITEM LOGERR B;               # TRUE IF EXPR W/O RELN OPERATOR    #
                                   # FOUND BEFORE LOG OPERATOR. OK AT  #
                                   # THAT POINT SINCE EXPR MAY STILL BE#
                                   # ARITH. DIAG WILL BE ISSUED IF LOG #
                                   # OP LATER FOUND, MAKING EXPR BOOL  #
      ITEM LOGOPSAVED I;           # A FLAG TO DISCARD SAVED SUBJECT   #
                                   # AND OPERATOR AT END OF PAREN PAIR #
                                   # IN WHICH IT WAS SAVED             #
      ITEM RELOPSAVED I;           # FLAG SET IF OPERAND AND RELATIONAL#
                                   # SPECIFIED                         #
      ITEM OPERANDSAVED I;         # FLAG SET IF OPERAND ENCOUNTERED   #
      ITEM PARENESTSAVE I;         # PARENTHESIS NESTING COUNTER       #
      ITEM COUNTER    I;           # COUNT OF STACK ENTRIES            #
      ITEM LOCPROGSTACK I;         # START OF TEMPORARY STACK          #
      ITEM NUMCHARS  I;            # SAVE NUMBER OF CHARS              #
      ITEM POINTER I;              # STACK POINTER FOR MOVING OPERANDS #
      ITEM PSTACKSAVE I;           # SAVED ADDR OF STACK AFTER PTR SET #
      ITEM PTRSTACK I;             # STACK LOC WHEN POINTER USED       #
      ITEM SAVEPTR I;              # SAVED STACK PTR-USED W/ SAVESTACK1#
      ITEM SAVESTACK I;            # SAVED ADDR OF BLOCK W/ SAVEDPTR   #
      ITEM STK$GROUPID I;          # GROUP NO. FOR TEMP STACK          #
      ITEM TEMPCOUNT  I;           # TEMPORARY COUNT=STKPTR-NBROPERANDS#
  
      DEF LAST  #24#;              # FINAL INDEX INTO TEMP PSTACK BLOCK#
  
        XREF ITEM SCANNING B; 
        XREF ITEM SM$GROUPID;      # GROUP ID OF CMM BLOCKS ALLOCATED  #
                                   # FOR THIS DIRECTIVE.               #
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#                    FUNCTION GETSPACE                                 #
#                                                                      #
#  THE PURPOSE OF THIS FUNCTION IS TO SET P<PROGRAMSTACK> TO FWA       #
#  OF CURRENT BLOCK AND TO SET POINTER TO INDEX WITHIN THAT BLOCK      #
#                                                                      #
#  THE FUNCTION REQUESTS ALLOCATION OF NEW BLOCKS OF 25 ENTRIES        #
#  (100 WORDS) FOR THE LOCAL PROGRAM STACK.  FORWARD AND BACKWARD      #
#  LINKAGES ARE SET.  THE VALUE TO BE USED AS AN INDEX INTO THE        #
#  BLOCK IS RETURNED.                                                  #
#  CALLING SEQUENCE:   P = GETSPACE(POINTER,INCREMENT)                 #
#     WHERE P = NEW VALUE OF POINTER                                   #
#           POINTER = VALUE OF CURRENT POINTER                         #
#           INCREMENT = AMOUNT TO INCREMENT POINTER (+ OR -)           #
#                                                                      #
#  ENTRY CONDITIONS:                                                   #
#     FIRST TIME CALLED P<PROGRAMSTACK> MUST BE 0                      #
#     ALL OTHER TIMES P<PROGRAMSTACK> MUST BE SET TO BLOCK             #
#     CONTAINING POINTER TO BE INCREMENTED                             #
#                                                                      #
#  EXIT CONDITIONS:                                                    #
#     FIRST TIME CALLED LOCPROGSTACK IS SET TO ADDRESS OF              #
#     BLOCK.                                                           #
#     P<PROGRAMSTACK> IS SET TO BLOCK CONTAINING INCREMENTED           #
#     POINTER.                                                         #
#     FORWARD AND BACKWARD LINKAGE SET AS NECESSARY                    #
#     RETURN IS INDEX INTO BLOCK RESULTING FROM POINTER + INCR         #
#                                                                      #
#----------------------------------------------------------------------#
  
      FUNC GETSPACE ((POINTER),INCR) I; 
      BEGIN 
        ITEM DUMDUM    I;          # LOOP VARIABLE                     #
        ITEM INCR      I;          # AMOUNT TO INCREMENT POINTER       #
        ITEM NEXT      I;          # START OF NEW STACK BLOCK          #
        ITEM POINTER   I;          # CURRENT VALUE OF STACK INDEX      #
        ITEM THIS      I;          # ADDRESS OF CURRENT STACK          #
  
        DEF STKBLK   #100#;        # SIZE OF TEMP STACK BLOCKS         #
  
        IF P<PROGRAMSTACK> EQ 0    # SEE IF FIRST TIME THRU            #
        THEN
          BEGIN 
          IF LOCPROGSTACK NQ 0     # COULD BE FIRST PSTKPTR CALL       #
          THEN
            BEGIN 
            P<PROGRAMSTACK> = LOCPROGSTACK;  # SET TO STACK START      #
            END 
          ELSE
            BEGIN 
            P<PROGRAMSTACK> = CMM$ALF (STKBLK, 0, STK$GROUPID); 
            LOCPROGSTACK = P<PROGRAMSTACK>; # SAVE STACK ADDRESS       #
            END                    # END LOCPROGSTACK EQ 0             #
          END                      # END FIRST TIME THRU               #
        POINTER = POINTER + INCR; 
        IF POINTER GR LAST         #  NEW BLOCK NEEDED                 #
        THEN
          BEGIN 
          FOR DUMDUM = 0           # MAY TAKE MORE THAN ONE BLOCK      #
            WHILE  POINTER GR LAST
          DO
            BEGIN 
            IF FORWDLINK[LAST] NQ 0     # ALREADY ALLOCATED            #
            THEN
              BEGIN 
              P<PROGRAMSTACK> = FORWDLINK[LAST];
              END 
            ELSE
              BEGIN 
              NEXT = CMM$ALF(STKBLK,0,STK$GROUPID); 
              FORWDLINK[LAST] = NEXT;    # SET LINK TO NEW BLOCK       #
              THIS = P<PROGRAMSTACK>;    # SAVE PRESENT BLOCK ADDRESS  #
              P<PROGRAMSTACK> = NEXT;    # SET UP FOR NEXT BLOCK       #
              BACKLINK[0] = THIS;        # BACKPOINTER SET TO PREV BLK #
              END 
            POINTER = POINTER - LAST - 1; 
            END                          # END LOOP                    #
          END                            # END POINTER GR LAST         #
        ELSE
          BEGIN 
          IF POINTER  LS 0        # MUST GO BACKWARD                   #
          THEN
            BEGIN 
            FOR DUMDUM = 0
              WHILE POINTER LS 0
            DO
              BEGIN 
              P<PROGRAMSTACK> = BACKLINK[0];
              POINTER = LAST + 1 + POINTER; 
              END                  # END LOOP                          #
            END                    # POINTER LS 0                      #
          END                      # POINTER NOT GR LAST               #
  
        GETSPACE = POINTER; 
  
        RETURN; 
        END                        # END FUNCTION GETSPACE             #
          CONTROL EJECT;
          XREF PROC DDIAG;
      XDEF PROC EXPRINIT; 
      PROC EXPRINIT;
          BEGIN 
 #
 0        EXPRINIT - INITIALIZES ALL NECESSARY LOCATIONS FOR EXPRESSION 
                    ANALYSIS. 
 #
          RECNO;                   # RETURN TO STDNO  IF RECORDING     #
          STK$GROUPID = CMM$AGR(0); 
          P<PROGRAMSTACK> = 0;     # CLEAR TO INDICATE FIRST TIME THRU #
          COUNTER = -1;            # NUMBER OF STACK ENTRIES           #
          LOCPROGSTACK = 0; 
          PSTACKSAVE = 0;          # NO SAVED STACK                    #
          HADALL = FALSE;                                               000870
          HADLAST = FALSE;                                              000880
          HADANY = FALSE;                                               000890
          HADNEXT = FALSE;                                              000900
          OPPTR = 0;
          NONEWOP = FALSE;
          ERRFLAG = 0;                 # INITIALIZE ERROR FLAG.        #
          OPWORD[0] = 0;               # STACK LEFT STRING TERMINATOR  #
                                       # ON TOP OF OPSTACK TO HELP IN- #
          UNMATCHEDLP = 0;
          SAVEDADDR = 0;
          RESULTSIZE = 0;              # DICATE A CORRECTLY PARSED EX- #
                                       # PRESSION STRING               #
                                       # STRUCTING THE PROGRAM STACK.  #
          NN = 0; 
          DATAPTR = -1; 
          PSTACKPTR = -1; 
          NRFUNCPARAMS = 0; 
         AAREAITM = FALSE;
           DDESITM = FALSE; 
          STDNO;
          END 
      CONTROL EJECT;
      XDEF PROC UNARYOP;
      PROC UNARYOP; 
          BEGIN 
 #
 0        UNARYOP - REPLACES A UNARY MINUS WITH "NEG" TO DIFFERENTIATE
                    BETWEEN UNARY AND BINARY MINUS OPERATORS. THE OPER- 
                    ATOR IS THEN STACKED. 
 #
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
          IF CLX[0] EQ O"10004" THEN   # GO STACK OP IF IT IS "NEG".   #
            OPERATOR; 
          ICW[0] = "NEG";              # ELSE REPLACE "-" WITH "NEG".  #
          CP1[0] = O"10"; 
          CURLENG = 3;
          CLX[0] = O"10004";
          OPERATOR; 
          END 
      CONTROL EJECT;
      XDEF PROC OPERATOR; 
      PROC OPERATOR;
          BEGIN 
 #
 0        OPERATOR - UNSTACKS FROM THE OPSTACK ALL OPERATORS WHOSE
                    PRECEDENCE EQUALS OR EXCEEDS THAT OF THE CURRENT
                    OPERATOR, PLACING THEM ON THE PROGRAMSTACK ALONG
                    WITH THEIR ASSOCIATED OPERANDS. THE CURRENT OPERATOR
                    IS THEN STACKED ON THE OPSTACK. 
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF NOT FULLSYNTX             # IF NOT PREPARING A REPORT         #
        AND STKFLAG                # AND THIS IS A REPORT DIRECTIVE    #
      THEN
        BEGIN 
        STDYES; 
        END 
      STACKLOOP:  
          IF CP1[0] EQ 1 THEN 
          BEGIN 
            IF OP[OPPTR] EQ O"60" THEN
            BEGIN 
              IF B<PARENESTSAVE,1>LOGOPSAVED EQ 1 
              THEN
                BEGIN 
                LOGOPFLAG = 0;
                LOGOPSAVED = 0; 
                RELOPSAVED = 0; 
                OPERANDSAVED = 0; 
                END 
              ELSE
                BEGIN 
                IF B<PARENESTSAVE,1>OPERANDSAVED EQ 1 
                THEN
                  BEGIN 
                  B<PARENESTSAVE - 1,1>OPERANDSAVED = 1;
                  END 
                END 
                PARENESTSAVE = PARENESTSAVE - 1;
              OPPTR = OPPTR - 1;
              UNMATCHEDLP = UNMATCHEDLP - 1;#) MATCHES ( ON STACK TOP. #
              STDYES; 
            END 
            IF OPPTR LS 0 THEN         # UNMATCHED CLOSEPAREN SINCE NO #
            BEGIN 
              OPPTR = 0;
              UNMATCHEDLP = -1; 
              CMM$FGR (STK$GROUPID);  # FREE TEMP STACK SPACE          #
              STDNO;
            END 
            IF USAGE[DATAPTR] NQ 7 # IF NOT TYPE LOGICAL               #
              AND PRIORITY[OPPTR] LQ 4
            THEN
              BEGIN 
              IF LOGOPFLAG NQ 0    # IF 1ST HALF OF RELATION SAVED     #
              THEN
            BEGIN                      # INSERT COPY OF THE 1ST HALF OF#
              DSTKWORD[DATAPTR+1] = DSTKWORD[DATAPTR];# THE PREVIOUS   #
              DSTKWORD2[DATAPTR+1] = DSTKWORD2[DATAPTR];# RELATION.    #
              DSTKWORD3[DATAPTR+1] = DSTKWORD3[DATAPTR];
              DSTKWORD[DATAPTR] = SAVEDOPND1; 
              DSTKWORD2[DATAPTR] = SAVEDOPND2;
              DSTKWORD3[DATAPTR] = SAVEDOPND3;
              DATAPTR = DATAPTR + 1;
              OPPTR = OPPTR + 1;
              OPWORD[OPPTR] = SAVEDRELOP; 
            END                        # TION.                         #
              ELSE
                BEGIN 
                DIAG(58);          # LOG OPERATOR NEEDS LOG TYPE OPERAN#
                ERRFLAG = 1;
                END 
              END 
          END 
          IF PRIORITY[OPPTR] LS CP1[0] THEN # PUSH DOWN OP STACK.      #
            BEGIN 
            IF NONEWOP             # IF NO OPERATOR IN CLXNUM TO SAVE  #
            THEN
              BEGIN 
              RETURN;              # RETURN TO CHKLOGOPFLAG            #
              END 
            OPPTR = OPPTR + 1;
            OP[OPPTR] = CLXNUM[0];     # OPCODE IS RIGHTMOST 9 BITS OF #
                                       # THE LEXID.                    #
            PRIORITY[OPPTR] = CP1[0]; 
            IF OP[OPPTR] LS O"70" THEN # IF OP IS NOT A FUNCTION THEN  #
            BEGIN                      # IT HAS 1 OPERAND IF IT IS A   #
              IF OP[OPPTR] EQ 4 THEN   # UNARY MINUS. ALL OTHER OPS ARE#
                NBROPERANDS[OPPTR] = 1;# BINARY OPS.                   #
              ELSE NBROPERANDS[OPPTR] = 2;
            END 
            ELSE                       # IF OP IS A FUNCTION, THE OPER-#
              NBROPERANDS[OPPTR] = NRFUNCPARAMS;#ANDS WERE TALLIED     #
                                       # PREVIOUSLY.                   #
            STDYES; 
            END 
          IF OPPTR EQ 0 AND            # EXPRESSION ANALYSIS COMPLETE  #
             CP1[0] EQ 0 THEN          # WHEN TOP OF OPSTACK IS LEFT   #
               BEGIN                   # STRING TERMINATOR AND CURRENT #
                                       # OP IS RIGHT STRING TERMINATOR.#
            SAVEPTR = PSTACKPTR;     # SAVE FOR LATER USE              #
            SAVESTACK = P<PROGRAMSTACK>;
            PSTACKPTR = GETSPACE(PSTACKPTR,1);  # INCREMENT POINTER    #
            PSTACKSAVE = P<PROGRAMSTACK>;   # BLOCK ADDR FOR PSTACKPTR #
            COUNTER = COUNTER + 1;          # NUMBER OF STACK ENTRIES  #
            ENTRYTYPE[PSTACKPTR] = 7; 
            OPCODE[PSTACKPTR] = O"70"; # END OF STACK OPERATOR.        #
            RETURN; 
          END 
          I = NBROPERANDS[OPPTR] + COUNTER; # TOTAL NO ENTRIES         #
          POINTER = NBROPERANDS[OPPTR];  # AMOUNT TO INCR PSTACKPTR    #
          TEMPCOUNT = COUNTER;
          PSTACKSAVE = P<PROGRAMSTACK>;     # SAVE THIS LOC FOR PSTKPTR#
                                   # POSITION TO LAST OPERAND          #
          POINTER = GETSPACE(PSTACKPTR,POINTER);
          J = NBROPERANDS[OPPTR] - 1; 
          IF J EQ 1 AND OP[OPPTR] LS O"60"
            THEN
            BEGIN 
            IF DATALITAL[DATAPTR] 
              THEN CHKLITAL = 1;
              ELSE CHKLITAL = 0;
            IF DATALITAL[DATAPTR - 1] 
              THEN CHKLITAL = CHKLITAL + 2; 
                                   # J IS NO. OF OPERANDS - 1          #
                                   # L WILL POINT TO FIRST OPERAND     #
                                   # ON DATASTACK                      #
            END 
          L = DATAPTR - J;
          M = 0;
          K = 0;
      OPERANDLOOP:                     # FIND HIGHEST DATATYPE FOR     #
          IF OP[OPPTR] EQ O"314"   # DECODE                            #
          THEN                                                           QU3A072
            BEGIN                                                        QU3A072
            J = 0;                 # ONLY LOOK AT LAST OPERAND         # QU3A072
            CALCULATEK = TRUE;     # MUST CALCULATE HIGHEST DATA TYPE  # QU3A072
            END                                                          QU3A072
          IF OP[OPPTR] EQ O"300"   # IF PROCESSING *SCAN*              # QU3A072
          THEN
            BEGIN 
            GOTO NOCON;      # NO CONVERSION                           #
            END 
          P<DESATT1> = TOWORDPTR[DATAPTR - J];
          TEMPUSAGE = USAGE[DATAPTR - J];                                QU3A072
          IF TEMPUSAGE EQ 1        # IF NUMERIC                        # QU3A072
            OR TEMPUSAGE EQ 3      # IF FIXED                          # QU3A072
            OR (TEMPUSAGE EQ 2     # IF INTEGER                        #
              AND P<DESATT1> NQ 0  # IF NOT LITERAL                    #
              AND DPTLOC[0] NQ 0)  # IF SCALED INTEGER                 #
          THEN                                                           QU3A072
            BEGIN                                                        QU3A072
            TEMPUSAGE = 4;         # FLOATING                          # QU3A072
            END                                                          QU3A072
          IF TEMPUSAGE GR K                                              QU3A072
          THEN                                                           QU3A072
            BEGIN                                                        QU3A072
            K = TEMPUSAGE;         # CONVERT TO HIGHER USAGE           # QU3A072
            END                                                          QU3A072
          IF OP[OPPTR] EQ O"314"   # DECODE                            #
          THEN
            BEGIN 
            FIRSTTYPE = K;         # SAVE RESULT TYPE SO IT CAN BE     #
                                   # RESTORED LATER                    #
            END 
          IF J GR 0 THEN
          BEGIN 
            J = J - 1;
            GOTO OPERANDLOOP; 
          END 
        NOCON: # #
          IF COUNTER GR 0 THEN         # CHECK FOR 1ST OPERAND DUPLICA-#
          BEGIN                        # TING RESULT OF PREVIOUS OP.   #
                                    # L POINTS TO FIRST OPERAND ON     #
                                    # DATASTACK.  PSTACKPTR POINTS     #
                                    # TO JUST STORED OPERATOR ON       #
                                    # PROGRAMSTACK                     #
            PTRSTACK = P<PROGRAMSTACK>;  # SAVE THIS LOC FOR POINTER   #
            P<PROGRAMSTACK> = PSTACKSAVE; # PSTACKPTR LOC              #
            IF DTYPE[L] EQ K AND
              FROMWORDPTR[L] EQ TOWORDADDR[PSTACKPTR] 
            THEN
            BEGIN 
              M = 1;
              I = I - 1;
                                   # SET UP FOR NEXT OPERAND           #
              P<PROGRAMSTACK> = PTRSTACK; 
              POINTER = GETSPACE(POINTER,-1); 
              PTRSTACK = P<PROGRAMSTACK>; #BLOCK ADDR MIGHT BE CHANGED #
              IF I EQ COUNTER      # SEE IF ALL OPERANDS PROCESSED     #
              THEN
                BEGIN              # FINISHED, PROCESS OPERATOR        #
                P<PROGRAMSTACK> = PSTACKSAVE; 
                PSTACKPTR = GETSPACE(PSTACKPTR,1);
                PSTACKSAVE = P<PROGRAMSTACK>; 
                COUNTER = COUNTER + 1;
                GOTO STOREOP; 
                END 
            END 
            P<PROGRAMSTACK> = PTRSTACK;  # RESTORE POINTER BLOCK       #
          END 
      NEXTOPERAND:  
          PSTKWORD[POINTER] = DSTKWORD[DATAPTR];
          IF DTYPE[DATAPTR] LS K THEN  # ALL OPERANDS MUST BE CONVER-  #
          BEGIN                        #TED TO HIGHEST TYPE.           #
            IF USAGE[DATAPTR] EQ 0 THEN 
            BEGIN                       # DIAGNOSE CHARACTER ARITHMETIC#
              DIAG(72);                 # OPERANDS AS ILLEGAL.         #
              ERRFLAG = 1;
            END 
       DOIT: # #
            IF DTYPE[DATAPTR] LQ 1 AND # IF DISPLAY AND NOT A LITERAL  #
               TOWORDPTR[DATAPTR] NQ 0 THEN  # THEN FROMADDR = PTR TO # 
                 BEGIN                 # DEFDESC ENTRY.                #
                 FROMWORDADDR[POINTER] = TOWORDPTR[DATAPTR];
                 EDITFLAG[POINTER] = TRUE;
                 END
            ELSE
             BEGIN
             IF DTYPE[DATAPTR] EQ 3 # IF UNNORMALIZED, STORE POINTER TO#
             THEN                   # DEFDESC ENTRY                    #
               BEGIN
               FROMWORDADDR[POINTER] = TOWORDPTR[DATAPTR];
               END
          ELSE
            BEGIN 
            IF DTYPE[DATAPTR] EQ 2  # IF INTEGER                       #
            THEN
              BEGIN 
              IF TOWORDPTR[DATAPTR] EQ 0  # IF LITERAL, NO ATTRIB TABLE#
              THEN
                BEGIN 
                P<ATTRIB> = CMM$ALF(2,0,SM$GROUPID);  # REQUEST TABLE  #
                ATTRWP[0] = FROMWORDPTR[DATAPTR]; 
                ATTRCLS[0] = 2; 
                TOWORDPTR[DATAPTR] = P<ATTRIB> - 1; 
                END 
              FROMWORDADDR[POINTER] = TOWORDPTR[DATAPTR]; 
              END 
            ELSE
                                   # IF DEFDESC PTR NOT USED AND DATA  #
                                   # AND DATA ITEM NOT AN AREA ITEM,   #
                                   # ITEM HAD A CONSTANT SUBSCRIPT,    #
                                   # PREVIOUSLY COMPUTED STARTING CHAR #
                                   # AND WORD POSITION IS STILL VALID, #
                                   # SO RELEASE INDEX TABLE INFORMATION#
            BEGIN 
            IF SUBSC[DATAPTR]      # IF SUBSCRIPTED                    #
              AND NOT DATAREAITEM[DATAPTR]  # IF NOT AREA ITEM         #
            THEN
              BEGIN 
              P<INDTBL> = IDXTBL[DATAPTR];
              IF INDFG EQ 0        # IF CONSTANT SUBSCRIPT             #
              THEN
                BEGIN 
                SUBSC[DATAPTR] = FALSE; 
                IF SM$GROUPID EQ 0  # IF NO GROUP ID                   #
                THEN
                  BEGIN 
                  CMM$FRF(P<INDTBL>);  # RELEASE INDTBL                #
                  END 
                END 
              END 
            END 
            END 
            END 
            CONVERTCODE[POINTER] = B<K*6,6>CCODE[DTYPE[DATAPTR]]; 
            IF FROMWORDADDR[POINTER]  LS 0  # IF SCRATCH RESULT        #
              AND FROMWORDADDR[POINTER] NQ SAVEDADDR  # AND NOT SAVED  #
              AND K NQ 5           # NOT CONVERTING TO DOUBLE PREC     #
              AND K NQ 6           # NOT CONVERTING TO COMPLEX WHICH   #
                                   # REQUIRES 2 WORDS OF SCRATCH SPACE #
            THEN
              BEGIN 
                                   # REUSE SPACE FOR THIS CONVERSION   #
              TOWORDADDR[POINTER] = FROMWORDADDR[POINTER];
              END 
            ELSE
            BEGIN 
            J = (NBRCHARS[POINTER] + 9) / 10; 
            IF J EQ 0 
            THEN
              BEGIN 
              J = 1;
              END 
            IF K EQ 5              # IF DOUBLE PRECISION               #
              OR K EQ 6            # IF COMPLEX                        #
            THEN
              BEGIN 
              J = 2;
              END 
            NN = NN + J;           # OFFSET OF THIS RESULT             #
            TOWORDADDR[POINTER] = -NN;  # LINKSCRATCH WILL ADD         #
                                   # LWA + 1 OF CMM BLOCK CONTAINING   #
                                   # PROGSTACK TO CALCULATE ACTUAL ADDR#
            END 
            RELTOCHAR[POINTER] = 0; 
            IF FROMBASELOC[DATAPTR] LQ O"100" AND 
               FROMBASELOC[DATAPTR] GR 0 THEN 
              BEGIN 
                                   # THIS VALUE IS AN AREA ORDINAL.    #
                                   # MOVE TO CORRECT LOCATION.         #
              TOWORDBASE[POINTER] = FROMBASELOC[DATAPTR]; 
              FROMBASELOC[DATAPTR] = 0; 
              END 
            FROMWORDBASE[POINTER] = FROMBASELOC[DATAPTR]; 
            IF SUBSC[DATAPTR] 
            THEN
              BEGIN 
              FROMWORDADDR[POINTER] = TOWORDPTR[DATAPTR]; 
              EXPRESSTACK[POINTER] = IDXTBL[DATAPTR]; 
              J = 4;
              END 
          ELSE
            J = 2;                     # FLAG AS CONVERSION ENTRY TYPE.#
          END 
          ELSE
          BEGIN 
          IF SUBSC[DATAPTR]        # IF SUBSCRIPTED                    #
          THEN
            BEGIN 
            P<INDTBL> = IDXTBL[DATAPTR];
            IF DATAREAITEM[DATAPTR]  # IF AN AREA ITEM                 #
              OR INDFG NQ 0        # IF NOT A CONSTANT SUBSCRIPT       #
            THEN
              BEGIN 
              GOTO  DOIT; 
              END 
            END 
            TOWORDBASE[POINTER] = FROMBASELOC[DATAPTR]; 
            RELTOCHAR[POINTER] = RELFROMCHAR[POINTER];
            TOWORDADDR[POINTER] = FROMWORDADDR[POINTER];  # MARK THIS  #
            J = 1;                     # ENTRY AS DOCUMENTARY, NO NEED #
          END                          # FOR EVALUATION-TIME ACTION.   #
          ENTRYTYPE[POINTER] = J; 
          IF DATAOVERSIGN[DATAPTR]
          THEN
            BEGIN 
            OVERSIGN[POINTER] = TRUE; 
            END 
          PRKEYENTRY[POINTER] = DATAPRKEY[DATAPTR]; 
          ALKEYENTRY[POINTER] = DATALTEKEY[DATAPTR];
          PRMAJKEY[POINTER] = DATAPRMAJ[DATAPTR]; 
          ALTMAJKEY[POINTER] = DATAALTMAJ[DATAPTR]; 
          ALTKEYSIZE[POINTER] = DATAALTSIZE[DATAPTR]; 
          KEYEXCL[POINTER] = DATAKEYEXCL[DATAPTR];
          IF IMFDBM                # IF IMF DATA BASE MODE             #
          THEN
            BEGIN 
            IF PRKEYENTRY[POINTER] # IF KEY                            #
              OR PRMAJKEY[POINTER] # OR MAJOR KEY                      #
            THEN
              BEGIN 
              KEYID[POINTER] = KEYORDINAL;
              END 
            END 
  
          ELSE                     # IF CRM/CDCS DATABASE MODE         #
            BEGIN 
            RECDORDINAL[POINTER] = DDATARECDORD[DATAPTR]; 
            ITEMORDINAL[POINTER] = DDATAITEMORD[DATAPTR]; 
            END 
  
          KEYTYPE[POINTER] = DTYPE[DATAPTR];
          I = I - 1;
          POINTER = GETSPACE(POINTER,-1);  # SET NEW POINTER           #
          IF I GR COUNTER THEN     # IF ALL OPERANDS HAVE NOT BEEN     #
          BEGIN                        # STORED IN PROGRAM STACK GO    #
            DATAPTR = DATAPTR - 1;     # PROCESS NEXT OPERAND.         #
            IF OP[OPPTR] EQ O"314"  # IF PROCESSING *DECODE*           # QU3A072
            THEN                                                         QU3A072
              BEGIN                                                      QU3A072
              IF CALCULATEK        # IF MUST CALCULATE HIGHEST DATATYPE# QU3A072
              THEN                                                       QU3A072
                BEGIN                                                    QU3A072
                CALCULATEK = FALSE;  # K IS KNOWN NEXT TIME            # QU3A072
                K = USAGE[DATAPTR];  # DATATYPE OF 1ST OPERAND         # QU3A072
                P<DESATT1> = TOWORDPTR[DATAPTR];
                IF K EQ 1          # IF NUMERIC                        # QU3A072
                  OR K EQ 3        # IF FIXED                          # QU3A072
                  OR (K EQ 2       # IF INTEGER                        #
                    AND P<DESATT1> NQ 0  # IF NOT LITERAL              #
                    AND DPTLOC[0] NQ 0)  # IF SCALED INTEGER           #
                THEN                                                     QU3A072
                  BEGIN                                                  QU3A072
                  K = 4;           # CONVERT TO FLOATING               # QU3A072
                  END                                                    QU3A072
                TEMPUSAGE = USAGE[DATAPTR - 1];                          QU3A072
                P<DESATT1> = TOWORDPTR[DATAPTR - 1];
                IF TEMPUSAGE EQ 1  # IF NUMERIC                        # QU3A072
                  OR TEMPUSAGE EQ 3  # IF FIXED                        # QU3A072
                  OR (TEMPUSAGE EQ 2  # IF INTEGER                     #
                    AND P<DESATT1> NQ 0  # IF NOT LITERAL              #
                    AND DPTLOC[0] NQ 0)  # IF SCALED INTEGER           #
                THEN                                                     QU3A072
                  BEGIN                                                  QU3A072
                  TEMPUSAGE = 4;   # FLOATING                          # QU3A072
                  END                                                    QU3A072
                IF TEMPUSAGE GR K  # 2ND OPERAND HIGHER TYPE           # QU3A072
                THEN                                                     QU3A072
                  BEGIN                                                  QU3A072
                  K = TEMPUSAGE;                                         QU3A072
                  END                                                    QU3A072
                END                                                      QU3A072
              ELSE                                                       QU3A072
                BEGIN                                                    QU3A072
                CALCULATEK = TRUE; # MUST CALCULATE K NEXT TIME        # QU3A072
                END                                                      QU3A072
              END                                                        QU3A072
            GOTO NEXTOPERAND; 
          END 
          DATAPTR = DATAPTR - M;
          # POSITION POINTER AND STACK TO OPERATOR                     #
          # GO PAST ALL OPERANDS                                       #
          I = NBROPERANDS[OPPTR] + 1 - M; 
          COUNTER = COUNTER + I;   # INCREMENT COUNTER TO OPERATOR     #
          P<PROGRAMSTACK> = PSTACKSAVE; 
          PSTACKPTR = GETSPACE(PSTACKPTR,I); # RESET POINTER           #
          PSTACKSAVE = P<PROGRAMSTACK>; 
          B<PARENESTSAVE,1>OPERANDSAVED = 1;
      STOREOP:  
          PSTKWORD[PSTACKPTR] = 0;
          PSTKWORD1[PSTACKPTR] = 0;                                      EXPANAL
          PSTKWORD2[PSTACKPTR] = 0; 
          L = OP[OPPTR];               # SAVE OPCODE IN TEMP WORD.     #
          ENTRYTYPE[PSTACKPTR] = 7;    # FLAG AS OPERATOR ENTRY.       #
          LITBITS[PSTACKPTR] = CHKLITAL;                                 EXPANAL
          IF L LS O"71" THEN BEGIN
          IF K EQ 7 THEN
          BEGIN 
            IF L LS 6 OR               # DIAGNOSE LOGICAL OPERANDS USED#
               L GR 7 AND L LS O"14" THEN # WITH ARITHMETIC OPERATORS. #
            BEGIN 
              DIAG(59); 
              ERRFLAG = 1;
            END 
            OPCODE[PSTACKPTR] = L;
          END 
          ELSE
          IF L GQ O"14" AND 
             L LQ O"70" AND 
             K NQ 7 THEN               # DIAGNOSE LOGICAL OPERATORS    #
          BEGIN                        # USED W/O LOGICAL OPERANDS.    #
            IF L GR O"17" THEN I = L - O"30"; 
            ELSE I = L - O"14"; 
            DIAG(58,LOGOPS[I]); 
            ERRFLAG = 1;
          END 
          ELSE
          IF K EQ 0 THEN               # TEST FOR CHARACTER USAGE.     #
          BEGIN 
            IF L LS 6 THEN             # DIAGNOSE ARITHMETIC OPERATIONS#
            BEGIN                      # ATTEMPTED ON CHARACTER TYPE   #
              DIAG(72);                # OPERANDS.                     #
              ERRFLAG = 1;
            END 
            IF L LS O"10" THEN L = L + O"30"; 
            ELSE L = L + O"44"; 
            OPCODE[PSTACKPTR] = L;
          END 
          ELSE
          BEGIN 
            I = K - 2;
            IF I GR 0 THEN
              I = I - 1;
            OPCODE[PSTACKPTR] = L + I*O"20";# BIAS THE OPCODE FOR THE  #
          END                          # TYPE OF DATA IN THE OPERATION.#
           END
         ELSE BEGIN                                                     017720
              IF L EQ O"75"               # IF JULIAN AND              #
                AND DTYPE[DATAPTR] EQ 0   # DISPLAY SET                #
              THEN                        # CONVERT NEEDED             #
                BEGIN 
                PSTACKPTR = GETSPACE(PSTACKPTR,-1); 
                CONVERTCODE[PSTACKPTR] = 1; 
                PSTACKPTR = GETSPACE(PSTACKPTR,1);
                PSTACKSAVE = P<PROGRAMSTACK>; 
                END 
              OPCODE[PSTACKPTR] = L;                                    017750
              END                                                       017760
          NBRCHARS[PSTACKPTR] = 10;  # ASSUME 10 CHARACTER RESULT      #
          I = OPCODE[PSTACKPTR];
          IF (I GQ O"40"           # IF DOUBLE PRECISION RESULT        #
              AND I LQ O"45") 
            OR (I GQ O"60"         # IF COMPLEX RESULT                 #
              AND I LQ O"65") 
            OR I EQ O"105"         # MIN DOUBLE PRECISION              #
            OR I EQ O"106"         # MIN COMPLEX                       #
            OR I EQ O"115"         # MAX DOUBLE PRECISION              #
            OR I EQ O"116"         # MAX COMPLEX                       #
          THEN
            BEGIN 
            NBRCHARS[PSTACKPTR] = 20; 
            END 
          IF I EQ O"77"            # MASK                              #
            OR I EQ O"314"         # DECODE                            #
          THEN
            BEGIN 
            NBRCHARS[PSTACKPTR] = FIRSTLENGTH;
            END 
          IF I EQ O"150"           # MIN FOR CHARACTER ITEM            #
            OR I EQ O"160"         # MAX FOR CHARACTER ITEM            #
          THEN
            BEGIN 
            PSTACKPTR = GETSPACE(PSTACKPTR,-1); 
            NUMCHARS = NBRCHARS[PSTACKPTR]; 
            PSTACKPTR = GETSPACE(PSTACKPTR,1);
            PSTACKSAVE = P<PROGRAMSTACK>; 
            NBRCHARS[PSTACKPTR] = NUMCHARS; 
            END 
          I = 0;
          IF L EQ O"75" THEN K = 2; 
           ELSE IF L EQ O"76"               THEN K = 0; 
          ELSE IF L EQ O"77" OR L EQ O"314" THEN K = FIRSTTYPE; 
          ELSE
          IF L GQ 6 AND 
             L LQ O"70" THEN           # RESULT OF LOGICAL OR RELATION-#
            K = 7;                     # AL OPERATOR IS TYPE LOGICAL.  #
          IF L EQ O"300" THEN 
            BEGIN 
                                   # RESULT OF SCAN IS TYPE LOGICAL.   #
            K = 7;
            SCANNING = TRUE;
            EXPRESSTACK[PSTACKPTR] = NBROPERANDS[OPPTR];
            END 
          IF L EQ O"314"           # DECODE                            #
          THEN
            BEGIN 
            PSTACKSAVE = P<PROGRAMSTACK>; 
            POINTER = GETSPACE(PSTACKPTR,-1); 
            J = CONVERTCODE[POINTER]; 
            IF J EQ 1              # CHAR--> CHAR                      #
              OR J EQ O"11"        # N --> N                           #
              OR J EQ O"27"        # U --> U                           #
            THEN
              BEGIN 
              CONVERTCODE[POINTER] = 0; 
              END 
            P<PROGRAMSTACK> = PSTACKSAVE; 
            EXPRESSTACK[PSTACKPTR] = NBROPERANDS[OPPTR];
            END 
  
#----------------------------------------------------------------------#
#                      EXPRESSION OPTIMIZATION                         #
#           WHENEVER A TEMPORARY RESULT AREA IS TO BE CREATED,         #
#           THE COUNTER FOR THE OPERATOR USING THE TEMPORARY AREA      #
#           IS SAVED IN PSTKLOC OF THE DATA STACK ENTRY.  WHENEVER     #
#           LOGICAL OPERATORS *AND* OR *OR* ARE RECOGNIZED, A POINTER  #
#           IS SET TO THE PROGRAM STACK ENTRY REPRESENTED BY PSTKLOC   #
#           OF THE DATASTACK ENTRY OF THE FIRST TEMPORARY ITEM.        #
#           THE PROGRAM STACK ENTRY THEN HAS SKIPT SET IF THE          #
#           LOGICAL OPERATOR IS *OR* SINCE ONE TRUE MEANS THE          #
#           EXPRESSION IS TRUE- SKIPF IS SET FOR *AND* SINCE           #
#           ONE FALSE MEANS ALL FALSE.  SKIPADDR IS SET TO THE         #
#           COUNTER VALUE OF THE LOGICAL OPERATOR.                     #
#----------------------------------------------------------------------#
  
                                   # IF LOGICAL OP MUST SET FLAGS      #
                                   # AND SKIPADDR.  TEST FIRST FOR     #
                                   # *AND* OR *OR*.                    #
                                   # L CONTAINS THE OPCODE SET         #
                                   # IN CODE JUST PRECEDING THIS       #
      EO: 
          IF L EQ O"16" 
            OR L EQ O"17" 
          THEN
            BEGIN 
                                   # DATAPTR IS POINTING TO            #
                                   # FIRST TEMP ITEM                   #
                                   # CALCULATE PTR TO PROGRAMSTACK     #
                                   # OF FIRST OPERATOR                 #
            POINTER = PSTKLOC[DATAPTR] - COUNTER; 
            POINTER = GETSPACE(PSTACKPTR,POINTER);
            IF L EQ O"16"              # IS OPCODE *AND*               #
            THEN
              BEGIN 
              SKIPF[POINTER] = TRUE;
              END 
            ELSE                   # MUST BE *OR*                      #
              BEGIN 
              SKIPT[POINTER] = TRUE;
              END 
            SKIPADDR[POINTER] = COUNTER;
            END 
                                   # RESTORE STACK AND POINTERS TO     #
                                   # OPERATOR ENTRY SO THAT NEED FOR   #
                                   # SCRATCH SPACE MAY BE DETERMINED   #
          P<PROGRAMSTACK> = PSTACKSAVE; 
          J = GETSPACE(PSTACKPTR,(-NBROPERANDS[OPPTR]));
      CKFORSCRATCH: 
        P<INDTBL> = EXPRESSTACK[J];  # POSITION TO INDEX TABLE         #
        IF ENTRYTYPE[J] EQ 4       # IF INDEX TABLE EXISTS             #
          AND (ALLFG               # IF -ALL-                          #
            OR ANYFG)              # IF -ANY-                          #
        THEN
                                   # OPERAND SPACE CANNOT BE REUSED FOR#
                                   # OPERATOR SINCE EXPEVAL WILL       #
                                   # EVALUATE OPERATOR FOR EACH        #
                                   # OCCURRENCE WITHOUT RECONVERTING   #
                                   # OR RE-FIGSUB-ING OPERANDS         #
          BEGIN 
          I = 1;                   # FLAG THAT SPACE CANNOT BE REUSED  #
          TEMPCOUNT = COUNTER;     # EXIT LOOP                         #
          P<PROGRAMSTACK> = PSTACKSAVE; 
          END 
  
        ELSE
          BEGIN 
          IF TOWORDADDR[J] LS I THEN   # IF SCRATCH SPACE USED FOR CON-#
          BEGIN                        #VERTING OPERAND, RE-USE FOR OP.#
            I = TOWORDADDR[J];
          END 
          J = GETSPACE(J,1);       # POSITION TO NEXT OPERAND          #
          TEMPCOUNT = TEMPCOUNT + 1; # NUMBER OF OPERAND ENTRIES       #
          END 
  
          IF TEMPCOUNT LS COUNTER THEN # CHECK ALL OPERANDS            #
            GOTO CKFORSCRATCH;
          P<PROGRAMSTACK> = PSTACKSAVE; 
          IF I LS 0 AND                # IF OPERAND USED SCRATCH SPACE #
             I NQ SAVEDADDR THEN       # AND SPACE IS NOT RESERVED,    #
          BEGIN                        # THEN INSERT OPERATOR ON END OF#
            TOWORDADDR[PSTACKPTR] = I; # SCRATCH SPACE.                #
          END 
          ELSE                         # OTHERWISE NEW SCRATCH SPACE   #
          BEGIN                        # MUST BE ALLOCATED FOR RESULT. #
          POINTER = GETSPACE(PSTACKPTR,-1);  # LAST OPERAND POSITION   #
          L = (NBRCHARS[POINTER] + 9) / 10; 
          P<PROGRAMSTACK> = PSTACKSAVE;  # BACK TO OPERATOR BLOCK      #
          IF L LS 1 
          THEN
            BEGIN 
            L = 1;
            END 
          IF K EQ 5                # IF DOUBLE PRECISION               #
            OR K EQ 6              # IF COMPLEX                        #
          THEN
            BEGIN 
            L = 2;                 # TWO WORD RESULT                   #
            END 
          NN = NN + L;             # OFFSET OF THIS RESULT             #
                                   # SAVE OFFSET.  LINKSCRATCH WILL ADD#
                                   # LWA + 1 OF CMM BLOCK CONTAINING   #
                                   # PROGSTACK TO CALCULATE ACTUAL ADDR#
          TOWORDADDR[PSTACKPTR] = -NN;
          END 
          RESULTUSAGE = K;             # UPDATE RESULT USAGE.          #
          DSTKWORD[DATAPTR] = 0;
          DSTKWORD2[DATAPTR] = 0; 
          DSTKWORD3[DATAPTR] = 0; 
          DSTKWORD4[DATAPTR] = 0; 
          DTYPE[DATAPTR] = K;          # ENTER OP RESULT ON DATA STACK.#
          USAGE[DATAPTR] = K; 
          FROMWORDPTR[DATAPTR] = TOWORDADDR[PSTACKPTR]; 
          PSTKLOC[DATAPTR] = COUNTER;  # SAVE OPERATOR PTR             #
  
          IF K EQ 0                # IF CHARACTER                      #
          THEN
            BEGIN 
            POINTER = GETSPACE(PSTACKPTR,-1); 
            NRCHARS[DATAPTR] = NBRCHARS[POINTER];  # NO OF CHARS       #
            P<PROGRAMSTACK> = PSTACKSAVE; 
            END 
          OPPTR = OPPTR - 1;           # POP OP STACK.                 #
          GOTO STACKLOOP; 
          END 
      CONTROL EJECT;
      XDEF PROC EXPRESSDATA;
      PROC EXPRESSDATA; 
          BEGIN 
 #
 0        EXPRESSDATA - STACKS ENTRY DESCRIBING AN OPERAND ON THE 
                    DATA STACK. THE ENTRY MAY DESCRIBE A LITERAL, A 
                    SIMPLE DATA NAME, OR A SUBSCRIPTED DATA-NAME. 
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          B<PARENESTSAVE,1>OPERANDSAVED = 0;
          IF FIGLITDATA EQ S"CONDEXPR" THEN 
            CONDEXPRESS;
          ELSE
            BEGIN 
            SETINFO;
            B<PARENESTSAVE,1>OPERANDSAVED = 1;
            END 
          END 
          STDYES;                                                       001200
          END 
      CONTROL EJECT;
          PROC SETINFO; 
          BEGIN 
          IF AREAITM THEN AAREAITM = TRUE;
           IF DESITM THEN DDESITM = TRUE; 
          DATAPTR = DATAPTR + 1;       # STACK DESCRIPTION ON DATA STK.#
          DSTKWORD2[DATAPTR] = 0;      # INITIALIZE STACK ENTRY.       #
          DSTKWORD[DATAPTR] = 0;
          DSTKWORD3[DATAPTR] = 0; 
          DSTKWORD4[DATAPTR] = 0; 
          USAGE[DATAPTR] = DATANAMEUSE; 
          DTYPE[DATAPTR] = DATATYPE;
          FROMWORDPTR[DATAPTR] = DATAWORDADDR;
          DDATARECDORD[DATAPTR] = DATARECDORD;
          DDATAITEMORD[DATAPTR] = DATAITEMORD;
  
          IF FIGLITDATA EQ 1     # IF LITERAL              #
            OR (FIGLITDATA EQ 2  # OR DEFINED CHAR ITEM    #
              AND DATATYPE EQ 0)
          THEN
            BEGIN 
            DATALITAL[DATAPTR] = TRUE;
            END 
          IF FIGLITDATA EQ 5 AND NOT RECORDFLAG THEN
               TOWORDPTR[DATAPTR] = SAVATTR;
            ELSE
          TOWORDPTR[DATAPTR] = DATANAMEPTR;# SAVE PTR TO DEFDESC ENTRY.#
          NRCHARS[DATAPTR] = DATALENG;
          FROMCHARPTR[DATAPTR] = DATACHARPOS; 
          IF INDICED               # IF ITEM SUBSCRIPTED               #
          THEN
            BEGIN 
            SUBSC[DATAPTR] = TRUE;
            IF CONDIT              # IF IN A CONDITION                 #
            THEN
              BEGIN 
                                   # ONLY 1 FIGURATIVE SUBSCRIPT IS    #
                                   # ALLOWED PER RELATION. IF THERE    #
                                   # IS MORE THAN ONE, RELEASE         #
                                   # SPACE AND GO TO -NO-              #
              IF (HADALL OR HADANY OR HADLAST)
                AND (FALL OR FANY OR FLAST) 
              THEN
                BEGIN 
                DIAG (937); 
                CMM$FGR (STK$GROUPID);
                STDNO;
                END 
  
              IF FNEXT             # IF SUBSCRIPT IS -NEXT-            #
              THEN
                BEGIN 
                DIAG (938);        # -NEXT- IS ILLEGAL IN CONDITION    #
                CMM$FGR (STK$GROUPID);
                STDNO;
                END 
              END                  # END IF CONDITION                  #
  
            ELSE                   # IF NOT A CONDITION                #
              BEGIN 
              IF FANY              # IF SUBSCRIPT IS -ANY-             #
              THEN
                BEGIN 
                DIAG (936);        # -ANY- ONLY LEGAL IN CONDITION     #
                CMM$FGR (STK$GROUPID);
                STDNO;
                END 
  
              ELSE                 # IF NOT SUBSCRIPTED BY -ANY-       #
                BEGIN 
                IF (FNEXT OR HADNEXT)  # IF SUBSCRIPT IS OR WAS -NEXT- #
                  AND DATAPTR NQ 0     # AND BUILDING AN EXPRESSION    #
                THEN
                  BEGIN 
                  DIAG (938);      # -NEXT- ILLEGAL IN EXPRESSION      #
                  CMM$FGR (STK$GROUPID);
                  STDNO;
                  END 
                END 
  
              IF (HADALL OR HADANY)  # IF PREV SUB WAS -ALL- OR -ANY-  #
                                     # AND THIS ONE IS A FIG SUB       #
                AND (FALL OR FANY OR FNEXT OR FLAST)
              THEN
                BEGIN 
                DIAG (940);        # NO FIG SUB AFTER -ALL- OR -ANY-   #
                CMM$FGR (STK$GROUPID);
                STDNO;
                END 
  
              IF FANY              # SAVE FIG SUB FOR FUTURE           #
              THEN
                BEGIN 
                HADANY = TRUE;
                END 
  
              ELSE
                BEGIN 
                IF FALL 
                THEN
                  BEGIN 
                  HADALL = TRUE;
                  END 
  
                ELSE
                  BEGIN 
                  IF FLAST
                  THEN
                    BEGIN 
                    HADLAST = TRUE; 
                    END 
  
                  ELSE
                    BEGIN 
                    IF FNEXT
                    THEN
                      BEGIN 
                      HADNEXT = TRUE; 
                      END 
                    END 
                  END 
                END 
              END                  # END IF NOT A CONDITION            #
  
            IDXTBL[DATAPTR] = INDCTBLOC;
            END 
  
          IF NOT ABSADDRESS THEN
          BEGIN 
            FROMBASELOC[DATAPTR] = DATANAMEBASE;
          END 
          IF FIGLITDATA EQ 5       # IF AREA ITEM                      #
          THEN
            BEGIN 
            DATAREAITEM[DATAPTR] = TRUE;  # INDICATE AREA ITEM         #
            END 
      IF AKEYITEM THEN                                                   XXXX 
      BEGIN PRIMKEY = TRUE;                                              XXXX 
            DATAPRKEY[DATAPTR] = TRUE;                                   XXXX 
      IF DIRLEXID EQ O"112" OR DIRLEXID EQ O"124" THEN
        PKEY = TRUE;
      END                                                                XXXX 
      IF ALTKEYITEM THEN                                                 XXXX 
      BEGIN ALTERKEY = TRUE;                                             XXXX 
            DATALTEKEY[DATAPTR] = TRUE;                                  XXXX 
      IF DIRLEXID EQ O"112" OR DIRLEXID EQ O"124" THEN
        AKEY = TRUE;
        END 
      IF PMAJKEYITEM               # IF PRIMARY MAJOR KEY ITEM         #
      THEN
        BEGIN 
        PRIMKEY = TRUE;            # DIRECTIVE CONTAINS MAJ PRIMARY KEY#
        DATAPRMAJ[DATAPTR] = TRUE;
        IF DIRLEXID EQ O"112"      # IF *IF*                           #
          OR DIRLEXID EQ O"124"    # IF *SPECIFY*                      #
        THEN
          BEGIN 
          PKEY = TRUE;             # XMISSN CONTAINS PRIMARY KEY       #
          END 
        END 
      IF AMAJKEYITEM               # IF ALTERNATE MAJOR KEY ITEM       #
      THEN
        BEGIN 
        ALTERKEY = TRUE;           # DIRECTIVE CONTAINS MAJ ALT KEY    #
        DATAALTMAJ[DATAPTR] = TRUE; 
        DATAALTSIZE[DATAPTR] = SIZEALTKEY;
        IF DIRLEXID EQ O"112"      # IF *IF*                           #
          OR DIRLEXID EQ O"124"    # IF *SPECIFY*                      #
        THEN
          BEGIN 
          AKEY = TRUE;             # XMISSN CONTAINS ALTERNATE KEY     #
          END 
        END 
      DATAKEYEXCL[DATAPTR] = EXCLKEYITEM; 
          IF SIGNATERKEY THEN DATAOVERSIGN[DATAPTR] = TRUE; 
              RETURN; 
          END 
      CONTROL EJECT;
      XDEF PROC OPERAND;
      PROC OPERAND; 
          BEGIN 
 #
 0        OPERAND - THIS ROUTINE IS INTENDED TO PERFORM ANY CLEAN-UP
                    NECESSARY IN AN OPERAND ENTRY IN THE PROGRAM STACK, 
                    INCLUDING NOTING A NEED FOR ALLOCATION OF SCRATCH 
                    SPACE FOR RECEIVING THE RESULTS OF
                    INTERMEDIATE STEPS IN EXPRESSION EVALUATION.
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          NBROPERANDS[OPPTR] = NRFUNCPARAMS;
          IF (NRFUNCPARAMS NQ MAXPARAM
              AND MAXPARAM NQ O"777") 
            OR (NRFUNCPARAMS EQ 1 
              AND MAXPARAM EQ O"777") 
          THEN
            BEGIN 
            CMM$FGR (STK$GROUPID);
            STDNO;
            END 
  
          I = OP[OPPTR];
          IF I EQ O"314" THEN 
          BEGIN I = NRFUNCPARAMS / 2; 
                I = NRFUNCPARAMS - I * 2; 
                IF I EQ 0 
                THEN
                  BEGIN 
                  CMM$FGR (STK$GROUPID);
                  STDNO;
                  END 
                OP[OPPTR] = O"314"; 
                STDYES; 
          END 
          IF I EQ O"302" OR  I EQ O"303" THEN   #MIN  100 - 107B DEPEND#
                                  #ON DATA TYPE, MAX  110 - 117B       #
              OP[OPPTR] = O"60" + B<57,3>I * 8 + FIRSTTYPE; 
          ELSE
          IF I LS O"307" AND I GR O"303" THEN   #JULIAN 75B, GREG 76B  #
              OP[OPPTR] = O"71" + B<57,3>I;     #MASK 77B              #
          IF I EQ O"300"           # IF SCAN                           #
          THEN
            BEGIN 
            USAGE[DATAPTR] = 7;    # LOGICAL                           #
            END 
          END 
          STDYES; 
          END 
      CONTROL EJECT;
      XDEF PROC OPENPAREN;
      PROC OPENPAREN; 
          BEGIN 
 #
 0        OPENPAREN - STACKS THE ( ON THE TEMPORARY STACK.
 #
          RECYES;                  # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          PARENESTSAVE = PARENESTSAVE + 1;
          B<PARENESTSAVE,1>LOGOPSAVED = 0;
          B<PARENESTSAVE,1>OPERANDSAVED = 0;
          B<PARENESTSAVE,1>RELOPSAVED = 0;
          UNMATCHEDLP = UNMATCHEDLP + 1;
          IF UNMATCHEDLP EQ OPSTACKLENG / 2 
          THEN                     # MAY NOT EXCEED DEPTH LIMIT        #
            BEGIN 
            CMM$FGR (STK$GROUPID); # RELEASE TEMP STACK SPACE          #
            STDNO;                 # RETURN TO -NO-                    #
            END 
          OPPTR = OPPTR + 1;
          OPWORD[OPPTR] = O"00000000000000000060";# CODE FOR (.        #
          END 
          STDYES; 
          END 
      CONTROL EJECT;
      XDEF PROC FUNCTION; 
      PROC FUNCTION;
          BEGIN 
 #
 0        FUNCTION - STACKS FUNCTION CALL ON EXPRESSION STACK AS AN 
                    OPERAND.
 #
      IF RECORDFLAG                # IF RECORDING                      #
        OR (NOT FULLSYNTX          # IF NOT PREPARING A REPORT         #
          AND STKFLAG)             # AND THIS IS A REPORT DIRECTIVE    #
      THEN
          BEGIN 
          STDYES;                                                        QU3A334
          END 
  
      CURFUNC = TRUE;              # FLAG THAT DATANAME IS A FUNCTION  #
          NRFUNCPARAMS = 0; 
              OPPTR = OPPTR + 1;
              OP[OPPTR] = CLXNUM[0];
              PRIORITY[OPPTR] = CP1[0]; 
          IF ICW[0] EQ "MASK" THEN MAXPARAM = 3;
          ELSE IF ICW[0] EQ "MIN" OR ICW[0] EQ "MAX" OR 
                  ICW[0] EQ "SCAN" OR 
                  ICW[0] EQ "DECODE" THEN MAXPARAM = O"777";
          ELSE MAXPARAM = 1;
              STDYES; 
          END 
      CONTROL EJECT;
      XDEF PROC FUNCPARAM;
      PROC FUNCPARAM; 
          BEGIN 
 #
 0        FUNCPARAM - ANALYZES PARAMETER USAGE IN FUNCTION CALLS. 
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          I = OP[OPPTR];
          NRFUNCPARAMS = NRFUNCPARAMS + 1;
          IF NRFUNCPARAMS GR MAXPARAM THEN GOTO PDIAG;
          IF (I EQ O"300")         #           *SCAN*                  #
            AND DATATYPE NQ 0 
          THEN
            BEGIN                  # IF PARAMETER NOT CHARACTER        #
            GOTO PDIAG;            # GENERATE (068) DIAGNOSTIC         #
            END 
          IF I EQ O"301" THEN 
          BEGIN 
          IF DATATYPE EQ 0 OR DATATYPE GR 4 THEN GOTO PDIAG;
          OP[OPPTR] = O"70" + DATANAMEUSE;
          IF DATANAMEUSE EQ 1      # IF NUMERIC                        #
          THEN
            BEGIN 
            OP[OPPTR] = O"74";     # ABS(NUMERIC) IS FLOATING          #
            END 
          END 
          ELSE
         IF I EQ O"304" AND ((DATATYPE EQ 0 AND DATALENG LS 5) OR       017690
              DATATYPE GR 2)                                            017700
          THEN GOTO PDIAG;
          ELSE
  
            IF I EQ O"305"         #         *GREGORIAN*               #
              AND DATATYPE NQ 2 
            THEN
              BEGIN 
              GOTO PDIAG;          # PARAMETER NQ INTEGER - ERROR      #
              END 
  
          ELSE
          ITEM J; 
          IF I EQ O"314" THEN 
          BEGIN J = NRFUNCPARAMS / 2; 
                J = NRFUNCPARAMS - J * 2; 
                IF J NQ 0 THEN
                BEGIN FIRSTTYPE = DATATYPE; 
                      FIRSTLENGTH = DATALENG; 
               IF NOT FALL THEN GOTO PDIAG; 
                      FALL = FALSE; 
                END 
              ELSE                                                       QU3A072
                BEGIN                                                    QU3A072
                IF FALL            # *DECODE* (ALL) ERROR              #
                THEN
                  BEGIN                                                  QU3A072
                  GOTO PDIAG;                                            QU3A072
                  END                                                    QU3A072
                IF (DATATYPE NQ FIRSTTYPE  # PARAMETERS INCONSITENT    #
                  AND (DATATYPE EQ 0       # AND TYPE IS CHARACTER     #
                    OR DATATYPE EQ 7       # OR LOGICAL                #
                    OR FIRSTTYPE EQ 0 
                    OR FIRSTTYPE EQ 7)) 
                THEN
                  BEGIN 
                  GOTO QDIAG;      # PRINT (332) ERROR MESSAGE -       #
                  END              # INCONSISTENT DATA TYPES           #
                END                                                      QU3A072
          END 
          IF MAXPARAM NQ 1 THEN 
          BEGIN 
              IF NRFUNCPARAMS EQ 1 THEN 
              BEGIN 
                  FIRSTTYPE = DATATYPE; 
                  FIRSTLENGTH = DATALENG; 
              END 
              ELSE
              BEGIN 
  
                IF (I EQ O"302")   #      *MIN*             *MAX*      #
                  OR (I EQ O"303")
                THEN
                  BEGIN 
                  IF DATATYPE NQ FIRSTTYPE
                  THEN             # IF PARAMETERS OF MIXED TYPE       #
                    BEGIN          # GENERATE (332) DIAGNOSTIC         #
                    GOTO QDIAG; 
                    END 
                  END 
  
                IF I EQ O"306"     #           *MASK*                  #
                THEN
                  BEGIN 
                  IF DATATYPE NQ FIRSTTYPE
                  THEN
                    BEGIN          # IF PARAMETERS OF MIXED TYPE       #
                    GOTO QDIAG;    # GENERATE (332) DIAGNOSTIC         #
                    END 
                  IF DATALENG NQ FIRSTLENGTH
                  THEN
                    BEGIN          # IF PARAMETERS OF MIXED LENGTH     #
                    GOTO RDIAG;    # GENERATE (950) DIAGNOSTIC         #
                    END 
                  END 
  
              END 
          END 
          SETINFO;
          END 
          STDYES; 
  
#                   ****** ERROR EXITS ******                          #
PDIAG:                             # (068) ERROR MESSAGE - INVALID     #
  BEGIN                            #                       PARAMETER   #
  DDIAG(68);
  CMM$FGR (STK$GROUPID);
  STDNO;
  END 
QDIAG:                             # (332) ERROR MESSAGE - PARAMETER   #
  BEGIN                            # WITH INCONSISTENT DATA TYPES      #
  DDIAG(332); 
  CMM$FGR (STK$GROUPID);
  STDNO;
  END 
RDIAG:                             # (950) ERROR MESSAGE - PARAMETER   #
  BEGIN                            # LENGTHS INCONSISTENT              #
  DDIAG(950); 
  CMM$FGR (STK$GROUPID);
  STDNO;
  END 
  
          END 
      CONTROL EJECT;
      XDEF PROC ENDEXPRESS; 
      PROC ENDEXPRESS;
          BEGIN 
 #
 0        ENDEXPRESS - CLEANS UP THE PROGRAM STACK AND ALLOCATES SCRATCH
                    SPACE IN THE STACK. 
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          IF UNMATCHEDLP NQ 0 THEN
          BEGIN 
            DIAG(62); 
          CMM$FGR (STK$GROUPID);
            STDNO;
          END 
          IF AAREAITM THEN         # IF AN AREA ITEM WAS ENCOUNTERED   #
                                   # IN THE EXPRESSION BEING PROCESSED #
            BEGIN 
            AREAITM = TRUE;        # TREAT EXPRESSION AS AN AREA ITEM. #
  
                                   # TO PREVENT *DISPTBL* FROM         #
                                   # CONFUSING A POSSIBLE DEFINE ITEM  #
                                   # WITH A CUMULATIVE FUNCTION        #
            FIGLITDATA = TYPEOFTHING"AREANAME"; 
            END 
          ELSE
            BEGIN 
            AREAITM = FALSE;       # TREAT EXPRESSION AS NON-AREA ITEM #
            END 
           IF DDESITM THEN DESITM = TRUE; ELSE DESITM = FALSE;
          IF ERRFLAG NQ 0          # CHECK FOR ERROR DETECTED          #
          THEN                     # IN EXPRESSION                     #
            BEGIN 
            CMM$FGR (STK$GROUPID);
            STDNO;
            END 
          CP1[0] = 0;                  # FLAG FOR ARITHOP: RIGHT STRING#
                             # TERMINATOR, CAUSES ARITHOP TO FLUSH ALL #
                             # STACKS AND COMPLETE BUILDING PROGRAM STK#
          OPERATOR; 
          IF ERRFLAG NQ 0          # SEE IF ERROR OCCURRED WHILE       #
          THEN                     # IN PROC OPERATOR                  #
            BEGIN 
            CMM$FGR (STK$GROUPID); # RELEASE TEMP STACK SPACE          #
            STDNO;                 # RETURN TO -NO-                    #
            END 
          IF COUNTER LS 1 THEN         # EXPRESSION HAS DEGENERATED    #
          BEGIN                        # INTO A SIMPLE LITERAL OR DATA-#
                                       # NAME W OR W/O SUBSCRIPTS.     #
            PROGSTACKLEN = -1;
            PROGSTACKLOC = 0; 
            CMM$FGR (STK$GROUPID);
            STDYES; 
          END 
          # RESTORE BLOCK AND USE POINTER SAVED IN PROC OPERATOR       #
          P<PROGRAMSTACK> = SAVESTACK;
          IF ((OPCODE[SAVEPTR] GR O"76" 
            AND OPCODE[SAVEPTR] LS O"120")
              OR OPCODE[SAVEPTR] EQ O"314") 
             AND RESULTUSAGE EQ 0 THEN
             BEGIN RESULTSIZE = FIRSTLENGTH;
              DATALENG = FIRSTLENGTH; 
                   DATATYPE = RESULTUSAGE;
            END 
          ELSE
          BEGIN 
          IF RESULTUSAGE LS 2 
          THEN
            BEGIN 
            P<PROGRAMSTACK> = SAVESTACK;    # RESTORE BLOCK AND USE PTR#
            POINTER = GETSPACE(SAVEPTR,-1); # SAVED IN PROC OPERATOR   #
            DATALENG = NBRCHARS[POINTER]; 
            END 
          ELSE IF RESULTUSAGE EQ 5 OR RESULTUSAGE EQ 6 THEN 
            DATALENG = 20; ELSE DATALENG = 10;
          IF OPCODE[SAVEPTR] EQ O"73" 
          THEN
            BEGIN 
            DATALENG = 10;
            END 
          DATATYPE = RESULTUSAGE; 
          RESULTSIZE = PICSIZE[RESULTUSAGE];# USE DEFAULT PIC SIZE.    #
          END 
          LINKSCRATCH;                 # LINK SCRATCH SPACE TO STACK   #
                                       # ENTRIES AND RETURN ALL UNUSED #
                                       # SPACE TO SPACE MANAGER.       #
          END 
          STDYES; 
          END 
      CONTROL EJECT;
      PROC LINKSCRATCH; 
 #
 0        LINKSCRATCH - ALLOCATES SCRATCH SPACE IN THE PROGRAM STACK
              AND LINKS IT TO OPERANDS AND OPERATORS. 
 #
          BEGIN 
                                   # IF JUST CHECKING SYNTAX, THE      #
                                   # STACK IS NOT SAVED. FREE THE      #
                                   # TEMPORARY STACK SPACE AND         #
                                   # RETURN.                           #
          IF RECORDFLAG 
          THEN
            BEGIN 
            CMM$FGR (STK$GROUPID);
            RETURN; 
            END 
          PROGSTACKLEN = (1 + COUNTER) * STKSIZE + NN;  # LENGTH OF    #
                                   # THE FINAL PROGAM STACK            #
                                   # GET A GROUP ID FOR PROGRAMSTACK.  #
                                   # -SM$GROUPID- WILL BECOME PART     #
                                   # OF THE BASICTABLE---BASC$GROUPID- #
          P<MOVER> = CMM$ALF (PROGSTACKLEN, 0, SM$GROUPID); 
                                       # STACK + SCRATCH SPACE.        #
          P<PROGRAMSTACK> = LOCPROGSTACK;  # START OF LOCAL STACK      #
          I = 0;
      RESULTSLOC = P<MOVER> + PROGSTACKLEN;  # LWA + 1 OF CMM BLOCK    #
      FOR J = 0 STEP 1
        UNTIL COUNTER 
      DO
        BEGIN 
        IF ENTRYTYPE[I] NQ 7       # IF OPERAND                        #
        THEN
          BEGIN 
          IF FROMWORDADDR[I] LS 0  # IF OFFSET WITHIN PROGRAM STACK    #
          THEN
            BEGIN 
                                   # ADD LWA + 1 OF PROG STACK         #
            FROMWORDADDR[I] = RESULTSLOC + FROMWORDADDR[I]; 
            END 
  
          ELSE
            BEGIN 
            IF EDITFLAG[I]         # IF EDITTING                       #
            THEN
              BEGIN 
              EDITBIT = 1;
              END 
            ELSE
              BEGIN 
              EDITBIT = 0;
              END 
  
            IF ENTRYTYPE[I] GQ 2   # IF CONVERSION REQUIRED            #
                                   # IF FROMWORDADDR POINTS TO ATTRIB  #
              AND B<CONVERTCODE[I],1>MVEVFROM[EDITBIT] NQ 0 
            THEN
              BEGIN 
              P<ATTRIB> = FROMWORDADDR[I];  # POSITION TO ATTRIB TABLE #
              IF ATTRWP[1] LS 0    # IF OFFSET WITHIN PROGRAM STACK    #
              THEN
                BEGIN 
                ATTRWP[1] = ATTRWP[1] + RESULTSLOC; 
                                   # ADD LWA + 1 OF PROGRAM STACK      #
                END 
              END 
            END 
          END 
  
        IF TOWORDADDR[I] LS 0 
        THEN
          BEGIN 
          TOWORDADDR[I] = RESULTSLOC + TOWORDADDR[I]; 
          END 
        IF I EQ LAST              # SEE IF NEW BLOCK NEEDED            #
        THEN
          BEGIN 
          P<PROGRAMSTACK> = FORWDLINK[LAST];
          I = 0;
          END 
        ELSE
          BEGIN 
          I = I + 1;
          END 
        END 
      P<PROGRAMSTACK> = SAVESTACK;     # STACK ADDR AND POINTER SAVED  #
                                       # IN PROC OPERATOR              #
      RESULTSLOC = TOWORDADDR[SAVEPTR]; 
      SAVEPTR = GETSPACE(SAVEPTR,1);
      TOWORDADDR[SAVEPTR] = RESULTSLOC;  # SAVE LOC IN LAST OP ENTRY   #
      I = 0;
      P<PROGRAMSTACK> = LOCPROGSTACK;  # BACK TO THE BEGINNING         #
      FOR J = 0 STEP 1
        UNTIL COUNTER 
      DO
        BEGIN 
        MWORD[J] = PSTKWORD[I]; 
        MWORD2[J] = PSTKWORD1[I]; 
        MWORD3[J] = PSTKWORD2[I]; 
        MWORD4[J]  = PSTKWORD3[I];
        IF I EQ LAST
        THEN
          BEGIN 
          P<PROGRAMSTACK> = FORWDLINK[I]; 
          I = 0;
          END 
        ELSE
          BEGIN 
          I = I + 1;
          END 
        END 
      PROGSTACKLOC = P<MOVER>;
      P<PROGRAMSTACK> = PROGSTACKLOC; 
      CMM$FGR(STK$GROUPID);      # RELEASE LOCAL STACK SPACE           #
          RETURN; 
          END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     E N D A B E X P R                                                #
#                                                                      #
#     PROC *ENDABEXPR* IS CALLED FROM SYNGEN PROCESSING OF EITHER AN   #
#     ARITHMETIC OR BOOLEAN EXPRESSION (*ABEXPR*) AFTER THE ENTIRE     #
#     EXPRESSION HAS BEEN PARSED.  IT CALLS THE APPROPRIATE ROUTINE TO #
#     DO THE STACK CLEAN-UP FOR WHICHEVER TYPE OF EXPRESSION WAS GIVEN.#
#                                                                      #
#     INPUT: BOOFLAG - TRUE IF EXPRESSION WAS BOOLEAN                  #
#                      FALSE IF EXPRESSION WAS ARITHMETIC              #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC ENDABEXPR;
      PROC ENDABEXPR; 
      BEGIN 
      IF BOOFLAG                   # IF THE EXPRESSION IS BOOLEAN      #
      THEN
        BEGIN 
        ENDCOND;                   # CLEAN UP STACK FOR A CONDITION    #
        END 
  
      ELSE                         # IF ARITHMETIC EXPRESSION          #
        BEGIN 
        ENDEXPRESS;                # DO ITS APPROPRIATE CLEAN-UP       #
        END 
      END                          # PROC *ENDABEXPR*                  #
          CONTROL EJECT;
          ITEM FLAG1 B; 
           ITEM FLAG2 B;
      XDEF PROC CONDINIT; 
      PROC CONDINIT;
          BEGIN 
 #
 0        CONDINIT - INITIALIZES ALL NECESSARY LOCATIONS FOR CONDITIONAL
                    EXPRESSION ANALYSIS.
 #
  
          RECNO;                   # RETURN TO STDNO  IF RECORDING     #
          FLAG1 = FALSE;
          NONEWOP = FALSE;
          P<PROGRAMSTACK> = 0;     # INDICATE NO STACK YET             #
          PSTACKSAVE = 0;          # NO STACK SAVED                    #
          STK$GROUPID = CMM$AGR(0); 
          COUNTER = -1;            # INITIALIZE COUNT OF ENTRIES       #
          LOCPROGSTACK = 0; 
          AAREAITM = FALSE; 
           FLAG2 = FALSE; 
           DDESITM = FALSE; 
          HADALL = FALSE;                                               000920
          HADANY = FALSE;                                               000930
          HADNEXT = FALSE;                                              000940
          HADLAST = FALSE;                                              000950
          CONDIT = TRUE;                                                000960
          OPPTR = 0;
          DATAPTR = -1; 
          OPWORD[0] = 0;
          NN = 0; 
          PSTACKPTR = -1; 
          UNMATCHEDLP = 0;
          ERRFLAG = 0;
          LOGOPFLAG = 0;
          SAVEDADDR = 0;
          PRIMKEY = FALSE;    #PRESET ALL FLAGS AND ITEMS TO INITIAL   # XXXX 
          ALTERKEY = FALSE;   #VALUE                                   # XXXX 
          LOGOPSAVED = 0; 
          PARENESTSAVE = 0; 
          RELOPSAVED = 0; 
          OPERANDSAVED = 0; 
          RESULTSIZE = 0;          # SIZE OF EXPR RESULT IN CHARS      #
          NRFUNCPARAMS = 0;        # NUM OF PARAMS IN FUNCTION CALL    #
          BOOFLAG = FALSE;         # WILL BE TRUE IF LOGICAL OR        #
                                   # RELATIONAL OPERATOR FOUND         #
          LOGERR = FALSE;          # T IF EXPR W/O RELOP BEFORE LOGOP  #
          STDNO;
          END 
      CONTROL EJECT;
      XDEF PROC NOTOP;
      PROC NOTOP; 
          BEGIN 
 #
 0        NOTOP - THE UNARY OPERATOR "NOT" IS STACKED ON THE TEMPORY
                    CONDITION STACK.
 #
          RECNO;                   # RETURN TO STDNO  IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          OPPTR = OPPTR + 1;
          OPWORD[OPPTR] = O"00500000000100000035";
          BOOFLAG = TRUE;          # FLAG THAT EXPR IS BOOLEAN         #
                                   # IF EXPR W/O RELATIONAL OPERATOR   #
          IF LOGERR                # ENCOUNTERED BUT NOT YET DIAGED    #
          THEN
            BEGIN 
            DIAG (58, CURWORD);    # LOGICAL OPERATOR NEEDS LOG OPND   #
            ERRFLAG = 1;           # FLAG ERRONEOUS BOOLEAN EXPR       #
            LOGERR = FALSE;        # WE"VE DIAGED ERR, SO TURN OFF FLAG#
            END 
  
          END 
          STDNO;
          END 
      CONTROL EJECT;
      XDEF PROC CHKLOGOPFLAG; 
      PROC CHKLOGOPFLAG;
          BEGIN 
 #
 0        CHKLOGOPFLAG - INSERTS A COPY OF THE 1ST HALF OF THE PREVIOUS 
                    RELATION AND THE PREVIOUS RELATIONAL OPERATOR TO
                    ENABLE SHORTHAND CONDITIONAL EXPRESSIONS. 
 #
      RECNO;                       # RETURN TO STDNO  IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          IF LOGOPFLAG EQ 0        # IF NO LOGICAL OPERATOR SAVED      #
          THEN
            BEGIN 
            IF USAGE[DATAPTR] NQ 7 # IF NOT LOGICAL                    #
            THEN
              BEGIN 
              IF BOOFLAG           # IF THIS IS BOOLEAN,NOT ARITH, EXPR#
              THEN
                BEGIN 
                DIAG (58, CURWORD);  # LOGICAL OPERATOR NEEDS LOG OPND #
                ERRFLAG = 1;         # FLAG ERRONEOUS BOOLEAN EXPR     #
                END 
                                   # THIS IS EXPECTED IF ARITH EXPR,   #
              ELSE                 # SO DON"T DIAGNOSE YET             #
                BEGIN 
                LOGERR = TRUE;     # BUT FLAG IT IN CASE EXPR TURNS    #
                                   # OUT TO BE BOOLEAN AFTER ALL       #
                END 
  
              END 
            ELSE
              BEGIN 
              RELOPSAVED = 0; 
              OPERANDSAVED = 0; 
              END 
            STDNO;
            END 
          ELSE                     # IF LOGICAL OPERATOR SAVED         #
            BEGIN 
            IF USAGE[DATAPTR] EQ 7 # IF LOGICAL                        #
            THEN
              BEGIN 
              LOGOPFLAG = 0;       # DISCARD SAVED HALF                #
              RELOPSAVED = 0; 
              OPERANDSAVED = 0; 
              STDNO;
              END 
            END 
          IF B<0,9>SAVEDRELOP LS PRIORITY[OPPTR]  # IF MUST STACK AN   #
                                   # OPERATOR FROM OPSTACK TO PROG STK #
          THEN
            BEGIN 
            NONEWOP = TRUE;        # NO NEW OP TO STACK                #
            CP1[0] = B<0,9>SAVEDRELOP;  # PRECEDENCE OF SAVED OPERATOR #
            OPERATOR;              # STACK OPERATOR                    #
            NONEWOP = FALSE;       # CLEAR FLAG                        #
            END 
          DSTKWORD[DATAPTR+1] = DSTKWORD[DATAPTR];
          DSTKWORD2[DATAPTR+1] = DSTKWORD2[DATAPTR];
          DSTKWORD3[DATAPTR+1] = DSTKWORD3[DATAPTR];
          DSTKWORD[DATAPTR] = SAVEDOPND1; 
          DSTKWORD2[DATAPTR] = SAVEDOPND2;
          DSTKWORD3[DATAPTR] = SAVEDOPND3;
          DATAPTR = DATAPTR + 1;
          OPPTR = OPPTR + 1;
          OPWORD[OPPTR] = SAVEDRELOP; 
          END 
          STDNO;
          END 
      CONTROL EJECT;
      XDEF PROC RELOP;
      PROC RELOP; 
          BEGIN 
 #
 0        RELOP - SAVES RELATIONAL OPERATOR ON TOP OF OP STACK AND OPER-
                    AND ON TOP OF DATA STACK FOR POSSIBLE DUPLICATION 
                    LATER IN SHORTHAND NOTATION.
 #
      RECNO;                       # RETURN TO STDNO  IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
        BEGIN 
        IF B<PARENESTSAVE,1>OPERANDSAVED EQ 1 
        THEN
          BEGIN 
          BOOFLAG = TRUE;          # FLAG THAT EXPR IS BOOLEAN         #
                                   # IF EXPR W/O RELATIONAL OPERATOR   #
          IF LOGERR                # ENCOUNTERED BUT NOT YET DIAGED    #
          THEN
            BEGIN 
            DIAG (58, CURWORD);    # LOGICAL OPERATOR NEEDS LOG OPND   #
            ERRFLAG = 1;           # FLAG ERRONEOUS BOOLEAN EXPR       #
            LOGERR = FALSE;        # WE"VE DIAGED ERR, SO TURN OFF FLAG#
            END 
  
          B<PARENESTSAVE,1>RELOPSAVED = 1;
          IF AREAITM THEN FLAG1 = TRUE; 
           IF DESITM THEN FLAG2 = TRUE; 
          SAVEDRELOP = OPWORD[OPPTR]; 
          SAVEDOPND1 = DSTKWORD[DATAPTR]; 
          SAVEDOPND2 = DSTKWORD2[DATAPTR];
          SAVEDOPND3 = DSTKWORD3[DATAPTR];
          SAVEDADDR = FROMWORDPTR[DATAPTR]; 
          END 
        ELSE
          BEGIN 
          B<PARENESTSAVE,1>RELOPSAVED = 0;
          END 
        END 
          STDNO;
          END 
      CONTROL EJECT;
      XDEF PROC LOGOP;
      PROC LOGOP; 
          BEGIN 
 #
 0        LOGOP - LOGOPFLAG IS TURNED ON AND LOGICAL OPERATOR IS
                    STACKED BY PROC NAMED OPERATOR. 
 #
          BOOFLAG = TRUE;          # FLAG THAT EXPR IS BOOLEAN         #
                                   # IF EXPR W/O RELATIONAL OPERATOR   #
          IF LOGERR                # ENCOUNTERED BUT NOT YET DIAGED    #
          THEN
            BEGIN 
            DIAG (58, CURWORD);    # LOGICAL OPERATOR NEEDS LOG OPND   #
            ERRFLAG = 1;           # FLAG ERRONEOUS BOOLEAN EXPR       #
            LOGERR = FALSE;        # WE"VE DIAGED ERR, SO TURN OFF FLAG#
            END 
  
          IF B<PARENESTSAVE,1>RELOPSAVED EQ 1 
          THEN
            BEGIN 
            LOGOPFLAG = 1;
            B<PARENESTSAVE,1>LOGOPSAVED = 1;  # DISCARD SAVED WHEN     #
                                              # MATCHING PAREN FOUND   #
            END 
          ELSE
            BEGIN 
            LOGOPFLAG = 0;
            END 
          OPERATOR; 
          END 
      CONTROL EJECT;
      XDEF PROC STKOPNDSAVED; 
      PROC STKOPNDSAVED;
          BEGIN 
 #
 0        STKOPNDSAVED - INSERTS A COPY OF THE 1ST HALF OF THE PREVIOUS 
                    RELATION BEFORE THE CURRENT RELATIONAL OPERATOR TO
                    ENABLE SHORTHAND CONDITIONAL RELATIONAL EXPRESSIONS 
 #
      RECNO;                       # RETURN TO STDNO  IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          IF LOGOPFLAG EQ 0 THEN       # NO RELATION HAS BEEN SAVED.   #
            BEGIN 
            DIAG(58,CURWORD);      # LOG OPERATOR W/O LOG OPERAND      # QU3A350
            ERRFLAG = 1;
            STDNO;
            END 
          DATAPTR = DATAPTR + 1;
          DSTKWORD[DATAPTR] = SAVEDOPND1; 
          DSTKWORD2[DATAPTR] = SAVEDOPND2;
          DSTKWORD3[DATAPTR] = SAVEDOPND3;
          END 
          STDNO;
          END 
      CONTROL EJECT;
      PROC CONDEXPRESS; 
          BEGIN 
 #
 0        CONDEXPRESS - STACKS AN ARITHMETIC EXPRESSION STACK ONTO THE
                    CONDITION STACK.
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF NOT FULLSYNTX
        AND STKFLAG 
      THEN
        BEGIN 
        STDYES; 
        END 
          P<PROGRAMSTACK> = PSTACKSAVE; 
          PSTACKPTR = GETSPACE(PSTACKPTR,1);  # INCREMENT POINTER      #
          COUNTER = COUNTER + 1;
          PSTACKSAVE = P<PROGRAMSTACK>; 
          ENTRYTYPE[PSTACKPTR] = 3; 
          EXPRESSTACK[PSTACKPTR] = PROGSTACKLOC;
          TOWORDADDR[PSTACKPTR] = RESULTSLOC; 
          IF DATANAMEPTR NQ 0 THEN
          BEGIN 
          P<DESATT1> = DATANAMEPTR; 
          END 
          DATAPTR = DATAPTR + 1;
          DSTKWORD[DATAPTR] = 0;
          DSTKWORD2[DATAPTR] = 0; 
          DSTKWORD3[DATAPTR] = 0; 
          DSTKWORD4[DATAPTR] = 0; 
          USAGE[DATAPTR] = 7; 
          DTYPE[DATAPTR] = 7; 
          PSTKLOC[DATAPTR] = COUNTER; 
          FROMWORDPTR[DATAPTR] = RESULTSLOC;
           IF AREAITM THEN AAREAITM=TRUE; 
           IF DESITM THEN DDESITM = TRUE; 
          END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     I F S A M E                                                      #
#                                                                      #
#     *IFSAME* IS CALLED FROM THE SYNTAX-CRACKING OF A CONDITION WHEN  #
#     THE KEYWORD *SAME* IS ENCOUNTERED. AFTER MAKING SURE THE         #
#     CONDITION WAS IN AN *IF* AND A *SAME* LIST EXISTS, IT SAVES ALL  #
#     LEXICAL INFORMATION ABOUT THE CURRENT INPUT BUFFER AND SWITCHES  #
#     THE LEXICAL SCAN OVER TO THE SAVED *SAME* BUFFER. IF *SAME* IS   #
#     FOLLOWED BY MORE OF THE CONDITION, *SAMINIF* IS SET TRUE, AND    #
#     *SAMPTR* IS BUMPED TO THE WORD AFTER *SAME*.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC IFSAME; 
      PROC IFSAME;
      BEGIN 
      IF DIRLEXID NQ O"112"        # IF DIRECTIVE WAS NOT AN -IF-      #
      THEN
        BEGIN 
        STDNO;                     # ERROR - *SAME* CONDITION ALLOWED  #
                                   # ONLY IN *IF* DIRECTIVE            #
        END 
  
      RECYES;                      # -STDYES- EXIT IF RECORDING        #
  
      IF SAMWD[1] EQ 0             # IF NO -SAME- ENTRY FOR -IF-       #
      THEN
        BEGIN 
        DIAG (189);                # NO SAME LIST TO REFER TO          #
        STDNO;
        END 
  
      P<BASICTABLE> = BASCPTR;     # POSN TO CURRENT BLOCK OF BASIC TBL#
  
      IF NOT NLXDIRV[0]            # IF WORD AFTER -SAME- IS NOT A DIR #
        AND NOT (NLX[0] EQ 0       # AND NOT END OF TRANSMISSION       #
          AND NEXTYPE EQ 12)
      THEN
        BEGIN 
        SAMINIF = TRUE;            # -SAME- IS ONLY PART OF THE -IF-   #
                                   # DIRECTIVE-S CONDITION             #
        SAMPTR = CT100 + OLDLEX;   # BUMP -SAMPTR- TO WORD AFTER -SAME-#
  
                                   # IF WORD STARTED IN PREVIOUS SET   #
        IF SUB100                  # OF 100 CHARS                      #
        THEN
          BEGIN 
          SAMPTR = SAMPTR - 100;   # DECREASE -SAMPTR- ACCORDINGLY     #
          END 
        END 
                                   # SAVE ALL LEXSCAN-S INFO ABOUT THE #
                                   # CURRENT -QUIWSA-                  #
                                   # START WITH -ESTD- VALUES          #
      ESTDLEN = LOC(ESTDEND) - LOC(ESTDBEG);
      P<SVESTD> = CMM$ALF (ESTDLEN, 0, 0);
      MOVE (ESTDBEG, ESTDLEN, SVESTD);
                                   # NOW SAVE -LEXSCAN- LOCAL AND      #
                                   # -QUIWSA- RELATED ITEMS            #
      SVCT100 = CT100;
      SVEOTTERM = EOTTERM;
      SVOLDLEX = OLDLEX;
      SVQUIRL = QUIRL;
      SVQUIWSA = P<QUIWSA>; 
      SVSTATE = STATE;
      SVSTATRANS = P<STATETRANS>; 
                                   # SWITCH POINTERS OVER TO -SAME-    #
                                   # BUFFER AND START LEXSCAN ON IT    #
      P<QUIWSA> = SAMADDR[1]; 
      QUIRL = SAMLEN[1];
      CT100 = -100; 
      LEXINIT;
  
      SAMUSED[1] = TRUE;           # FLAG THAT -SAME- LIST USED IN DIR #
      SAMINPUT = TRUE;             # FLAG THAT -SAME- LIST IN -QUIWSA- #
  
      STDYES; 
      END                          # PROC *IFSAME*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E C S A M E                                                    #
#                                                                      #
#     *RECSAME* IS CALLED AFTER A *SAME* IS FOUND IN ORDER TO SKIP     #
#     FURTHER PROCESSING IF IT-S BEING RECORDED.                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC RECSAME;
      PROC RECSAME; 
      BEGIN 
      RECNO;                       # RETURN VIA -NO- IF RECORDING      #
  
      STDYES;                      # OTHERWISE, RETURN VIA -YES-       #
      END                          # PROC *RECSAME*                    #
      CONTROL EJECT;
      XDEF PROC ENDCOND;
      PROC ENDCOND; 
          BEGIN 
 #
 0        ENDCOND - CLEANS UP THE PROGRAM STACK.
 #
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF FULLSYNTX                 # IF PREPARING A REPORT             #
        OR NOT STKFLAG             # OR NOT WORKING ON REPORT DIRECTIVE#
      THEN
          BEGIN 
          CONDIT = FALSE;                                               000980
          ITEM FLG B; FLG = FALSE;                                      000120
          IF FLAG1 OR AAREAITM THEN AREAITM = TRUE; 
             ELSE AREAITM = FALSE;
           IF FLAG2 OR DDESITM THEN DESITM = TRUE;
           ELSE DESITM = FALSE; 
          IF UNMATCHEDLP NQ 0 THEN
          BEGIN 
            DIAG(62); 
            CMM$FGR (STK$GROUPID);
            STDNO;
          END 
          IF ERRFLAG NQ 0          # CHECK FOR ERRORS DETECTED         #
          THEN                     # IN EXPRESSION .                   #
            BEGIN 
            CMM$FGR (STK$GROUPID);
            STDNO;
            END 
          CP1[0] = 0;                  # FLAG FOR OPERATOR: RIGHT      #
                             # STRING TERMINATOR, CAUSES ALL STACKS TO #
                             # BE FLUSHED AND PROGRAM STACK COMPLETED. #
          OPERATOR; 
          IF ERRFLAG NQ 0          # CHECK FOR ERRORS DETECTED         #
          THEN                     # IN PROC OPERATOR.                 #
            BEGIN 
            CMM$FGR (STK$GROUPID);
            STDNO;
            END 
          IF COUNTER LS 1          # IF CONDITION IS A DATANAME        #
          THEN
            BEGIN 
            IF DATANAMEUSE NQ 7 THEN  #IF NOT LOGICAL                  #
              BEGIN 
                                   #IF RECORDING AND SAME              #
              IF RECORDFLAG AND (CLXWRD[0] EQ O"0625") THEN 
                BEGIN 
                STDYES;            #GOOD RETURN                        #
                END 
              ELSE
                BEGIN 
                CMM$FGR (STK$GROUPID);
                STDNO;             #ERROR RETURN                       #
                END 
              END 
                                   #CONDITION IS A LOGICAL DATANAME    #
                                   #BUILD A STACK TESTING THE VALUE    #
                                   #FOR TRUE                           #
          DSTKWORD[1] = 0;                                              000380
           DSTKWORD2 [1] = 0; 
          DTYPE[1] = 7;                                                 000390
          USAGE[1] = 7;                                                 000400
                                   # SET UP FOR BRAND NEW STACK        #
          PSTACKPTR = -1; 
          P<PROGRAMSTACK> = 0;
          LOCPROGSTACK = 0; 
          PSTACKSAVE = 0; 
            DATAPTR = 1;
            OPWORD[1] = O"00600000000200000014";
            OPPTR = 1;
            CP1[0] = 0; 
            OPERATOR; 
          FLG = TRUE;                                                   000140
          NN = NN + 1;             # OFFSET OF THIS RESULT             #
          TOWORDADDR[1] = -NN;     # LINKSCRATCH WILL ADD LWA + 1 OF   #
                                   # BLOCK CONTAINING PROGSTACK        #
          FROMWORDADDR[1] = -NN;
          END 
          IF COUNTER EQ 0 AND      # CHECK FOR DEGENERATE FORM CON-    #
             ENTRYTYPE[0] EQ 3 THEN    # SISTING OF ONLY A CONDITION-  #
             BEGIN                     # NAME.                         #
               PROGSTACKLOC = EXPRESSTACK[0]; 
               PROGSTACKLEN = 1;
  
             END
          ELSE
            BEGIN 
            LINKSCRATCH;               # LINK SCRATCH SPACE TO STACK   #
                                       # ENTRIES AND RETURN ALL UNUSED #
                                       # SPACE TO THE SPACE MANAGER.   #
          IF NOT RECORDFLAG THEN
          IF FLG THEN BEGIN 
              P<MOVER> = TOWORDADDR[1]; 
              B<0,60>MWORD[0] = 
           O"77777777777777777776";                                     000210
                      END 
          END 
            END 
          STDYES; 
          END 
      # 
 0[                         :     :     :     :     : 
 +?                     ?     AND   OR    XOR  EQUIV  IMP?
 ?                      ?TT    T     T     F     T     T ?
 ?                      ?TF    F     T     T     F     F ?
 ?                      ?FT    F     T     T     F     T ?
 ]                          :     :     :     :     : 
 +                       FF    F     F     F     T     T
      # 
          END                               # END "EXPRESS" PROC       #
 #
 F    (END OF "EXPRESS" DESCRIPTION)
 #
      TERM
