*DECK SET2
USETEXT CCTTEXT 
USETEXT DNTEXT
USETEXT PPTEXT
    PROC SET2;
         CONTROL PACK;
         BEGIN
*CALL DPPPDDATA 
*CALL PPCOMMON2 
  
*CALL DNATVALS
*CALL AUXTVALS
*CALL PLTVALS 
         $BEGIN 
         XREF ITEM PRI$STK$TRC  B;     # PRIORITY STACK TRACE          #
         XREF ITEM SUB$OBJ$TRC  B;     # SUBJECT/OBJECT STACK TRACE    #
         XREF PROC SUB$DMP;            # SUBJECT STACK DUMP            #
         XREF PROC OBJ$DMP;            # OBJECT STACK DUMP             #
         XREF PROC OUTPUT;             # OUTPUT TO LISTING             #
         $END 
         SWITCH SUB    #SUB0#,
         SUB1 , SUB2 , SUB3 , SUB4 , SUB5 , 
         SUB6 , SUB7 , SUB8 , SUB9 , SUB10, 
         SUB11, SUB12, SUB13, SUB14, SUB15, 
         SUB16, SUB17, SUB18, SUB19, SUB20, 
         SUB21, SUB22, SUB23, SUB24, SUB25, 
         SUB26, SUB27, SUB28, SUB29, SUB30, 
         SUB31, SUB32, SUB33, SUB34, SUB35, 
         SUB36, SUB37, SUB38, SUB39, SUB40, 
         SUB41, SUB42, SUB43, SUB44, SUB45, 
         SUB46, SUB47, SUB48, SUB49, SUB50, 
         SUB51, SUB52, SUB53, SUB54, SUB55, 
         SUB56, SUB57, SUB58, SUB59, SUB60, 
         SUB61, SUB62, SUB63, SUB64, SUB65, 
         SUB66, SUB67, SUB68; 
         PROC END$EQUATE; 
           BEGIN
             IF DSS$STK$PTR GQ 0
               THEN BEGIN 
                      TEMP$1 = ENDADDRESS;
                      TEMP$2 = NSFLAG;
                      IMPSTATFLG = IMPFLG;
                      POP$DSS$PKG;
                      IF TEMP$2 EQ 1
                        THEN NSFLAG = 1;
                      SET(PN$EQUATE,PNAT$,TEMP$1,ENDADDRESS); 
                    END 
             RETURN;
           END  # END$EQUATE #
    FUNC  KEY(P)  I;
         BEGIN
         ITEM K        I; 
         ITEM P        U; 
         REG2=B<36,15>P;    # PICK OFF DNAT POINTER # 
         # PICK OFF THE OPERAND (GTEXT) TYPE #
         REG1 = B<30,6>P; 
         IF REG1 EQ GDATAREF
            THEN BEGIN # TEMP REF IMPLIES ARITHMETIC EXPRESSION # 
                   IF GET(DN$LEVEL,DNAT$,REG2) EQ TEMPLEVL
                   THEN BEGIN 
                            KEY=11; 
                            RETURN; 
                            END 
                   END
         IF REG1 EQ GLITREF THEN GOTO LITREF; 
         # OPERAND IS A DATA REFERENCE.  LOOK UP THE DATA TYPE. # 
         REG3 = GET(DN$TYPE,DNAT$,REG2);
         IF REG3 EQ NUMERIC 
            THEN BEGIN
                    IF GET(DN$POINT,DNAT$,REG2) LQ 0
                       THEN KEY=4;   #NUMERIC DISPLAY INTEGER # 
                       ELSE KEY=7;    #NUMERIC DISPLAY NON-INTEGER  # 
                    RETURN; 
                    END 
          IF REG3 GR 0 AND REG3 LS NONDATA
          THEN BEGIN
                  KEY=BYTE(KEYSTR,REG3);
                  RETURN; 
                  END 
         IF REG3 EQ BOOLBIT OR REG3 EQ BOOLDSP
         THEN BEGIN 
              KEY = 12; 
              RETURN; 
              END 
         #   ELSE ITS ILLEGAL AND MUST BE DIAGNOSED # 
         REG1 = GET(DN$LEVEL,DNAT$,REG2); 
         IF REG3 EQ NONDATA  AND REG1 GR 49 AND REG1 LS LITLEVL 
            THEN # SPECIFIC ERROR  #
                 FIX1 = BYTE(NONDATAERR,REG1 - CDDATANAME); 
            ELSE #  COMPILER ERROR  # 
                 FIX1 = 94; 
          IF REG3 EQ NONDATA AND REG1 EQ 88 
          THEN BEGIN
               FIX1 = 646;
               END
         ERROR(SEVERE,FIX1,LINE1,COLUMN1);
         KEY=0; 
         RETURN;
LITREF: 
         # COME HERE IF THE OPERAND IS A LITERAL #
         # GET THE PLT POINTER OUT OF THE LAT # 
         REG2 = GET(L$PLT,LAT$,REG2); 
         # ARE WE DEALING WITH FIGCON ZERO #
          IF GET(PL$CODE,PLT$,REG2) EQ PLTFGCONZERO 
          THEN BEGIN    # FIGCON ZERO # 
                  KEY=10; 
                  RETURN; 
                  END 
         # LOOK UP LITERAL TYPE # 
         REG2 = GET(PL$6BITTYPE,PLT$,REG2); 
         IF REG2 EQ PLTBOOLLIT
         THEN BEGIN 
              KEY = 12; 
              RETURN; 
              END 
          IF REG2 EQ PLTQUOTEDLIT 
          THEN BEGIN
                  KEY = 2;
                  RETURN; 
                  END 
          IF REG2 EQ PLTINTLIT
              THEN  KEY=5;
              ELSE  KEY=6;    #OTHERWISE, NUMERIC NON INTEGER # 
         RETURN;
         END  # FUNC  KEY  #
          CONTROL EJECT;
   FUNC OPSIZE(P,K);
         BEGIN
         ITEM P, K; 
         REG2 = B<36,15>P;
         IF K EQ 1 OR K EQ 3 OR K EQ 4
         THEN BEGIN 
              OPSIZE = GET(DN$ITMLEN,DNAT$,REG2); 
              END 
         ELSE BEGIN 
              REG2 = GET(L$PLT,LAT$,REG2);
              IF GET(PL$FIGCON,PLT$,REG2) NQ 0
              THEN BEGIN
                   OPSIZE = 0;
                   END
              ELSE BEGIN
                   OPSIZE = GET(PL$LENGTH,PLT$,REG2); 
                   END
              END 
         END
         CONTROL EJECT; 
