*DECK SET9
USETEXT CCTTEXT 
USETEXT DNTEXT
USETEXT PPTEXT
    PROC SET9;
         CONTROL PACK;
          BEGIN 
         XREF PROC SETPLST; 
*CALL DPPPDDATA 
*CALL PPCOMMON2 
*CALL DNATVALS
*CALL AUXTVALS
*CALL FNATVALS
*CALL PLTVALS 
*CALL ASSEMOP 
         SWITCH SUB    #SUB0#,
         SUB1 , SUB2 , SUB3 , SUB4 , SUB5 , 
         SUB6 , SUB7 , SUB8 , SUB9 , SUB10, 
         SUB11,      ,      , 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; 
          DEF D833  #833#;
          DEF D834  #834#;
          DEF D835  #835#;
          CONTROL EJECT;
     FUNC SETKEY(SETNAME)    I; 
          BEGIN 
          ITEM   REG1        I; 
          ITEM   REG2        I; 
          ITEM   SETNAME     I; 
          #CLASSIFY AN IDENTIFIER:# 
               #0 - ERROR TYPE# 
               #1 - INDEX NAME# 
               #2 - INDEX DATA ITEM#
               #3 - ELEMENTARY INTEGER DATA ITEM# 
               #4 - OTHER#
          ARRAY SETSTR [0:2] S(1);
            ITEM SETSTRI U = [ X"04 04 04 04 04 00 04 0", 
                               X"03 04 03 04 04 03 04 0", 
                               X"02 01 04 04 04 04 04 0"];
          #TRANSLATE DNAT TYPE TO KEY#
          REG1 = GET(DN$TYPE,DNAT$,SETNAME);
          IF REG1 GR 18         #ILLEGAL TYPE#
          THEN BEGIN
               SETKEY = 4;
               RETURN;
               END
          REG2 = BYTE(SETSTR,REG1); 
          IF REG2 EQ 0           #ERROR-TYPE# 
          THEN FREEZEFLAG = 0;
          ELSE IF REG2 EQ 3   AND 
                  GET(DN$POINT,DNAT$,SETNAME) GR 0
               THEN REG2 = 4; 
          SETKEY = REG2;
          RETURN; 
          END #SETKEY#
    FUNC REALMTEST; 
         BEGIN
         IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR 
         THEN BEGIN 
              I = GET(DN$FNATPTR,DNAT$,VALUE$); 
              IF GET(FN$SSCHEMA,FNAT$,I) EQ 1 
              THEN BEGIN
                   REALMTEST = I; 
                   RETURN;
                   END
              END 
         REALMTEST = 0; 
         # A REALM-NAME REFERENCE IS REQUIRED HERE #
         ERROR(SEVERE,554,LINE$,COLUMN$); 
         END
    PROC PROCESSREALM (P1); 
         BEGIN
         ITEM P1; 
         IF GET(FN$ACINPUT,FNAT$,P1) EQ 1 AND ACMODE NQ 1 
         OR GET(FN$ACIO   ,FNAT$,P1) EQ 1 AND ACMODE NQ 0 
         THEN BEGIN 
              # ONE OR MORE USE FOR ACCESS CONTROL #
              # DECLARATIVES HAVE SPECIFIED EITHER INPUT #
              # OR I-O MORE THAN ONCE FOR THE SAME #
              # REALM-NAME #
              ERROR(SEVERE,555,LINE$,COLUMN$);
              RETURN; 
              END 
         IF ACMODE EQ 0 OR ACMODE EQ 2
         THEN SET(FN$ACINPUT,FNAT$,P1,1); 
         IF ACMODE EQ 1 OR ACMODE EQ 2
         THEN SET(FN$ACIO,FNAT$,P1,1);
         S = S + 1; 
         XSTACK(S,GTX(GFILEREF,P1,0));
         END
  
          GOTO SUB[SUB$]; 
  
