*DECK SET5
USETEXT CCTTEXT 
USETEXT DNTEXT
USETEXT PPTEXT
    PROC SET5;
         CONTROL PACK;
         BEGIN
*CALL DPPPDDATA 
*CALL PPCOMMON2 
*CALL RCT 
*CALL AUXTVALS
*CALL DNATVALS
*CALL FNATVALS
*CALL PLTVALS 
*CALL GETSET
         SWITCH SUB    #SUB0#,
         SUB1 , SUB2 , SUB3 , SUB4 , SUB5 , 
         SUB6 , SUB7 , SUB8 , SUB9 , SUB10, 
         SUB11, SUB12, SUB13, SUB14, SUB15, 
         SUB16, SUB17, SUB18, SUB19, SUB20, 
              ,      , SUB23, SUB24, SUB25, 
         SUB26, SUB27;
    PROC CORR2; 
         BEGIN
         ITEM I I;
         #COPY SUBSCRIPT NUMBERS (IF ANY) TO THE CORRESPONDING PAIR#
         XTSUBCODE(S,TSUBCODE(S-2));
         XTSUBCODE(S-1,TSUBCODE(S-3));
         #NOW, EXAMINE EACH MEMBER OF THE CORRESPONDING PAIR# 
         FOR I = 0 STEP 1 UNTIL 1 DO BEGIN
              #DNAT OF THE PAIR ITEM# 
              REG1 = TPOINTER(S-I); 
              #DNAT OF ORIGINAL GROUP#
              REG2 = TPOINTER(S-I-2); 
              #IGNORE THE PAIR IF THE ITEM IS AN INDEX DATA ITEM# 
              IF REG1 EQ 0 OR REG2 EQ 0 
              THEN GOTO IGNOREPAIR; 
              IF GET(DN$TYPE,DNAT$,REG1) EQ INDXDATA
              THEN GOTO IGNOREPAIR; 
              GOTO L2;
L1: 
              #MINOR LOOP#
              #ARE WE SUBORDINATE TO AN ITEM THAT CONTAINS# 
              #REDEFINES OR OCCURS  # 
              #STOP WHEN WE REACH THE ORIGINAL GROUP# 
              #DO NOT TEST ORIGINAL GROUP#
              REG1 = REG1 - 1;
              IF REG1 EQ REG2 
              THEN GOTO BOTTOM; 
              #TEST FOR SUPERIOR ITEM#
              IF GET(DN$LEVEL,DNAT$,REG1) GQ REG3 
              THEN GOTO L1; 
L2: 
              #TEST PAIR (OR SUPERIOR) ITEM#
               FIX1 = GET(DN$OCCURS,DNAT$,REG1);
              IF GET(DN$RDEF,DNAT$,REG1) EQ 1 OR FIX1 EQ 1
              THEN GOTO IGNOREPAIR; 
              REG3 = GET(DN$LEVEL,DNAT$,REG1);
              GOTO L1;
BOTTOM: 
              END   #END OF DO CASE#
         GOTO L3; 
IGNOREPAIR: 
         TRUEFALSE = 0; 
L3: 
         RETURN;
         END   #CORR2#
         CONTROL EJECT; 
         # ----- SET 5 MAIN LINE BEGINS HERE -----# 
  
         GOTO  SUB[SUB$]; 
         #ACCEPTSWITCH = 0  -> MNEMONIC-NAME OR NULL# 
         #             = 1  -> DAY-OF-WEEK# 
         #             = 5  -> DAY# 
         #             = 6  -> DATE#
         #             = 8  -> TIME#
         #NOTE 1 - THE VALUE OF ACCEPTSWITCH ALSO#
         #REPRESENTS THE ITEM-LENGTH AND NUMERIC-LENGTH#
         #OF THE CONCEPTUAL DATA ITEMS DAY, DATE,#
         #TIME, AND DAY-OF-WEEK#
         #NOTE 2 - THE ERROR MESSAGES 2, 5, 26 AND THOSE# 
         #WHICH ORIGINATE IN MOVESTRING MAKE REFERENCE TO#
         #THE MOVE STATEMENT AND NOT THE ACCEPT STATEMENT#
         #THIS IS JUSTIFIED BECAUSE THE ACCEPT STATEMENT# 
         #SPECIFICATIONS INDICATE THAT THE MOVE STATEMENT#
         #RULES MUST BE OBEYED - IN THE FUTURE, WE MAY WISH#
         #TO DEFINE SEPARATE MESSAGES FOR THE ACCEPT STATEMENT# 
SUB1: 
# ACCEPT ROUTINE #
         VD;
         ACCEPTSWITCH = 0;
         RETURN;
SUB3: 
# ACCEPT DATE # 
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK(S,$DATE); 
         ACCEPTSWITCH = 6;
         RETURN;
SUB4: 
# ACCEPT DAY #
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK(S,$DAY);
         ACCEPTSWITCH = 5;
         RETURN;
SUB5: 
# ACCEPT TIME # 
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK(S,$TIME); 
         ACCEPTSWITCH = 8;
         RETURN;
SUB6: 
# ACCEPT DAY OF WEEK #
         S = S + 1; 
         S$ = S$ + 1; 
         XSTACK(S,$DAYOFWEEK);
         ACCEPTSWITCH = 1;
         RETURN;
