*DECK SET4
USETEXT CCTTEXT 
USETEXT DNTEXT
USETEXT PPTEXT
         PROC SET4; 
         CONTROL PACK;
         BEGIN
*CALL DPPPDDATA 
*CALL PPCOMMON2 
*CALL AUXTVALS
*CALL DNATVALS
*CALL PLTVALS 
         $BEGIN 
         XREF ITEM PRI$STK$TRC    B;   # PRIORITY STACK TRACE          #
         XREF FUNC OCT          C(10); # BINARY TO OCTAL DISPLAY CODE  #
         XREF PROC OUTPUT;             # OUTPUT TO LISTING             #
         DEF DBUGADDRESS # $BEGIN IF PRI$STK$TRC THEN 
                           OUTPUT(4," ADDRESS  ",DEC(Z),"  IS      ", 
                           OCT(ADDRESS(Z),13,7));$END CONTROL LIST#;
         $END 
         PROC DO$INITIALIZ (P1);
           BEGIN
             ITEM P1 I; 
             FOR I = INITIALIZE [P1] STEP 1 
             UNTIL INCREMENT [P1] - 1 
             DO BEGIN 
                  NG(GETGT(I)); 
                END 
           END # DO$INITIALIZ # 
         PROC DO$INCREMENT (P1);
           BEGIN
             ITEM P1 I; 
             FOR I = INCREMENT [P1] STEP 1
             UNTIL CONDITION [P1] - 1 
             DO BEGIN 
                  NG(GETGT(I)); 
                END 
           END # DO$INCREMENT # 
         PROC DO$TEST (P1); 
           BEGIN
             ITEM P1 I; 
             FOR I = CONDITION [P1] STEP 1
             UNTIL INITIALIZE [P1 + 1] - 1
             DO BEGIN 
                  NG(GETGT(I)); 
                END 
           END # DO$TEST #
         CONTROL EJECT; 
         # ----- MAIN LINE ENTERS HERE ----- #
         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; 
         GOTO SUB[SUB$];
       PROC CHKLITORID; 
        BEGIN 
         IF TCODE(S) EQ GDATAREF
         THEN BEGIN 
              TEMP1 = GET(DN$TYPE,DNAT$,TPOINTER(S)); 
              IF TEMP1 NQ ERRTYPE 
              THEN BEGIN
                   IF TEMP1 LS LOWNUMOPERND OR TEMP1 GR HINUMOPERND 
                   THEN #(DIAG 81)# 
                        #THIS OPERAND MUST BE NUMERIC#
                        ERROR(SEVERE,81,LINE$,COLUMN$); 
                   ELSE BEGIN 
                        #CHECK IF THE IDENTIFIER IS A NUMERIC INTEGER#
                        IF GET(DN$POINT,DNAT$,TPOINTER(S)) GR 0 
                        THEN #(DIAG 263)# 
                             #THIS IDENTIFIER MUST REFERENCE# 
                             #AN ELEMENTARY NUMERIC#
                             #INTEGER DATA ITEM#
                             ERROR(SEVERE,263,LINE$,COLUMN$); 
                        END 
                   END
              END 
         ELSE BEGIN 
              #CHECK IF THE LITERAL IS A NUMERIC UNSIGNED LITERAL#
              TEMP1 = GET(L$PLT,LAT$,TPOINTER(S));
              IF GET(PL$CODE,PLT$,TEMP1) EQ PLTQUOTEDLIT
              THEN BEGIN
                   #(DIAG 81)#
                   #THIS OPERAND MUST BE NUMERIC# 
                   ERROR(SEVERE,81,LINE$,COLUMN$);
                   END
              ELSE BEGIN
                   IF GET(PL$TYPE,PLT$,TEMP1) EQ PLTUNSGNILIT 
                   OR GET(PL$CODE,PLT$,TEMP1) EQ PLTFGCONZERO 
                   THEN NONZEROLIT(S);
                   ELSE #(DIAG 882)#
                        #AN UNSIGNED INTEGER LITERAL IS REQUIRED HERE#
                        ERROR(SEVERE,882,LINE$,COLUMN$);
                   END
              END 
        END 
  
SUB11:  
#PERFORM TIMES ROUTINE# 
         CHKLITORID;
          CCTPERFTIMES = CCTPERFTIMES + 1;
          # COUNT NUMBER OF PERFORM TIMES SO THAT IF SEGMENTATION      #
          # IS USED, CGEN WILL KNOW HOW MAY WORDS TO ALLOCATE IN THE   #
          # 0,0 OVERLAY FOR INDUCTION VARIABLES.                       #
         NG($PERFORMTM);
         FOR I = 1
         STEP 1 
         UNTIL 4
         DO NGSTACK(I); 
         IF CCTUARWANTED OR DEBUGFLAG EQ 1
         THEN BEGIN 
              # WE WISH TO EXECUTE PERFORM T DEBUG IN SET 10 #
              TRUEFALSE = 1;
              END 
         ELSE BEGIN 
              # WE CAN AVOID LOADING SET 10 # 
              TRUEFALSE = 0;
              END 
         RETURN;
SUB13:  
#PERFORM SIMPLE ROUTINE#
         NG($PERFORM);
         FOR I = 1
         STEP 1 
         UNTIL 3
         DO NGSTACK(I); 
         NGLABELDEF(PERFMRETURN); 
         RETURN;
SUB7: 
#PERFORM ROUTINE# 
         VD;
         S = 3; 
         S$ = 3;
         PERFVARFLAG = 0; 
         RETURN;
SUB8: 
#PERFORM PN#
         PN1 = VALUE$;
         RETURN;