SUB1: 
#SEARCH TABLE ROUTINE#
          IF GET(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE 
          THEN GOTO SEARCHERROR1; 
          SRTEMP = 0; 
          IF GET(DN$OCCURS,DNAT$,VALUE$)  EQ 0  OR
             GET(DN$INDEXED,DNAT$,VALUE$) EQ 0 OR 
             GET(DN$TYPE,DNAT$,VALUE$) EQ NONDATA 
          THEN GOTO SEARCHERROR;
          IF GET(DN$DEP,DNAT$,VALUE$) EQ 1
          THEN BEGIN
               REG1 = GET(DN$AUXREF,DNAT$,VALUE$);
               REG2 = FINDAUX(VAROCCUR,REG1); 
               REG3 = GET(AX$DEPNAM,AUX$,REG2); 
               SRTEMP = GTX(GDATAREF,REG3,0); 
               END
          ELSE BEGIN
               FIX1 = GETAUX(VALUE$,MAXOCCUR);
               LATTEMP = GET(AX$MAXOCCNO,AUX$,FIX1);
               REG1 = VALUE$ + 1; 
               SRTEMP = CREATELDL(REG1,1);
               END
          SRADDRESS = NEXTPNAT; 
         NGGOTO;
         NGLABELREF (SRADDRESS, 0); 
         SAVE$ADDRESS = NEXTPNAT; 
         NGLABELDEF (SAVE$ADDRESS); 
          PERFMPATCH = SRTEMP;
           SRSTATUS = 0;
SEARCHDIDDLE: 
          SRTEMP = VALUE$;
          SRSUBJECT1  = S;
          SRDELIMITER = S$; 
          SRSUBDEPTH = GET(DN$SDEPTH,DNAT$,VALUE$); 
          SET(DN$SDEPTH,DNAT$,VALUE$,0);
          RETURN; 
SEARCHERROR:  
          ERROR (SEVERE,501,LINE$,COLUMN$); 
SEARCHERROR1: 
          FREEZEFLAG = 0; 
          SRSTATUS = 1; 
          IF GET(DN$OCCURS,DNAT$,VALUE$) EQ 0 
          THEN RETURN;
          GOTO SEARCHDIDDLE;
SUB2: 
#SEARCH RESTORE ROUTINE#
          IF GET(DN$OCCURS,DNAT$,SRTEMP) EQ 1 
          THEN BEGIN
               S = SRSUBJECT1;
               S$ = SRDELIMITER;
               SET(DN$SDEPTH,DNAT$,SRTEMP,SRSUBDEPTH);
               END
          DS = 0; 
          RETURN; 
SUB16:  
#SEARCH GTEXT ROUTINE#
          NG($LESS);
          NG(PERFMPATCH); 
         NGDATAREF (SRAUTOVARY);
          RETURN; 
SUB3: 
#SEARCH WITHOUT VARYING ROUTINE#
          IF SRSTATUS EQ 1  THEN RETURN;
          SEARCHSTACK[0] = 0; 
SWITHOUTVAR:  
          #FIRST INDEX IS THE ONE TO VARY AS THE CONTROL# 
          SRAUTOVARY = SRTEMP + 1;
         GOTO SRCHEPILOGUE; 
SUB4: 
#SEARCH VARYING ROUTINE#
          IF SRSTATUS EQ 1
          THEN BEGIN
               S  = 0;
               S$ = 0;
               RETURN;
               END
          SRLENGTH = 0; 
          REG1 =REMOVE(5);
          SEARCHSTACK[0] = STACK(REG1); 
          REG2 = TPOINTER(REG1);
          REG3 = GET(DN$TYPE,DNAT$,REG2); 
          #TYPE MUST BE INDEX-NAME, INDEX DATA OR ELEM INTEGER ITEM#
          IF REG3 EQ ERRTYPE  THEN GOTO VARYINGERROR; 
          IF REG3 EQ INDXNAME  THEN GOTO VARINDEXNAME;
          IF REG3 EQ INDXDATA  THEN GOTO SWITHOUTVAR; 
          IF REG3 GQ LOWNUMOPERND AND 
             REG3 LQ HINUMOPERND  AND 
             GET(DN$POINT,DNAT$,REG2) LQ 0
          THEN GOTO SWITHOUTVAR;
          #ELSE ITS INVALID#
          REG4 = COLUMN(REG1);
          REG5 = LINE(REG1);
          ERROR (SEVERE,507,REG5,REG4); 
VARYINGERROR: 
          FREEZEFLAG = 0; 
          SEARCHSTACK[0] = 0; 
          GOTO SWITHOUTVAR; 
VARINDEXNAME: 
          #IF THE INDEX BELONGS TO IDENT-1, THEN IT IS THE AUTO#
          #VARY ITEM# 
          IF REG2 LS SRTEMP  THEN GOTO SWITHOUTVAR; 
          REG4 = SRTEMP + 1;
          FOR $DUMMY$ = 0 WHILE 
                GET(DN$TYPE,DNAT$,REG4) EQ INDXNAME 
          DO   BEGIN
               IF REG4 EQ REG2  THEN GOTO VARSPECIAL; 
               REG4 = REG4 + 1; 
               END
          GOTO SWITHOUTVAR; 
VARSPECIAL: 
          NG(SEARCHSTACK[0]); 
          SRAUTOVARY = REG4;
          SEARCHSTACK[0] = 0; 
  
SRCHEPILOGUE: 
          IF SRSTATUS EQ 1 OR FREEZEFLAG EQ 0 
          THEN RETURN;
          IF SEARCHSTACK[0] EQ 0
          THEN GOTO SAUTOVARYGEN; 
          IF SRLENGTH NQ 0                    #OUTPUT SUBSCRIPTS# 
          THEN FOR REG1 = 1 STEP 1 UNTIL SRLENGTH 
               DO NG(SEARCHSTACK[REG1]);
          #SELECT THE DNAT POINTER# 
          REG1 = B<36,15> SEARCHSTACK[0]; 
          IF GET(DN$TYPE,DNAT$,REG1) EQ INDXNAME
          THEN REG2 = REG1; 
          ELSE BEGIN
               IF GET(DN$TYPE,DNAT$,REG1) EQ INDXDATA 
               THEN REG2 = SRAUTOVARY;
               ELSE BEGIN 
                    NG($ADD); 
                    LATTEMP = 1;
                    NG(CREATELDL(REG1,1));
                    NG(SEARCHSTACK[0]); 
                    NG(SEARCHSTACK[0]); 
                    GOTO SAUTOVARYGEN;
                    END 
               END
          NG($SET); 
          NG($SETUPBY); 
          LATTEMP = 1;
          NG(CREATELDL(REG2,1));
          NG(SEARCHSTACK[0]); 
SAUTOVARYGEN: 
          NG($SET); 
          NG($SETUPBY); 
          LATTEMP = 1;
          REG1 = SRAUTOVARY;
          NG(CREATELDL(REG1,1));
          NGDATAREF(SRAUTOVARY);
         NGLABELDEF (SRADDRESS);
         RETURN;
  
SUB5: 
#SEARCH EPILOGUE# 
          #LOOP#
          NGGOTO; 
         NGLABELREF (SAVE$ADDRESS, 0);
          RETURN; 
  
SUB49:  
#SAVE IDENTIF DESCRIP SRCHALL PROLOGUE# 
         B<00,20>TEMP$1 = VALUE$; 
         B<20,20>TEMP$1 = LINE$;
         B<40,20>TEMP$1 = COLUMN$;
         PUSH$SRCHALL;
         SRENDADDRESS = 0;
         SRADDRESS = 0; 
         RETURN;
  
SUB50:  
#RESTORE INDENTIF DESCRIP#
         POP$SRCHALL; 
         VALUE$ = B<00,20>TEMP$1; 
         LINE$ = B<20,20>TEMP$1;
         COLUMN$ = B<40,20>TEMP$1;
         RETURN;
  
SUB51:  
#RESTORE SEARCH ALL ADDRESSES#
         POP$SRCHALL; 
         SRADDRESS = B<0,30>TEMP$1; 
         SRENDADDRESS = B<30,30>TEMP$1; 
         RETURN;
SUB6: 
#SEARCH ALL TABLE R#
          SRTEMP = 0; 
          #TO BE OK, THE IDENT MUST HAVE AN OCCURS--INDEXED BY# 
          #CLAUSE AND AT LEAST ONE KEY# 
          IF GET(DN$TYPE,DNAT$,VALUE$) EQ ERRTYPE 
          THEN GOTO SEARCHERROR1; 
          IF GET(DN$OCCURS,DNAT$,VALUE$) EQ 0 
          THEN GOTO SEARCHERROR;
          IF GET(DN$INDEXED,DNAT$,VALUE$) EQ 0
          THEN BEGIN
               ERROR(SEVERE,501,LINE$,COLUMN$); 
               GOTO SEARCHDIDDLE; 
               END
          REG1 = GET(DN$AUXREF,DNAT$,VALUE$); 
          IF FINDAUX(KEYNAME,REG1)  EQ 0 AND
             FINDAUX(KEYGRNAM,REG1) EQ 0
          THEN BEGIN
               ERROR(SEVERE,513,LINE$,COLUMN$); 
               GOTO SEARCHERROR1; 
               END
          SRSTATUS = 0; 
          CONDTYPE = $LESS; 
          SRTEMP = VALUE$;
          SRMOSTMINOR = 0;
          GOTO SEARCHDIDDLE;
SUB7: 
#SEARCH ALL AT END R# 
          SRADDRESS = NEXTPNAT; 
          #BRANCH AROUND AT END#
          NGGOTO; 
          NGLABELREF(SRADDRESS,0);
          SRENDADDRESS = NEXTPNAT;
          NGLABELDEF(SRENDADDRESS); 
         B<0,30>TEMP$1 = SRADDRESS; 
         B<30,30>TEMP$1 = SRENDADDRESS; 
         PUSH$SRCHALL;
          RETURN; 
SUB8: 
#SEARCH ALL INIT R# 
          #SYNTAX ONLY IF THIS SEARCH CONTAINED A NESTED SEARCH#
          IF F17 EQ 0 
          THEN BEGIN
               SRSTATUS = 1;
               RETURN;
               END
          IF SRENDADDRESS NQ 0
          THEN BEGIN
               NSFLAG = 1;
               NGGOTO;
               NGLABELREF(ENDADDRESS,0);
               NGLABELDEF(SRADDRESS); 
               END
          SRUPPER = NEXTTEMP; 
          REG1 = SRUPPER; 
          SET(DN$TYPE,DNAT$,REG1,BINARY); 
          SET(DN$ITMLEN,DNAT$,REG1,10); 
          SET(DN$NUMLEN,DNAT$,REG1,5);
          LOCALTEMP(REG1);
          REG2 = NEXTTEMP;
         COPYD4 (REG1,REG2);
          LOCALTEMP(REG2);
          SRLOWER = REG2; 
          REG2 = NEXTTEMP;
         COPYD4 (REG1,REG2);
          LOCALTEMP(REG2);
          SRMIDPOINT = REG2;
          LATTEMP = 1;
          NGMOVE; 
          REG1 = SRLOWER; 
          NG(CREATELDL(REG1,1));
          SET(L$VCODE,LAT$,LATLENGTH,2);
          NGDATAREF(SRLOWER); 
          NGMOVE; 
          REG1 = GET(DN$AUXREF,DNAT$,SRTEMP); 
          IF GET(DN$DEP,DNAT$,SRTEMP) EQ 1
          THEN BEGIN
               REG2 = FINDAUX(VAROCCUR,REG1); 
               REG3 = GET(AX$DEPNAM,AUX$,REG2); 
               NGDATAREF(REG3); 
               END
          ELSE BEGIN
               FIX1 = FINDAUX(MAXOCCUR,REG1); 
               LATTEMP = GET(AX$MAXOCCNO,AUX$,FIX1);
               REG1 = SRUPPER;
               NG(CREATELDL(REG1,1)); 
               SET(L$VCODE,LAT$,LATLENGTH,2); 
               END
          NGDATAREF(SRUPPER); 
          #SAVE S OF 1ST SUBJECT# 
          S = 0;
          S$ = 0; 
          SRDELIMITER = 0;
          SRSUBJECT1 = 1; 
          SRSUBJECT2 = 1; 
          RETURN; 
SUB10:  
#SEARCH ALL SUBJECT R#
          #THE SUBJECT OF A CONDITION IS IN STACK#
          SRDELETEFLAG = 0; 
          IF SRSTATUS EQ 1  THEN RETURN;
          IF GET(DN$TYPE,DNAT$,TABLENAME) EQ ERRTYPE
          THEN BEGIN
               SRDELETEFLAG = 1;        #DELETE ONLY CURRENT# 
               GOTO SEARCHFORIDX;       #CONDITION# 
               END
          #CHECK THAT THE SUBJECT IS A KEY OF THE TABLE BEING SEARCHED# 
          REG1 = GET(DN$AUXREF,DNAT$,TABLENAME);
          FOR $DUMMY$ = 0 WHILE REG1 NQ 0 
          DO   BEGIN
               IF GET(AX$TTYPE,AUX$,REG1)  EQ KEYGRNAM  AND 
                  GET(AX$OCCNAM,AUX$,REG1) EQ SRTEMP
               THEN GOTO SEARCHKEYOK; 
               REG1 = GET(AX$TNEXTPTR,AUX$,REG1); 
               END
          #DID NOT FIND IT# 
          ERROR(SEVERE,514,TABLELINE,TABLECOLUMN);
          SRDELETEFLAG = 1; 
          RETURN; 
SEARCHKEYOK:  
          #PUT SPECIAL DELIMITER INTO STACK CONTAINING:#
          # - S$ OF PREVIOUS DELIMITER ATOM#
          # - HIERARCHY NUMBER OF CURRENT KEY(1 IS MAJOR)#
          # - ORDER OF CURRENT KEY ( 0 - DESCENDING, 1 - ASCENDING)#
          S = S + 1;
          XTCODE(S,SRDELIMITER);
          XTPOINTER(S,GET(AX$HIERCNT,AUX$,REG1)); 
          REG2 = GET(AX$ORDER,AUX$,REG1); 
          XTSUBCODE(S,REG2);
          S$ = S$ + 1;             #SAVE S$ OF CURRENT DELIMITER ATOM#
          SRDELIMITER = S$; 
          SROBJECT = S + 1;        #SAVE S OF THE COMING OBJECT#
          #IF CURRENT KEY IS MOST MINOR SO FAR SAVE ITS HIERARCHY#
          #AND ITS S (TO GET LINE AND COLUMN FOR DIAGNOSTICS)#
          IF GET(AX$HIERCNT,AUX$,REG1) GR SRMOSTMINOR 
          THEN BEGIN
               SRMOSTMINOR = GET(AX$HIERCNT,AUX$,REG1); 
               MOSTMINORS  = SRSUBJECT1;
               END
          #NOW VERIFY THAT THIS KEY IS INDEXED BY THE FIRST INDEX-NAME# 
          #ASSOCIATED WITH THE TABLE# 
SEARCHFORIDX: 
          FOR REG1 = SRSUBJECT1 STEP 1 UNTIL S - 1
          DO   BEGIN
               IF TCODE(REG1)    EQ GDATAREF  AND 
                  TPOINTER(REG1) EQ SRTEMP + 1
               THEN RETURN; 
               END
          ERROR(SEVERE,515,TABLELINE,TABLECOLUMN);
          RETURN; 
SUB11:  
#SEARCH ALL CONDITION R#
          IF SRSTATUS EQ 1  THEN RETURN;
          IF SRDELETEFLAG EQ 1    #SUBJECT WAS BAD SO DELETE# 
          THEN  BEGIN 
               #THIS CONDITION# 
               S = SRSUBJECT1 - 1;
               S$ = SRSUBJECT2 - 1; 
               OPERAND1 = 0;  #DISABLE ATTRIBUTE CHECKING#
               RETURN;
               END
          FOR REG1 = 0 STEP 1 UNTIL FL
               #OUTPUT TEXT FOR AN EXPRESSION IF ANY# 
               DO NG(FORMULA(REG1));
          FL = -1;
          OPERAND1 = STACK(SRSUBJECT1); 
          OPERAND2 = STACK(SROBJECT); 
          SRSUBJECT1 = S + 1; 
          SRSUBJECT2 = S$ + 1;
          #ATTRIBUTES WILL BE CHECKED BY A ROUTINE IN SET2# 
          RETURN; 
SUB9: 
#SEARCH ALL WRAP UP R#
          IF SRSTATUS EQ 1  THEN RETURN;
          REG1 = NEXTPNAT;                 #LOOP ADDR#
          NGGOTO; 
          NGLABELREF(REG1,0); 
          REG2 = NEXTPNAT;                 #GO-UP ADDR# 
          NGLABELDEF(REG2); 
          #CREATE ATOMS FOR 1, U-BOUND, L-BOUND, MIDPOINT#
          REG3 = SRMIDPOINT;
          LATTEMP = 1;
          FIX1 = CREATELDL(REG3,1); 
          FIX2 = GTX(GDATAREF,SRUPPER,0); 
          FIX3 = GTX(GDATAREF,SRLOWER,0); 
          FIX4 = GTX(GDATAREF,SRMIDPOINT,0);
          NG($ADD);               #MID + 1 -> L-BOUND#
          NG(FIX1); 
          NG(FIX4); 
          NG(FIX3); 
          NGGOTO; 
          NGLABELREF(REG1,0); 
          SEARCHSTACK[0] = REG2;       #SAVE GO-UP ADDR#
          REG2 = NEXTPNAT;              #GO-DOWN ADDR#
          NGLABELDEF(REG2); 
          SEARCHSTACK[1] = REG2;
          NG($SUBTRACT);              #MID - 1 -> U-BOUND#
          NG(FIX4); 
          NG(FIX1); 
          NG(FIX2); 
          NGLABELDEF(REG1); 
          NG($GREATER);              #TERMINAL CONDITION# 
          NG(FIX3); 
          NG(FIX2); 
          IF SRENDADDRESS EQ 0
          THEN BEGIN
               NSFLAG = 1;
               REG1 = ENDADDRESS; 
               END
          ELSE REG1 = SRENDADDRESS; 
          NGLABELREF(REG1,GTRUE); 
          NG($ADD);          #(U-BOUND + L-BOUND)/2 -> MID# 
          NG(FIX2); 
          NG(FIX3); 
          NG(FIX4); 
          NG($DIVIDE);
          NG(FIX4); 
          LATTEMP=2;
          FIX1 = CREATELDL(REG3,1); 
          NG(FIX1); 
          NG(FIX4); 
          NG($SET);       #SET INDEX TO MID#
          NG($SETTO); 
          NG(FIX4); 
          NGDATAREF(SRTEMP+1);
          SRSTATUS = 0; 
          FOR REG1 = 1 STEP 1 UNTIL SRMOSTMINOR 
          DO   BEGIN
               #OUTPUT COMPARES IN ORDER OF MAJOR TO MINOR# 
               REG2 = SRDELIMITER;            #LAST DELIM ATOM# 
               FOR $DUMMY$ = 0 WHILE REG2 NQ 0
               DO   BEGIN 
                    REG3 = RETRIEVE(REG2);
                    IF TPOINTER(REG3) EQ REG1 
                    THEN BEGIN
                         REG4 = REG2 - 1;       #S$ OF SUBJECT# 
                         OPERAND1 = RETRIEVE(REG4); 
                         REG4 = REG2 + 1; 
                         OPERAND2 = RETRIEVE(REG4); 
                         #IF OPERAND2 IS AN ARITHMETIC EXPRESSION,# 
                         #CHANGE THE RESULTTEMP TO A GLOBAL TEMP.#
                         IF TCODE(OPERAND2) EQ GDATAREF 
                         THEN BEGIN 
                              REG5 = TPOINTER(OPERAND2);
                              IF GET(DN$LEVEL,DNAT$,REG5) EQ TEMPLEVL 
                              THEN BEGIN  #IT IS AN EXPRESSION SO NOW#
                                   #FORCE PROC GLOBALTEMP TO ALLOCATE#
                                   #ONE WORD.                        #
                                   SET(DN$ITMLEN,DNAT$,REG5,10);
                                   GLOBALTEMP(REG5);
                                   SET(DN$TYPE,DNAT$,REG5,COMP2); 
                                   END
                              END 
                         NG($COMPARE);
                         NGSTACK(OPERAND1); 
                         NGSTACK(OPERAND2); 
                         FIX1 = SEARCHSTACK[TSUBCODE(REG3)];
                         NGLABELREF(FIX1,GTRUE);
                         FIX1 = SEARCHSTACK[1 - TSUBCODE(REG3)];
                         NGLABELREF(FIX1,GTRUE);
                         GOTO SEARCHKEYD; 
                         END
                    ELSE REG2 = TCODE(REG3);      #S$ OF NEXT DELIM#
                    END  #INNER LOOP# 
               #NO COND FOR THIS KEY# 
               IF SRSTATUS EQ 0 
               THEN BEGIN 
                    SRSTATUS = 1; 
                    ERROR(SEVERE,516,LINE(MOSTMINORS),
                         COLUMN(MOSTMINORS)); 
                    END 
SEARCHKEYD: 
               END #OUTER LOOP# 
          RETURN; 
SUB20:  
#USE AFTER INPUT# 
          INPUTDECL = 1;
         REG1 = AUXINPUTDCL;
         GOTO ATTACHAUXE; 
SUB21:  
#USE AFTER OUTPUT#
          OUTPUTDECL = 1; 
          REG1 = AUXOUTPUTDCL;
          GOTO ATTACHAUXE;
SUB22:  
#USE AFTER EXTEND#
          EXTENDDECL = 1; 
          REG1 = AUXEXTENDDCL;
          GOTO ATTACHAUXE;
SUB23:  
#USE AFTER I O# 
          IODECL = 1; 
          REG1 = AUXIODCL;
          GOTO ATTACHAUXE;
SUB24:  
#USE AFTER FILE NAME# 
          IF GET(DN$LEVEL,DNAT$,VALUE$) EQ FDDESCR
          THEN BEGIN
               FIX1 = GET(DN$FNATPTR,DNAT$,VALUE$); 
               SET(FN$ERRPTR,FNAT$,FIX1,LASTSDEF);
               END
          ELSE  BEGIN 
                ERROR(SEVERE,810,LINE$,COLUMN$);
                RETURN; 
                END 
          REG1 = AUXFILEDCL;
ATTACHAUXE: 
          #ADD AN AUX ENTRY TO THE LIST ATTACHED TO THE USE PROC.#
          AUXTLENGTH = AUXTLENGTH +1; 
          SET(AX$TTYPE,AUX$,AUXTLENGTH,REG1); 
          IF GET(PN$AUXREF,PNAT$,LASTSDEF) EQ 0 
          THEN  BEGIN 
                SET(PN$AUXREF,PNAT$,LASTSDEF,AUXTLENGTH); 
                SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,0); 
                END 
          ELSE  BEGIN 
                #APPEND TO FRONT OF LIST# 
                TEMP1 = GET(PN$AUXREF,PNAT$,LASTSDEF);
                SET(PN$AUXREF,PNAT$,LASTSDEF,AUXTLENGTH); 
                SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,TEMP1); 
                END 
         IF REG1 EQ AUXFILEDCL OR REG1 EQ AUXREALMNAME
          THEN SET(AX$TFIRST,AUX$,AUXTLENGTH,VALUE$); 
          RETURN; 