PROC RELOPERANDS(OP1,OP2);
          BEGIN 
         #OP1 AND OP2 ARE GTEXT ATOMS.  THEY ARE THE OPERANDS OF A     #
         #CONDITION.                                                   #
         #CHECK THE ATTRIBUTES OF THE ITEMS REFERENCED BY OP1 AND      #
         #OP2 AND DIAGNOSE IF NECESSARY.  IF ONE IS A LITERAL AND      #
         #THE OTHER IS A DATA ITEM, COPY THE DATA ITEMS DNAT TO THE    #
         #LITERAL DNAT AND SET L$VCODE TO 1 TO INDICATE THAT THE       #
         #LITERAL APPEARED IN A CONDITION.                             #
         # THE DATA-ITEM WITH LITERAL CASE COPIES THE DATA-ITEM DNAT   #
         # TO THE LITERL DNAT TO MAKE THE LITERAL LOOK MORE LIKE THE   #
         # DATA-ITEM, THEREBY MAKING THE GENERATED CODE MORE EFFICIENT #
         # BY NOT REQUIRING CONVERSION.  THEN IF THE ACTUAL LENGTH OF  #
         # THE LITERAL IS LESS THAN THE DECLARED LENGTH OF THE LITERAL #
         # (AS COPIED FROM THE DATA-ITEM DNAT), LITPOOLER WILL SET IT  #
         # TO THE CORRECT VALUE.  IN THIS CASE, GENERATED CODE AND/OR  #
         # C.BCDCM WILL EXTEND THE LITERAL BY THE APPROPRIATE NUMBER   #
         # OF SPACES.                                                  #
         #                                                             #
         # HOWEVER THIS METHOD FAILS WITH VARGROUP ITEMS.              #
         # GENERATED CODE WOULD COMPUTE THE LENGTH OF THE LITERAL AS   #
         # THE TRAILER LENGTH PLUS THE ROOT LENGTH, BUT THE ROOT       #
         # LENGTH IS DN$ITMLEN - AX$MAXOCCNO * AX$OCCLEN, WHICH WOULD  #
         # BE INCORRECT DUE TO DN$ITMLEN CHANGING. BESIDES, THE        #
         # INDUCED CODE GENERATION FOR VARGROUP LITERALS IS VERY       #
         # INEFFICIENT.                                                #
         #                                                             #
         # SO THIS CODE LEAVES THE LITERAL WITH A VARGROUP DATA-ITEM   #
         # AS A SIMPLE ALPHNUM LITERAL,  WHICH CAUSES CORRECT AND      #
         # EFFICIENT CODE TO BE GENERATED.                             #
  
  
         ITEM    OP1; 
         ITEM    OP2; 
         ITEM    REG1;
         ITEM    REG2;
         ITEM    FIX1;
         ITEM    KEY1;
         ITEM    KEY2;
         ITEM    LITSTR      = O"11420000000000000000"; 
                             # KEYS 2, 5, 6, AND 10 ARE LITERALS #
         KEY1 = KEY(OP1); 
         KEY2 = KEY(OP2); 
         IF KEY1 EQ 0 OR KEY2 EQ 0
             THEN RETURN;    # INVALID OPERAND #
         REG1 = 12 * KEY1 + KEY2 - 13;
         FIX1 =  BYTE(RSTRING,REG1);
         IF FIX1 NQ 0 AND SIGNFLAG EQ 0 
         THEN BEGIN 
                  ERROR(SEVERE,FIX1,LINE1,COLUMN1); 
                  RETURN; 
                  END 
         IF CCTFIPSLEVEL LS 3 
         THEN BEGIN 
              IF (KEY1 EQ 1 OR
                  KEY1 EQ 2 OR
                  KEY1 EQ 3 OR
                  KEY2 EQ 1 OR
                  KEY2 EQ 2 OR
                  KEY2 EQ 3) AND KEY1 NQ 10 AND KEY2 NQ 10
              THEN BEGIN
                   # OPSIZE WILL RETURN 0 IF OPERAND IS A FIG CONSTANT# 
                   REG1 = OPSIZE(OP1,KEY1); 
                   REG2 = OPSIZE(OP2,KEY2); 
                   IF REG1 NQ REG2 AND
                      REG1 NQ 0 AND 
                      REG2 NQ 0 
                   THEN BEGIN 
                        #FIPS = 3 SUPPORTS COMPARISON OF #
                        #NON NUMERIC OPERANDS OF UNEQUAL LENGTH # 
                        ERROR(TRIVIAL,443,LINE1,COLUMN1); 
                        END 
                   END
              END 
         REG1 = B<KEY1,1>LITSTR;
         REG2 = B<KEY2,1>LITSTR;
  
         #0 INDICATES A DATA ITEM # 
         #1 INDICATES A LITERAL   # 
  
         IF REG1 EQ 0  AND REG2 EQ 0
         THEN RETURN;     #BOTH ARE DATA ITEMS# 
  
         IF REG1 EQ 1  AND REG2 EQ 1
         THEN BEGIN 
              #BOTH ARE LITERALS. THIS IS PROBABLY ILLEGAL AND THIS    #
              #CODE WILL NOT BE EXECUTED. IF IT IS MADE LEGAL, CODE    #
              #SHOULD BE INSRTED HERE TO DO SOMETHING WITH THE DNATS OF#
              #THE LITERALS.                                           #
              RETURN; 
              END 
  
         IF REG1 EQ 1  AND REG2 EQ 0
         THEN BEGIN 
              REG1 = B<36,15>OP1;    #LAT  PTR# 
              REG2 = B<36,15>OP2;    #DNAT PTR# 
              END 
         ELSE BEGIN 
              REG1 = B<36,15>OP2;    #LAT  PTR# 
              REG2 = B<36,15>OP1;    #DNAT PTR# 
              END 
  
  
         FIX1 = REG1; 
         SET(L$VCODE,LAT$,REG1,1);
         REG3 = GET(L$PLT,LAT$,REG1); 
         REG4 = GET(L$IMMEDIATE,LAT$,REG1); 
         REG1 = GET(L$DNAT,LAT$,REG1);    #LITERAL DNAT#
  
         COPYD4 (REG2,REG1);
  
         IF GET(DN$LEVEL,DNAT$,REG1) EQ REFMODLEVEL 
         THEN BEGIN 
              SET(DN$BYTEOFFS,DNAT$,REG1,0);
              SET(L$REFMOD,LAT$,FIX1,1);
              END 
         SET(DN$LEVEL,DNAT$,REG1,LITLEVL);
         #SPECIAL CASE FOR COMPARING A NUMERIC DATA ITEM TO A # 
         #NON NUMERIC LITERAL.  CHANGE THE TYPE OF THE LITERAL# 
         #DNAT TO ALPHANUMERIC AND SET THE SIGN BITS AND      # 
         #NUMERIC LENGTH AND POINT LOCATION TO 0.             # 
  
         #DECIDE LITERAL TYPE - IMMEDIATE IMPLIES INTEGER#
         IF REG4 EQ 0 
         THEN REG3 = GET(PL$CODE,PLT$,REG3);
         ELSE REG3 = PLTINTLIT; 
  
         FIX1 = GET(DN$TYPE,DNAT$,REG1);
  
         # IF DATA ITEM IS VARGROUP, LEAVE LITERAL AS ALPHNUM          #
         IF FIX1 EQ VARGROUP
         THEN 
             BEGIN
             SET(DN$TYPE,DNAT$,REG1,ALPHNUM); 
             RETURN;
             END
  
         IF (FIX1 EQ NUMERIC AND REG3 EQ PLTQUOTEDLIT)
         OR (FIX1 EQ NUMEDIT AND (REG3 EQ PLTQUOTEDLIT OR 
                                  REG3 EQ PLTINTLIT OR
                                  REG3 EQ PLTFGCONZERO))
         THEN 
             BEGIN
             SET(DN$TYPE,DNAT$,REG1,ALPHNUM); 
             SET(DN$SIGNGRP,DNAT$,REG1,0);
             SET(DN$NUMLEN,DNAT$,REG1,0); 
             SET(DN$POINT,DNAT$,REG1,0);
             END
         RETURN;
         END  # PROC  RELOPERANDS # 
         CONTROL EJECT; 