SUB13:  
# ACCEPT EPILOGUE # 
         #REGISTER USAGE# 
              #REG1   RECEIVING FIELD ATOM# 
              #REG2   DNAT INDEX OF TEMP# 
              #REG3   STACK INDEX OF REAL RECEIVING FIELD#
         #IF THE SOURCE IS A SPECIAL SYSTEM QUANTITY, IT IS#
         #NECESSARY TO ACCEPT THE DATA INTO A TEMP AND THEN#
         #TO MOVE THE TEMP TO THE ACTUAL RECEIVING FIELD# 
         #A UNCHECKED POSSIBILITY OF OPTIMIZATION IS IF THE#
         #RECEIVING FIELD HAS THE CORRECT ATTRIBUTES IN WHICH#
         #CASE THE MOVE STATEMENT IS UNNECESSARY# 
         IF ACCEPTSWITCH  NQ  0 
         THEN BEGIN 
              #DATE, DAY, TIME, DAY-OF-WEEK#
              #GENERATE TEMP FOR RECEIVING FIELD# 
              REG1 = GTX(GDATAREF,(NEXTTEMP),0);
              REG2 = DNATLENGTH;
              SET(DN$TYPE,DNAT$,REG2,NUMERIC);
              SET(DN$ITMLEN,DNAT$,REG2,ACCEPTSWITCH); 
              SET(DN$NUMLEN,DNAT$,REG2,ACCEPTSWITCH); 
              SET(DN$POINT,DNAT$,REG2,0); 
              SET(DN$SIGNBIT,DNAT$,REG2,0); 
              END 
         ELSE BEGIN 
              #MNEMONIC-NAME OR NULL. SUBSCRIPTS (IF ANY) -> GTEXT# 
              REG1 = 1; 
              REG5 = RETRIEVE(REG1);
              REG7 = TPOINTER(REG5);
              REG1 = STACK(REG1); 
              REG8 = GET(DN$TYPE,DNAT$,REG7); 
              FIX1 = 0; 
              #INDEX DATA ITEM# 
              IF REG8 EQ 14 THEN FIX1 = 2;
              #INDEX-NAME#
              IF REG8 EQ 15 THEN FIX1 = 5;
              #NON-DATA ITEM# 
              IF REG8 EQ 18 THEN FIX1 = 26; 
              IF FIX1  NQ  0
              THEN  ERROR(SEVERE,FIX1,LINE(REG5),COLUMN(REG5)); 
              END 
         #OUTPUT VERB ATOM# 
         NG($ACCEPT); 
         #OUTPUT RECEIVING FIELD ATOM#
         NG(REG1);
         #OUTPUT SYSTEM REFERENCE#
         NGSTACK(S);
         IF ACCEPTSWITCH  NQ  0 
         THEN BEGIN 
              #DATE, DAY, TIME, DAY-OF-WEEK#
              #SUBSCRIPTS (IF ANY) -> GTEXT#
              REG3 = 1; 
              REG3 = RETRIEVE(REG3);
              #OUTPUT MOVE GTEXT# 
              NGMOVE; 
              NG(REG1); 
              NGSTACK(REG3);
              #DOES MOVE TEMP TO IDENTIFER FOLLOW#
              #THE RULES FOR THE MOVE STATEMENT  #
              OPERAND1 = REG1;
              KEY1 = MOVESKEY(OPERAND1);
              REG1 = TPOINTER(REG3);
              #CHEAT A LITTLE HERE GIVE MOVERKEY GOOD LINE AND COLUMN#
              #SO IT CAN DIAGNOSE INDEX-NAME, INDEX DATA# 
              #AND NON-DATA IF ENCOUNTERED# 
              XLINE(S,LINE(REG3));
              XCOLUMN(S,COLUMN(REG3));
              KEY2 = MOVERKEY(REG1);
              #IS THE KEY ITSELF OK  #
              IF KEY1 EQ 0 OR KEY2 EQ 0 
              THEN RETURN;
              REG1 = 7 * KEY1 + KEY2 - 8; 
              FIX1 = BYTE(MOVESTRING,REG1); 
              IF FIX1  NQ  0
              THEN ERROR(SEVERE,FIX1,LINE(REG3),COLUMN(REG3));
              END 
         RETURN;
SUB2: 
# ACCEPT MESSAGE #
         NG($ACCEPTMESS); 
         #OUTPUT CD NAME REFERENCE# 
         NGSTACK(S);
         RETURN;
SUB7: 
# ALTER ROUTINE # 
         VD;
         #THE PROGRAM CONTAINS AT LEAST ONE ALTER STATEMENT#
         CCTALTER[0] = TRUE;
         XSTACK(1,$ALTER);
         S = 1; 
         RETURN;