SUB18:  
#FIPS USE AFTER FILE-NAME SERIES ROUTINE                               #
          IF CCTFIPSLEVEL LS 4
          THEN
              BEGIN 
              REG1 = GET(DN$FNATPTR,DNAT$,VALUE$);
              REG2 = GET(FN$ORG,FNAT$,REG1);
              IF REG2 EQ INDEXED
              THEN
                  BEGIN 
#                 FIPS = 4 SUPPORTS USE AFTER FILE-NAME SERIES FOR     #
#                 INDEXED FILE ORGANIZATIONS                           #
                  ERROR(TRIVIAL,D833,LINE$,COLUMN$);
                  RETURN; 
                  END 
              IF CCTFIPSLEVEL LS 3
              THEN
                  BEGIN 
                  IF REG2 EQ SEQUENTIAL 
                  THEN
                      BEGIN 
#                     FIPS = 3 SUPPORTS USE AFTER FILE-NAME SERIES FOR #
#                     SEQUENTIAL FILE ORGANIZATIONS                    #
                      ERROR(TRIVIAL,D834,LINE$,COLUMN$);
                      RETURN; 
                      END 
                  IF REG2 EQ RELATIVE 
                  THEN
                      BEGIN 
#                     FIPS = 3 SUPPORTS USE AFTER FILE-NAME SERIES FOR #
#                     RELATIVE FILE ORGANIZATIONS                      #
                      ERROR(TRIVIAL,D835,LINE$,COLUMN$);
                      END 
                  END 
              END 
          RETURN; 