PROC BOOLEANLIT (P1,P2);
         BEGIN
         # P1 IS THE STACK INDEX OF THE OPERAND # 
         # P2 IS THE BITLENGTH OF THE BOOLEAN TEMP #
         ITEM P1; 
         ITEM P2; 
         ITEM T1; 
         IF P1 EQ 0 
         THEN BEGIN 
              # ONLY ONE OPERAND FOR BOOLEAN-NOT #
              RETURN; 
              END 
         IF TCODE(P1) EQ GLITREF
         THEN BEGIN 
              T1 = TPOINTER(P1);
              T1 = GET(L$DNAT,LAT$,T1); 
              SET(DN$TYPE,DNAT$,T1,BOOLDSP);
              SET(DN$ITMLEN,DNAT$,T1,P2); 
              END 
         RETURN;
         END # BOOLEANLIT # 
FUNC CALCLENGTH (P1); 
         BEGIN
         # P1 IS THE STACK INDEX OF THE OPERAND # 
         ITEM P1; 
         ITEM T1; 
         IF P1 EQ 0 
         THEN BEGIN 
              # ONLY ONE OPERAND FOR BOOLEAN-NOT #
              CALCLENGTH = 0; 
              RETURN; 
              END 
         T1 = TPOINTER (P1);
         IF TCODE (P1) EQ GLITREF 
         THEN BEGIN 
              T1 = GET(L$PLT,LAT$,T1);
              CALCLENGTH = GET(PL$LENGTH,PLT$,T1);
              END 
         ELSE BEGIN 
              IF GET(DN$TYPE,DNAT$,T1) EQ BOOLDSP 
              THEN BEGIN
                   CALCLENGTH = GET(DN$ITMLEN,DNAT$,T1);
                   END
              END 
         RETURN;
         END # CALCLENGTH # 
FUNC BOOLEANTEMP (P1,P2); 
         BEGIN
         # P1 IS THE STACK INDEX OF THE FIRST OPERAND # 
         # P2 IS THE STACK INDEX OF THE SECOND OPERAND #
         ITEM P1; 
         ITEM P2; 
         ITEM L1; 
         ITEM L2; 
         L1 = CALCLENGTH (P1);
         L2 = CALCLENGTH (P2);
         IF L2 GR L1
         THEN BEGIN 
              L1 = L2;
              END 
         BOOLEANLIT(P1,L1); 
         BOOLEANLIT(P2,L1); 
         DNATLENGTH = DNATLENGTH + 1; 
        SET(DN$ITMLEN,DNAT$,DNATLENGTH,L1); 
         GLOBALTEMP(DNATLENGTH);
         SET(DN$TYPE,DNAT$,DNATLENGTH,BOOLDSP); 
         BOOLEANTEMP = DNATLENGTH;
         END # BOOLEANTEMP #
  
         GOTO SUB[SUB$];
SUB2: 
# CONDITION INITIALIZATION #
         VERBCODE=0;
          DS = 0; 
         CONDTYPE = 0;
         SUBJECTFLAG = 0; 
         LEFTCOUNT = 0; 
         Z = Z+1; 
         XPRIORITY(Z,1);
         XADDRESS(Z,-1);
         CONDFLAG = 0;
         NEGATION = 0;
         RETURN;
SUB20:  
# FORMULA INITIALIZATION #
         FL = -1; 
         RETURN;
SUB68:  
# BOOLEAN FORMULA INITIALIZATION #
         BL = -1; 
         RETURN;
SUB15:  
#BEGIN DS STATEMENT#
         IF ENDADDRESS NQ 0 
           THEN PUSH$DSS$PKG; 
         ENDADDRESS = NEXTPNAT; 
         VERB$LINE = LINE$; 
         VERB$COL = COLUMN$;
         IMPFLG =  IMPSTATFLG;
         IMPSTATFLG = 0;
         NSFLAG = 0;
         NEXT$SENTNC = 0; 
         RETURN;
SUB1: 
# IF ROUTINE #
         VD;
         ANDADDRESS = 0;
         ORADDRESS = 0; 
         NEGATION = 0;
         PERIODFLAG = 0;
         IF CCTFIPSLEVEL LS 3 AND NESTEDIF EQ 1 
         THEN BEGIN 
              # FIPS=3 SUPPORTS NESTED IF STATEMENTS #
              ERROR(TRIVIAL,813,LINE$,COLUMN$); 
              END 
         NESTEDIF = 1;
         RETURN;
SUB8: 
# PERIOD ROUTINE #
          NESTEDIF = 0; 
          IF F18 EQ 1 THEN RETURN;
          IF PERIODFLAG EQ 1 THEN RETURN; 
          UNSTACK(1); 
          IF ORADDRESS NQ 0 
          THEN BEGIN
                  SET(PN$EQUATE,PNAT$,ORADDRESS,ENDADDRESS);
                  ORADDRESS = 0;
                  NSFLAG = 1; 
                  END 
         FOR TEMP$1 = 0 WHILE DSS$STK$PTR GQ 0
           DO BEGIN 
                IF IMPFLG NQ 0
                  THEN ERROR(TRIVIAL,88,VERB$LINE,VERB$COL);
                END$EQUATE; 
              END 
         IF NSADDRESS NQ 0
           THEN BEGIN 
                  IF ENDADDRESS NQ 0
                    THEN BEGIN
                           SET(PN$EQUATE,PNAT$,ENDADDRESS,NSADDRESS); 
                           NSFLAG = 0;
                           POP$DSS$PKG; 
                         END
                  NGLABELDEF(NSADDRESS);
                  NSADDRESS = 0;
               END
          IF NSFLAG EQ 1
          THEN BEGIN
                  NGLABELDEF(ENDADDRESS); 
                 POP$DSS$PKG; 
                  END 
         PERIODFLAG = 1;
         RETURN;