SUB9: 
# ALTER PN TO PN ROUTINE #
         #PNAT POINTER OF ORIGIN (GO TO)# 
         REG1 = TPOINTER(S-1);
         #PNAT POINTER OF DESTINATION#
         REG2 = TPOINTER(S);
         REG8 = LINE(S-1);
         REG9 = COLUMN(S-1);
         IF GET(PN$PROCKIND,PNAT$,REG1)  EQ  1
         THEN BEGIN 
              #AN ALTER STATEMENT CANNOT ALTER A SECTION.#
              # A PARAGRAPH NAME REFERENCE IS REQUIRED HERE.# 
              ERROR(SEVERE,296,REG8,REG9);
              RETURN; 
              END 
         #TCONTROL ANALYZES THE RELATIONSHIP BETWEEN# 
         #THE LOCATION OF THE ALTER STATEMENT AND THE LOCATION# 
         #OF EACH OF THE OPERANDS - WE CALL IT TWICE# 
         REG3 = LASTPNDEF;
         FIX1 = TCONTROL(REG3,REG1,1);
         FIX2 = TCONTROL(REG3,REG2,1);
         IF FIX1 EQ 0 OR FIX2 EQ 0  THEN RETURN;
         SET(PN$ALTERED,PNAT$,REG1,1);
         AUXTLENGTH = AUXTLENGTH + 1; 
         SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,ALTEREDCHAIN); 
         SET(FST$BIG$FLD,AUX$,AUXTLENGTH,REG1); 
         ALTEREDCHAIN = AUXTLENGTH; 
         REG3 = GET(PN$SEGMENTNO,PNAT$,REG1); 
         #IF THE GO TO STATEMENT IS IN AN#
         #INDEPENDENT SEGMENT (SEGMENT NUMBER > 49)#
         #THEN THE ALTER STATEMENT MUST BE IN THE#
         #SAME INDEPENDENT SEGMENT# 
         IF REG3  GR  49 AND
            REG3  NQ  GET(PN$SEGMENTNO,PNAT$,LASTSDEF)
         THEN  ERROR(SEVERE,116,REG8,REG9); 
         #IF THE GO TO IS IN AN INDEPENDENT SEGMENT#
         #THEN PNATANALYSIS MUST PROVIDE A SET OF#
         #INITIAL VALUE MEMORY LOCATIONS TO BE USED IN# 
         #INITIALIZATION OF ALTERED PARAGRAPHS IN INDEPENDENT#
         #SEGMENTS - SEE PNATANALYSIS#
         #THE INDICATOR IS CCT-ALTERED-INDEP-SEG (CCTALTINDSEG) # 
         IF REG3  GR  49  THEN CCTALTINDSEG[0] = TRUE;
         #WE MUST WAIT UNTIL THE END OF THE P-PARSER# 
         #BEFORE WE CAN DETERMINE IF THE PARAGRAPH IS#
         #ALTERABLE - WE NOW ATTACH AN AUX ENTRY TO#
         #THE PNAT OF THE ALTERED PARAGRAPH - IT WILL#
         #CONTAIN THE LINE AND COLUMN NUMBER OF THE#
         #PARAGRAPH NAME REFERENCE# 
         AUXTLENGTH = AUXTLENGTH + 1; 
         REG7 = AUXTLENGTH; 
         FIX1 = GET(PN$AUXREF,PNAT$,REG1);
         SET(AX$TNEXTPTR,AUX$,REG7,FIX1); 
         SET(PN$AUXREF,PNAT$,REG1,REG7);
         SET(AX$TTYPE,AUX$,REG7,WASALTERED);
         SET(AX$TFIRST,AUX$,REG7,REG8); 
         SET(AX$TSECOND,AUX$,REG7,REG9);
         RETURN;
SUB8: 
# ALTER PN ROUTINE #
         #STACK UP THE PROCEDURE NAME#
         S = S+1; 
         XSTACK(S,GTX(GPROCREF,VALUE$,0));
         XLINE(S,LINE$);
         XCOLUMN(S,COLUMN$);
         RETURN;
SUB14:  
# GO TO ROUTINE # 
         VD;
         DEPENDCOUNT = 0; 
         S = 0; 
         RETURN;
SUB15:  
# GO TO PERIOD ROUTINE #
         #PARSTATUS MUST BE 2 OR 3 COMING FROM STATEMENT# 
         IF PARSTATUS  EQ  2
         THEN BEGIN 
              #GOOD - ONE STATEMENT IN THE PARAGRAPH# 
              #THAT STATEMENT IS IN FACT OUR ALTERABLE GO TO# 
              SET(PN$ALTERABLE,PNAT$,LASTPNDEF,1);
              AUXTLENGTH = AUXTLENGTH + 1;
              SET(AX$TNEXTPTR,AUX$,AUXTLENGTH,MBACHAIN);
              SET(FST$BIG$FLD,AUX$,AUXTLENGTH,LASTPNDEF); 
              SET(AX$TSECOND,AUX$,AUXTLENGTH,PARAGLINE);
              MBACHAIN = AUXTLENGTH;
              XSTACK(1,$NULL);
              XSTACK(2,$GOTO);
              CCTGOTO[0] = TRUE;
              PARSTATUS = 4;
              END 
         ELSE 
              #PARSTATUS MUST BE 3 AND THAT MEANS#
              #THE PARAGRAPH CONTAINS MORE THAN ONE STATEMENT#
              #TOO BAD - GO TO MUST BE THE ONLY STATEMENT#
              ERROR(SEVERE,124,VERBLINE,VERBCOLUMN);
         RETURN;
SUB16:  
# GO TO PN ROUTINE #
         PN1 = VALUE$;
         XSTACK(1,GTX(GPROCREF,PN1,0)); 
         RETURN;
SUB17:  
# ORDINARY GO ROUTINE # 
         #ORIGIN# 
         REG1 = LASTPNDEF;
         #DESTINATION#
         REG2 = PN1;
         IF TCONTROL(REG1,REG2,0)  EQ  1
          OR REG1 EQ 0
         THEN BEGIN 
              #GOOD - WE CAN GET THERE FROM HERE# 
              CCTGOTO[0] = TRUE;
              IF PARSTATUS  EQ  2 
              THEN
                   #WE ARE THE FIRST STATEMENT IN THE PARAGRAPH#
                   SET(PN$ALTERABLE,PNAT$,LASTPNDEF,1); 
              #NOTE - LASTPNDEF COULD BE LASTSDEF OR EVEN 0#
              #IN CERTAIN ERROR SITUATIONS# 
              #OK - NOW THE LAST STATEMENT IN THIS PARAGRAPH# 
              #IS GO TO PN.#
              PARSTATUS = 6;
              XSTACK(2,$GOTO);
              END 
         RETURN;