SUB19:  
#USING IDENTIFIER ROUTINE#
          IF STACK(S)  EQ SUBMARKER 
          THEN  S = STACK(S-1)-1; 
          IF GET(DN$TYPE,DNAT$,TPOINTER(S)) NQ ERRTYPE
          THEN  BEGIN 
              IF  NOT CCTSUBPROGR  THEN 
                  ERROR(TRIVIAL,890,TABLELINE,TABLECOLUMN); 
               IF GET(DN$MAJMSEC,DNAT$,TPOINTER(S)) NQ LINKMSEC 
               THEN  ERROR(SEVERE,888,TABLELINE,TABLECOLUMN); 
               ELSE BEGIN 
                    FIX1 = GET(DN$LEVEL,DNAT$,TPOINTER(S)); 
                    IF FIX1 EQ 1 OR FIX1 EQ 77
                    THEN BEGIN
                         FOR REG1 = G STEP -2 UNTIL G - 2*PARAMCOUNT
                         DO  BEGIN
                             IF GETGT(REG1) EQ STACK(S) 
                             THEN BEGIN 
                                  ERROR(SEVERE,889,TABLELINE, 
                                        TABLECOLUMN); 
                                   RETURN;
                                   END
                              END 
                         MAXPDUSINGID = MAXPDUSINGID + 1; 
                         # STACK THE USING IDENTIFIERS DNAT POINTERS   #
                         XCOMMONSTACK(MAXPDUSINGID,TPOINTER(S));
                         PARAMCOUNT=PARAMCOUNT + 1; 
                         NGGTX(GVERB,PARAMCOUNT,GFPARAM); 
                         NGSTACK(S);
                         END
                    ELSE  ERROR(SEVERE,886,TABLELINE,TABLECOLUMN);
                    END 
               END
          S=S-1;
          S$=S$-1;
          RETURN; 