SUB64:  
#DSS EXPLICIT END ROUTINE#
         ERROR(TRIVIAL,753,VERB$LINE,VERB$COL); 
         IF NEXT$SENTNC NQ 0
           THEN ERROR(TRIVIAL,754,VERB$LINE,VERB$COL);
         IF F16 EQ 1
           THEN BEGIN 
                  UNSTACK (2);
                  IF ORADDRESS NQ 0 
                    THEN BEGIN
                           SET(PN$EQUATE,PNAT$,ORADDRESS,ENDADDRESS); 
                           ORADDRESS = 0; 
                           NSFLAG = 1;
                         END
                  Z = Z - 1;
               END
         IF F17 EQ 0
           THEN BEGIN 
                  IF NSFLAG EQ 1
                    THEN BEGIN
                           NGLABELDEF(ENDADDRESS);
                           NSFLAG = 0;
                         END
                  POP$DSS$PKG;
                END 
         ELSE END$EQUATE; 
         RETURN;
  
SUB65:  
#DSS IMPLICIT END ROUTINE#
         IF IMPFLG NQ 0 
           THEN ERROR(TRIVIAL,88,VERB$LINE,VERB$COL); 
         END$EQUATE;
         RETURN;
SUB3: 
# STACK ADJUSTMENT #
         FOR $DUMMY$ = 0  WHILE ADDRESS(Z) NQ -1 DO BEGIN 
         Z = Z-1; 
         END
         $BEGIN 
         IF PRI$STK$TRC THEN OUTPUT(3," STACKADJS","TMENT  Z= ",DEC(Z));
         $END 
         RETURN;
SUB4: 
# THEN GOTO ROUTINE # 
          UNSTACK(3); 
          GOFLAG =1;
          IF ANDADDRESS NQ 0
          THEN BEGIN
                 SET(PN$EQUATE,PNAT$,ANDADDRESS,PN);
                 ANDADDRESS = 0;
                 END
         IF NEGATION EQ 1 
                THEN  NGPROCREF(PN,GFALSE); 
                ELSE  NGPROCREF(PN,GTRUE);
         RETURN;
SUB31:  
# AND ROUTINE # 
         P = 5; 
         UNSTACK(5);
ANDTHENROUT:  
          IF ORADDRESS EQ 0 
             THEN ORADDRESS = NEXTPNAT; 
          IF NEGATION EQ 0
             THEN  NGLABELREF(ORADDRESS,GFALSE);
             ELSE BEGIN 
                  NGLABELREF(ORADDRESS,GTRUE);
                  NEGATION = 0; 
                  END 
         Z = Z+1; 
         XADDRESS(Z,ORADDRESS); 
         XPRIORITY(Z,P);
         CONDFLAG = 0;
         ORADDRESS = 0; 
         IF ANDADDRESS NQ 0 
            THEN BEGIN
                  NGLABELDEF(ANDADDRESS); 
                  ANDADDRESS = 0; 
                  END 
         RETURN;
SUB30:  
# OR ROUTINE #
          UNSTACK(4); 
          IF ANDADDRESS EQ 0
             THEN ANDADDRESS = NEXTPNAT;
          IF NEGATION EQ 0
            THEN  NGLABELREF(ANDADDRESS,GTRUE); 
            ELSE BEGIN
                  NGLABELREF(ANDADDRESS,GFALSE);
                  NEGATION = 0; 
                  END 
         Z = Z+1; 
         XADDRESS(Z,ANDADDRESS);
         ANDADDRESS = 0;
         XPRIORITY(Z,4);
         CONDFLAG = 0;
         IF ORADDRESS NQ 0
            THEN BEGIN
                  NGLABELDEF(ORADDRESS);
                  ORADDRESS = 0;
                  END 
         RETURN;
SUB29:  
# RIGHT ROUTINE # 
         SUBJECTFLAG = 0; 
         CONDTYPE = 0;
         UNSTACK(2);
         Z = Z-1; 
         IF PRIORITY(Z) EQ 6
            THEN BEGIN
                  Z = Z-1;
                  TEMPADDRESS = ANDADDRESS; 
                  ANDADDRESS = ORADDRESS; 
                  ORADDRESS = TEMPADDRESS;
                  IF NEGATION EQ 0
                      THEN NEGATION = 1;
                      ELSE NEGATION = 0;
                  END 
         $BEGIN 
         IF PRI$STK$TRC THEN OUTPUT(3," RIGHT ROU","TINE  Z = ",DEC(Z));
         $END 
         RETURN;
SUB7: 
# THEN ROUTINE #
         GOFLAG = 0;
         P = 3; 
         UNSTACK(3);
         GOTO ANDTHENROUT;
SUB9: 
# ELSE NS ROUTINE # 
          UNSTACK(2); 
          IF ORADDRESS NQ 0 
          THEN BEGIN
                  IF NSADDRESS NQ 0 
                    THEN SET(PN$EQUATE,PNAT$,ORADDRESS,NSADDRESS);
                  ELSE NSADDRESS = ORADDRESS; 
                  ORADDRESS = 0;
                  END 
         NEXT$SENTNC = 1; 
         GOFLAG = 0;
         Z = Z-1; 
         RETURN;
SUB5: 
# THEN NS ROUTINE # 
         IF NSADDRESS EQ 0
           THEN NSADDRESS = NEXTPNAT; 
         PN = NSADDRESS;
         NEXT$SENTNC = 1; 
         GOTO SUB4; 
SUB6: 
# THEN NS ELSE GOTO ROUTINE # 
          UNSTACK(3); 
          IF ANDADDRESS NQ 0
          THEN BEGIN
                  IF NSADDRESS EQ 0 
                    THEN NSADDRESS = ANDADDRESS;
                  ELSE SET(PN$EQUATE,PNAT$,ANDADDRESS,NSADDRESS); 
                  ANDADDRESS = 0; 
                  END 
          IF ORADDRESS NQ 0 
          THEN BEGIN
                  SET(PN$EQUATE,PNAT$,ORADDRESS,PN);
                  ORADDRESS = 0;
                  END 
         IF NEGATION EQ 0 
            THEN  NGPROCREF(PN,GFALSE); 
            ELSE  NGPROCREF(PN,GTRUE);
         NEXT$SENTNC = 1; 
         Z = Z-1; 
         RETURN;