SUB18:  
# GO DEPENDING ROUTINE #
         #CREATE DNAT ENTRY FOR BRANCH TABLE HEADER#
         DNATLENGTH = DNATLENGTH + 1; 
         I = DNATLENGTH;
         SET(DN$TYPE,DNAT$,I,NONDATA);
         SET(DN$LEVEL,DNAT$,I,BRHEADER);
         SET(DN$NXTBRTB,DNAT$,I,BRTBLPTR);
         BRTBLPTR = I;
         CCTGOTODEPND[0] = TRUE;
         VALUE$ == PN1; 
         #PUT THE FIRST PN INTO VALUE$# 
         #EXECUTE SUB19#
         #PUT THE SECOND PN INTO VALUE$#
         #RETURN TO SYNTAX TABLES#
         #COME BACK AND EXECUTE SUB19 AGAIN#
         #FALLING THROUGH#
SUB19:  
# GO DEPENDING PN ROUTINE # 
         DEPENDCOUNT = DEPENDCOUNT + 1; 
         #ADD BRANCH TABLE ENTRY# 
         DNATLENGTH = DNATLENGTH + 1; 
         I = DNATLENGTH;
         SET(DN$TYPE,DNAT$,I,BRTABLE);
         SET(DN$LEVEL,DNAT$,I,0); 
         SET(DN$MAJMSEC,DNAT$,I,GITMMSEC);
         SET(DN$ITMLEN,DNAT$,I,10); 
         SET(DN$BYTEOFFS,DNAT$,I,BRTBLCOUNT); 
         BRTBLCOUNT = BRTBLCOUNT + 10;
         SET(DN$SIGNBIT,DNAT$,I,0); 
         SET(DN$BRENTVL,DNAT$,I,0); 
         #STACK UP THE PROC NAME REF# 
         #REDUNDANT FOR S = 1#
         S = S + 1; 
         XSTACK(S,GTX(GPROCREF,VALUE$,0));
         IF TCONTROL(LASTPNDEF,VALUE$,0) EQ 1 
         THEN SET(DN$BRENTVL,DNAT$,I,VALUE$); 
         IF S EQ 1
         THEN VALUE$ = PN1; 
         RETURN;
SUB20:  
# GO DEPENDING EPILOGUE # 
         #PUT TABLE LENGTH IN HEADER# 
         SET(DN$BRTBLEN,DNAT$,BRTBLPTR,DEPENDCOUNT + 1);
         #CHECK FOR NUMERIC INTEGER#
         I = TPOINTER(S); 
         FIX1 = GET(DN$TYPE,DNAT$,I); 
         #NOTE - FLOATING POINT (COMP-2) ILLEGAL HERE#
         IF (FIX1 EQ COMP OR FIX1 EQ COMP1 OR FIX1 EQ COMP4) AND
            GET(DN$POINT,DNAT$,I) EQ 0
         THEN GOTO GODEPEPILOG; 
         #WE ARE IN TROUBLE#
         IF GET(DN$TYPE,DNAT$,I)  NQ  ERRTYPE 
         THEN  ERROR(SEVERE,74,LINE(S),COLUMN(S));
         RETURN;
GODEPEPILOG:  
         #THIS SECTION BUILDS THE GTEXT#
         #THE VERB# 
         NG($GODEPENDING);
         #THE DEPENDING ON IDENTIFIER#
         NGSTACK(S);
         #THE SUBVERB#
         NGGTX(GSUBVERB,DEPENDCOUNT,GCOUNT);
         #THE BRANCH TABLE HEADER#
         NGDATAREF(BRTBLPTR); 
         #THE PROCEDURE NAME REFERENCES#
         FOR I = 1 STEP 1 UNTIL S-1 DO
              NGSTACK(I); 
         RETURN;
SUB23:  
# MOVE ROUTINE #
         #FOR MOVE THE STACK LOOKS LIKE#
              #1 MOVE VERB ATOM#
              #2 SENDING FIELD (LIT OR ID)# 
              #3 RECEIVING FIELD# 
         VD;
         XSTACK(1,$MOVE); 
         S = 1; 
         RETURN;
SUB24:  
# MOVE OPERAND ROUTINE #
         #SAVE REF INDEX IN CASE OF MOVE SERIES#
         SENDREFINDX = REFCOUNTINDX;
         #CALCULATE KEY FOR THE SENDING FIELD#
         KEY1 = MOVESKEY(STACK(2)); 
         RETURN;