SUB14:  
#DECLARATIVES ROUTINE#
          PDADDRESS = NEXTPNAT; 
          NGGOTO; 
          NGLABELREF(PDADDRESS,0);
          RETURN; 
SUB15:  
#END DECLARATIVES ROUTINE#
          IF DPROCEND  NQ 0 
          THEN BEGIN
               NGLABELDEF(DPROCEND);
               DPROCEND=0;
               END
          IF CCTDEBUGMODE[0]
          THEN DEBUGFLAG = 1; 
          RETURN; 
SUB17:  
#END DECLARATIVES LABEL#
         IF PDADDRESS NQ 0
         THEN BEGIN 
              #THE BRANCH AROUND DECLARATIVES COMES HERE# 
              #WE ARE INSIDE THE COMPILER GENERATED SECTION#
              #WHICH REPRESENTS THE END DECLARATIVES BOUNDARY#
              NGLABELDEF(PDADDRESS);
              PDADDRESS = 0;
              END 
SUB25:  
#SET ROUTINE# 
          VD; 
          #ASSUME IT WILL BE FORMAT 1#
          FORMAT = 0; 
          SUBVERB= $SETTO;
          RETURN; 
         CNSOFAR = 0; 
SUB26:  
#SET UP BY ROUTINE# 
          FORMAT = 1; 
          SUBVERB= $SETUPBY;
          RETURN; 
SUB27:  
#SET DOWN BY ROUTINE# 
          FORMAT = 1; 
          SUBVERB= $SETDOWNBY;
          RETURN; 