SUB10:  
# ELSE GOTO ROUTINE # 
          UNSTACK(2); 
          IF ORADDRESS NQ 0 
          THEN BEGIN
                  SET(PN$EQUATE,PNAT$,ORADDRESS,PN);
                  ORADDRESS = 0;
                  END 
          IF GOFLAG EQ 1
          THEN BEGIN
                  GOFLAG = 0; 
                  NGGOTO; 
                  NGPROCREF(PN,0);
                  END 
         Z = Z-1; 
         RETURN;
SUB11:  
# ELSE ROUTINE #
          UNSTACK(2); 
          IF GOFLAG EQ 0
          THEN BEGIN
                  NGGOTO; 
                  NGLABELREF(ENDADDRESS,0); 
                  NSFLAG = 1; 
                  NGLABELDEF(ORADDRESS);
                  ORADDRESS = 0;
                  END 
          ELSE BEGIN
                  GOFLAG = 0; 
                  IF ORADDRESS NQ 0 
                  THEN BEGIN
                           NGLABELDEF(ORADDRESS); 
                           ORADDRESS = 0; 
                           END
                  END 
         # UNSTACK IF, SEARCH, ETC. # 
         # BUT WATCH OUT FOR ILLEGAL NESTED SEARCHES #
         IF Z GR 0
         THEN BEGIN 
              Z = Z - 1;
              END 
         RETURN;
SUB12:  
# SAVE PROCNAME # 
         PN = VALUE$; 
         RETURN;
SUB27:  
# NOT ROUTINE # 
         Z = Z+1; 
         XPRIORITY(Z,6);
         XADDRESS(Z,0); 
         RETURN;
SUB28:  
# LEFT ROUTINE #
         Z = Z+1; 
         XPRIORITY(Z,1);
         XADDRESS(Z,0); 
         LEFTCOUNT = LEFTCOUNT + 1; 
         RETURN;
SUB51:  
# UNSTACK LEFT ROUTINE #
         Z = Z-1; 
         LEFTCOUNT = LEFTCOUNT - 1; 
         RETURN;
SUB36:  
# EQUAL ROUTINE # 
         IF RELNOTFLAG EQ 0 
             THEN  CONDTYPE = $EQUAL; 
             ELSE  CONDTYPE = $NOTEQ; 
         LINE1 = LINE$; 
         COLUMN1 = COLUMN$; 
         RETURN;
SUB38:  
# LESS THAN ROUTINE # 
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $LESS; 
             ELSE CONDTYPE = $NOTLT;
         LINE1 = LINE$; 
         COLUMN1 = COLUMN$; 
         RETURN;
SUB39:  
# GREATER THAN ROUTINE #
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $GREATER;
             ELSE CONDTYPE = $NOTGT;
         LINE1 = LINE$; 
         COLUMN1 = COLUMN$; 
         RETURN;
SUB44:  
# UNEQUAL ROUTINE # 
          IF RELNOTFLAG EQ 0
          THEN CONDTYPE = $NOTEQ; 
          ELSE BEGIN
                  CONDTYPE = $EQUAL;
                  ERROR(TRIVIAL,67,LINE$,COLUMN$);
                  END 
         LINE1 = LINE$; 
         COLUMN1 = COLUMN$; 
         RETURN;
SUB22:  
# ADD TERM ROUTINE #
         TEMPATOM = $ADD; 
         GOTO BUILDFORMTXT; 
SUB21:  
# SUBTRACT TERM ROUTINE # 
         TEMPATOM = $SUBTRACT;
         GOTO BUILDFORMTXT; 
SUB24:  
# MULTIPLY GROUP ROUTINE #
         TEMPATOM = $MULTIPLY;
         GOTO BUILDFORMTXT; 
SUB23:  
# DIVIDE GROUP ROUTINE #
         TEMPATOM = $DIVIDE;
         GOTO BUILDFORMTXT; 
SUB25:  
# EXPONENTIATE PRIMARY ROUTINE #
         TEMPATOM = $EXPONENT;
         # FALLING THROUGH #
BUILDFORMTXT: 
# BUILD FORMULA TEXT #
         FIX1 = REMOVE(2);
         OPERANDTEST(FIX1); 
         FIX2 = REMOVE(2);
         OPERANDTEST(FIX2); 
         FL = FL + 1; 
         XFORMULA(FL,TEMPATOM); 
         FL = FL + 1; 
         XFORMULA(FL,STACK(FIX2));
         FL = FL + 1; 
         XFORMULA(FL,STACK(FIX1));
         FL = FL + 1; 
         XFORMULA(FL,GTX(GDATAREF,(NEXTTEMP),0)); 
         S = S+1; 
         S$ = S$+1; 
         XSTACK(S,FORMULA(FL)); 
         RETURN;
SUB17:  
# OUTPUT RELATION ROUTINE # 
          TRUEFALSE = 1;
          IF LEFTCOUNT GR 0 OR SUBJECTFLAG EQ 0 
          THEN BEGIN
                  TRUEFALSE = 0;
                  LEFTCOUNT = 0;
                  RETURN; 
                  END 
      # FALLING THROUGH # 
      # SKIP THE ABOVE TESTS FOR CONDITION NAMES #
SUB53:  
# CN OUTPUT RELATION #
         FOR FIX1 =0 STEP 1  UNTIL SLENGTH DO BEGIN 
         NG(SUBJECT(FIX1)); 
         END
         FOR FIX1 =0 STEP 1  UNTIL OLENGTH DO BEGIN 
         NG(OBJECT(FIX1));
         END
         OLENGTH = -1;
         # FALLING THRU # 
SUB50:  
# RELATION OPERANDS ROUTINE # 
         #CHECK ATTRIBUTES, CALL GTEXT SCAN # 
         #IF NECESSARY SET UP LITERAL DNATS # 
          IF OPERAND1 NQ 0
          THEN RELOPERANDS(OPERAND1,OPERAND2);
          PATCH = G;
         RETURN;