SUB25:  
# CHECK MOVE 1 #
         #CALCULATE THE KEY FOR THE RECEIVING FIELD#
         REG1 = TPOINTER(3);
         KEY2 = MOVERKEY(REG1); 
         #DO WE HAVE AN INTRINSICALLY BAD MOVE #
         IF KEY1 NQ 0 AND KEY2 NQ 0 
         THEN BEGIN 
              P<MST> = LOC(MOVESTRING); 
              IF CCTSSDNATPTR NQ 0
              THEN BEGIN
                   IF (TCODE(2) EQ GDATAREF AND 
                      GET(DN$MAJMSEC,DNAT$,TPOINTER(2)) 
                      EQ SECSMSEC) OR 
                      GET(DN$MAJMSEC,DNAT$,TPOINTER(3)) EQ SECSMSEC 
                   THEN P<MST> = LOC(SSMOVESTRING); 
                   END
              REG1 = 7 * KEY1 + KEY2 - 8; 
              FIX1 = BYTE(MST,REG1);
              #CHECK THE LEGALITY OF THE MOVE#
              IF FIX1  NQ  0
              THEN  ERROR(SEVERE,FIX1,LINE(3),COLUMN(3)); 
              ELSE BEGIN
                   #BUILD DNAT ENTRY FOR A LITERAL SENDING FIELD# 
                   IF TCODE(2)  EQ  GLITREF 
                   THEN BEGIN 
                        #GET LAT ENTRY INDEX# 
                        REG1 = TPOINTER(2); 
                        #COPY RECEIVING FIELD DNAT# 
                        LITERALDNAT(TPOINTER(3),
                                    GET(L$DNAT,LAT$,REG1)); 
                        #SET UP VERBCODE FOR MOVE#
              IF GET(DN$LEVEL,DNAT$,TPOINTER(3)) EQ REFMODLEVEL 
              THEN SET(L$REFMOD,LAT$,REG1,1); 
                        SET(L$VCODE,LAT$,REG1,2); 
                        END 
                   END
              END 
         RETURN;
SUB26:  
# CHECK MOVE 2 #
         #PROCESS SENDING FIELD AND THEN EXECUTE CHECK MOVE 1#
         IF TCODE(2)  EQ  GDATAREF
         THEN BEGIN 
              #BUMP SUBSCRIPT REF COUNT FOR SENDING IDENTIFIER# 
              REG1 = SENDREFINDX; 
              IF REG1  NQ  0
              THEN BEGIN
                   FIX1 = GET(RCT$ENTRY,RCT$,REG1)+1; 
                   SET(RCT$ENTRY,RCT$,REG1,FIX1); 
                   END
              END 
         ELSE BEGIN 
              #CREATE A NEW DNAT ENTRY FOR LITERAL SENDING FIELD# 
         LATTEMP = GET(L$PLT,LAT$,TPOINTER(2)); 
              REG1 = NEXTLAT; 
              #COPY "ALL" INFO FROM PREVIOUS ENTRY TO CURRENT#
              FIX1 = GET(L$ALL,LAT$,TPOINTER(2)); 
              SET(L$ALL,LAT$,REG1,FIX1);
              #COPY LAT INDEX INTO PREVIOUS STACK ENTRY#
              XTPOINTER(2,REG1);
              END 
         GOTO SUB25;
SUB27:  
# MOVE CORR PAIR ROUTINE #
         TRUEFALSE = 1; 
         CORR2; 
         #DID CORR2 DISQUALIFY THIS PAIR #
         IF TRUEFALSE  EQ  0
         THEN RETURN; 
         #INCREMENT COUNTER FOR NUMBER OF CORRESPONDING PAIRS#
         PAIRCOUNT = PAIRCOUNT + 1; 
         #CHECK LEGALITY OF PAIRWISE MOVE#
         KEY1 = MOVESKEY(STACK(S-1)); 
         REG2 = TPOINTER(S);
         KEY2 = MOVERKEY(REG2); 
         #IS THIS MOVE INTRINSICALLY ILLEGAL #
         IF KEY1 NQ 0 AND KEY2 NQ 0 
         THEN BEGIN 
              REG1 = 7 * KEY1 + KEY2 - 8; 
              FIX1 = BYTE(MOVESTRING,REG1); 
              IF FIX1  NQ  0
              THEN  ERROR(SEVERE,FIX1,LINE(S-2),COLUMN(S-2)); 
              END 
         XSTACK(6,$SEPARATOR);
         RETURN;
SUB10:  
# DISPLAY ROUTINE # 
         VD;
         #INITIALIZE TOTAL OPERAND LENGTH COUNTER#
         DISPLAYLEN = 0;
         #INITIALIZE VARIABLE LENGTH OPERAND SWITCH#
         DISPLAYSWTCH = 0;
          # INITIALIZE OPERAND COUNTER  # 
          PARAMCOUNT = 0; 
         RETURN;