SUB30:  
#SET EPILOGUE 1#
          #SENDING FIELD IS AN IDENTIFIER#
          #DETERMINE THE SENDING FIELD KEY# 
          # 0 - ERROR TYPE                       #
          # 1 - INDEX NAME                       #
          # 2 - INDEX DATA NAME                  #
          # 3 - ELEMENTARY INTEGER DATA NAME     #
          # 4 - OTHER                            #
          # 5 - (NOT USED)                       #
          # 6 - (NOT USED)                       #
          # 7 - (NOT USED)                       #
          # NOTE, NON-ZERO BYTES BELOW REPRESENT ERROR MESSAGES # 
          REG1 = SETKEY(TABLENAME); 
          FIX3 = 8 * REG1;
          IF FORMAT EQ 0
          THEN FIX1 =  X"00 00 00 00 8D 00 00 0"; 
          ELSE FIX1 =  X"00 9A 9A 00 9A 00 00 0"; 
          FIX1 = B<FIX3,8> FIX1;
          IF FIX1 NQ 0
          THEN BEGIN
               ERROR(SEVERE,FIX1,TABLELINE,TABLECOLUMN);
               IF FORMAT EQ 0 
               THEN REG1 = 0;       #FORMAT 1 ERROR#
               ELSE REG1 = 5;       #FORMAT 2#
               END
          #SF SUBSCRIPTS TO GTEXT#
          REG2 = REMOVE(1); 
          SFLIT = 0;
          REG2 = STACK(REG2); 
          GOTO SETLOOP; 
SUB31:  
#SET EPILOGUE 2#
          #SENDING FIELD IS A LITERAL. CLASSIFY LITERAL#
          PLTPTR = LATTEMP; 
          REG3 = GET(PL$CODE,PLT$,PLTPTR);
          IF REG3 EQ PLTFGCONZERO 
          THEN REG1 = 0;
          ELSE  IF REG3 EQ PLTINTLIT
                THEN BEGIN
                     IF GET(PL$SIGNFLAG,PLT$,PLTPTR) EQ 1 
                     THEN REG1 = 1; 
                     ELSE REG1 = 2; 
                     END
                ELSE REG1 = 3;
          #KEYS FOR LITERAL SENDING FIELDS# 
          # 0 - FIGURATIVE CONSTANT ZERO     #
          # 1 - POSITIVE OR UNSIGNED ILIT    #
          # 2 - NEGATIVE ILIT                #
          # 3 - OTHER                        #
          # 4 - (NOT USED)                   #
          # 5 - (NOT USED)                   #
          # 6 - (NOT USED)                   #
          # NOTE, BYTES BELOW REPRESENT ERROR MESSAGES #
          FIX3 = 8 * REG1;
          IF FORMAT EQ 0
          THEN FIX1 =  X"99 00 99 98 00 00 00 0"; 
          ELSE FIX1 =  X"00 00 00 98 00 00 00 0"; 
          FIX1 = B<FIX3,8> FIX1;
          IF FIX1 NQ 0
          THEN BEGIN
               ERROR(SEVERE,FIX1,LINE(S),COLUMN(S));
               IF FORMAT EQ 0 
               THEN REG1 = 0;          #FORMAT 1 ERROR# 
               ELSE REG1 = 5;          #FORMAT 2# 
               END
          ELSE BEGIN
               IF FORMAT EQ 0 
               THEN  REG1 = 4;           #FORMAT 1 LIT# 
               ELSE  REG1 = 5;           #FORMAT 2# 
               END
          SFLIT = 1;
          REG2 = REMOVE(1); 
          REG2 = STACK(REG2); 
SETLOOP:  
          FIRSTTIME = 1;
          #LOOP THRU REC FIELDS IN STACK# 
          #REG1 IS SF KEY#
          #REG2 IS SF ATOM. IF ITS A LITERAL THEN NEW LATS# 
          #MUST BE CREATED FOR 2ND, 3RD,... REC FIELDS# 
          #REG3 IS LOOP CONTROL#
          #REG4 IS STACK POINTER TO REC FIELD#
          #REG5 IS DNAT POINTER OF REC FIELD# 
          #REG6 IS KEY OF REC FIELD#
          FOR REG3 = 1 STEP 1 UNTIL S$
          DO   BEGIN
               #SUBSCRIPTS OF RF TO GTEXT#
               REG4 = RETRIEVE(REG3); 
               FIX2 = TPOINTER(REG4); 
               REG5 = FIX2; 
               #DIAGNOSE SF VS. RF# 
               # THE SFRFKEY MATRIX OF ERROR MESSAGES           # 
               # THE FIRST INDEX IS A COMBINATION OF THE        # 
               # SENDING FIELD TYPE AND THE STATEMENT TYPE      # 
               # 0 - FORMAT 1 ERROR                             # 
               # 1 - FORMAT 1 INDEX NAME                        # 
               # 2 - FORMAT 1 INDEX DATA NAME                   # 
               # 3 - FORMAT 1 ELEMENTARY INTEGER DATA NAME      # 
               # 4 - FORMAT 2                                   # 
               # SECOND INDEX ... THE RECEIVING FIELD KEY       # 
               # 0 - ERROR TYPE                                 # 
               # 1 - INDEX NAME                                 # 
               # 2 - INDEX DATA ITEM                            # 
               # 3 - ELEMENTARY INTEGER DATA ITEM               # 
               # 4 - OTHER                                      # 
               #                                                # 
               REG6 = SETKEY(FIX2); 
               FIX3 = 6 * REG6 + REG1;
               FIX1 = BYTE(SFRFKEYSTR,FIX3);
               IF FIX1 NQ 0 
               THEN BEGIN 
                    ERROR(SEVERE,FIX1,LINE(REG4),COLUMN(REG4)); 
                    GOTO ENDSETLOOP;
                    END 
               NG($SET);
               NG(SUBVERB); 
               #OUTPUT SF#
              IF SFLIT EQ 1 
              THEN
                   IF FIRSTTIME EQ 1
                   THEN BEGIN 
                        #DNATLENGTH POINTS TO THE COMPILER GENERATED# 
                        #LITERAL, COPY 1ST RF DNAT TO IT.           # 
         COPYD4 (REG5,DNATLENGTH);
                        SET(DN$LEVEL,DNAT$,DNATLENGTH,LITLEVL); 
                        FIRSTTIME = 0;
                        END 
                   ELSE 
                        REG2 = CREATELDL(REG5,0); 
               NG(REG2);
               #OUTPUT RF#
               NGSTACK(REG4); 