SUB55:  
# RELATION GTEXT ROUTINE #
          NG(CONDTYPE); 
          #IF THE OPERANDS ARE ARITHMETIC EXPRESSIONS AND IF GTEXT# 
          #FOR DEBUGGING HAS BEEN INSERTED, CHANGE THE LOCAL TEMPS# 
          #CONTAINING THE OPERANDS TO GLOBAL TEMPS.               # 
  
          IF G NQ PATCH + 1 
          THEN BEGIN
               IF B<30,6> OPERAND1 EQ GDATAREF
               THEN BEGIN 
                    REG5 = B<36,15> OPERAND1; 
                    IF GET(DN$LEVEL,DNAT$,REG5) EQ TEMPLEVL 
                    THEN BEGIN
                         SET(DN$ITMLEN,DNAT$,REG5,10);
                         GLOBALTEMP(REG5);
                         SET(DN$TYPE,DNAT$,REG5,COMP2); 
                         END
                     END
               IF CONDFLAG EQ 0 
               THEN BEGIN 
                    IF B<30,6> OPERAND2 EQ GDATAREF 
                    THEN BEGIN
                         REG5 = B<36,15> OPERAND2;
                         IF GET(DN$LEVEL,DNAT$,REG5) EQ TEMPLEVL
                         THEN BEGIN 
                              SET(DN$ITMLEN,DNAT$,REG5,10); 
                              GLOBALTEMP(REG5); 
                              SET(DN$TYPE,DNAT$,REG5,COMP2);
                              END 
                          END 
                     END
               END
  
          NG(OPERAND1); 
          B<00,1>OPERAND1 = 1;   # FLAG AS USED IN CASE OF IMPLIED SUBJ#
          IF CONDFLAG EQ 0
          THEN  NG(OPERAND2); 
          RETURN; 
SUB43:  
# SUBJECT ROUTINE # 
         SUBJECTFLAG = 1; 
         LEFTCOUNT = 0; 
         IF FL EQ -1
             THEN   GOTO SUBR1; 
         FOR FIX1 =0 STEP 1  UNTIL FL DO BEGIN
         XSUBJECT(FIX1,FORMULA(FIX1));
         END
         SLENGTH = FL;
         FL = -1; 
         OPERAND1 = STACK(REMOVE(0)); 
         $BEGIN IF SUB$OBJ$TRC THEN SUB$DMP; $END 
         RETURN;
  
SUBR1:  
         SLENGTH = -1;
         OPERAND1 = STACK(REMOVE(3)); 
         RETURN;
SUB16:  
# OBJECT ROUTINE #
         TRUEFALSE = 1; 
         IF CONDTYPE EQ 0 
              THEN BEGIN
                     TRUEFALSE = 0; 
                     RETURN;
                     END
         IF FL EQ -1 THEN GOTO OBJ1;
         FOR FIX1 =0 STEP 1  UNTIL FL DO BEGIN
         XOBJECT(FIX1,FORMULA(FIX1)); 
         END
         OLENGTH = FL;
         FL = -1; 
         OPERAND2 = STACK(REMOVE(0)); 
         $BEGIN IF SUB$OBJ$TRC THEN OBJ$DMP; $END 
         RETURN;
  
OBJ1: 
         OLENGTH = -1;
         OPERAND2 = STACK(REMOVE(4)); 
          IF B<30,6>OPERAND1 EQ GLITREF 
          AND B<00,1>OPERAND1 EQ 1
          THEN
              BEGIN 
              # GET NEW LAT FOR IMPLIED SUBJECT#
              REG1 = B<36,15> OPERAND1; 
              REG2 = GET(L$PLT,LAT$,REG1);
              REG3 = NEXTLAT; 
              B<36,15> OPERAND1 = REG3; 
              SET(L$PLT,LAT$,REG3,REG2);
              FIX1 = GET(L$ALL, LAT$, REG1);
              SET (L$ALL, LAT$, REG3, FIX1);
              END 
         RETURN;
SUB66:  
# BOOLEAN SUBJECT ROUTINE # 
         IF BL EQ -1
         THEN BEGIN 
              SLENGTH = -1; 
              OPERAND1 = STACK(REMOVE(3));
         $BEGIN IF SUB$OBJ$TRC THEN SUB$DMP; $END 
              RETURN; 
              END 
         FOR FIX1 = 0 STEP 1 UNTIL BL 
         DO BEGIN 
            XSUBJECT(FIX1,BOOLSTACK(FIX1)); 
            END 
         SLENGTH = BL;
         BL = -1; 
         OPERAND1 = STACK(REMOVE(0)); 
         RETURN;
SUB67:  
# BOOLEAN OBJECT ROUTINE #
         IF BL EQ -1
         THEN BEGIN 
              OLENGTH = -1; 
              OPERAND2 = STACK(REMOVE(4));
              RETURN; 
              END 
         FOR FIX1 = 0 STEP 1 UNTIL BL 
         DO BEGIN 
            XOBJECT(FIX1,BOOLSTACK(FIX1));
            END 
         OLENGTH = BL;
         BL = -1; 
         OPERAND2 = STACK(REMOVE(0)); 
         $BEGIN IF SUB$OBJ$TRC THEN OBJ$DMP; $END 
         RETURN;
SUB54:  
#FIGURATIVE CONSTANT ZERO#
         IF GET(PL$CODE,PLT$,VALUE$) EQ PLTFGCONZERO
         THEN TRUEFALSE = 1;
         ELSE TRUEFALSE = 0;
         RETURN;
SUB47:  
# ZERO ROUTINE #
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $EQUAL;
             ELSE CONDTYPE = $NOTEQ;
         FIX1 = KEY(OPERAND1);
         FIX1 = BYTE(SIGNSTR,FIX1); 
         IF FIX1 NQ 0 
             THEN  ERROR(SEVERE,FIX1,LINE$,COLUMN$);
         SUBJECTFLAG = 1; 
         #CREATE AN IMMEDIATE LITERAL WHOSE VALUE (LATTEMP)#
         #IS ZERO AND WHOSE ATTRIBUTES ARE THE SAME AS THE# 
         #SUBJECT OF THIS SIGN CONDITION# 
         LATTEMP = 0; 
         REG1 = B<36,15> OPERAND1;
         OPERAND2 = CREATELDL(REG1,1);
         RETURN;
SUB46:  
# NEGATIVE ROUTINE #
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $NEGATVE;
             ELSE CONDTYPE = $NOTNEG; 
         GOTO POS1; 
SUB45:  
# POSITIVE ROUTINE #
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $POSITVE;
             ELSE CONDTYPE = $NOTPOS; 
  
POS1: 
         FOR FIX1 = 0 
         STEP 1 
         UNTIL SLENGTH
         DO   NG(SUBJECT(FIX1));
         FIX1 = KEY(OPERAND1);
         FIX1 = BYTE(SIGNSTR,FIX1); 
         IF FIX1 NQ 0 
             THEN  ERROR(SEVERE,FIX1,LINE$,COLUMN$);
         CONDFLAG = 1;
         RETURN;
SUB40:  
# RELEASE SUBJECT ROUTINE # 
         CONDTYPE = 0;
         SUBJECTFLAG = 0; 
         RETURN;