SUB9: 
#PERFORM PN1# 
         XSTACK(1,GTX(GPROCREF,PN1,0)); 
         PERFORMENTRY = PN1;
         #TRANSFER CONTROL IS A FUNCTION# 
         #P3 = 2 IS FOR PERFORM STATEMENT#
         #P1 = LOCATION OF PERFORM STATEMENT# 
         #P2 = ENTRY POINT OF PERFORMED REGION# 
         #DIAGNOSTICS IN THE RANGE 625 TO 634 ARE POSSIBLE# 
         $DUMMY$ = TCONTROL(LASTPNDEF,PN1,2); 
         RETURN;
SUB10:  
#PERFORM PN2# 
         XSTACK(2,GTX(GPROCREF,PN1,0)); 
         PERFMRETURN = NEXTPNAT;
         XSTACK(3,GTX(GLABELREF,PERFMRETURN,0));
         #TRANSFER CONTROL# 
         #P3 = 3 IS FOR PERFORM RETURN# 
         #P1 = FIRST PROCEDURE# 
         #P2 = SECOND PROCEDURE#
         #POSSIBLE DIAGNOSTICS 635, 637, 638, 639, 640, 641, 642# 
         IF TCONTROL(PERFORMENTRY,PN1,3) EQ 1 
         THEN BEGIN 
              SET(PN$PERFLAST,PNAT$,PN1,1); 
              END 
         REG1 = GET(PN$SEGMENTNO,PNAT$,PERFORMENTRY); 
         REG2 = GET(PN$SEGMENTNO,PNAT$,PN1);
         REG3 = GET(PN$SEGMENTNO,PNAT$,LASTSDEF); 
         IF REG1 LS 50 AND REG2 LS 50 THEN RETURN;
         IF REG3 LS 50 AND REG1 EQ REG2 THEN RETURN;
         IF REG3 GR 49 AND REG1 EQ REG3 AND REG2 EQ REG3
         THEN RETURN; 
         IF REG3 LS 50
         THEN BEGIN 
              #THE RANGE OF A PERFORM STATEMENT LOCATED#
              #IN A NON-INDEPENDENT SEGMENT MUST BE WHOLLY# 
              #CONTAINED IN ONE OR MORE NON-INDEPENDENT#
              #SEGMENTS OR WHOLLY CONTAINED IN A SINGLE#
              #INDEPENDENT SEGMENT# 
              ERROR(SEVERE,402,VERBLINE,VERBCOLUMN);
              END 
         ELSE BEGIN 
              #THE RANGE OF A PERFORM STATEMENT LOCATED#
              #IN AN INDEPENDENT SEGMENT MUST BE WHOLLY#
              #CONTAINED IN ONE OR MORE NON-INDEPENDENT#
              #SEGMENTS OR WHOLLY CONTAINED IN THE SAME#
              #INDEPENDENT SEGMENT AS THAT PERFORM STATEMENT# 
              ERROR(SEVERE,403,VERBLINE,VERBCOLUMN);
              END 
         RETURN;
SUB14:  
#PERFORM UNTIL CONDITION ROUTINE# 
         UNSTACK(3);
         IF ORADDRESS NQ 0
         THEN BEGIN 
              SET(PN$EQUATE,PNAT$,ORADDRESS,PERFORMENTRY);
              ORADDRESS = 0;
              END 
         IF NEGATION EQ 0 
         THEN BEGIN 
              NGPROCREF(PERFORMENTRY,GFALSE); 
              END 
         ELSE BEGIN 
              NGPROCREF(PERFORMENTRY,GTRUE);
              END 
         IF ANDADDRESS NQ 0 
         THEN BEGIN 
              NGLABELDEF(ANDADDRESS); 
              ANDADDRESS = 0; 
              END 
         Z = Z-1; 
         RETURN;
SUB21:  
#UNSTACK PERFORM# 
         Z = Z-1; 
         RETURN;
SUB18:  
#FROM ROUTINE#
         INITIALIZE[VP] = G+1;
         TEMP1 = REMOVE(1); 
         OPERAND1 = STACK(TEMP1); 
         TEMP2 = RETRIEVE(S$);
         OPERAND2 = STACK(TEMP2); 
         IF TCODE(TEMP1) EQ GDATAREF AND
            GET(DN$LEVEL,DNAT$,TPOINTER(TEMP1)) EQ INDXLEVL 
         THEN FROMINDEX = 1;
         IF GET(DN$LEVEL,DNAT$,TPOINTER(TEMP2)) EQ INDXLEVL 
         THEN VARYINDEX = 1;
         IF FROMINDEX EQ 1
         THEN BEGIN 
              #THE IDENTIFIER FOLLOWING FROM IS AN INDEX-NAME#
              I = TPOINTER(TEMP2);
              REG1 = GET(DN$TYPE,DNAT$,I);
              IF REG1 NQ ERRTYPE
              THEN BEGIN
                   IF REG1 LS LOWNUMOPERND OR REG1 GR INDXNAME
                   THEN #(DIAG 81)# 
                        #THIS OPERAND MUST BE NUMERIC#
                        ERROR(SEVERE,81,LINE(TEMP2),COLUMN(TEMP2)); 
                   ELSE BEGIN 
                        IF REG1 NQ INDXNAME AND 
                             GET (DN$POINT,DNAT$,I) GR 0
                        THEN #(DIAG 263)# 
                             #THIS IDENTIFIER MUST REFERENCE# 
                             #AN ELEMENTARY NUMERIC INTEGER#
                             #DATA ITEM#
                             ERROR
                             (SEVERE,263,LINE(TEMP2),COLUMN(TEMP2));
                        END 
                   END
              END 
         ELSE BEGIN 
              IF VARYINDEX EQ 1 
              THEN BEGIN
                   #THE IDENTIFIER FOLLOWING VARYING# 
                   #OR AFTER IS AN INDEX-NAME#
                   I = TPOINTER(TEMP1); 
                   IF TCODE(TEMP1) EQ GDATAREF
                   THEN BEGIN 
                        REG1 = GET(DN$TYPE,DNAT$,I);
                        IF REG1 NQ ERRTYPE
                        THEN BEGIN
                             IF REG1 LS LOWNUMOPERND
                             OR REG1 GR HINUMOPERND 
                             THEN #(DIAG 81)# 
                                  #THIS OPERAND MUST BE NUMERIC#
                                  ERROR 
                                  (SEVERE,81,LINE(TEMP1),COLUMN(TEMP1));
                             ELSE BEGIN 
                                  IF GET(DN$POINT,DNAT$,I) GR 0 
                                  THEN #(DIAG 263)# 
                                       #THIS IDENTIFIER MUST REFERENCE# 
                                       #AN ELEMENTARY NUMERIC INTEGER#
                                       #DATA ITEM#
                                       ERROR(SEVERE,263,
                                       LINE(TEMP1),COLUMN(TEMP1));
                                  END 
                             END
                        END 
                   ELSE BEGIN 
                        #A MOVE WILL BE GENERATED SO SET VERBCODE#
                        SET(L$VCODE,LAT$,I,2);
                        I = GET(L$PLT,LAT$,I);
                        IF GET(PL$CODE,PLT$,I) EQ PLTQUOTEDLIT
                        THEN BEGIN
                             #(DIAG 81)#
                             #THIS OPERAND MUST BE NUMERIC# 
                             ERROR(SEVERE,81,LINE(TEMP1),COLUMN(TEMP1));
                             END
                        ELSE BEGIN
                             IF GET(PL$TYPE,PLT$,I) EQ PLTUNSGNILIT OR
                             GET(PL$TYPE,PLT$,I) EQ PLTPLUSILIT 
                             OR GET(PL$CODE,PLT$,I) EQ PLTFGCONZERO 
                             THEN NONZEROLIT(TEMP1);
                             ELSE #(DIAG 883)#
                                  #A POSITIVE INTEGER LITERAL#
                                  #IS REQUIRED HERE#
                                  ERROR(SEVERE,883,LINE(TEMP1), 
                                  COLUMN(TEMP1)); 
                             END
                        END 
                   END
              ELSE BEGIN
                   OPERANDTEST(TEMP1);
                   OPERANDTEST(TEMP2);
                   END
              END 
         IF VARYINDEX EQ 1 OR FROMINDEX EQ 1
         THEN BEGIN 
              NG($SET); 
              NG($SETTO); 
              END 
         ELSE NGMOVE; 
         NG(OPERAND1);
         NG(OPERAND2);
         RETURN;