ENDSETLOOP: 
               END
          RETURN; 
SUB28:  
#SET ON R#
          SUBVERB = $SETON; 
          GOTO SETONOFFR; 
SUB29:  
#SET OFF R# 
          SUBVERB = $SETOFF;
SETONOFFR:  
          FOR REG1 = 1 STEP 1 UNTIL S$
          DO   BEGIN
               REG2 = RETRIEVE(REG1);    #REG2 = STACK PTR OF SW. NAME# 
               REG3 = TPOINTER(REG2);    #REG3 = DNAT PTR OF SW.NAME# 
               IF GET(DN$TYPE,DNAT$,REG3) EQ ERRTYPE
               THEN FREEZEFLAG = 0; 
               ELSE BEGIN 
                    IF GET(DN$LEVEL,DNAT$,REG3) NQ MNEMNAME 
                       OR 
                       GET(DN$SWITCH,DNAT$,REG3) NQ 1 
                    THEN  ERROR(SEVERE,299,LINE(REG2),COLUMN(REG2));
                    ELSE BEGIN
                         NG($SETSWITCH);
                         NG(SUBVERB); 
                         NGSTACK(REG2); 
                         END
                    END 
               END
          S = 0;
          S$ = 0; 
          RETURN; 
SUB37:  
#SET ALL FILES R# 
          FOR REG1 = 1 STEP 1 UNTIL CCTFNATLEN
          DO   BEGIN
               REG2 = GET(FN$DNATPTR,FNAT$,REG1); 
              IF GET(DN$CODEILL,DNAT$,REG2) EQ 1
               THEN  ERROR(SEVERE,346,LINE$,COLUMN$); 
               ELSE BEGIN 
                    S = S + 1;
                    S$ = S$ + 1;
                    XSTACK(S,GTX(GFILEREF,REG1,0)); 
                    END 
               END
          RETURN; 
SUB39:  
#SET FILE NAME R# 
          IF GET(DN$LEVEL,DNAT$,VALUE$) NQ FDDESCR
          THEN  ERROR(SEVERE,142, LINE$,COLUMN$); 
         ELSE IF GET(DN$CODEILL,DNAT$,VALUE$) EQ 1
               THEN 
                    ERROR(SEVERE,346,LINE$,COLUMN$);
          ELSE BEGIN
               S = S + 1; 
               S$ = S$ + 1; 
               FIX1 = GET(DN$FNATPTR,DNAT$,VALUE$); 
               XSTACK(S,GTX(GFILEREF,FIX1,0));
               END
          RETURN; 
SUB32:  
#SET SORT R#
          SUBVERB = $SETSORT; 
          RETURN; 
SUB33:  
#SET MERGE R# 
          SUBVERB = $SETMERGE;
          RETURN; 
SUB34:  
#SET SORT MERGE R#
          SUBVERB = $SETSM; 
          RETURN; 
SUB36:  
#SET CODE SET R#
          SUBVERB = $SETCODESET;
          RETURN; 
SUB35:  
#SET PROGRAM R# 
          SUBVERB = $SETPROGRAM;
          #SET CCT INDICATOR FOR VARIABLE PROGRAM COLLATING SEQUENCE# 
          CCTHILO[0] = TRUE;
          RETURN; 
SUB38:  
#SET EPILOGUE 3#
          IF GET(DN$TYPE,DNAT$,TABLENAME) EQ ERRTYPE
          THEN BEGIN
               FREEZEFLAG = 0;
               RETURN;
               END
          IF GET(DN$LEVEL,DNAT$,TABLENAME) NQ ALPHNAME
          THEN BEGIN
               ERROR(SEVERE,150,TABLELINE,TABLECOLUMN); 
               RETURN;
               END
          IF SUBVERB NQ $SETCODESET 
          THEN BEGIN
               #ITS A COLLATING SEQUENCE# 
               NG($SETALPHABET);
               NG(SUBVERB); 
               NGSTACK(1);
               END
          ELSE BEGIN
               IF GET(DN$ANTYPE,DNAT$,TABLENAME) NQ ANUNI 
               THEN BEGIN 
                    ERROR(SEVERE,393,TABLELINE,TABLECOLUMN);
                    RETURN; 
                    END 
               REG2 = REMOVE(0);
               FOR REG1 = 1 STEP 1 UNTIL S$ 
               DO   BEGIN 
                    NG($SETALPHABET); 
                    NG(SUBVERB);
                    NGSTACK(REG2);
                    NGSTACK(REG1);
                    END 
               END
          RETURN; 
SUB40:  
#USE ACCESS CONTROL I-O#
         ACMODE = 1;
         RETURN;
SUB41:  
#USE ACCESS CONTROL INPUT#
         ACMODE = 0;
         RETURN;
SUB42:  
#USE ACCESS CONTROL INPUT I-O#
         ACMODE = 2;
         RETURN;
SUB43:  
#USE ACCESS CONTROL REALMS# 
         # SEARCH THE FNAT #
         # LOCATE ALL REALM-NAMES # 
         # PUT EACH REALM-NAME INTO THE STACK # 
         S = 0; 
         FOR I = 1
         STEP 1 
         UNTIL CCTFNATLEN 
         DO BEGIN 
            IF GET(FN$SSCHEMA,FNAT$,I) EQ 1 
            THEN BEGIN
                 PROCESSREALM(I); 
                 END
            END 
         RETURN;
SUB44:  
#USE ACCESS CONTROL REALM-NAME# 
         REG1 = REALMTEST;
         IF REG1 EQ 0 
         THEN RETURN; 
         PROCESSREALM(REG1);
         RETURN;
SUB45:  
# USE DEADLOCK REALMS # 
         CONTROL IFNQ CB5$CDCS,"CDCS2"; 
         # THE USE FOR DEADLOCK DECLARATIVE IS #
         # NOT SUPPORTED IN THIS VERSION OF THE COMPILER #
         ERROR(SEVERE,560,VERBLINE,VERBCOLUMN); 
         RETURN;
         CONTROL FI;
         REG1 = AUXREALMS;
         GOTO ATTACHAUXE; 
SUB46:  
# USE DEADLOCK REALM-NAME # 
         CONTROL IFNQ CB5$CDCS,"CDCS2"; 
         # THE USE FOR DEADLOCK DECLARATIVE IS #
         # NOT SUPPORTED IN THIS VERSION OF THE COMPILER #
         ERROR(SEVERE,560,VERBLINE,VERBCOLUMN); 
         RETURN;
         CONTROL FI;
         REG2 = REALMTEST;
         IF REG2 EQ 0 
         THEN RETURN; 
         REG1 = AUXREALMNAME; 
         GOTO ATTACHAUXE; 