SUB41:  
# CLASS IS ILLEGAL #
         CLASSFLAG = 1; 
         RETURN;
SUB42:  
# CLASS IS LEGAL #
         CLASSFLAG = 0; 
         RETURN;
SUB26:  
# UNARY MINUS # 
         REG1 = REMOVE(2);
         REG2 = TPOINTER(REG1); 
         IF TCODE(REG1) EQ GLITREF
         THEN BEGIN 
              # UNARY MINUS FOLLOWED BY A LITERAL # 
              # CHANGE THE SIGN OF THE LITERAL IN THE PLT # 
              REG4 = GET(L$PLT,LAT$,REG2);
              SET(PL$SIGNEDFLG,PLT$,REG4,1);
              IF GET(PL$SIGNFLAG,PLT$,REG4) EQ 1
              THEN SET(PL$SIGNFLAG,PLT$,REG4,0);
              ELSE SET(PL$SIGNFLAG,PLT$,REG4,1);
              # PUT THE MODIFIED LITERAL BACK INTO THE STACK #
              S = S + 1;
              S$ = S$ + 1;
              RETURN; 
              END 
         LATTEMP = 0; 
         #CREATE AN IMMEDIATE LITERAL WHOSE VALUE IS ZERO#
         #AND HAVING ATTRIBUTES SAME AS UNARY MINUS OPERAND#
         REG3 = CREATELDL(REG2,1);
         FL = FL + 1; 
         XFORMULA(FL,$SUBTRACT);
         FL = FL + 1; 
         XFORMULA(FL,REG3); 
         FL = FL + 1; 
         XFORMULA(FL,STACK(REG1));
         FL = FL + 1; 
         XFORMULA(FL,GTX(GDATAREF,(NEXTTEMP),0)); 
         S = S+1; 
         S$ = S$+1; 
         XSTACK(S,FORMULA(FL)); 
         RETURN;
SUB49:  
# ALPHABETIC ROUTINE #
         CONTYPE = 2; 
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $ALPHABETIC; 
             ELSE CONDTYPE = $NOTALPHAB;
         GOTO OUTPUTCLASSR; 
SUB48:  
# NUMERIC ROUTINE # 
         CONTYPE = 1; 
         IF RELNOTFLAG EQ 0 
             THEN CONDTYPE = $NUMERIC;
             ELSE CONDTYPE = $NOTNUMERIC; 
         # FALLING THROUGH #
  
OUTPUTCLASSR: 
# OUTPUT CLASS ROUTINE #
         TRUEFALSE = 1; 
         IF CLASSFLAG EQ 1
             THEN BEGIN 
                    TRUEFALSE = 0;
                    RETURN; 
                    END 
         REG1 = REMOVE(1);
         OPERAND1 = STACK(REG1);
         CONDFLAG = 1;
         SUBJECTFLAG = 0; 
         REG2 = B<36,15>OPERAND1; 
         REG3 = GET(DN$TYPE,DNAT$,REG2);
         IF REG3 EQ NONDATA 
         THEN ERROR(SEVERE,280,LINE(REG1),COLUMN(REG1));
         IF CONTYPE EQ 1
             THEN FIX1 = BYTE(NUMSTR,REG3); 
             ELSE FIX1 = BYTE(ALPSTR,REG3); 
         IF FIX1 EQ 0 THEN RETURN;
         ERROR(SEVERE,FIX1,LINE(REG1),COLUMN(REG1));
         RETURN;
SUB37:  
# RELATIONAL NOT PR    NT # 
         RELNOTFLAG = 1;
         RETURN;
SUB35:  
# RELATIONAL NOT ABSENT # 
         RELNOTFLAG = 0;
         RETURN;
SUB52:  
# ON OFF ROUTINE #
         TRUEFALSE =0;
         IF GET(DN$ONSTAT,DNAT$,VALUE$) EQ  0 
             AND GET(DN$OFFSTAT,DNAT$,VALUE$) EQ  0 
             THEN RETURN; 
         IF GET(DN$ONSTAT,DNAT$,VALUE$) EQ 1
             THEN NG($SWITCH);
             ELSE NG($NOTSWITCH); 
         NGDATAREF(VALUE$); 
         TRUEFALSE = 1; 
         RETURN;