SUB19:  
#BY ROUTINE#
         INCREMENT[VP] = G+1; 
         TEMP1 = REMOVE(1); 
         OPERANDTEST(TEMP1);
         OPERAND1 = STACK(TEMP1); 
         IF TCODE(TEMP1) NQ GDATAREF
         THEN NONZEROLIT(TEMP1);
         IF VARYINDEX EQ 1
         THEN BEGIN 
              IF TCODE(TEMP1) EQ GDATAREF 
              THEN BEGIN
                   IF GET(DN$POINT,DNAT$,TPOINTER(TEMP1)) GR 0
                   THEN #(DIAG 263)#
                        #THIS IDENTIFIER MUST REFERENCE#
                        #AN ELEMENTARY NUMERIC INTEGER DATA ITEM# 
                        ERROR(SEVERE,263,LINE$,COLUMN$);
                   END
              ELSE BEGIN
                   TEMP2 = GET(L$PLT,LAT$,TPOINTER(TEMP1)); 
                   IF GET(PL$CODE,PLT$,TEMP2) NQ PLTINTLIT
                   THEN #(DIAG 269)#
                        #AN INTEGER LITERAL IS REQUIRED HERE# 
                        ERROR(SEVERE,269,LINE$,COLUMN$);
                   END
              END 
         TEMP2 = RETRIEVE(S$);
         OPERAND2 = STACK(TEMP2); 
         IF VARYINDEX EQ 1
         THEN BEGIN 
              NG($SET); 
              NG($SETUPBY); 
              END 
         ELSE NG($ADD); 
         NG(OPERAND1);
         NG(OPERAND2);
         NG(OPERAND2);
         RETURN;
SUB20:  
#FBU CONDITION PROLOGUE#
         CONDITION[VP] = G+1; 
         IF VP EQ 1 
         THEN DPATCH = G+1; 
         RETURN;
SUB17:  
#FBU PROLOGUE#
         VP = VP+1; 
         VARYINDEX = 0; 
         FROMINDEX = 0; 
         RETURN;
SUB15:  
#PERFORM VARYING PROLOGUE#
         VP = 0;
         IF F18 EQ 1
           THEN G = G - 3;
         ELSE G = G - 1;
         PERFVARFLAG = 1; 
         RETURN;
SUB16:  
#PERFORM VARYING EPILOGUE#
         TEMP1 = G+1; 
         PERFVARFLAG = 0; 
         INITIALIZE[VP+1] = TEMP1;
         DO$INITIALIZ (1);
         IF VP EQ 3 
         THEN BEGIN 
              DO$INITIALIZ (2); 
              DO$INITIALIZ (3); 
              END 
         IF F18 EQ 1
           THEN GOTO TESTAFTER; 
         TEMP2 = NEXTPNAT;
         NGGOTO;
         NGLABELREF(TEMP2,0); 
         NGLABELDEF(PERFMRETURN); 
         PERFMRETURN = 0; 
         DO$INCREMENT (VP); 
         SET(PN$EQUATE,PNAT$,ADDRESS(Z),PERFORMENTRY);
         $BEGIN DBUGADDRESS; $END 
         Z = Z - 2; 
         IF VP EQ 1 
         THEN BEGIN 
              NGLABELDEF(TEMP2);
              END 
         ELSE BEGIN 
              PREVCOND = NEXTPNAT;
              NGLABELDEF(PNATLENGTH); 
              END 
         DO$TEST (VP);
         IF VP EQ 1 
         THEN GOTO PV2; 
         IF VP EQ 2 
         THEN GOTO PV1; 
         DO$INCREMENT (2);
         DO$INITIALIZ (3);
         SET(PN$EQUATE,PNAT$,ADDRESS(Z),PREVCOND);
         $BEGIN DBUGADDRESS; $END 
         Z = Z-2; 
         PREVCOND = NEXTPNAT; 
         NGLABELDEF(PNATLENGTH);
         DO$TEST (2); 