SUB47:  
# USE ACCESS CONTROL EPILOGUE # 
  
         # THE USE FOR ACCESS CONTROL STATEMENT # 
         # IS ACTUALLY EXECUTED # 
  
         # THIS IS GENERALLY NOT TRUE FOR OTHER DECLARATIVES #
  
         # THE CODE CONSISTS OF A PERFORM STATEMENT TO #
         # PERFORM THE DECLARATIVE SECTION FOLLOWED BY AN # 
         # ENTER STATEMENT TO CALL THE PRIVACY CHECKING # 
         # ROUTINE #
  
         # IN ADDITION, THERE IS A COMPILER GENERATED # 
         # BRANCH AROUND THE PERFORM AND ENTER #
         # SO THAT THEY CANNOT BE EXECUTED BY # 
         # PERFORMING THE DECLARATIVE FROM THE SOURCE # 
         # PROGRAM #
  
         # THE NORMAL BRANCH AROUND THE DECLARATIVES #
         # WILL BE DEFINED TO LAND UPON THE PERFORM # 
         # STATEMENT AND A NEW BRANCH AROUND THE #
         # REMAINING DECLARATIVES WILL BE DEFINED AFTER # 
         # THE ENTER STATEMENT #
  
         # IN THIS WAY, THE USE FOR ACCESS CONTROL #
         # DECLARATIVE WILL BE PERFORMED AND THE #
         # PRIVACY CHECKING ROUTINE CALLED ONCE AND ONLY ONCE # 
         # PRIOR TO THE EXECUTION OF THE FIRST PROCEDURE #
         # DIVISION MAINLINE STATEMENT #
  
         CONTROL IFNQ CB5$CDCS,"CDCS2"; 
         # THE USE FOR ACCESS CONTROL DECLARATIVE IS NOT #
         # SUPPORTED IN THIS COMPILER # 
         ERROR(SEVERE,561,VERBLINE,VERBCOLUMN); 
         # DO NOT RETURN #
         # STILL HAVE TO RESOLVE BRANCHES # 
         CONTROL FI;
         IF PDADDRESS EQ 0
         THEN BEGIN 
              # THE USE FOR ACCESS CONTROL STATEMENT IS ONLY #
              # LEGAL IN THE DECLARATIVES PORTION OF THE PROCEDURE #
              # DIVISION #
              ERROR(SEVERE,556,VERBLINE,VERBCOLUMN);
              END 
         IF LASTSDEF EQ 0 
         THEN BEGIN 
              # THE USE FOR ACCESS CONTROL SECTION HEADER # 
              # IS MISSING #
              ERROR(SEVERE,557,VERBLINE,VERBCOLUMN);
              END 
         IF FREEZEFLAG EQ 0 
         THEN BEGIN 
              # AN ERROR HAS BEEN DETECTED #
              # DO NOT DEFINE ANY NEW GTEXT # 
              RETURN; 
              END 
         # GENERATE A BRANCH AROUND THE CODE WHICH FOLLOWS #
         BYPASS = NEXTPNAT; 
         NGGOTO;
         NGLABELREF(BYPASS,0);
         NGLABELDEF(PDADDRESS); 
         # PERFORM THE DECLARATIVE SECTION #
         NG($PERFORM);
         NGPROCREF(LASTSDEF,0); 
         NGPROCREF(LASTSDEF,0); 
         NGLABELREF((NEXTPNAT),0);
         NGLABELDEF(PNATLENGTH);
         IF CDMPVC EQ 0 
         THEN BEGIN 
              # SET UP C.DMPVC ENTRY POINT LITERAL #
              CCTPLTLEN = CCTPLTLEN + 1;
              SET(PL$CODE,PLT$,CCTPLTLEN,PLTQUOTEDLIT); 
              SET(PL$LENGTH,PLT$,CCTPLTLEN,7);
              SETPLST(CCTPLTLEN,LOC(CDMPVCSTRING)); 
              LATTEMP = CCTPLTLEN;
              CDMPVC = GTX(GLITREF,(NEXTLAT),0);
              SET(DN$TYPE,DNAT$,DNATLENGTH,ALPHNUM);
              SET(DN$ITMLEN,DNAT$,DNATLENGTH,7);
              # SET UP A LITERAL 1 #
              LATTEMP = 1;
              LITERAL1 = GTX(GLITREF,(NEXTLAT),0);
              SET(L$IMMEDIATE,LAT$,LATLENGTH,1);
              END 
         IF ACMODE EQ 1 
         THEN BEGIN 
              MODELITERAL = LITERAL1; 
              END 
         ELSE BEGIN 
              # SET UP MODE LITERAL # 
              LATTEMP = ACMODE; 
              MODELITERAL = GTX(GLITREF,(NEXTLAT),0); 
              SET(L$IMMEDIATE,LAT$,LATLENGTH,1);
              END 
         NG($ENTER);
         NG(CDMPVC);
         NG($NULL); 
         NGGTX(GSUBVERB,S+3,GCOUNT);
         NGGTX(GVERB,S+3,GPARAM); 
         NGDATAREF(ACKEY);
         NGGTX(GVERB,S+2,GPARAM); 
         NG(LITERAL1);
         NGGTX(GVERB,S+1,GPARAM); 
         NG(MODELITERAL); 
         FOR I = 1
         STEP 1 
         UNTIL S
         DO BEGIN 
            NGGTX(GVERB,S-I+1,GPARAM);
            NGSTACK(I); 
            END 
         # JUMP AROUND THE REMAINING DECLARATIVES # 
         PDADDRESS = NEXTPNAT;
         NGGOTO;
         NGLABELREF(PDADDRESS,0); 
         NGLABELDEF(BYPASS);
         RETURN;
SUB48:  
# USE ACCESS CONTROL KEY #
         IF GET(DN$TYPE,DNAT$,VALUE$) NQ ALPHNUM OR 
            GET(DN$ITMLEN,DNAT$,VALUE$) GR 30 
            THEN BEGIN
                 # A THIRTY CHARACTER ALPHANUMERIC DATA # 
                 # ITEM IS REQUIRED IN THE KEY IS DATA- # 
                 # NAME PHRASE OF THE USE FOR ACCESS CONTROL #
                 # STATEMENT #
                 ERROR(SEVERE,559,LINE$,COLUMN$); 
                 END
         ACKEY = VALUE$;
         RETURN;
          END #SET9#
          TERM