SUB18:  
# CONDITION NAME ROUTINE #
          TRUEFALSE = 1;
          IF GET(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE 
          THEN BEGIN
                 TRUEFALSE = 0; 
                 RETURN;
                 END
         TABLENAME = GET(DN$88DNREF,DNAT$,VALUE$);
          IF GET(DN$TYPE, DNAT$, TABLENAME) EQ ERRTYPE
          THEN BEGIN
                 TRUEFALSE = 0; 
                 RETURN;
          END 
         TABLELINE = LINE$; 
         TABLECOLUMN = COLUMN$; 
         IF GET(DN$MAJMSEC,DNAT$,TABLENAME) 
            EQ SECSMSEC 
         THEN BEGIN 
               ERROR(SEVERE,350,TABLELINE,TABLECOLUMN); 
              TRUEFALSE = 0;
              RETURN; 
              END 
         S = S+1; 
         S$ = S$+1; 
         XSTACK(S,GTX(GDATAREF,TABLENAME,0)); 
         RETURN;
SUB34:  
# CN SUBJECT ROUTINE #
         SUBJECTFLAG = 1; 
         SLENGTH = -1;
         OPERAND1 = STACK(REMOVE(3)); 
         RETURN;
SUB19:  
# CONDITION NAME LITERAL #
         OPERAND2 = STACK(REMOVE(1)); 
         REG1 = B<36,15>OPERAND1; 
         REG2 = GET(DN$TYPE,DNAT$,REG1);
         IF REG2 EQ BOOLDSP OR REG2 EQ BOOLBIT
         THEN BEGIN 
              REG3 = B<36,15>OPERAND2;
              REG4 = GET(L$DNAT,LAT$,REG3); 
              SET(L$VCODE,LAT$,REG3,1); 
              COPYD4(REG1,REG4);
              SET(DN$LEVEL,DNAT$,REG4,LITLEVL); 
              END 
         RETURN;
SUB14:  
# PS3 ROUTINE # 
         #SAVE STATUS FOR USE BY SUBSCRIPT OPTIMIZER# 
         OLDPARSTATUS = PARSTATUS;
         PARSTATUS = 3; 
         RETURN;
SUB13:  
# OPTIMIZED GO LEGALITY ROUTINE # 
        # ORIGIN #
         REG1 = LASTPNDEF;
        # DESTINATION # 
         REG2 = PN; 
         IF TCONTROL(REG1,REG2,0) EQ 1
             THEN CCTGOTO[0] = TRUE;
         # PARAGRAPH STATUS REMAINS THE WAY IT IS # 
         RETURN;
SUB56:  
# SET CONDITION-NAME PROLOGUE # 
         TRUEFALSE = 0; 
         IF GET(DN$ONSTAT,DNAT$,VALUE$) EQ 0 AND
            GET(DN$OFFSTAT,DNAT$,VALUE$) EQ 0 
         THEN BEGIN 
              TRUEFALSE = 1;
              END 
         RETURN;
SUB57:  
# SET CONDITION-NAME ROUTINE #
         OPERAND2 = STACK(REMOVE(1)); 
         OPERAND1 = STACK(REMOVE(1)); 
         REG1 = B<36,15> OPERAND2;
         REG2 = B<36,15> OPERAND1;
         LITERALDNAT(REG2,GET(L$DNAT,LAT$,REG1)); 
         SET(L$VCODE,LAT$,REG1,2);
         NGMOVE;
         NG(OPERAND2);
         NG(OPERAND1);
         FOR I = 1
         STEP 1 
         UNTIL CNSOFAR
         DO BEGIN 
            IF REG1 NQ COMMONSTACK(I) 
            THEN TEST I;
            ELSE BEGIN
                 # TWO OR MORE CONDITION NAMES HAVING # 
                 # THE SAME CONDITIONAL VARIABLE CANNOT # 
                 # APPEAR IN THE SAME SET STATEMENT # 
                 ERROR(TRIVIAL,470,TABLELINE,TABLECOLUMN);
                 END
            END 
         CNSOFAR = CNSOFAR + 1; 
         XCOMMONSTACK(CNSOFAR,REG1);
         RETURN;
SUB58:  
# BOOLEAN-EXOR ROUTINE #
         TEMPATOM = $BOOLEANEXOR; 
         GOTO BUILDBOOLTXT; 
SUB59:  
# BOOLEAN-OR ROUTINE #
         TEMPATOM = $BOOLEANOR; 
         GOTO BUILDBOOLTXT; 
SUB60:  
# BOOLEAN-AND ROUTINE # 
         TEMPATOM = $BOOLEANAND;
         # FALLING THROUGH #
BUILDBOOLTXT: 
# BUILD BOOLEAN VERB PACKET # 
         FIX1 = REMOVE(6);
         FIX2 = REMOVE(6);
         REG1 = BOOLEANTEMP (FIX1,FIX2);
         BL = BL + 1; 
         XBOOLSTACK(BL,TEMPATOM); 
         BL = BL + 1; 
         XBOOLSTACK(BL,STACK(FIX2));
         BL = BL + 1; 
         XBOOLSTACK (BL,STACK(FIX1)); 
         BL = BL + 1; 
         XBOOLSTACK (BL,GTX(GDATAREF,REG1,0));
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK (S,BOOLSTACK(BL));
         RETURN;
SUB61:  
# BOOLEAN-NOT ROUTINE # 
         REG1 = REMOVE(6);
         BL = BL + 1; 
         XBOOLSTACK(BL,$BOOLEANNOT);
         REG2 = BOOLEANTEMP (REG1,0); 
         BL = BL + 1; 
         XBOOLSTACK (BL,STACK(REG1)); 
         BL = BL + 1; 
         XBOOLSTACK (BL,GTX(GDATAREF,REG2,0));
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK (S,BOOLSTACK(BL));
         RETURN;
SUB32:  
# BOOLEAN DATA NAME ROUTINE # 
         TRUEFALSE = 0; 
         REG1 = GET(DN$TYPE,DNAT$,VALUE$);
         IF REG1 EQ BOOLBIT OR REG1 EQ BOOLDSP
         THEN BEGIN 
              # DATA NAME IS BOOLEAN #
              TRUEFALSE = 1;
              END 
         RETURN;
SUB33:  
# BOOLEAN LITERAL ROUTINE # 
         TRUEFALSE = 0; 
         IF GET(PL$CODE,PLT$,VALUE$) EQ PLTBOOLLIT OR 
            GET(PL$FIGZERO,PLT$,VALUE$) EQ 1
         THEN BEGIN 
              # LITERAL IS BOOLEAN #
              TRUEFALSE = 1;
              END 
         RETURN;
SUB62:  
# OUTPUT BOOLEAN RELATION # 
         FOR FIX1 = 0 STEP 1 UNTIL SLENGTH
         DO BEGIN 
            NG(SUBJECT(FIX1));
            END 
         FOR FIX1 = 0 STEP 1 UNTIL OLENGTH
         DO BEGIN 
            NG(OBJECT(FIX1)); 
            END 
         OLENGTH = -1;
         # IF ONE SIDE OF THE RELATION IS A SINGLE BOOLEAN LITERAL #
         # WE MUST SET UP THE DNAT FOR THAT LITERAL # 
         REG1 = B<30,6>OPERAND1;
         REG2 = B<30,6>OPERAND2;
         IF REG1 EQ GDATAREF AND REG2 EQ GDATAREF 
         THEN BEGIN 
              RETURN; 
              END 
         IF REG1 EQ GLITREF AND REG2 EQ GLITREF 
         THEN BEGIN 
              # COMPARISON OF TWO LITERALS IS # 
              # NOT ALLOWED IN A RELATION CONDITION # 
              ERROR(SEVERE,249,LINE1,COLUMN1);
              END 
         # LITERAL = EXPRESSION # 
         # EXPRESSION = LITERAL # 
         REG3 = B<36,15>OPERAND1; 
         REG4 = B<36,15>OPERAND2; 
         IF REG2 EQ GLITREF 
         THEN BEGIN 
              REG3 == REG4; 
              END 
         # REG3 CONTAINS LAT POINTER #
         # REG4 CONTAINS DNAT POINTER # 
         SET (L$VCODE,LAT$,REG3,1); 
         REG5 = GET(L$DNAT,LAT$,REG3);
         COPYD4(REG4,REG5); 
         SET(DN$LEVEL,DNAT$,REG5,LITLEVL);
         RETURN;
SUB63:  
# OUTPUT BOOLEAN GTEXT# 
         IF CONDTYPE NQ $EQUAL AND CONDTYPE NQ $NOTEQ 
         THEN BEGIN 
              # IS EQUAL TO, IS =, EQUALS, IS NOT EQUAL TO, # 
              # IS NOT =, OR IS UNEQUAL TO ARE THE LEGAL #
              # RELATIONAL OPERATORS IN A BOOLEAN RELATION CONDITION #
              ERROR(SEVERE,488,LINE1,COLUMN1);
              END 
         NG(CONDTYPE);
         NG(OPERAND1);
         NG(OPERAND2);
         RETURN;
         END  # PROC SET2 # 
         TERM 