PV1:  
         DO$INCREMENT (1);
         IF VP EQ 2 
         THEN NGLABELDEF(TEMP2);
         DO$INITIALIZ (2);
         IF VP EQ 3 
         THEN NGLABELDEF(TEMP2);
         SET(PN$EQUATE,PNAT$,ADDRESS(Z),PREVCOND);
         $BEGIN DBUGADDRESS; $END 
         Z = Z-2; 
         DO$TEST (1); 
PV2:  
         TEMP2 = INITIALIZE[1]; 
         FOR I = TEMP1
         STEP 1  UNTIL G
         DO   BEGIN 
              REG1 = GETGT(I);
              SETGT(TEMP2,REG1);
              TEMP2 = TEMP2 + 1;
              END 
         G = TEMP2 - 1; 
         RETURN;
  
TESTAFTER:  
         IF VP EQ 2 
           THEN DO$INITIALIZ (2); 
         NGGOTO;
         NGPROCREF (PERFORMENTRY, 0); 
         NGLABELDEF (PERFMRETURN);
         PERFMRETURN = 0; 
# IN THIS TEST AFTER CODE, THE LABEL HOLDER "PREVCOND" HOLDS A         #
# FORWARD REFERENCE TO THE NEXT CONDITION NOT A BACKWARDS REFERENCE    #
# TO A PREVIOUS CONDITION.                                             #
         TEMP2 = NEXTPNAT;
         PREVCOND = NEXTPNAT; 
         SET (PN$EQUATE, PNAT$, ADDRESS (Z), TEMP2);
         $BEGIN DBUGADDRESS; $END 
         Z = Z - 2; 
         DO$TEST (VP);
         NGGOTO;
         NGLABELREF (PREVCOND, 0);
         NGLABELDEF (TEMP2);
         DO$INCREMENT (VP); 
         NGGOTO;
         NGPROCREF (PERFORMENTRY, 0); 
         NGLABELDEF (PREVCOND); 
         IF VP EQ 1 
           THEN GOTO PV2; 
         IF VP EQ 3 
           THEN BEGIN 
                  TEMP2 = NEXTPNAT; 
                  PREVCOND = NEXTPNAT;
                  SET (PN$EQUATE, PNAT$, ADDRESS (Z), TEMP2); 
                  $BEGIN DBUGADDRESS; $END
                  Z = Z - 2;
                  DO$TEST (2);
                  NGGOTO; 
                  NGLABELREF (PREVCOND, 0); 
                  NGLABELDEF (TEMP2); 
                  DO$INCREMENT (2); 
                  DO$INITIALIZ (3); 
                  NGGOTO; 
                  NGPROCREF (PERFORMENTRY, 0);
                  NGLABELDEF (PREVCOND);
                END 
         TEMP2 = NEXTPNAT;
         PREVCOND = NEXTPNAT; 
         SET (PN$EQUATE, PNAT$, ADDRESS (Z), TEMP2);
         $BEGIN DBUGADDRESS; $END 
         Z = Z - 2; 
         DO$TEST (1); 
         NGGOTO;
         NGLABELREF (PREVCOND, 0);
         NGLABELDEF (TEMP2);
         DO$INCREMENT (1);
         DO$INITIALIZ (2);
         IF VP EQ 3 
           THEN DO$INITIALIZ (3); 
         NGGOTO;
         NGPROCREF (PERFORMENTRY, 0); 
         NGLABELDEF (PREVCOND); 
         GOTO PV2;
SUB22:  
#PERFORM COMPLEX ROUTINE# 
         NG($PCOMPLEX); 
         FOR I = 1
         STEP 1  UNTIL S
         DO   BEGIN 
              NGSTACK(I); 
              END 
         S = 0; 
         S$ = 0;
         IF F18 EQ 1
           THEN BEGIN 
         DPATCH = G + 1;
                  NGGOTO; 
                  NGPROCREF (PERFORMENTRY, 0);
                END 
         NGLABELDEF(PERFMRETURN); 
         RETURN;
SUB37:  
#OUT-OF-LINE PERFORM WITH TEST AFTER# 
         ITEM TF18 I; 
         TF18 = F18;
         F18 = 1; 
         RETURN;
SUB38:  
#OUT-OF-LINE PERFORM WITH TEST BEFORE#
         TF18 = F18;
         F18 = 0; 
         RETURN;
SUB31:  
#IN-LINE PERFORM TIMES ROUTINE# 
         CHKLITORID;
         REG1 = NEXTTEMP; 
         SET (DN$TYPE, DNAT$, REG1, BINARY);
         SET (DN$ITMLEN, DNAT$, REG1, 10);
         SET (DN$NUMLEN, DNAT$, REG1, 14);
         SET (DN$SYNC, DNAT$, REG1, 1); 
         SET( DN$SIGNBIT, DNAT$, REG1, 1);
         GLOBALTEMP (REG1); 
         NG ($MOVE);
         NGSTACK (S); 
         NGDATAREF (REG1);
         SAVE$ADDRESS = NEXTPNAT; 
         NGLABELDEF (SAVE$ADDRESS); 
         NG ($SUBTRACT);
         NGDATAREF (REG1);
         LATTEMP = 1; 
         NG (CREATELDL (REG1, 1));
         NGDATAREF (REG1);
         NG ($LESS);
         NGDATAREF (REG1);
         LATTEMP = 0; 
         NG (CREATELDL (REG1, 1));
         NGLABELREF (ENDADDRESS, GTRUE);
         RETURN;
  