SUB11:  
# DISPLAY OPERAND # 
  
         ARRAY PACKET [0];  #EDIT PATTERN PACKET LAYOUT#
         BEGIN
         ITEM  COMMAND   U(0,0,3);
         ITEM  RPTCNT    U(0,3,3);
         ITEM INSCHAR1   C(0,6,1);  #USED ONLY W/ COMMANDS 1,2,4,5,6# 
         ITEM INSCHAR2   C(0,12,1); #USED ONLY W/ COMMANDS 1,5# 
         ITEM PKT        C(0,0,3);
         END
  
         DEF  DATA    #0#;   #THE COMMANDS# 
         DEF  SIGN    #1#;
         DEF  INSERT  #2#;
         DEF  TFLOAT  #4#;
         DEF  TSIGN   #5#;
         DEF  TINSERT #6#;
  
          PARAMCOUNT = PARAMCOUNT + 1;
         #SPECIAL PROCESSING FOR A LITERAL# 
         IF TCODE(S)  EQ  GLITREF 
         THEN BEGIN 
              PLTPTR = LATTEMP; 
              REG1 = GET(PL$CODE,PLT$,PLTPTR);
              REG2 = GET(PL$SIGNEDFLG,PLT$,PLTPTR); 
              #CHECK FOR A NONNUMERIC OR AN INTEGER#
              IF REG1 NQ PLTQUOTEDLIT   AND 
                 REG1 NQ PLTFGCONZERO   AND 
                 (REG1 NQ PLTINTLIT OR REG2 NQ 0) 
              THEN  ERROR(JOD,278,LINE$,COLUMN$); 
              #SET UP CGL DNAT ENTRY# 
              REG3 = DNATLENGTH;
              SET(DN$TYPE,DNAT$,REG3,GROUP);
              REG4 = GET(PL$LENGTH,PLT$,PLTPTR) + REG2; 
              SET(DN$ITMLEN,DNAT$,REG3,REG4); 
              #ACCUMULATE OPERAND LENGTH# 
              DISPLAYLEN = DISPLAYLEN + REG4; 
              END 
         ELSE BEGIN 
              #IDENTIFIER PROCESSING# 
              REG1 = TABLENAME; 
                    IF GET(DN$TYPE,DNAT$,REG1) EQ NONDATA  THEN 
                        ERROR(SEVERE, 79, LINE$, COLUMN$);
              #TOGGLE SWITCH FOR VARIABLE GROUP OPERANDS# 
              IF GET(DN$TYPE,DNAT$,REG1) EQ VARGROUP OR 
                GET(DN$LEVEL,DNAT$,REG1) EQ REFMODLEVEL 
              THEN BEGIN
                   DISPLAYSWTCH = 1;
                   END
          # CHECK IF THE OPERAND NEEDS CONVERSION, IN THIS CASE  #
          # CONVERT IT BY MOVING IT TO A TEMP, REPLACE THE STACK #
          # ELEMENT BY THE TEMP.                                 #
          REG10 = GET(DN$TYPE,DNAT$,REG1);
          REG2 = 0; 
          IF (REG10 EQ NUMERIC AND NOT CCTNOEDIT) OR REG10 EQ BINARY
            OR REG10 EQ COMP4 
          THEN BEGIN
               S = REMOVE(1); 
               # ALLOCATE TEMP TO MOVE THE OPERAND FOR CONVERSION # 
               REG2 = NEXTTEMP; 
               SET(DN$TYPE,DNAT$,REG2,NUMERICEDIT); 
               FIX1 = GET(DN$NUMLEN,DNAT$,REG1);
               FIX2 = GET(DN$POINT,DNAT$,REG1); 
               #ESTABLISH NUMERIC LENGTH OF TEMP IN FIX3# 
               IF FIX2 GR FIX1
               THEN FIX3 = FIX2;
               ELSE BEGIN 
                    IF FIX2 LS 0
                    THEN FIX3 = FIX1 - FIX2;
                    ELSE FIX3 = FIX1; 
                    END 
               #ESTABLISH ITEM LENGTH OF TEMP IN FIX1#
               IF FIX2 GR 0 
               THEN FIX1 = FIX3 + 2;
               ELSE FIX1 = FIX3 + 1;
               #ESTABLISH POINT LOCATION OF TEMP IN FIX2# 
               IF FIX2 LS 0 
               THEN FIX2 = 0; 
  
               IF FIX2 EQ FIX3
               THEN BEGIN 
                    FIX1 = FIX1 +1; 
                    FIX3 = FIX3 + 1;
                    END 
               SET(DN$ITMLEN,DNAT$,REG2,FIX1);
               SET(DN$POINT,DNAT$,REG2,FIX2); 
               SET(DN$NUMLEN,DNAT$,REG2,FIX3);
               SET(DN$SIGNBIT,DNAT$,REG2,1);
               LOCALTEMP(REG2); 
               # ATTACH AN AUX-ENTRY CONTAINING EDIT INFO  #
               SET(DN$AUXREF,DNAT$,REG2,(NEXTAUX)); 
               SET(AX$TTYPE,AUX$,AUXTLENGTH,EDITINFO);
               SET(AX$TFLTINS,AUX$,AUXTLENGTH,3); 
               # CREATE A PLT-ENTRY WITH THE EDIT PATTERN # 
               CCTPLTLEN = CCTPLTLEN + 1; 
               # STORE IN THE AUX-ENTRY THE PLT POINTER # 
               SET(AX$PATTOFFS,AUX$,AUXTLENGTH,CCTPLTLEN);
               I = CCTPLTLEN; 
               SET(PL$CODE,PLT$,I,7); 
               SET(PL$LINE,PLT$,I,LINE$); 
               SET(PL$COLUMN,PLT$,I,COLUMN$); 
               # GENERATE THE EDIT PATTERN #
               C2 = " ";
  
               #FIRST, GENERATE MINUSES FOLLOWED BY ONE NINE# 
               I = (FIX3 - FIX2)/7; 
               J = (FIX3 - FIX2) - (I*7); 
               K = 1; 
               COMMAND = TSIGN; 
               INSCHAR1 = " ";
               INSCHAR2 = "-";
               RPTCNT = 7;
               FOR REG3 = 1 STEP 1 UNTIL I
               DO BEGIN 
                  C<K,3>C2 = PKT; 
                  K = K + 3;
                  END 
               IF J NQ 0
               THEN BEGIN 
                    RPTCNT = J; 
                    C<K,3>C2 = PKT; 
                    K = K + 3;
                    END 
               COMMAND = DATA;
               RPTCNT = 1;
               C<K,1>C2 = PKT;
               K = K + 1; 
  
               # NEXT, GENERATE POINT FOLLOWED BY RIGHT-NINES#
               IF FIX2 GR 0 
               THEN BEGIN 
                    COMMAND = INSERT; 
                    RPTCNT = 1; 
                    INSCHAR1 = "."; 
                    C<K,2>C2 = PKT; 
                    K = K + 2;
                    I = FIX2/7; 
                    J = FIX2 - (I*7); 
                    COMMAND = DATA; 
                    RPTCNT = 7; 
                    FOR REG3 = 1 STEP 1 UNTIL I 
                    DO BEGIN
                       C<K,1>C2 = PKT;
                       K = K + 1; 
                       END
                    IF J NQ 0 
                    THEN BEGIN
                         RPTCNT = J;
                         C<K,1>C2 = PKT;
                         K = K + 1; 
                         END
                    END 
               I = CCTPLTLEN; 
               SET(PL$LENGTH,PLT$,I,K); 
              SETPLST(I,LOC(C2)); 
               # GENERATE GTEXT TO MOVE THE OPERAND INTO THE TEMP # 
               NGMOVE;
               NGSTACK(S);
               XSTACK(S,GTX(GDATAREF,REG2,0));
               NGSTACK(S);
               S$ = S$ + 1; 
               END
  
          IF REG10 EQ COMP2 
          THEN BEGIN
               S = REMOVE(1); 
               # ALLOCATE TEMP TO MOVE THE OPERAND FOR CONVERSION # 
               REG2 = NEXTTEMP; 
               SET(DN$TYPE,DNAT$,REG2,EXTFLOAT);
               SET(DN$ITMLEN,DNAT$,REG2,23);
               LOCALTEMP(REG2); 
               # GENERATE GTEXT TO MOVE THE OPERAND INTO THE TEMP # 
               NGMOVE;
               NGSTACK(S);
               XSTACK(S,GTX(GDATAREF,REG2,0));
               NGSTACK(S);
               S$ = S$ + 1; 
               END
         IF REG10 EQ BOOLBIT
         THEN BEGIN 
              S = REMOVE(1);
              DNATLENGTH = DNATLENGTH + 1;
              REG2 = DNATLENGTH;
              FIX1 = GET(DN$BITLEN,DNAT$,REG1); 
              SET(DN$ITMLEN,DNAT$,REG2,FIX1); 
              GLOBALTEMP(REG2); 
              SET(DN$TYPE,DNAT$,REG2,BOOLDSP);
              NGMOVE; 
              NGSTACK(S); 
              XSTACK(S,GTX(GDATAREF,REG2,0)); 
              NGSTACK(S); 
              S$ = S$ + 1;
              END 
  
          IF REG10 EQ INDXDATA  OR  REG10 EQ INDXNAME 
          THEN BEGIN
               S = REMOVE(1); 
               # ALLOCATE TEMP TO MOVE THE OPERAND #
               REG2 = NEXTTEMP; 
               SET(DN$TYPE,DNAT$,REG2,NUMERIC); 
               SET(DN$SIGNBIT,DNAT$,REG2,0);
               SET(DN$NUMLEN,DNAT$,REG2,10);
               SET(DN$POINT,DNAT$,REG2,0);
               SET(DN$ITMLEN,DNAT$,REG2,10);
               LOCALTEMP(REG2); 
               # GENERATE GTEXT TO MOVE THE OPERAND INTO THE TEMP # 
               NG($SET);
               NG($SETTO);
               NGSTACK(S);
               XSTACK(S,GTX(GDATAREF,REG2,0));
               NGSTACK(S);
               S$ = S$ + 1; 
               END
          # INCREMENT TOTAL LENGTH OF OPERAND STRING #
          IF REG2 EQ 0
          THEN DISPLAYLEN = DISPLAYLEN+GET(DN$ITMLEN,DNAT$,REG1); 
          ELSE DISPLAYLEN = DISPLAYLEN+GET(DN$ITMLEN,DNAT$,REG2); 
          END 
         RETURN;