SUB32:  
#IN-LINE PERFORM UNTIL PROLOGUE#
         IF F18 EQ 1
         THEN BEGIN 
                  PERFORMENTRY = NEXTPNAT;
                  NGGOTO; 
                  NGLABELREF (PERFORMENTRY, 0); 
                END 
         SAVE$ADDRESS = NEXTPNAT; 
         NGLABELDEF (SAVE$ADDRESS); #PERFORM RETURN ADDRESS#
         RETURN;
  
SUB33:  
#IN-LINE PERFORM UNTIL TEST AFTER ROUTINE#
         SET (PN$EQUATE, PNAT$, ADDRESS (Z), PERFORMENTRY); 
         $BEGIN DBUGADDRESS; $END 
         XADDRESS (Z, PERFORMENTRY);
         RETURN;
  
SUB34:  
#IN-LINE PERFORM EPILOGUE#
         NGGOTO;
         NGLABELREF (SAVE$ADDRESS, 0);
         NSFLAG = 1; # SET FLAG TO DEFINE ENADDRESS FOR FORMAT 2,3,4 #
         RETURN;
  
SUB36:  
#IN-LINE PERFORM VARYING PROLOGUE#
         VP = 0;
         PERFVARFLAG = 1; 
         RETURN;
  
SUB35:  
#IN-LINE PERFORM VARYING ROUTINE# 
         TEMP1 = G + 1; 
         PERFVARFLAG = 0; 
         INITIALIZE [VP + 1] = TEMP1; 
         DO$INITIALIZ (1);
        IF VP EQ 3 THEN 
              BEGIN 
              DO$INITIALIZ (2); 
              DO$INITIALIZ (3); 
              END 
                   IF VP EQ 2 AND F18 EQ 1
                   THEN DO$INITIALIZ(2);
         TEMP2 = NEXTPNAT;
         NGGOTO;
         NGLABELREF (TEMP2, 0); 
         IF F18 EQ 1
           THEN BEGIN 
                  PERFORMENTRY = TEMP2; 
                  TEMP2 = NEXTPNAT; 
                END 
         ELSE BEGIN 
                PERFORMENTRY = NEXTPNAT;
              END 
         SAVE$ADDRESS = NEXTPNAT; 
         NGLABELDEF (SAVE$ADDRESS); 
         IF F18 EQ 1
           THEN BEGIN 
                  SET (PN$EQUATE, PNAT$, ADDRESS (Z), TEMP2); 
                  $BEGIN DBUGADDRESS; $END
                  Z = Z - 2;
              DO$TEST(VP);
                  NGGOTO; 
                   IF VP EQ 1 
                   THEN NGLABELREF(ENDADDRESS,0); 
                   ELSE BEGIN 
                        PREVCOND = NEXTPNAT;
                        NGLABELREF(PREVCOND,0); 
                        END 
                  NGLABELDEF (TEMP2); 
              DO$INCREMENT(VP); 
              IF VP NQ 1 THEN 
                   BEGIN
                   NGGOTO;
                   NGLABELREF(PERFORMENTRY,0);
                   NGLABELDEF(PREVCOND);
                   IF VP EQ 3 
                        THEN BEGIN
                        TEMP2 = NEXTPNAT; 
                        PREVCOND = NEXTPNAT;
                        SET(PN$EQUATE,PNAT$,ADDRESS(Z),TEMP2);
                        $BEGIN DBUGADDRESS; $END
                        Z = Z-2;
                        DO$TEST(2); 
                        NGGOTO; 
                        NGLABELREF(PREVCOND,0); 
                        NGLABELDEF(TEMP2);
                        DO$INCREMENT(2);
                        DO$INITIALIZ(3);
                        NGGOTO; 
                        NGLABELREF(PERFORMENTRY,0); 
                        NGLABELDEF(PREVCOND); 
                        END 
                   TEMP2 = NEXTPNAT;
                   SET(PN$EQUATE,PNAT$,ADDRESS(Z),TEMP2); 
                   $BEGIN DBUGADDRESS; $END 
                   Z = Z-2; 
                   DO$TEST(1);
                   NGGOTO;
                   NGLABELREF(ENDADDRESS,0);
                   NGLABELDEF(TEMP2); 
                   DO$INCREMENT(1); 
                   DO$INITIALIZ (2);
                   IF VP EQ 3 THEN DO$INITIALIZ (3);
                   NGGOTO;
                   NGLABELREF(PERFORMENTRY,0);
                   END
                END 
         ELSE BEGIN 
              DO$INCREMENT(VP); 
              IF VP EQ 1
              THEN NGLABELDEF(TEMP2); 
              ELSE
                   BEGIN
                   PREVCOND = NEXTPNAT; 
                   NGLABELDEF(PNATLENGTH);
                   END
                SET (PN$EQUATE, PNAT$, ADDRESS (Z), PERFORMENTRY);
                $BEGIN DBUGADDRESS; $END
                Z = Z - 2;
              DO$TEST(VP);
              IF VP EQ 3 THEN 
                   BEGIN
                   DO$INCREMENT(2); 
                   DO$INITIALIZ (3);
                   SET(PN$EQUATE,PNAT$,ADDRESS(Z),PREVCOND);
                   $BEGIN DBUGADDRESS; $END 
                   Z = Z-2; 
                   PREVCOND=NEXTPNAT; 
                   NGLABELDEF(PNATLENGTH);
                   DO$TEST(2);
                   END
              IF VP EQ 2 OR VP EQ 3 THEN
                   BEGIN
                   DO$INCREMENT(1); 
                   IF VP EQ 2 
                   THEN NGLABELDEF(TEMP2);
                   DO$INITIALIZ (2);
                   IF VP EQ 3 THEN NGLABELDEF(TEMP2); 
                   SET(PN$EQUATE,PNAT$,ADDRESS(Z),PREVCOND);
                   $BEGIN DBUGADDRESS; $END 
                   Z = Z-2; 
                   DO$TEST(1);
                   END
                NGGOTO; 
                NGLABELREF (ENDADDRESS, 0); 
              END 
         NGLABELDEF (PERFORMENTRY); 
         GOTO PV2;
SUB12:  
#END PERFORM COMPLEX ROUTINE# 
         F18 = TF18;
         NG($PERFORMEND); 
         NGPROCREF(PN1,0);
         RETURN;
SUB6: 
#EXIT ROUTINE#
         VD;
         NG($EXIT); 
         #PARSTATUS MUST BE 2 OR 3 COMING FROM STATEMENT# 
         IF PARSTATUS EQ 2
         #GOOD - ONE STATEMENT IN THE PARAGRAPH#
         #THAT STATEMENT IS IN FACT OUR EXIT (PROGRAM) STATEMENT# 
         THEN PARSTATUS = 5;
         #THE PARAGRAPH CONTAINS MORE THAN ONE STATEMENT# 
         #TOO BAD - EXIT MUST BE THE ONLY STATEMENT IN PARAGRAPH# 
         ELSE #(DIAG 38)# 
              #AN EXIT STATEMENT MUST APPEAR IN A SENTENCE# 
              #AND IN A PARAGRAPH BY ITSELF#
                    ERROR (TRIVIAL, 38, LINE$,  COLUMN$); 
         RETURN;
SUB5: 
#EXIT PROGRAM ROUTINE#
         VD;
         IF CCTSUBPROGR[0]
         THEN NG($EXITPROGRAM); 
         ELSE NG($NOOP);
         IF PARSTATUS NQ 2
         #ANSI INSISTS THAT THE EXIT PROGRAM STATEMENT# 
         #BE THE ONLY STATEMENT IN THE PARAGRAPH# 
         THEN ERROR(TRIVIAL,029,LINE$,COLUMN$); 
         PARSTATUS = 8; 
         RETURN;
SUB4: 
#COMPUTE EPILOGUE#
         # RHSLITERAL = 0 MEANS RHS IS A DATA NAME #
         #            = 1 MEANS RHS IS A TEMP      #
         #            = 2 MEANS RHS IS A LITERAL   #
         #                (OK TO USE ORIGINAL LAT) #
         #            = 3 MEANS RHS IS A LITERAL   #
         #                (MORE THAN ONE RECEIVING #
         #                 FIELD ... NEED NEW LAT) #
         RHSLITERAL = 0;
         IF BFLAG EQ 1 AND BL NQ -1 
         THEN BEGIN 
              FOR REG1 = 0 STEP 1 UNTIL BL
              DO BEGIN
                 NG(BOOLSTACK(REG1)); 
                 END
              BL = -1;
              REG1 = REMOVE(0); 
              OPERAND1 = STACK(REG1); 
              # RHS IS A TEMP # 
              RHSLITERAL = 1; 
              GOTO CE2; 
              END 
         #IS THE RIGHT HAND SIDE AN ARITHMETIC EXPRESSION#
         IF BFLAG EQ 0 AND FL NQ -1 
         THEN BEGIN 
              #YES - MOVE ARITH EXPRESSION TO GTEXT#
              FOR REG1 = 0
              STEP 1  UNTIL FL
              DO   BEGIN
                   NG(FORMULA(REG1)); 
                   END
              FL = -1;
              REG1 = REMOVE(1); 
              OPERAND1 = STACK(REG1); 
              #RHS IS A TEMP# 
              RHSLITERAL = 1; 
              GOTO CE2; 
              END 
         #THE RIGHT HAND SIDE IS NOT AN ARITHMETIC EXPRESSION#
         #RHS IS A LITERAL OR DATA NAME#
         #REMOVE RHS FROM THE STACK#
         REG2 = REMOVE(1);
         IF BFLAG EQ 0
         THEN BEGIN 
              OPERANDTEST(REG2);
              END 
         OPERAND1 = STACK(REG2);
         IF TCODE(REG2) EQ GLITREF
         THEN BEGIN 
              #RHS IS A LITERAL ... ORIGINAL LAT OK#
              RHSLITERAL = 2; 
              GOTO CE2; 
              END 
CE2:  
         #PROCESS THE RECEIVING FIELDS LEFT TO RIGHT# 
         FOR REG1 = 1 
         STEP 2 UNTIL S$ - 1
         DO   BEGIN 
              REG2 = REG1+1;
              #RECEIVING FIELD SUBSCRIPTS (IF ANY) ENTER GTEXT NOW# 
              REG3 = RETRIEVE(REG1);
              REG4 = RETRIEVE(REG2);
              #CHECK THE ATTRIBUTES OF THE RECEIVING FIELD# 
              IF BFLAG EQ 1 
              THEN BEGIN
                   I = TPOINTER (REG3); 
                   I = GET(DN$TYPE,DNAT$,I);
                   IF I NQ BOOLBIT AND I NQ BOOLDSP 
                   THEN BEGIN 
                        #A BOOLEAN DATA ITEM IS REQUIRED HERE#
                        ERROR(SEVERE,481,LINE(REG3),COLUMN(REG3));
                        END 
                   END
              ELSE BEGIN
                   RESULTTEST(REG3);
                   END
              IF RHSLITERAL GQ 2
              THEN BEGIN
                   #THE RHS IS A LITERAL# 
                   IF RHSLITERAL EQ 3 
                   THEN BEGIN 
                        #WE NEED TO CREATE A NEW LAT# 
                        OPERAND1 = GTX(GLITREF,(NEXTLAT),0);
                        REG6 = GET(L$PLT,LAT$,LATLENGTH-1); 
                        SET(L$PLT,LAT$,LATLENGTH,REG6); 
                   REG6 = GET(L$ALL,LAT$,LATLENGTH-1);
                   SET(L$ALL,LAT$,LATLENGTH,REG6);
                        END 
                   RHSLITERAL = 3;
                   #A LITERAL MOVE WILL BE GENERATED SO SET VERBCODE# 
                   SET(L$VCODE,LAT$,LATLENGTH,2); 
                   #ESTABLISH ATTRIBUTES FOR THE LITERAL# 
                   REG5 = B<36,15> OPERAND1;
                   REG6 = GET(L$DNAT,LAT$,REG5);
                   LITERALDNAT(TPOINTER(REG3),REG6);
                   IF STACK(REG4) EQ $MOVEROUND 
                   THEN BEGIN 
                        SET(L$ROUNDED,LAT$,LATLENGTH,1);
                        XSTACK(REG4,$MOVE); 
                        END 
                   END
              #MOVE OR MOVE ROUNDED ENTERS GTEXT# 
              NGSTACK(REG4);
              NG(OPERAND1); 
              NGSTACK(REG3);
              IF RHSLITERAL EQ 1
              THEN BEGIN
                   FIX1 = B<36,15> OPERAND1;
                   FIX2 = TPOINTER(REG3); 
                   RTEMP(FIX1,FIX2);
                   END
              END 
         RETURN;