SUB12:  
# DISPLAY EPILOGUE #
         #REGISTER USAGE# 
              #REG1   DNAT INDEX OF RECEIVING FIELD TEMP# 
              #REG2   DNAT INDEX OF VARIABLE GROUP REDEF OF REG1# 
              #REG3   DNAT INDEX OF SUBORDINATE TEMP# 
              #REG4   DNAT INDEX OF DEPENDING NAME TEMP#
              #REG5   AUX TABLE INDEX#
              #REG6   DISPLAY OPERAND ATOM# 
              #REG7   STRING POINTER REF ATOM#
              #REG8   IR POOL OFFSET OF REG1# 
         #TEST FOR ONLY 1 OPERAND - NO STRING GTEXT NEEDED# 
          IF PARAMCOUNT EQ 1
          THEN BEGIN
               #OUTPUT OPERAND SUBSCRIPTS#
               REG1=1;
               REG1=RETRIEVE(REG1); 
               REG6=STACK(REG1);
               END
         ELSE BEGIN 
              #ALLOCATE TEMP FOR OPERAND RECEIVING FIELD# 
              REG1 = NEXTTEMP;
              SET(DN$TYPE,DNAT$,REG1,ALPHNUM);
              SET(DN$ITMLEN,DNAT$,REG1,DISPLAYLEN); 
              LOCALTEMP(REG1);
              IF DISPLAYSWTCH  EQ  0
              THEN BEGIN
                   #NO VARIABLE LENGTH OPERANDS#
                   REG6 = GTX(GDATAREF,REG1,0); 
                   REG7 = $NULL;
                   END
              ELSE BEGIN
                   #GENERATE VARIABLE GROUP TEMP# 
                   REG2 = NEXTTEMP; 
                   REG6 = GTX(GDATAREF,REG2,0); 
                   #ALLOCATE SUBORDINATE ITEM FOR VGR TEMP# 
                   REG3 = NEXTTEMP; 
                   #ALLOCATE DEPENDING NAME TEMP# 
                   REG4 = NEXTTEMP; 
                   REG7 = GTX(GDATAREF,REG4,0); 
                   #FIX UP ATTRIBUTES OF VGR TEMP#
                   SET(DN$TYPE,DNAT$,REG2,VARGROUP);
                   SET(DN$ITMLEN,DNAT$,REG2,DISPLAYLEN);
                   #FIX UP SPACE REQS FOR REDEFINITION ITEM#
                   REG8 = GET(DN$LONGOFF,DNAT$,REG1); 
                   SET(DN$MAJMSEC,DNAT$,REG2,TEMPMSEC); 
                   SET(DN$LONGOFF,DNAT$,REG2,REG8); 
                   REG5 = NEXTAUX;
                   SET(DN$AUXREF,DNAT$,REG2,REG5);
                   SET(AX$TNEXTPTR,AUX$,REG5,0);
                   SET(AX$TTYPE,AUX$,REG5,SUBOCCDEP); 
                   SET(AX$DEPNAM,AUX$,REG5,REG4); 
                   SET(AX$OCCNAM,AUX$,REG5,REG3); 
                   #FIX UP ATTRIBUTES OF SUBORDINATE ITEM#
                   SET(DN$TYPE,DNAT$,REG3,ALPHNUM); 
                   SET(DN$ITMLEN,DNAT$,REG3,1); 
                   SET(DN$DEP,DNAT$,REG3,1);
                   SET(DN$SDEPTH,DNAT$,REG3,1); 
                   #FIX UP SPACE REQS FOR SUBORDINATE ITEM# 
                   SET(DN$MAJMSEC,DNAT$,REG3,TEMPMSEC); 
                   SET(DN$LONGOFF,DNAT$,REG3,REG8); 
                   REG5 = NEXTAUX;
                   SET(DN$AUXREF,DNAT$,REG3,REG5);
                   SET(AX$TNEXTPTR,AUX$,REG5,(NEXTAUX));
                   SET(AX$TTYPE,AUX$,REG5,VAROCCUR);
                   SET(AX$MINOCCNO,AUX$,REG5,0);
                   SET(AX$DEPNAM,AUX$,REG5,REG4); 
                   SET(AX$SUBSLVL,AUX$,REG5,1); 
                   REG5 = AUXTLENGTH; 
                   SET(AX$TNEXTPTR,AUX$,REG5,0);
                   SET(AX$TTYPE,AUX$,REG5,MAXOCCUR);
                   SET(AX$OCCLEN,AUX$,REG5,1);
                   SET(AX$MAXOCCNO,AUX$,REG5,DISPLAYLEN); 
                   SET(AX$SUBSLVL,AUX$,REG5,1); 
                   #FIX UP ATTRIBUTES OF DEPENDING NAME#
                   SET(DN$TYPE,DNAT$,REG4,BINARY);
                   SET(DN$ITMLEN,DNAT$,REG4,10);
                   SET(DN$POINT,DNAT$,REG4,0);
                   SET(DN$NUMLEN,DNAT$,REG4,5); 
                   SET(DN$SIGNBIT,DNAT$,REG4,0);
                   LOCALTEMP(REG4); 
                   #GENERATE GTEXT FOR POINTER INITIALIZATION#
                   NGMOVE;
                   LATTEMP = 1; 
                   NG(CREATELDL(REG4,1)); 
                   SET(L$VCODE,LAT$,LATLENGTH,2); 
                   NG(REG7);
                   END
              #OUTPUT HEADER PORTION OF STRING GTEXT# 
              NG($STRING);
              NGDATAREF(REG1);
              NG(REG7); 
              NGGTX(GSUBVERB,PARAMCOUNT,RMPRESENT+DISPLAYSWTCH);
              NG($NULL);
              #OUTPUT DELIMITED VERB AND SIZE OPERAND#
              NG($SDELIMITED);
              NG($SIZE);
              #LOOP THRU OPERANDS EMITTING STRING GTEXT#
               FOR REG2 = 1 STEP 1 UNTIL S$-1 
               DO BEGIN 
                  REG3=RETRIEVE(REG2);
                 # OUTPUT OPERATOR VERB AND OPERAND # 
                 IF TCODE(REG3) EQ GLITREF THEN 
                    SET(L$VCODE,LAT$,TPOINTER(REG3),3); 
                 NG($SOPERATOR);
                 NGSTACK(REG3); 
                 END
               IF DISPLAYSWTCH NQ 0 
               THEN 
                   BEGIN
                   #SUBTRACT 1 FROM POINTER TO GIVE SIZE# 
                   NG($SUBTRACT); 
                   NG(REG7);
                   LATTEMP=1; 
                   NG(CREATELDL(REG4,1)); 
                   NG(REG7);
                   END
              END 
         NG($DISPLAY);
         #OUTPUT OPERAND# 
         NG(REG6);
         #OUTPUT MNEMONIC NAME REFERENCE# 
         NGSTACK(S);
         IF NOADVANCING EQ 1
         THEN NG($NOADVANCING); 
         ELSE NG($NULL);
         NOADVANCING = 0; 
         RETURN;
         END   #SET5# 
         TERM 