SUB1: 
#COMPUTE ROUTINE# 
         VD;
         NG($NOOP); 
         SIZEPATCH = G; 
         RETURN;
SUB2: 
#COMPUTE ROUNDED ROUTINE# 
         S$ = S$ + 1; 
         S = S+1; 
         XSTACK(S,$MOVEROUND);
         RETURN;
SUB3: 
#COMPUTE WITHOUT ROUNDING#
         S$ = S$ + 1; 
         S = S+1; 
         XSTACK(S,$MOVE); 
         RETURN;
SUB27:  
#RPW VD R#
         VD;
         RETURN;
SUB24:  
#GENERATE OPERAND R#
         IF GET(DN$TYPE,DNAT$,TABLENAME) EQ ERRTYPE 
         THEN BEGIN 
              FREEZEFLAG = 0; 
              RETURN; 
              END 
         IF GET(DN$LEVEL,DNAT$,TABLENAME) NQ RDDESCR
         THEN GOTO GENTAIL; 
         REG1 = GET(DN$AUXREF,DNAT$,TABLENAME); 
         REG2 = FINDAUX(AUXRDINFO,REG1);
         IF REG2 EQ 0 
         OR 
         GET(AX$SUPPERF,AUX$,REG2) EQ 1 
         THEN BEGIN 
              #(DIAG 180)#
              #AN ERROR WAS DETECTED IN THE DESCRIPTION OF THIS ITEM.#
              #THAT ERROR MUST BE CORRECTED BEFORE THIS STATEMENT#
              #CAN BE COMPILED CORRECTLY# 
              ERROR(PROPAGATED,180,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         IF GET(AX$SMMRYILLG,AUX$,REG2) EQ 1
         THEN BEGIN 
              #(DIAG 597)#
              #SUMMARY REPORTING IS NOT ALLOWED FOR THIS REPORT#
              #BECAUSE IT DOES NOT CONTAIN A CONTROL CLAUSE, OR#
              #DOES NOT CONTAIN AT LEAST ONE BODY GROUP, OR#
              #BECAUSE IT CONTAINS MORE THAN ONE DETAIL GROUP#
              ERROR(SEVERE,597,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         REG3 = FINDAUX(AUXSUMRPTSW,REG1);
         IF REG3 EQ 0 
         THEN BEGIN 
              #(DIAG 94)# 
              #COMPILER ERROR#
              ERROR(SEVERE,94,TABLELINE,TABLECOLUMN); 
              RETURN; 
              END 
         LATTEMP = 1; 
         REG4 = GET(AX$SMRPTSWDN,AUX$,REG3);
         REG5 = CREATELDL(REG4,1);
         SET(L$VCODE,LAT$,LATLENGTH,2); 
         NGMOVE;
         NG(REG5);
         NGDATAREF(REG4); 
         REG3 = GET(AX$BEGDETPN,AUX$,REG2); 
         REG4 = GET(AX$ENDDETPN,AUX$,REG2); 
         GOTO RWPERFORMGEN; 
GENTAIL:  
         IF GET(DN$LEVEL,DNAT$,TABLENAME) NQ 1
         THEN BEGIN 
              #(DIAG 596)#
              #A REPORT NAME OR THE NAME OF A#
              #DETAIL REPORT GROUP IS REQUIRED HERE#
              ERROR(SEVERE,596,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         REG1 = GET(DN$AUXREF,DNAT$,TABLENAME); 
         REG2 = FINDAUX(AUXRPWGEN,REG1);
         IF REG2 EQ 0 
         THEN BEGIN 
              #DIAG(596)# 
              #A REPORT NAME OR THE NAME OF A#
              #DETAIL REPORT GROUP IS REQUIRED HERE#
              ERROR(SEVERE,596,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         IF GET(AX$SUPPERF,AUX$,REG2) EQ 1
         THEN BEGIN 
              #(DIAG 180)#
              #AN ERROR WAS DETECTED IN THE DESCRIPTION OF THIS ITEM.#
              #THAT ERROR MUST BE CORRECTED BEFORE THIS STATEMENT#
              #CAN BE COMPILED CORRECTLY# 
              ERROR(PROPAGATED,180,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         REG3 = GET(AX$1DETPAR,AUX$,REG2);
         REG4 = GET(AX$LSTDETPAR,AUX$,REG2);
         GOTO RWPERFORMGEN; 
SUB25:  
#INITIATE OPERAND R#
         REG5 = 1;
         GOTO ITCOMMON; 
SUB26:  
#TERMINATE OPERAND R# 
         REG5 = 0;
ITCOMMON: 
         IF GET(DN$LEVEL,DNAT$,TABLENAME) NQ RDDESCR
         THEN BEGIN 
              IF GET(DN$TYPE,DNAT$,TABLENAME) NQ ERRTYPE
              THEN #(DIAG 595)# 
                   #A REPORT NAME IS REQUIRED HERE# 
                   ERROR(SEVERE,595,TABLELINE,TABLECOLUMN); 
              ELSE FREEZEFLAG = 0;
              RETURN; 
              END 
         REG1 = GET(DN$AUXREF,DNAT$,TABLENAME); 
         REG2 = FINDAUX(AUXRDINFO,REG1);
         IF REG2 EQ 0 
         THEN BEGIN 
              #(DIAG 180)#
              #AN ERROR WAS DETECTED IN THE DESCRIPTION OF THIS ITEM# 
              #THAT ERROR MUST BE CORRECTED BEFORE THIS STATEMENT CAN#
              #BE COMPILED CORRECTLY# 
              ERROR(PROPAGATED,180,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         IF GET(AX$SUPPERF,AUX$,REG2) EQ 1
         THEN BEGIN 
              #(DIAG 180)#
              #AN ERROR WAS DETECTED IN THE DESCRIPTION OF THIS ITEM# 
              #THAT ERROR MUST BE CORRECTED BEFORE THIS STATEMENT CAN#
              #BE COMPILED CORRECTLY# 
              ERROR(PROPAGATED,180,TABLELINE,TABLECOLUMN);
              RETURN; 
              END 
         IF REG5 EQ 1 
         THEN BEGIN 
              REG2 = FINDAUX(AUXINITRTNAM,REG1);
              REG3 = GET(AX$BEGINITPN,AUX$,REG2); 
              REG4 = GET(AX$ENDINITPN,AUX$,REG2); 
              END 
         ELSE BEGIN 
              REG2 = FINDAUX(AUXTERMRTNAM,REG1);
              REG3 = GET(AX$BEGTERMPN,AUX$,REG2); 
              REG4 = GET(AX$ENDTERMPN,AUX$,REG2); 
              END 
         IF REG2 EQ 0 
         THEN BEGIN 
              #(DIAG 94)# 
              #COMPILER ERROR#
              ERROR(SEVERE,94,TABLELINE,TABLECOLUMN); 
              RETURN; 
              END 
RWPERFORMGEN: 
         NGMOVE;
         LATTEMP = VERBLINE;
         NG(CREATELDL(CCTRWVRBLINE,1)); 
         SET(L$VCODE,LAT$,LATLENGTH,2); 
         NGDATAREF(CCTRWVRBLINE); 
         NG($PERFORM);
          NGPROCREF(REG3,0);
          NGPROCREF(REG4,0);
          NGLABELREF((NEXTPNAT),0); 
         NGLABELDEF(PNATLENGTH);
         RETURN;
SUB23:  
#SUPPRESS R#
         IF UBRAUXPTR EQ 0
         THEN  #SOMETHING WAS WRONG WITH THE USE STATEMENT# 
         RETURN;
         #ALLOCATE A SUPPRESS-SWITCH# 
         REG1 = NEXTTEMP; 
         SET(DN$TYPE,DNAT$,REG1,ALPHNUM); 
         SET(DN$ITMLEN,DNAT$,REG1,1); 
         GLOBALTEMP(REG1);
         #PUT DNAT PTR IN UBR AUX ENTRY FOR UBR VERB TO FIND# 
         SET(AX$TSECOND,AUX$,UBRAUXPTR,REG1); 
         #OUTPUT MOVE 1 TO SUPPRESS-SWITCH# 
         NGMOVE;
         LATTEMP = 1; 
         REG2 = CREATELDL(REG1,1);
         SET(L$VCODE,LAT$,LATLENGTH,2); 
         NG(REG2);
         NGDATAREF(REG1); 
         RETURN;
SUB28:  
#UBR OP1 R# 
         #GEN PERFORM UBR SECTION IF THERE IS ONE#
         REG1 = GET(DN$AUXREF,DNAT$,VALUE$);
         FIX1 = FINDAUX(UBRSECTION,REG1); 
         #IF THIS ENTRY DOESNT EXIST, THEN NEITHER DID A# 
         #UBR FOR THIS REPORT GROUP#
         IF FIX1 EQ 0 
         THEN BEGIN 
              SUPPRESSDNAT = 0; 
              RETURN; 
              END 
         REG1 = GET(AX$TSECOND,AUX$,FIX1);
         IF REG1 NQ  0
         THEN   #A SUPPRESS APPEARED IN THE UBR#
         #INITIALIZE SUPPRESS-SWITCH# 
         BEGIN
              NGMOVE; 
              LATTEMP = 0;
              REG2 = CREATELDL(REG1,1); 
         SET(L$VCODE,LAT$,LATLENGTH,2); 
              NG(REG2); 
              NGDATAREF(REG1);
              END 
         REG2 = GET(AX$TFIRST,AUX$,FIX1); 
         #EXTRACT PNAT OF THE UBR SECTION#
         DPATCH=G+1;
         NG($PERFORM);
         NGPROCREF(REG2,0); 
         NGPROCREF(REG2,0); 
          NGLABELREF((NEXTPNAT),0); 
         NGLABELDEF(PNATLENGTH);
         #SAVE FIX1 SO UBR OP2 R CAN TELL IF SUPPRESS-SWITCH# 
         #SHOULD BE TESTED# 
         SUPPRESSDNAT = REG1; 
         RETURN;
SUB29:  
#UBR OP2 R# 
         # SUPPRESSDNAT IS THE DNAT OF THE SUPPRESS SWITCH #
         # SUPPRESSDNAT = 0 MEANS NO UBR OR NO SUPPRESS IN UBR #
         FIX1 = SUPPRESSDNAT; 
         IF FIX1 EQ 0 
         THEN RETURN; 
         NG($NOTEQ);
         NGDATAREF(FIX1); 
         REG2 = FIX1; 
         LATTEMP = 0; 
         REG1 = CREATELDL(REG2,1);
          SET(L$VCODE,LAT$,LATLENGTH,1);
         NG(REG1);
         NGLABELREF(VALUE$,GTRUE);
         RETURN;
SUB30:  
#UBR OP3 R# 
         RETURN;
         END #SET4# 
         TERM 
