*DECK D$SUBS
USETEXT CCTTEXT 
USETEXT DNTEXT
    PROC D$SUBS;
     BEGIN
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     GLOBAL DEFS FOR D$SUBS                                          #
 #                                                                     #
 #---------------------------------------------------------------------#
  
     DEF PROCESS$TYPE  #10#;
     DEF LABEL$FLD$NO  #9#; 
     DEF D$ERR  #1#;
     DEF S$ERR  #2#;
     DEF P$ERR  #3#;
     DEF A$ERR  #4#;
     DEF T$ERR  #5#;
     DEF J$ERR  #6#;
          DEF   HASHEDVALUE    #1#; 
          DEF   DEBUGITEM      #2#; 
          DEF   DEBUGLINE      #3#; 
          DEF   DEBUGNAME      #5#; 
          DEF   DEBUGSUB1      #7#; 
          DEF   DEBUGSUB2      #9#; 
          DEF   DEBUGSUB3      #11#;
          DEF   DEBUGCONTS    #13#; 
          DEF   DEBUGNUMCON    #14#;
  DEF          UNDEFINED  #1#;
  DEF          DUBLDEFINED  #2#;
          DEF GET          # GETQUICK #;
          DEF SET          # SETFIELD #;
  
 #     DIAGNOSTIC NUMBER DEFS TO FACILITATE LOOKUPS                    #
  
          DEF D202         # 202 #; 
          DEF D203         # 203 #; 
          DEF D800         # 800 #; 
 CONTROL EJECT; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     "INCLUDE" SOME COMMON DECKS                                     #
 #                                                                     #
 #---------------------------------------------------------------------#
  
*CALL DPPPDDATA 
*CALL WORKTABS
*CALL AUXT1.
*CALL AUXTVALS. 
*CALL DNATVALS. 
*CALL FNAT1.
*CALL FNATVALS. 
*CALL GETSET. 
*CALL INT1. 
*CALL PAT1. 
*CALL PLTVALS.
*CALL PLT1. 
*CALL TABLNAMES.
 CONTROL EJECT; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     GLOBAL DATA DECLARATIONS FOR D$SUBS                             #
 #                                                                     #
 #---------------------------------------------------------------------#
  
   ITEM  I I, 
         LABELPTR I,
          TEMPER   I, 
         PLTPTR I,
         TEMP I,
         $$$DUMMY$$$$ I,
         ERR$NO I,
         SEV$NO I,
         EQ$FLAG B, 
         FILE$SECTION B,
         COMSTOR$SECT B,
         SECSTOR$SECT B,
         WORK$SECTION B,
         COMM$SECTION B,
         LINK$SECTION B,
         FD$SD$LEGAL B, 
         CD$LEGAL B,
         DNAT$INDEX   I,
         PAT$INDEX    I,
         LASTDATADNAT I,
         FNAT$INDEX I,
         CD$NAME$CNTR   I,
         AUX$INDEX   I, 
         SVD$PLT$PTR I, 
         SVD$FNAT$PTR I,
         SAME$A$TYPE I, 
         LBL$FLDINDEX I,
         LINAGE$LIT I,
         T$REG I, 
         BADINTEGER I,
         TMP$T$REG I, 
         CDERRDNATPTR  I, 
         CDDESDNATPTR   I,
         CDOUTDNATPTR    I, 
         CLOCK$UNITS I, 
         RERUN$COND I,
         LEVEL$SAVE I,
         J I, 
         WORD I,
         T$ I,
         HIERARCHY U, 
         FILE$COUNT U,
         CHAIN$HEAD U,
         RERUN$COUNT U, 
         OPT$FILEFLAG B,
         ASC$DESC$FLG U,
         ALL$FLAG U,
         VERBLINE I,
         VERBCOLUMN I,
         SEEN$IDX$PHR B,
         CD$OUT$FLAG B; 
          ARRAY STR$BASE[0:25] S(3);
        BEGIN ITEM
          TMP$STRING1 C(0,0,10),
          TMP$STRING2 C(1,0,10),
          TMP$STRING3 C(2,0,10);
        END 
          ARRAY BEAD$BASE[0:25];
        BEGIN ITEM
          BEADFUNCID C(0,0,10); 
        END 
   ARRAY LABEL$FLD [1:9] S(3);
    BEGIN 
    ITEM LABEL$FLD$1 C(0,0,10) =
         ["FILE-ID   ","FILE-SET-I","FILE-SECTI","FILE-SEQUE",
          "GENERATION","GENERATION","CREATION-D","EXPIRATION",
          "ACCESSIBIL"];
    ITEM LABEL$FLD$2 C(1,0,10) =
         ["          ","D         ","ON-NUMBER ","NCE-NUMBER",
          "-NUMBER   ","-VERSION-N","ATE       ","-DATE     ",
          "ITY       "];
    ITEM LABEL$FLD$3 C(2,0,10) =
         ["          ","          ","          ","          ",
          "          ","UMBER     ","          ","          ",
          "          "];
    END 
   ARRAY MODE [1:5] S(1); 
    ITEM MODE$FLD$1 C(0,0,1) = ["V","F","S","D","U"]; 
         COMMON FIPSCOM;
             BEGIN
             ITEM W3           I; 
             END
 CONTROL EJECT; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     EXTERNAL DECLARATIONS                                           #
 #                                                                     #
 #---------------------------------------------------------------------#
  
    XDEF BEGIN
          ITEM  NXT$AUX$ENT   U,
                NEXT$LAT      U,
                NEXT$FNAT     U,
                SIGN$CONTROL  B,
                LEADSIGNCNRL  B,
                SEPSIGNCNRL   B;
         ITEM LITERAL$TEMP I; 
         END
         XREF BEGIN 
          PROC INTERCEPTOR; 
         END
 CONTROL EJECT; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     INTERNAL PROCEDURES AND FUNCTIONS TO D$SUBS                     #
 #                                                                     #
 #---------------------------------------------------------------------#
  
      PROC ERR$OUT(LOC$ID); 
          BEGIN 
  
          ITEM LOC$ID       I;
  
          INTERCEPTOR(COLUMN$, LINE$, LOC$ID, 1); 
  
          END  # ERR$OUT #
 CONTROL EJECT; 
  
      PROC FIPSLOG(P1, P2, P3); 
         BEGIN
         # P1 DIAGNOSTIC NUMBER # 
         # P2 ORGANIZATION #
         # P3 FIPS LEVEL #
         ITEM P1; 
         ITEM P2; 
         ITEM P3; 
         IF CCTFIPSLEVEL LS P3
         THEN BEGIN 
              W3 = W3 + 1;
              SET(W3$FIPSDIAG,WORK3$,W3,P1);
              SET(W3$FIPSLINE,WORK3$,W3,VERBLINE);
              SET(W3$FIPSCOL,WORK3$,W3,VERBCOLUMN); 
              SET(W3$FIPSFNAT,WORK3$,W3,FNAT$INDEX);
              SET(W3$FIPSORG,WORK3$,W3,P2); 
              END 
         END
 CONTROL EJECT; 
  
      PROC SETUP$CD(ENTRY$POINT); 
         ITEM ENTRY$POINT ; 
         BEGIN
           DNAT$INDEX = VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SWITCH CDDNATCHOICE
       CDDUMMY, CD$ENTRY1,CD$ENTRY2,CD$ENTRY3,CD$ENTRY4,
                CD$ENTRY5,CD$ENTRY6,CD$ENTRY7,CD$ENTRY8,CD$ENTRY9,
                CD$ENTRY10,CD$ENTRY11,CD$ENTRY12,CD$ENTRY13,
                CD$ENTRY14,CD$ENTRY15,CD$ENTRY16; 
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,50);
         GOTO CDDNATCHOICE[ENTRY$POINT];
         CDDUMMY:     RETURN; 
         CD$ENTRY1:  SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY2:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,12); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY3:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,24); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY4:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,36); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY5:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,48); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,6);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,6);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY6:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,54); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,8);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,8);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY7:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,62); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY8:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,74); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY9:  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,78); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,1);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY10: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,79); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,2);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY11: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,81); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,6);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,6);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY12: SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY13: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,4);
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,4);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NUMERIC);
                     RETURN;
         CD$ENTRY14: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,8);
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,2);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY15: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,10); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,1);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         CD$ENTRY16: SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$INDEX,11); 
                     SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,12); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ALPHNUM);
                     RETURN;
         END
 CONTROL EJECT; 
  
      FUNC FIND$AUX$ENT(START$PTR, TYPE) I; 
              BEGIN 
              ITEM TYPE      I, 
                   START$PTR U, 
                   TMP$INDEX ;
              TMP$INDEX=START$PTR;
              IF TMP$INDEX EQ 0 THEN RETURN;
              FOR $$$DUMMY$$$$ = 0 WHILE GETQUICK(AX$TNEXTPTR,AUX$, 
                   TMP$INDEX) NQ 0 DO 
                   BEGIN
                   IF GETQUICK(AX$TTYPE,AUX$,TMP$INDEX) EQ TYPE 
                   THEN BEGIN 
                        FIND$AUX$ENT= TMP$INDEX;
                        RETURN; 
                        END 
                   TMP$INDEX=GETQUICK(AX$TNEXTPTR,AUX$,TMP$INDEX);
                   END
              IF GETQUICK(AX$TTYPE,AUX$,TMP$INDEX) EQ TYPE
              THEN FIND$AUX$ENT= TMP$INDEX; 
              ELSE FIND$AUX$ENT= 0; 
              END 
 CONTROL EJECT; 
  
      FUNC ADDNEWAUXENT(AUX$PTR$FLD) I; 
              BEGIN 
              ITEM AUX$PTR$FLD U, 
                   TMP$INDEX  ; 
                NXT$AUX$ENT = NXT$AUX$ENT + 1;
                    TMP$INDEX = NXT$AUX$ENT;
                    IF AUX$PTR$FLD EQ 0 THEN
                        SETFIELD(AX$TNEXTPTR,AUX$,TMP$INDEX,0); 
                     ELSE 
                      SETFIELD(AX$TNEXTPTR,AUX$,TMP$INDEX,AUX$PTR$FLD); 
              SETFIELD(FST$BIG$FLD,AUX$,TMP$INDEX,0); 
              SETFIELD(SEC$BIG$FLD,AUX$,TMP$INDEX,0); 
              SETFIELD(AX$TTYPE,AUX$,TMP$INDEX,0);
              SETFIELD(AX$TBYTE,AUX$,TMP$INDEX,0);
               ADDNEWAUXENT = TMP$INDEX;
              END 
 CONTROL EJECT; 
  
      PROC INT$OR$DIAG(DIAG$NO);
              BEGIN 
              ITEM DIAG$NO I, 
                   TMP$T$REG I, 
                   COUNT I, 
                   BASE I;
              IF GETQUICK(PL$TYPE,PLT$,VALUE$) NQ PLTUNSGNILIT
              THEN BEGIN
                   ERR$OUT(DIAG$NO);
                   T$REG=1; 
                   BADINTEGER = 1;
                   END
              ELSE BEGIN
                 GETPLST(VALUE$,LOC(BEAD$BASE));
                   T$REG= 0;
                   BADINTEGER = 0;
                   BASE= "0"; 
                   FOR COUNT= 0 STEP 1 UNTIL
                        GETQUICK(PL$LENGTH,PLT$,VALUE$)-1 DO
                        BEGIN 
                        TMP$T$REG = C<COUNT,1> BEADFUNCID[0]; 
                        T$REG= T$REG*10+TMP$T$REG-BASE; 
                        END 
                   END
              END #INT$OR$DIAG# 
 CONTROL EJECT; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 #     MAINLINE OF D$SUBS                                              #
 #                                                                     #
 #---------------------------------------------------------------------#
  
SWITCH CASE 
     EO$CASE,SET$BWZ,ST$BLK$LIT,ST$BLK$LIT2,SET$REC$BIT,TST$DATA$REC, 
     ADD$DATA$REC,SET$JUST$BIT,SET$LBL$OMIT,SET$LBLS$STD,SET$LBL$ERR, 
     ST$LIN$NAME,ST$LIN$LIT,ST$FOOT$NAME,ST$FOOT$LIT,ST$TOP$NAME, 
     ST$TOP$LIT,ST$BTM$NAME,ST$BTM$LIT,ST$OCRS$LIT,OCRS$MAX$LIT,
     ST$DEPENDING,SET$ASC$FLAG,SET$DES$FLAG,ST$KEY$NAME,INDEX$PROC, 
     PICTURE$PROC,ST$REC$LIT,SET$RECCONT$,ST$MODE$NAME,ST$REDF$NAME,
     TST$REP$NAME,ST$REP$NAME,EO$CASE,SET$SIGN$LDG,SET$SIGN$TRL,
     SET$SIGN$SEP,SET$USE$DISP,SET$USE$CMP,SET$USE$CMP1,SET$USE$CMP2, 
     SET$USE$CMP4,SET$USE$INDX,SET$USE$ERR,SET$ALL$FLAG,SET$EXTERNAL, 
     ST$VRECMIN,ST$VRECMAX,            ,            ,            ,
                 ,ST$VAL$LIT,TEST$BIT$VAL,ST$LBL$NAME,ST$LABEL$LIT, 
     ST$LABEL$VAL,SET$SYNC$BIT,SETUP$DNAT,ST$RENAMES,ST$RENAMES2, 
         SET$PRD$BIT,SET$88$DNAT,SETUP$CT$PTR,CLEAR$CT$PTR,  ,
     SETFIL$TO$X2,SETUP$FDNAME,SETUP$SDNAME,SETUP$CDNAME,SETUP$RDNAME,
     SET$INIT$BIT,SET$INPT$BIT,SET$CD$DATA,NEXT$CD$DATA,GOT$11$DATA,
     SET$OUTPTBIT,TST$FD$CNTXT,TST$SD$CNTXT,TST$CD$CNTXT,SET$FILE$SEC,
     SET$WS$SEC,SET$LINK$SEC,SET$COMM$SEC,SET$QUEUE,SET$SQUEUE1,
     SET$SQUEUE2,SET$SQUEUE3,SETUP$SOURCE,SETUP$DESTIN,SET$MESS$CNT,
     SET$DEST$CNT,SET$TEXT$LEN,SET$STAT$KEY,SET$ERR$KEY,SET$MES$TIME, 
     SET$MES$DATE,SET$END$KEY,ST$DEST$TBL,SUB99,SUB100, 
     TST$OCRS$BIT,CD$INDX$PROC,SET$0$DNAT,DP$INIT,SAVE$LEVEL, 
     LIT$ROUTINE,DP$EPILOGUE,ST$CODE$SET,SYNC$RIGHT,
         SET$CS$SEC,SET$SS$SEC,ST$DEP$NAME,TESTFORZERO, 
         SET$USE$BIT,SKIP$FILLER; 
GOTO CASE[SUB$];
     #  END OF TEXT FOUND   # 
     SET$BWZ: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF GETQUICK(DN$BZERO,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(200);
              ELSE BEGIN
                   IF GETQUICK(DN$PICTURE,DNAT$,DNAT$INDEX) EQ 1
                        AND 
                      GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) EQ NUMERICEDIT 
                        AND 
                      GETQUICK(P$CKPROTECT,PAT$,PAT$INDEX) EQ 1 
                   THEN 
                      ERR$OUT(351);         #ASTERISK AND BWZ#
                   ELSE 
                      SETFIELD(DN$BZERO,DNAT$,DNAT$INDEX,1);
                   END
              END 
              GOTO EO$CASE; 
     ST$BLK$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$BLKCONT,DNAT$,DNAT$INDEX) EQ 1 
              THEN BEGIN
                   ERR$OUT(250);
                   SYNTAXONLY = 1;
                   END
              ELSE BEGIN
                   SETFIELD(DN$BLKCONT,DNAT$,DNAT$INDEX,1); 
                   INT$OR$DIAG(251);
                   SETFIELD(FN$BCTMAX,FNAT$,FNAT$INDEX,T$REG);
                   END
              END 
         # FIPS=2 SUPPORTS BLOCK CONTAINS FOR RELATIVE FILES #
         FIPSLOG(781,RELATIVE,2); 
         # FIPS=4 SUPPORTS BLOCK CONTAINS FOR INDEXED FILES # 
         FIPSLOG(782,INDEXED,4);
              GOTO EO$CASE; 
     ST$BLK$LIT2: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              INT$OR$DIAG(251); 
               TEMPER = GETQUICK(FN$BCTMAX,FNAT$,FNAT$INDEX); 
              SETFIELD(FN$BCTMIN,FNAT$,FNAT$INDEX,TEMPER);
              SETFIELD(FN$BCTMAX,FNAT$,FNAT$INDEX,T$REG); 
         # FIPS=3 SUPPORTS BLOCK CONTAINS INTEGER TO INTEGER #
         # CHARACTERS/RECORDS # 
         FIPSLOG(783,RELATIVE,3); 
         FIPSLOG(783,SEQUENTIAL,3); 
              END 
              GOTO EO$CASE; 
     SET$REC$BIT: IF SYNTAXONLY EQ 0 THEN 
              SETFIELD(FN$BLKCTREC,FNAT$,FNAT$INDEX,1); 
              GOTO EO$CASE; 
     TST$DATA$REC: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$DATREC,DNAT$,DNAT$INDEX) EQ 1
              THEN BEGIN
                   ERR$OUT(252);
                   SYNTAXONLY = 1;
                   END
              ELSE SETFIELD(DN$DATREC,DNAT$,DNAT$INDEX,1);
              END 
         # FIPS=2 SUPPORTS DATA RECORDS CLAUSE FOR RELATIVE FILES # 
         FIPSLOG(790,RELATIVE,2); 
         # FIPS=4 SUPPORTS DATA RECORDS CLAUSE FOR INDEXED FILES #
         FIPSLOG(791,INDEXED,4);
              GOTO EO$CASE; 
     ADD$DATA$REC: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              AUX$INDEX=ADDNEWAUXENT( 
                   GETQUICK(FN$DRECPTR,FNAT$,FNAT$INDEX));
                SETFIELD(FN$DRECPTR,FNAT$,FNAT$INDEX,AUX$INDEX);
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,DATARECNAME);
              SETFIELD(AX$DATARCNAM,AUX$,AUX$INDEX,VALUE$); 
              END 
              GOTO EO$CASE; 
     SET$JUST$BIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$JUST,DNAT$,DNAT$INDEX) EQ 1
              THEN ERR$OUT(201);
              ELSE SETFIELD(DN$JUST,DNAT$,DNAT$INDEX,1);
              END 
              GOTO EO$CASE; 
     SET$LBL$OMIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$LABREC,DNAT$,DNAT$INDEX) EQ 1
              THEN ERR$OUT(253);
              ELSE BEGIN
                   SETFIELD(DN$LABREC,DNAT$,DNAT$INDEX,1);
                   SETFIELD(FN$LABELREC,FNAT$,FNAT$INDEX,OMITTED);
                   END
              END 
              GOTO EO$CASE; 
     SET$LBLS$STD: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF  GETQUICK(DN$LABREC,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(253);
              ELSE BEGIN
                   SETFIELD(DN$LABREC,DNAT$,DNAT$INDEX,1);
                   SETFIELD(FN$LABELREC,FNAT$,FNAT$INDEX,STANDARD); 
                   END
              END 
              GOTO EO$CASE; 
     SET$LBL$ERR: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF  GETQUICK(DN$LABREC,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(253);
              ELSE BEGIN
                   SETFIELD(DN$LABREC,DNAT$,DNAT$INDEX,1);
                   SETFIELD(FN$LABELREC,FNAT$,FNAT$INDEX,LABELERR); 
                   END
              END 
              GOTO EO$CASE; 
     ST$LIN$NAME: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF GETQUICK(FN$LINAGPTR,FNAT$,FNAT$INDEX) EQ 0
              THEN BEGIN
                   SETFIELD(FN$LINAGPTR,FNAT$,FNAT$INDEX,VALUE$); 
                   SETFIELD(FN$LINAGLIT,FNAT$,FNAT$INDEX,0);
                   SETFIELD(DN$LINAGE,DNAT$,DNAT$INDEX,1);
                   IF CCTLINAGE  EQ  0
                   THEN CCTLINAGE = DNAT$INDEX+1; 
                   ELSE CCTLINAGE = -1; 
                   END
              ELSE BEGIN
                   ERR$OUT(254);
                   SYNTAXONLY = 1;
                   END
              END 
              GOTO EO$CASE; 
     ST$LIN$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(FN$LINAGPTR,FNAT$,FNAT$INDEX) EQ 0
              THEN BEGIN
                   SETFIELD(FN$LINAGPTR,FNAT$,FNAT$INDEX,VALUE$); 
                   SETFIELD(FN$LINAGLIT,FNAT$,FNAT$INDEX,1);
                   IF CCTLINAGE  EQ  0
                   THEN CCTLINAGE = DNAT$INDEX+1; 
                   ELSE CCTLINAGE = -1; 
                   SETFIELD(DN$LINAGE,DNAT$,DNAT$INDEX,1);
                   INT$OR$DIAG(263);
                   IF BADINTEGER EQ 1 THEN
                               SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
                     IF T$REG EQ 0 THEN 
                       BEGIN
                       ERR$OUT(264);
                       SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
                      END 
                   IF BADINTEGER EQ 1 OR T$REG EQ 0 THEN
                      SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX+1,ERRTYPE); 
                   LINAGE$LIT=T$REG;
                   END
              ELSE BEGIN
                   ERR$OUT(254);
                   SYNTAXONLY = 1;
                   END
              END 
              GOTO EO$CASE; 
     ST$FOOT$NAME: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              SETFIELD(FN$FOOTPTR,FNAT$,FNAT$INDEX,VALUE$); 
              SETFIELD(FN$FOOTLIT,FNAT$,FNAT$INDEX,0);
              END 
              GOTO EO$CASE; 
     ST$FOOT$LIT: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              SETFIELD(FN$FOOTPTR,FNAT$,FNAT$INDEX,VALUE$); 
              SETFIELD(FN$FOOTLIT,FNAT$,FNAT$INDEX,1);
              INT$OR$DIAG(263); 
                   IF BADINTEGER EQ 1 THEN
                               SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
              IF BADINTEGER EQ 1 THEN 
                 SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX+1,ERRTYPE);
              IF GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX+1) NQ ERRTYPE
              THEN BEGIN
                   IF T$REG GR LINAGE$LIT AND 
                      GETQUICK(FN$LINAGLIT,FNAT$,FNAT$INDEX) EQ 1 
                   THEN BEGIN 
                        ERR$OUT(265); 
                         SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
                        SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX+1,ERRTYPE); 
                        END 
                   END
              END 
              GOTO EO$CASE; 
     ST$TOP$NAME: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              SETFIELD(FN$TOPPTR,FNAT$,FNAT$INDEX,VALUE$);
              SETFIELD(FN$TOPLIT,FNAT$,FNAT$INDEX,0); 
              END 
              GOTO EO$CASE; 
     ST$TOP$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              SETFIELD(FN$TOPPTR,FNAT$,FNAT$INDEX,VALUE$);
              SETFIELD(FN$TOPLIT,FNAT$,FNAT$INDEX,1); 
              INT$OR$DIAG(263); 
                   IF BADINTEGER EQ 1 THEN
                               SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
              IF BADINTEGER EQ 1 THEN 
                 SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX+1,ERRTYPE);
              END 
              GOTO EO$CASE; 
     ST$BTM$NAME: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              SETFIELD(FN$BOTTPTR,FNAT$,FNAT$INDEX,VALUE$); 
              SETFIELD(FN$BOTTLIT,FNAT$,FNAT$INDEX,0);
              END 
              GOTO EO$CASE; 
     ST$BTM$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              SETFIELD(FN$BOTTPTR,FNAT$,FNAT$INDEX,VALUE$); 
              SETFIELD(FN$BOTTLIT,FNAT$,FNAT$INDEX,1);
              INT$OR$DIAG(263); 
                   IF BADINTEGER EQ 1 THEN
                               SETFIELD(FN$ABORT,FNAT$,FNAT$INDEX,1); 
              IF BADINTEGER EQ 1 THEN 
                 SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX+1,ERRTYPE);
              END 
              GOTO EO$CASE; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 # NAME                                                                #
 #    STASH_OCCURS_LITERAL                                             #
 #                                                                     #
 # DESCRIPTION                                                         #
 #    WE ARE PROCESSING AN "OCCURS" CLAUSE. IF SYNTAXONLY IS NOT       #
 #    SET AND THIS IS NOT A DUPLICATE "OCCURS" CLAUSE, WE FILL IN      #
 #    INFORMATION ABOUT THE SUBJECT OF THIS "OCCURS" CLAUSE IN THE     #
 #    DNAT AND AUX. WE ALSO INITIALIZE SEEN$IDX$PHR, WHICH IS USED     #
 #    FOR DIAGNOSING NON-STANDARD COBOL ERRORS.                        #
 #                                                                     #
 #---------------------------------------------------------------------#
  
 ST$OCRS$LIT: 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              HIERARCHY = 1;
              IF GETQUICK(DN$OCCURS, DNAT$, DNAT$INDEX) EQ 1
              THEN
                  BEGIN         # DUPLICATE "OCCURS" CLAUSE            #
                  ERR$OUT(D202);
                  SYNTAXONLY = 1; 
                  END 
              ELSE
                  BEGIN 
                  IF TRUEFALSE EQ 1 
                  THEN
                      INT$OR$DIAG(D203);
                  ELSE
                      T$REG = 1;
                  AUX$INDEX = ADDNEWAUXENT(GETQUICK(DN$AUXREF,
                              DNAT$, DNAT$INDEX));
                  SETFIELD(DN$AUXREF, DNAT$, DNAT$INDEX, AUX$INDEX);
                  SETFIELD(AX$TTYPE, AUX$, AUX$INDEX, MAXOCCUR);
                  SETFIELD(DN$OCCURS, DNAT$, DNAT$INDEX, 1);
                  SETFIELD(AX$MAXOCCNO, AUX$, AUX$INDEX, T$REG);
                  SEEN$IDX$PHR = FALSE; 
                  END 
              END 
          GOTO EO$CASE; 
  
     OCRS$MAX$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              INT$OR$DIAG(203); 
              AUX$INDEX=
                   FIND$AUX$ENT(GETQUICK(DN$AUXREF, 
                   DNAT$,DNAT$INDEX),MAXOCCUR); 
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,VAROCCUR); 
              AUX$INDEX=
                   ADDNEWAUXENT(GETQUICK(DN$AUXREF,DNAT$,DNAT$INDEX));
              SETFIELD(DN$AUXREF,DNAT$,DNAT$INDEX,AUX$INDEX); 
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,MAXOCCUR); 
              SETFIELD(AX$MAXOCCNO,AUX$,AUX$INDEX,T$REG); 
              END 
              GOTO EO$CASE; 
     ST$DEPENDING: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              SETFIELD(DN$DEP,DNAT$,DNAT$INDEX,1);
              AUX$INDEX=FIND$AUX$ENT(GETQUICK(DN$AUXREF,DNAT$,
                                     DNAT$INDEX),VAROCCUR); 
              SETFIELD(AX$DEPNAM,AUX$,AUX$INDEX,VALUE$);
              END 
              GOTO EO$CASE; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 # NAME                                                                #
 #    SET_ASCENDING_FLAG, SET_DESCENDING_FLAG                          #
 #                                                                     #
 # DESCRIPTION                                                         #
 #    WE ARE FLAGING WHETHER WE HAVE SEEN AN "ASCENDING" OR "DESCEND-  #
 #    ING" PHRASE. IF WE ARE IN AN "OCCURS" CLAUSE, WE CHECK WHETHER   #
 #    AN "INDEXED BY" PHRASE HAS ALREADY BEEN SEEN AND IF SO, DIAGNOSE #
 #    THE ORDER OF APPEARENCE AS NON-STANDARD COBOL.                   #
 #                                                                     #
 #---------------------------------------------------------------------#
  
 SET$ASC$FLAG:  
          ASC$DESC$FLG = ASCENDING; 
          IF (GETQUICK(DN$OCCURS, DNAT$, DNAT$INDEX) NQ 0)  AND 
             SEEN$IDX$PHR 
          THEN
              ERR$OUT(D800);
          GOTO EO$CASE; 
  
 SET$DES$FLAG:  
          ASC$DESC$FLG = DESCENDING;
          IF (GETQUICK(DN$OCCURS, DNAT$, DNAT$INDEX) NQ 0)  AND 
             SEEN$IDX$PHR 
          THEN
              ERR$OUT(D800);
          GOTO EO$CASE; 
  
 ST$KEY$NAME: 
          IF SYNTAXONLY EQ 0  AND  VALUE$ NQ 0
          THEN
              BEGIN 
              SETFIELD(DN$KEYED, DNAT$, DNAT$INDEX, 1); 
              AUX$INDEX = ADDNEWAUXENT(GETQUICK(DN$AUXREF,
                          DNAT$, DNAT$INDEX));
              SETFIELD(DN$AUXREF, DNAT$, DNAT$INDEX, AUX$INDEX);
              SETFIELD(AX$TTYPE, AUX$, AUX$INDEX, KEYNAME); 
              SETFIELD(AX$HIERCNT, AUX$, AUX$INDEX, HIERARCHY); 
              HIERARCHY = HIERARCHY + 1;
              SETFIELD(AX$KEYNAM, AUX$, AUX$INDEX, VALUE$); 
              SETFIELD(AX$ORDER, AUX$, AUX$INDEX, ASC$DESC$FLG);
              END 
          GOTO EO$CASE; 
  
 #---------------------------------------------------------------------#
 #                                                                     #
 # NAME                                                                #
 #    INDEX_PROCESS                                                    #
 #                                                                     #
 # DESCRIPTION                                                         #
 #    WE ARE PROCESSING THE DATA-NAME IN THE "INDEXED BY" PHRASE. WE   #
 #    CREATE A DNAT ENTRY FOR THE DATA-NAME, FILL IN SOME INFORMATION  #
 #    ABOUT IT, AND FLAG THE SUBJECT OF THE "INDEXED BY" PHRASE AS     #
 #    BEING INDEXED. WE ALSO FLAG THE FACT WE HAVE SEEN AN "INDEXED    #
 #    BY" PHRASE FOR ERROR DIAGNOSING IF WE ARE IN AN "OCCURS" CLAUSE. #
 #                                                                     #
 #---------------------------------------------------------------------#
  
 INDEX$PROC:  
          BEGIN 
          CREATE$ENTRY(DNAT$, VALUE$);
          SETFIELD(DN$LINE, DNAT$, VALUE$, LINE$);
          SETFIELD(DN$LEVEL, DNAT$, VALUE$, INDXLEVL);
          SETFIELD(DN$INDEXED, DNAT$, DNAT$INDEX, 1); 
          IF GETQUICK(DN$OCCURS, DNAT$, DNAT$INDEX) NQ 0
          THEN
              SEEN$IDX$PHR = TRUE;
          END 
          GOTO EO$CASE; 
  
     PICTURE$PROC: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF TRUEFALSE EQ 1 THEN
              BEGIN 
              IF GETQUICK(DN$PICTURE,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(204);
              ELSE BEGIN
                   PAT$INDEX = VALUE$;
                   SETFIELD(DN$PICTURE,DNAT$,DNAT$INDEX,1); 
                TEMPER = GETQUICK(P$LENGTH,PAT$,VALUE$);
                   SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,TEMPER); 
                    TEMPER = GETQUICK(P$TYPE,PAT$,VALUE$);
                   SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,TEMPER); 
           SWITCH SUBCASE EO$SUBCASE,EO$SUBCASE,ALPHA$EDIT,EO$SUBCASE,
                        ALPHA$NUM$ED,EO$SUBCASE,NUMERIC$EDIT, 
                        NUMERICLAB,EXT$FLOAT,INSRTPATOFST;
     IF GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) GQ 9 THEN
         GOTO EO$CASE;
                   GOTO SUBCASE[GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX)];
              #   ALPHABETIC                          # 
  
              ALPHA$EDIT: 
                        BEGIN 
                          TEMPER=GETQUICK(P$REPLCNT,PAT$,VALUE$); 
                        SETFIELD(DN$REPCOUNT,DNAT$,DNAT$INDEX,TEMPER);
                        GOTO INSRTPATOFST;
                        END 
              #   ALPHANUMERIC                        # 
  
              ALPHA$NUM$ED: 
                        BEGIN 
                          TEMPER=GETQUICK(P$REPLCNT,PAT$,VALUE$); 
                        SETFIELD(DN$REPCOUNT,DNAT$,DNAT$INDEX,TEMPER);
                        GOTO INSRTPATOFST;
                        END 
              #   ERROR                                 # 
  
              NUMERIC$EDIT: 
                        BEGIN 
                       TEMPER = GETQUICK(P$PTLOC,PAT$,VALUE$);
                        SETFIELD(DN$POINT,DNAT$,DNAT$INDEX,TEMPER); 
                       TEMPER = GETQUICK(P$NUMLEN,PAT$,VALUE$); 
                        SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,TEMPER);
                        IF GETQUICK(P$CKPROTECT,PAT$,VALUE$) EQ 1 
                            AND 
                           GETQUICK(DN$BZERO,DNAT$,DNAT$INDEX) EQ 1 
                        THEN BEGIN
                             ERR$OUT(351); #ASTERISK AND BWZ# 
                             SETFIELD(DN$BZERO,DNAT$,DNAT$INDEX,0); 
                             END
                        GOTO INSRTPATOFST;
                        END 
              NUMERICLAB: 
                        BEGIN 
                        TEMPER = GETQUICK(P$PTLOC,PAT$,VALUE$); 
                        SETFIELD(DN$POINT,DNAT$,DNAT$INDEX,TEMPER); 
                       TEMPER = GETQUICK(P$NUMLEN,PAT$,VALUE$); 
                        SETFIELD(DN$NUMLEN,DNAT$,DNAT$INDEX,TEMPER);
                        TEMPER = GETQUICK(P$SGNPIC,PAT$,VALUE$);
                        SETFIELD(DN$PICSIGN,DNAT$,DNAT$INDEX,TEMPER); 
                        GOTO EO$SUBCASE;
                        END 
              EXT$FLOAT:  
                        BEGIN 
                       TEMPER = GETQUICK(P$PTLOC,PAT$,VALUE$);
                        SETFIELD(DN$COEFSCL,DNAT$,DNAT$INDEX,TEMPER); 
                        TEMPER = GETQUICK(P$NUMLEN,PAT$,VALUE$);
                        SETFIELD(DN$COEFLEN,DNAT$,DNAT$INDEX,TEMPER); 
                        TEMPER = GETQUICK(P$EXPLEN,PAT$,VALUE$);
                        SETFIELD(DN$EXPLEN,DNAT$,DNAT$INDEX,TEMPER);
                        TEMPER = GETQUICK(P$COEFFSGN,PAT$,VALUE$);
                        SETFIELD(DN$EXPSIGN,DNAT$,DNAT$INDEX,TEMPER); 
                        TEMPER = GETQUICK(P$EXPSIGN,PAT$,VALUE$); 
                        SETFIELD(DN$EXPSIGN,DNAT$,DNAT$INDEX,TEMPER); 
                        TEMPER = GETQUICK(P$DECPT,PAT$,VALUE$); 
                        SETFIELD(DN$DECPOINT,DNAT$,DNAT$INDEX,TEMPER);
                        GOTO EO$SUBCASE;
                        END 
              INSRTPATOFST: 
                        BEGIN 
                        AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,
                                   DNAT$,DNAT$INDEX));
           SETFIELD(DN$AUXREF,DNAT$,DNAT$INDEX,AUX$INDEX);
                        SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,EDITINFO); 
                        TEMPER = GETQUICK(P$PATTOFF,PAT$,VALUE$); 
                        SETFIELD(AX$PATTOFFS,AUX$,AUX$INDEX,TEMPER);
                       TEMPER = GETQUICK(P$FXDSGNLFT,PAT$,VALUE$);
                        SETFIELD(AX$TFXDLDSGN,AUX$,AUX$INDEX,TEMPER); 
                       TEMPER = GETQUICK(P$BWZ,PAT$,VALUE$);
                        SETFIELD(AX$TBWZ,AUX$,AUX$INDEX,TEMPER);
                       TEMPER = GETQUICK(P$FXDINSRT,PAT$,VALUE$); 
                        SETFIELD(AX$TFXDINS,AUX$,AUX$INDEX,TEMPER); 
                       TEMPER = GETQUICK(P$FLTINSRT,PAT$,VALUE$); 
                        SETFIELD(AX$TFLTINS,AUX$,AUX$INDEX,TEMPER); 
                       TEMPER = GETQUICK(P$ASTRSKFIL,PAT$,VALUE$);
                        SETFIELD(AX$TASTFILL,AUX$,AUX$INDEX,TEMPER);
                        IF GETQUICK(DN$TYPE,DNAT$,DNAT$INDEX) 
                        EQ NUMERICEDIT
                        THEN BEGIN
                             IF GETQUICK(AX$TFXDLDSGN,AUX$,AUX$INDEX) 
                             EQ 1 
                               OR 
                             GETQUICK(AX$TFXDINS,AUX$,AUX$INDEX) NQ 0 
                               OR 
                             GETQUICK(AX$TFLTINS,AUX$,AUX$INDEX) EQ 2 
                               OR 
                             GETQUICK(AX$TFLTINS,AUX$,AUX$INDEX) EQ 3 
                             THEN 
                                SETFIELD(DN$PICSIGN,DNAT$,DNAT$INDEX, 
                                1); 
                             END
                        END 
              EO$SUBCASE: END 
              END 
              ELSE BEGIN
                   SETFIELD(DN$PICTURE,DNAT$,DNAT$INDEX,1); 
                   SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ERRTYPE);
                   END
              END 
             GOTO EO$CASE;
     ST$REC$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$RECCONT,DNAT$,DNAT$INDEX) EQ 1 
              THEN BEGIN
                   ERR$OUT(255);
                   SYNTAXONLY = 1;
                   END
              ELSE BEGIN
                   INT$OR$DIAG(256);
                   IF BADINTEGER NQ 0 
                   THEN  # SIGNED LITERAL IN RECORD CLAUSE             #
                       BEGIN
                       SYNTAXONLY = 1;
                       END
                   ELSE   # STASH RECORD CONTAINS MIN AND POSSIBLE MAX #
                       BEGIN
                       SETFIELD(FN$RCTMAX,FNAT$,FNAT$INDEX,T$REG);
                       SETFIELD(FN$RCTMIN,FNAT$,FNAT$INDEX,T$REG);
                       END
                   END
         # FIPS=2 SUPPORTS RECORD CONTAINS FOR RELATIVE FILES # 
         FIPSLOG(784,RELATIVE,2); 
         # FIPS=4 SUPPORTS RECORD CONTAINS FOR INDEXED FILES #
         FIPSLOG(785,INDEXED,4);
              END 
              GOTO EO$CASE; 
ST$VRECMIN: 
#STASH VARYING RECORD MINIMUM#
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF GETQUICK(DN$RECCONT,DNAT$,DNAT$INDEX) EQ 1 
              THEN   # DUPLICATE RECORD CLAUSE IGNORE                  #
                  BEGIN 
                  ERR$OUT(255);   # DUPLICATE RECORD CLAUSE IGNORED    #
                  SYNTAXONLY = 1; 
                  END 
              ELSE   # STASH VARYING RECORD MINIMUM LENGTH IN FNAT     #
                  BEGIN 
                  INT$OR$DIAG(256);   # CONVERT LITERAL                #
                  IF BADINTEGER NQ 0
                  THEN   # ILLEGAL SIGNED LITERAL IN RECORD CLAUSE     #
                      BEGIN 
                      SYNTAXONLY = 1; 
                      END 
                  ELSE   # STASH RECORD VARYING MINIMUM LENGTH         #
                      BEGIN 
                      SETFIELD(FN$RCTMIN,FNAT$,FNAT$INDEX,T$REG); 
                      END 
                  END 
              END 
          GOTO EO$CASE; 
  
ST$VRECMAX: 
#STASH VARYING (CONTAINS) RECORD MAXIMUM# 
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              IF GETQUICK(DN$RECCONT,DNAT$,DNAT$INDEX) EQ 1 
              THEN   # DUPLICATE RECORD CLAUSE IGNORE CLAUSE           #
                  BEGIN 
                  ERR$OUT(255);   # DUPLICATE RECORD CLAUSE IGNORED    #
                  SYNTAXONLY = 1;               # INSURE RECORD CLAUSE #
                  SETFIELD(FN$RCTMIN,FNAT$,FNAT$INDEX,0);   # IGNORED  #
                  SETFIELD(FN$RCTMAX,FNAT$,FNAT$INDEX,0); 
                  END 
              ELSE   # STASH RECORD VARYING MAXIMUM LENGTH IN FNAT     #
                  BEGIN 
                  INT$OR$DIAG(256); 
                  IF BADINTEGER NQ 0
                  THEN   # ILLEGAL SIGNED LITERAL IN RECORD CLAUSE     #
                      BEGIN 
                      SYNTAXONLY = 1;           # INSURE RECORD CLAUSE #
                      SETFIELD(FN$RCTMAX,FNAT$,FNAT$INDEX,0); 
                      SETFIELD(FN$RCTMIN,FNAT$,FNAT$INDEX,0); # IGNORED#
                      END 
                  ELSE   # STASH VARYING MAX LEN                       #
                      BEGIN 
                      IF GETQUICK(FN$RCTMIN,FNAT$,FNAT$INDEX) EQ 0
                        OR GETQUICK(FN$RCTMIN,FNAT$,FNAT$INDEX) LS T$REG
                      THEN   # STASH RECORD VARYING MAXIMUM LENGTH     #
                          BEGIN 
                          SETFIELD(FN$RCTMAX,FNAT$,FNAT$INDEX,T$REG); 
                          END 
                      ELSE # ILLEGAL MIN LE MAX REC LEN IN RECORD CLAUS#
                          BEGIN 
                          ERR$OUT(305); # ILLEGAL MAX IGNORE CLAUSE    #
                          SYNTAXONLY = 1; 
                          SETFIELD(FN$RCTMIN,FNAT$,FNAT$INDEX,0); 
                          SETFIELD(FN$RCTMAX,FNAT$,FNAT$INDEX,0); 
                          END 
                      END 
                  END 
              END 
          GOTO EO$CASE; 
  
     ST$MODE$NAME: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$RECMODE,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(257);
              ELSE BEGIN
         TEMP = ERRMODE;
         GETPLST(VALUE$,LOC(BEAD$BASE));
         IF BEADFUNCID[0] EQ "BINARY    " THEN
              TEMP = BINMODE; 
         IF BEADFUNCID[0] EQ "DECIMAL   " THEN
              TEMP = DECMODE; 
         IF TEMP EQ ERRMODE THEN
              ERR$OUT(42);
         ELSE 
              SETFIELD(DN$RECMODE,DNAT$,DNAT$INDEX,1);
         SETFIELD(FN$RECMODE,FNAT$,FNAT$INDEX,TEMP);
                   END
              END 
              GOTO EO$CASE; 
     ST$REDF$NAME: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$RDEF,DNAT$,DNAT$INDEX) EQ 1
              THEN ERR$OUT(205);
              ELSE BEGIN
                   IF VALUE$ EQ 0 THEN GOTO EO$CASE;
                   SETFIELD(DN$RDEF,DNAT$,DNAT$INDEX,1);
                   AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF, 
                        DNAT$,DNAT$INDEX)); 
            SETFIELD(DN$AUXREF,DNAT$,DNAT$INDEX,AUX$INDEX); 
                   SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,RDEFNAME);
                   SETFIELD(AX$RDEFNAM,AUX$,AUX$INDEX,VALUE$);
                   END
              END 
              GOTO EO$CASE; 
     TST$REP$NAME: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$REPORTS,DNAT$,DNAT$INDEX) EQ 1 THEN
                   BEGIN
                   ERR$OUT(259);
                   SYNTAXONLY = 1;
                   END
              ELSE SETFIELD(DN$REPORTS,DNAT$,DNAT$INDEX,1); 
              END 
              GOTO EO$CASE; 
     ST$REP$NAME: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              AUX$INDEX=ADDNEWAUXENT( 
                GETQUICK(FN$RPTPTR,FNAT$,FNAT$INDEX));
           SETFIELD(FN$RPTPTR,FNAT$,FNAT$INDEX,AUX$INDEX);
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,REPORTNAM);
              SETFIELD(AX$RPTNAM,AUX$,AUX$INDEX,VALUE$);
              END 
              GOTO EO$CASE; 
     # HAND OFF TO D-ANALYZER         # 
  
     SET$SIGN$LDG: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$SIGNBIT,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(207);
              ELSE BEGIN
                   SETFIELD(DN$SIGNBIT,DNAT$,DNAT$INDEX,1); 
                   SETFIELD(DN$LSIGN,DNAT$,DNAT$INDEX,1); 
                   END
              END 
              GOTO EO$CASE; 
     SET$SIGN$TRL: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$SIGNBIT,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(207);
              ELSE SETFIELD(DN$SIGNBIT,DNAT$,DNAT$INDEX,1); 
              END 
              GOTO EO$CASE; 
     SET$SIGN$SEP: IF SYNTAXONLY EQ 0 THEN
              SETFIELD(DN$SCHAR,DNAT$,DNAT$INDEX,1);
              GOTO EO$CASE; 
     SET$USE$DISP: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
              ELSE SETFIELD(DN$USAGE,DNAT$,DNAT$INDEX,DISPUSE); 
              END 
              GOTO EO$CASE; 
     SET$USE$CMP: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
          ELSE
              BEGIN 
              IF CCTCOMPC1  THEN       # IF COMP = COMP-1              #
                  TEMP = COMP1USE;
              ELSE
                  TEMP = COMPUSE; 
              SETFIELD(DN$USAGE, DNAT$, DNAT$INDEX, TEMP);
              END 
              END 
              GOTO EO$CASE; 
     SET$USE$CMP1: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
              ELSE SETFIELD(DN$USAGE,DNAT$,DNAT$INDEX,COMP1USE);
              END 
              GOTO EO$CASE; 
     SET$USE$CMP2: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
              ELSE SETFIELD(DN$USAGE,DNAT$,DNAT$INDEX,COMP2USE);
              END 
              GOTO EO$CASE; 
   #USAGE IS COMPUTATIONAL-4# 
   SET$USE$CMP4:  
              IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
              ELSE SETFIELD (DN$USAGE,DNAT$,DNAT$INDEX,COMP4USE); 
              END 
              GOTO EO$CASE; 
     SET$USE$INDX: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
              ELSE BEGIN
                   SETFIELD(DN$USAGE,DNAT$,DNAT$INDEX,INDEXUSE);
                   SETFIELD(DN$USAGIDX,DNAT$,DNAT$INDEX,1); 
                   END
              END 
              GOTO EO$CASE; 
SET$USE$BIT:  
            IF  SYNTAXONLY EQ 0 
            THEN
                BEGIN 
                IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ NULL
                THEN ERR$OUT(208);
                ELSE  SETFIELD(DN$USAGE,DNAT$,DNAT$INDEX,BITUSE); 
                END 
            GOTO  EO$CASE;
     SET$USE$ERR: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
              IF GETQUICK(DN$USAGE,DNAT$,DNAT$INDEX) NQ  NULL 
              THEN ERR$OUT(208);
          ELSE  SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ERRTYPE) ;
              END 
              GOTO EO$CASE; 
     SET$ALL$FLAG: IF SYNTAXONLY EQ 0 THEN
              ALL$FLAG = 1; 
              GOTO EO$CASE; 
     SET$EXTERNAL:  
              IF SYNTAXONLY EQ 0 THEN 
                  BEGIN 
                  IF WORK$SECTION THEN
                    BEGIN 
                    IF GETQUICK(DN$EXTERNAL,DNAT$,DNAT$INDEX) EQ 1 THEN 
                        ERR$OUT(258); #DUP EXTERANL CLAUSE# 
                    ELSE
                        SETFIELD(DN$EXTERNAL,DNAT$,DNAT$INDEX,1); 
                    GOTO EO$CASE; 
                    END 
                  IF FILE$SECTION THEN
                    BEGIN 
                    IF GETQUICK(FN$EXTERNAL,FNAT$,FNAT$INDEX) EQ 1 THEN 
                        ERR$OUT(258); #DUP EXTERNAL CLAUSE# 
                    ELSE
                        SETFIELD(FN$EXTERNAL,FNAT$,FNAT$INDEX,1); 
                    GOTO EO$CASE; 
                    END 
                  END 
     ST$VAL$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$VALUE,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(209);
              ELSE BEGIN
                   IF GETQUICK(PL$FIGCON,PLT$,LITERAL$TEMP) NQ 0
                   THEN ALL$FLAG = 1; 
                   ELSE BEGIN 
                        IF GETQUICK(PL$CODE,PLT$,LITERAL$TEMP)
                        NQ PLTQUOTEDLIT AND 
                        GETQUICK(PL$CODE,PLT$,LITERAL$TEMP) 
                        NQ PLTBOOLLIT AND ALL$FLAG EQ 1 
                        THEN BEGIN
                             ALL$FLAG = 0;
                             ERR$OUT(210);
                             END
                        END 
                   SETFIELD(DN$VALUE,DNAT$,DNAT$INDEX,1); 
                   SETFIELD(PL$ALL,PLT$,LITERAL$TEMP,ALL$FLAG); 
                   SETFIELD(DN$PLTPTR,DNAT$,DNAT$INDEX,LITERAL$TEMP); 
                   ALL$FLAG = 0;
                   END
              END 
              GOTO EO$CASE; 
     TEST$BIT$VAL: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$LABVALU,DNAT$,DNAT$INDEX) EQ 1 
              THEN BEGIN
                   ERR$OUT(260);
                   SYNTAXONLY = 1;
                   END
              ELSE SETFIELD(DN$LABVALU,DNAT$,DNAT$INDEX,1); 
              END 
         # FIPS=2 SUPPORTS VALUE OF FOR RELATIVE FILES #
         FIPSLOG(786,RELATIVE,2); 
         # FIPS=4 SUPPORTS VALUE OF FOR INDEXED FILES # 
         FIPSLOG(787,INDEXED,4);
              GOTO EO$CASE; 
     ST$LBL$NAME: IF SYNTAXONLY EQ 0 THEN 
              BEGIN 
          TMP$STRING1[0] = " "; 
          TMP$STRING2[0] = " "; 
          TMP$STRING3[0] = " "; 
                GETPLST(VALUE$,LOC(STR$BASE));
              LBL$FLDINDEX=0; 
               IF GETQUICK(PL$6BITTYPE,PLT$,VALUE$) 
                      EQ PLTQUOTEDLIT 
              THEN FOR J =1 STEP 1  UNTIL LABEL$FLD$NO DO 
               BEGIN
                    IF LABEL$FLD$1[J] EQ  TMP$STRING1[0]
                       AND
                       LABEL$FLD$2[J] EQ  TMP$STRING2[0]
                       AND
                   LABEL$FLD$3[J] EQ TMP$STRING3[0] 
               THEN LBL$FLDINDEX=J; 
               END
              IF LBL$FLDINDEX EQ 0 THEN ERR$OUT(261); 
              END 
              GOTO EO$CASE; 
     ST$LABEL$LIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
                 SWITCH LABLCASEA INDEX0A,INDEX1A,INDEX2A,INDEX3A,
                   INDEX4A,INDEX5A,INDEX6A,INDEX7A,INDEX8A,INDEX9A; 
                 GOTO LABLCASEA[LBL$FLDINDEX];
         INDEX0A: SETFIELD(FN$LABLPTR0,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT0,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX1A: SETFIELD(FN$LABLPTR1,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT1,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX2A: SETFIELD(FN$LABLPTR2,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT2,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX3A: SETFIELD(FN$LABLPTR3,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT3,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX4A: SETFIELD(FN$LABLPTR4,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT4,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX5A: SETFIELD(FN$LABLPTR5,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT5,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX6A: SETFIELD(FN$LABLPTR6,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT6,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX7A: SETFIELD(FN$LABLPTR7,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT7,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX8A: SETFIELD(FN$LABLPTR8,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT8,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
         INDEX9A: SETFIELD(FN$LABLPTR9,FNAT$,FNAT$INDEX,LITERAL$TEMP);
                     SETFIELD(FN$LABLLIT9,FNAT$,FNAT$INDEX,1);
                     GOTO EO$CASE;
                     END
     ST$LABEL$VAL: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              # FIPS=3 SUPPORTS VALUE OF IMPLEMENTOR-NAME IS DATA-NAME# 
              FIPSLOG(795,SEQUENTIAL,3);
              FIPSLOG(795,RELATIVE,3);
              #FIPS=4 SUPPORTS VALUE OF IMPLEMENTOR-NAME IS DATA-NAME # 
              FIPSLOG(796,INDEXED,4); 
                 SWITCH LABLCASEB INDEX0B,INDEX1B,INDEX2B,INDEX3B,
        INDEX4B,INDEX5B,INDEX6B,INDEX7B,INDEX8B,INDEX9B;
                 GOTO LABLCASEB[LBL$FLDINDEX];
     INDEX0B: 
          SETFIELD(FN$LABLPTR0,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT0,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX1B: 
          SETFIELD(FN$LABLPTR1,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT1,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX2B: 
          SETFIELD(FN$LABLPTR2,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT2,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX3B: 
          SETFIELD(FN$LABLPTR3,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT3,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX4B: 
          SETFIELD(FN$LABLPTR4,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT4,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX5B: 
          SETFIELD(FN$LABLPTR5,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT5,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX6B: 
          SETFIELD(FN$LABLPTR6,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT6,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX7B: 
          SETFIELD(FN$LABLPTR7,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT7,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX8B: 
          SETFIELD(FN$LABLPTR8,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT8,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
     INDEX9B: 
          SETFIELD(FN$LABLPTR9,FNAT$,FNAT$INDEX,VALUE$);
                     SETFIELD(FN$LABLLIT9,FNAT$,FNAT$INDEX,0);
                     GOTO EO$CASE;
              END 
              GOTO EO$CASE; 
     SET$SYNC$BIT: IF SYNTAXONLY EQ 0 THEN
              BEGIN 
              IF GETQUICK(DN$SYNC,DNAT$,DNAT$INDEX) EQ 1
              THEN ERR$OUT(211);
              ELSE SETFIELD(DN$SYNC,DNAT$,DNAT$INDEX,1);
              END 
              GOTO EO$CASE; 
     SETUP$DNAT: BEGIN
         DNAT$INDEX=VALUE$; 
         LASTDATADNAT=DNAT$INDEX; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,LEVEL$SAVE);
         END
         GOTO EO$CASE;
     ST$RENAMES:  
              SETFIELD(DN$STRENAM,DNAT$,DNAT$INDEX,VALUE$); 
              GOTO EO$CASE; 
     ST$RENAMES2: 
              SETFIELD(DN$ENRENAM,DNAT$,DNAT$INDEX,VALUE$); 
              GOTO EO$CASE; 
     SET$PRD$BIT: 
              BEGIN 
              IF GETQUICK(DN$LEVEL,DNAT$,DNAT$INDEX) EQ 50
              THEN BEGIN
                   # MUST NOT CLOBBER DN$LONGOFF FOR CD ITEMS # 
                   GOTO EO$CASE;
                   END
              IF GETQUICK(DN$TERMPER,DNAT$,DNAT$INDEX) EQ 1 
              THEN ERR$OUT(212);
              ELSE SETFIELD(DN$TERMPER,DNAT$,DNAT$INDEX,1); 
              END 
              GOTO EO$CASE; 
     SET$88$DNAT: BEGIN 
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,88);
         SETFIELD(DN$88DNREF,DNAT$,DNAT$INDEX,LASTDATADNAT);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ERRTYPE);
         END
         GOTO EO$CASE;
     SETUP$CT$PTR: BEGIN
         # C$PTR$ IS A BYTE INDEX IN THE DRIVER # 
         # IT IS A HALF WORD INDEX WHEN STORED IN DNAT #
     SETFIELD(DN$88CPTR,DNAT$,DNAT$INDEX,CTEXTINDEX); 
         IF LASTDATADNAT NQ  0
         THEN SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA); 
         END
         GOTO EO$CASE;
     CLEAR$CT$PTR: BEGIN
         SETFIELD(DN$88CPTR,DNAT$,DNAT$INDEX,0);
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,ERRTYPE);
         END
         GOTO EO$CASE;
     SETFIL$TO$X2: SETFIELD(DN$FILLREF,DNAT$,DNAT$INDEX,1); 
         GOTO EO$CASE;
     SETUP$FDNAME: BEGIN
         LASTDATADNAT=0;
         DNAT$INDEX=VALUE$+1; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         DNAT$INDEX=DNAT$INDEX-1; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,FDDESCR); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         NEXT$FNAT = NEXT$FNAT + 1; 
         SETFIELD(DN$FNATPTR,DNAT$,DNAT$INDEX,NEXT$FNAT); 
         FNAT$INDEX=NEXT$FNAT;
         CREATE$ENTRY(FNAT$,FNAT$INDEX);
              SETFIELD(FN$SELECT,FNAT$,FNAT$INDEX,0); 
         END
         # FIPS=2 SUPPORTS FD LEVEL DESCRIPTIONS #
         # FOR RELATIVE FILES # 
         FIPSLOG(792,RELATIVE,2); 
         # FIPS=4 SUPPORTS FD LEVEL DESCRIPTIONS FOR INDEXED FILES #
         FIPSLOG(780,INDEXED,4);
         GOTO EO$CASE;
     SETUP$SDNAME: BEGIN
         LASTDATADNAT=0;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,SDDESCR); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         NEXT$FNAT = NEXT$FNAT + 1; 
         SETFIELD(DN$FNATPTR,DNAT$,DNAT$INDEX,NEXT$FNAT); 
         FNAT$INDEX=NEXT$FNAT;
         CREATE$ENTRY(FNAT$,FNAT$INDEX);
              SETFIELD(FN$SELECT,FNAT$,FNAT$INDEX,0); 
         END
         GOTO EO$CASE;
     SETUP$CDNAME: BEGIN
         LASTDATADNAT=0;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,CDDESCR); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         END
         GOTO EO$CASE;
     SETUP$RDNAME: BEGIN
         LASTDATADNAT=0;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,RDDESCR); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         END
         GOTO EO$CASE;
     SET$INIT$BIT: BEGIN
         SETFIELD(DN$CDINP,DNAT$,DNAT$INDEX,1); 
         SETFIELD(DN$CDINIT,DNAT$,DNAT$INDEX,1);
          IF CCTSUBPROGR
          THEN BEGIN
               # A SUBPROGRAM MUST NOT CONTAIN #
               # A CD FOR INITIAL INPUT # 
               ERR$OUT(342);
               END
          CCTINITCD = DNAT$INDEX; 
         CD$OUT$FLAG=FALSE; 
         CDOUTDNATPTR=0;
         END
         GOTO EO$CASE;
     SET$INPT$BIT: BEGIN
         SETFIELD(DN$CDINP,DNAT$,DNAT$INDEX,1); 
         SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,87); 
         CD$OUT$FLAG=FALSE; 
         CDOUTDNATPTR=0;
         END
         GOTO EO$CASE;
     SET$CD$DATA: BEGIN 
          CD$NAME$CNTR = 0; 
         END
         GOTO EO$CASE;
     NEXT$CD$DATA: BEGIN
          CD$NAME$CNTR = CD$NAME$CNTR + 1;
              IF CD$NAME$CNTR GQ 12 THEN ERR$OUT(213);
              ELSE BEGIN
                   SETUP$CD(CD$NAME$CNTR);
                   END
         END
         GOTO EO$CASE;
SKIP$FILLER:  
         CD$NAME$CNTR = CD$NAME$CNTR + 1; 
         IF CD$NAME$CNTR GQ 12 THEN ERR$OUT(213); 
         GOTO EO$CASE;
GOT$11$DATA:  
          IF CD$NAME$CNTR LS 11 THEN ERR$OUT(214);
         GOTO EO$CASE;
     SET$OUTPTBIT: BEGIN
         SETFIELD(DN$CDOUT,DNAT$,DNAT$INDEX,1); 
         CD$OUT$FLAG=TRUE;
         CDOUTDNATPTR=DNAT$INDEX; 
         SETFIELD(DN$ITMLEN,DNAT$,DNAT$INDEX,23); 
         CDERRDNATPTR=0;
         CDDESDNATPTR=0;
         END
         GOTO EO$CASE;
     TST$FD$CNTXT: IF NOT FD$SD$LEGAL THEN ERR$OUT(215);
         GOTO EO$CASE;
     TST$SD$CNTXT: IF NOT FD$SD$LEGAL THEN ERR$OUT(216);
         GOTO EO$CASE;
     TST$CD$CNTXT: IF NOT CD$LEGAL THEN ERR$OUT(217); 
         GOTO EO$CASE;
     SET$FILE$SEC: BEGIN
         LASTDATADNAT=0;
         IF FILE$SECTION THEN ERR$OUT(218); 
         IF WORK$SECTION THEN ERR$OUT(219); 
        IF COMSTOR$SECT THEN ERR$OUT(219);
        IF SECSTOR$SECT THEN ERR$OUT(219);
         IF LINK$SECTION THEN ERR$OUT(219); 
         IF COMM$SECTION THEN ERR$OUT(219); 
         FILE$SECTION = TRUE; 
         FD$SD$LEGAL = TRUE;
         CD$LEGAL = FALSE;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,FDSECTN); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         END
         GOTO EO$CASE;
     SET$WS$SEC: BEGIN
         LASTDATADNAT=0;
         IF WORK$SECTION THEN ERR$OUT(220); 
         IF LINK$SECTION THEN ERR$OUT(221); 
         IF COMM$SECTION THEN ERR$OUT(221); 
        IF SECSTOR$SECT THEN ERR$OUT(221);
         WORK$SECTION = TRUE; 
         FD$SD$LEGAL = FALSE; 
         CD$LEGAL = FALSE;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
      SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$); 
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,WSSECTN); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         END
         GOTO EO$CASE;
     SET$LINK$SEC: BEGIN
         LASTDATADNAT=0;
         IF LINK$SECTION THEN ERR$OUT(222); 
         IF COMM$SECTION THEN ERR$OUT(223); 
         LINK$SECTION = TRUE; 
         FD$SD$LEGAL = FALSE; 
         CD$LEGAL = FALSE;
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
      SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$); 
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,LKSECTN); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         END
         GOTO EO$CASE;
     SET$COMM$SEC: BEGIN
         LASTDATADNAT=0;
         IF COMM$SECTION THEN ERR$OUT(224); 
         COMM$SECTION = TRUE; 
         FD$SD$LEGAL = FALSE; 
         CD$LEGAL = TRUE; 
         DNAT$INDEX=VALUE$; 
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,CDSECTN); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         GOTO EO$CASE;
         END
     SET$QUEUE: SETUP$CD(1);
         GOTO EO$CASE;
     SET$SQUEUE1: SETUP$CD(2);
         GOTO EO$CASE;
     SET$SQUEUE2: SETUP$CD(3);
         GOTO EO$CASE;
     SET$SQUEUE3: SETUP$CD(4);
         GOTO EO$CASE;
     SETUP$SOURCE: SETUP$CD(7); 
         GOTO EO$CASE;
     SETUP$DESTIN: BEGIN
         SETUP$CD(16);
         IF GETQUICK(DN$OCCURS,DNAT$,CDOUTDNATPTR) EQ 0 
         THEN CDDESDNATPTR=DNAT$INDEX;
         ELSE BEGIN 
              SETFIELD(DN$SDEPTH,DNAT$,DNAT$INDEX,1); 
              AUX$INDEX=FIND$AUX$ENT(GETQUICK(DN$AUXREF,
                   DNAT$,CDOUTDNATPTR),DESTLIT);
              T$REG=GETQUICK(AX$DESTCNT,AUX$,AUX$INDEX);
              AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,
                   DNAT$,DNAT$INDEX));
ITEM TMHTEMP; 
TMHTEMP = AUX$INDEX;
            SETFIELD(DN$AUXREF,DNAT$,DNAT$INDEX,AUX$INDEX); 
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,MAXOCCUR); 
              SETFIELD(AX$MAXOCCNO,AUX$,AUX$INDEX,T$REG); 
              SETFIELD(AX$OCCLEN,AUX$,AUX$INDEX,13);
              SETFIELD(AX$SUBSLVL,AUX$,AUX$INDEX,1);
              IF GETQUICK(DN$INDEXED,DNAT$,CDOUTDNATPTR) EQ 1 THEN
                   BEGIN
                   AUX$INDEX=FIND$AUX$ENT(GETQUICK(DN$AUXREF,DNAT$, 
                        CDOUTDNATPTR),CDINDX);
                   FOR $$$DUMMY$$$$ = 0 WHILE AUX$INDEX NQ 0 DO 
                        BEGIN 
                        TEMPER = GETQUICK(AX$CDINDXPTR,AUX$,AUX$INDEX); 
                        SETFIELD(DN$LASIDX,DNAT$,TEMPER 
                           ,DNAT$INDEX);
SETFIELD(DN$AUXREF,DNAT$,TEMPER,TMHTEMP); 
                        AUX$INDEX=FIND$AUX$ENT(GETQUICK(AX$TNEXTPTR,
                             AUX$,AUX$INDEX),CDINDX); 
                        END 
                   END
              END 
         END
         GOTO EO$CASE;
     SET$MESS$CNT: SETUP$CD(11);
         GOTO EO$CASE;
     SET$DEST$CNT: SETUP$CD(12);
         GOTO EO$CASE;
     SET$TEXT$LEN: IF CD$OUT$FLAG 
         THEN SETUP$CD(13); 
         ELSE SETUP$CD(8);
         GOTO EO$CASE;
     SET$STAT$KEY: IF CD$OUT$FLAG 
         THEN SETUP$CD(14); 
         ELSE SETUP$CD(10); 
         GOTO EO$CASE;
     SET$ERR$KEY: BEGIN 
         SETUP$CD(15);
         IF GETQUICK(DN$OCCURS,DNAT$,CDOUTDNATPTR) EQ 0 
         THEN CDERRDNATPTR=DNAT$INDEX;
         ELSE BEGIN 
              SETFIELD(DN$SDEPTH,DNAT$,DNAT$INDEX,1); 
              AUX$INDEX=FIND$AUX$ENT(GETQUICK(DN$AUXREF,
                   DNAT$,CDOUTDNATPTR),DESTLIT);
              T$REG=GETQUICK(AX$DESTCNT,AUX$,AUX$INDEX);
              AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,
                   DNAT$,DNAT$INDEX));
            SETFIELD(DN$AUXREF,DNAT$,DNAT$INDEX,AUX$INDEX); 
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,MAXOCCUR); 
              SETFIELD(AX$MAXOCCNO,AUX$,AUX$INDEX,T$REG); 
              SETFIELD(AX$OCCLEN,AUX$,AUX$INDEX,13);
              SETFIELD(AX$SUBSLVL,AUX$,AUX$INDEX,1);
              IF GETQUICK(DN$INDEXED,DNAT$,CDOUTDNATPTR) EQ 1 
              THEN BEGIN
                   AUX$INDEX=FIND$AUX$ENT(GETQUICK(DN$AUXREF,DNAT$, 
                        CDOUTDNATPTR),CDINDX);
                   FOR $$$DUMMY$$$$ = 0 WHILE AUX$INDEX NQ 0 DO 
                        BEGIN 
                        TEMPER = GETQUICK(AX$CDINDXPTR,AUX$,AUX$INDEX); 
                        SETFIELD(DN$FIRIDX,DNAT$,TEMPER 
                            ,DNAT$INDEX); 
                        AUX$INDEX=FIND$AUX$ENT(GETQUICK(AX$TNEXTPTR,
                             AUX$,AUX$INDEX),CDINDX); 
                        END 
                   END
              END 
         END
              GOTO EO$CASE; 
     SET$MES$TIME: SETUP$CD(6); 
         GOTO EO$CASE;
     SET$MES$DATE: SETUP$CD(5); 
         GOTO EO$CASE;
     SET$END$KEY: SETUP$CD(9);
         GOTO EO$CASE;
     ST$DEST$TBL: IF CD$OUT$FLAG THEN 
              BEGIN 
              INT$OR$DIAG(225); 
              SETFIELD(DN$OCCURS,DNAT$,CDOUTDNATPTR,1); 
              SETFIELD(DN$ITMLEN,DNAT$,CDOUTDNATPTR,10+13*T$REG); 
              IF CDERRDNATPTR  EQ  0  OR
                   CDDESDNATPTR EQ 0
              THEN BEGIN
                   AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,DNAT$, 
                        CDOUTDNATPTR)); 
                   SETFIELD(DN$AUXREF, DNAT$, CDOUTDNATPTR, AUX$INDEX); 
                   SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,DESTLIT); 
                   SETFIELD(AX$DESTCNT,AUX$,AUX$INDEX,T$REG); 
                   END
              IF CDERRDNATPTR NQ  0 
              THEN BEGIN
                   AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,DNAT$, 
                        CDERRDNATPTR)); 
                   SETFIELD(DN$AUXREF, DNAT$, CDERRDNATPTR, AUX$INDEX); 
                   SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,MAXOCCUR);
                   SETFIELD(AX$MAXOCCNO,AUX$,AUX$INDEX,T$REG);
                   SETFIELD(AX$OCCLEN,AUX$,AUX$INDEX,13); 
                   SETFIELD(AX$SUBSLVL,AUX$,AUX$INDEX,1); 
                   END
              IF CDDESDNATPTR NQ  0 
              THEN BEGIN
                   AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,DNAT$, 
                        CDDESDNATPTR)); 
                   SETFIELD(DN$AUXREF, DNAT$, CDDESDNATPTR, AUX$INDEX); 
                   SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,MAXOCCUR);
                   SETFIELD(AX$MAXOCCNO,AUX$,AUX$INDEX,T$REG);
                   SETFIELD(AX$OCCLEN,AUX$,AUX$INDEX,13); 
                   SETFIELD(AX$SUBSLVL,AUX$,AUX$INDEX,1); 
                   END
              END 
              GOTO EO$CASE; 
  
SUB99:  
# LINE AND COLUMN # 
         VERBLINE = LINE$;
         VERBCOLUMN = COLUMN$;
         GOTO EO$CASE;
  
SUB100: 
# FIPS ROUTINE FOR LABEL RECORDS #
         # FIPS=2 SUPPORTS LABEL RECORDS CLAUSE FOR RELATIVE FILES #
         FIPSLOG(788,RELATIVE,2); 
         # FIPS=4 SUPPORTS LABEL RECORDS CLAUSE FOR INDEXED FILES # 
         FIPSLOG(789,INDEXED,4);
         GOTO EO$CASE;
  
 TST$OCRS$BIT:  
         IF GETQUICK(DN$OCCURS,DNAT$,DNAT$INDEX) EQ 0 
         THEN 
             BEGIN
             TRUEFALSE = 0; 
             END
         SYNTAXONLY = 0;
         GOTO EO$CASE;
  
 CD$INDX$PROC:  
         BEGIN
         LASTDATADNAT=0;
         CREATE$ENTRY(DNAT$,DNAT$INDEX);
         SETFIELD(DN$LEVEL,DNAT$,VALUE$,INDXLEVL);
         SETFIELD(DN$IDXDEP,DNAT$,VALUE$,1);
         SETFIELD(DN$LINE,DNAT$,VALUE$,LINE$);
         IF CDERRDNATPTR  EQ  0  OR 
              CDDESDNATPTR EQ 0 
         THEN BEGIN 
              SETFIELD(DN$INDEXED,DNAT$,CDOUTDNATPTR,1);
              AUX$INDEX=ADDNEWAUXENT(GETQUICK(DN$AUXREF,DNAT$,
                   CDOUTDNATPTR));
              SETFIELD(DN$AUXREF, DNAT$, CDOUTDNATPTR, AUX$INDEX);
              SETFIELD(AX$TTYPE,AUX$,AUX$INDEX,CDINDX); 
              SETFIELD(AX$CDINDXPTR,AUX$,AUX$INDEX,VALUE$); 
              END 
         IF CDERRDNATPTR NQ  0
         THEN SETFIELD(DN$FIRIDX,DNAT$,VALUE$,CDERRDNATPTR);
         IF CDDESDNATPTR NQ  0
         THEN SETFIELD(DN$LASIDX,DNAT$,VALUE$,CDDESDNATPTR);
         END
         GOTO EO$CASE;
  
 SET$0$DNAT:  
         CDOUTDNATPTR = 0;
         GOTO EO$CASE;
  
 DP$INIT: 
         BEGIN
         W3 = 0;     # FIPS WORK3 INDEX                                #
         CCTINITCD = 0; 
         CCTLINAGE = 0; 
         LASTDATADNAT=0;
         FILE$SECTION = FALSE;
         WORK$SECTION = FALSE;
         COMM$SECTION = FALSE;
         LINK$SECTION = FALSE;
         COMSTOR$SECT = FALSE;
         SECSTOR$SECT = FALSE;
         SEEN$IDX$PHR = FALSE;
         SECSTOR$SECT = FALSE;
         NEXT$FNAT=CCTFNATLEN;
         NXT$AUX$ENT=CCTAUXTLEN;
         NEXT$LAT=CCTLATLEN;
  
          # INITIALIZE THE DNAT ENTRIES FOR THE SPECIAL REGISTERS # 
          # HASHED-VALUE AND DEBUG-ITEM WITH ITS SUBORDINATES.    # 
          #     ***** INITIALIZE HASHED-VALUE *****     # 
         SETFIELD(DN$LEVEL,DNAT$,HASHEDVALUE,1);
         SETFIELD(DN$MAJMSEC,DNAT$,HASHEDVALUE,SREGMSEC); 
         SETFIELD(DN$ITMLEN,DNAT$,HASHEDVALUE,10);
         SETFIELD(DN$NUMLEN,DNAT$,HASHEDVALUE,8); 
         SETFIELD(DN$TYPE,DNAT$,HASHEDVALUE,COMP1); 
         SETFIELD(DN$SYNC,DNAT$,HASHEDVALUE,1); 
          # UPDATE CCTMSECLEN [ SREGMSEC ]         #
          CCTMSECLEN[SREGMSEC] = CCTMSECLEN[SREGMSEC] + 10; 
          #     ***** INITIALIZE DEBUG-ITEM *****     # 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGITEM,1);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGITEM,SREGMSEC); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGITEM,75);
         SETFIELD(DN$TYPE,DNAT$,DEBUGITEM,GROUP); 
  
          #     ***** INITIALIZE DEBUG-LINE *****     # 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGLINE,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGLINE,SREGMSEC); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGLINE,6); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGLINE,ALPHNUM); 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGLINE + 1,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGLINE + 1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGLINE + 1,6); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGLINE + 1,1); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGLINE + 1,ALPHNUM); 
  
          #     ***** INITIALIZE DEBUG-NAME *****     # 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGNAME,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGNAME,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGNAME,7); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGNAME,30);
         SETFIELD(DN$TYPE,DNAT$,DEBUGNAME,ALPHNUM); 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGNAME + 1,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGNAME + 1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGNAME + 1,37);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGNAME + 1,1); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGNAME + 1,ALPHNUM); 
  
          #     ***** INITIALIZE DEBUG-SUB-1 *****     #
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB1,2);
         SETFIELD(DN$SIGNBIT,DNAT$,DEBUGSUB1,1);
         SETFIELD(DN$LSIGN,DNAT$,DEBUGSUB1,1);
         SETFIELD(DN$SCHAR,DNAT$,DEBUGSUB1,1);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB1,38);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB1,5); 
         SETFIELD(DN$NUMLEN,DNAT$,DEBUGSUB1,4); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB1,NUMERIC); 
         SETFIELD(DN$PICSIGN,DNAT$,DEBUGSUB1,1);
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB1 + 1,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB1 + 1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB1 + 1,43);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB1 + 1,1); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB1 + 1,ALPHNUM); 
  
          #     ***** INITIALIZE DEBUG-SUB-2 *****     #
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB2,2);
         SETFIELD(DN$SIGNBIT,DNAT$,DEBUGSUB2,1);
         SETFIELD(DN$LSIGN,DNAT$,DEBUGSUB2,1);
         SETFIELD(DN$SCHAR,DNAT$,DEBUGSUB2,1);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB2,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB2,44);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB2,5); 
         SETFIELD(DN$NUMLEN,DNAT$,DEBUGSUB2,4); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB2,NUMERIC); 
         SETFIELD(DN$PICSIGN,DNAT$,DEBUGSUB2,1);
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB2 + 1,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB2 + 1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB2 + 1,49);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB2 + 1,1); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB2 + 1,ALPHNUM); 
  
          #     ***** INITIALIZE DEBUG-SUB-3 *****     #
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB3,2);
         SETFIELD(DN$SIGNBIT,DNAT$,DEBUGSUB3,1);
         SETFIELD(DN$LSIGN,DNAT$,DEBUGSUB3,1);
         SETFIELD(DN$SCHAR,DNAT$,DEBUGSUB3,1);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB3,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB3,50);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB3,5); 
         SETFIELD(DN$NUMLEN,DNAT$,DEBUGSUB3,4); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB3,NUMERIC); 
         SETFIELD(DN$PICSIGN,DNAT$,DEBUGSUB3,1);
         SETFIELD(DN$LEVEL,DNAT$,DEBUGSUB3 + 1,2);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGSUB3 + 1,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGSUB3 + 1,55);
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGSUB3 + 1,1); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGSUB3 + 1,ALPHNUM); 
  
          #     ***** INITIALIZE DEBUG-CONTENTS *****     # 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGCONTS,2); 
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGCONTS,SREGMSEC);
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGCONTS,56); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGCONTS,19); 
         SETFIELD(DN$TYPE,DNAT$,DEBUGCONTS,ALPHNUM);
  
          #     ***** INITIALIZE DEBUG-NUMERIC-CONTENTS *****     # 
          TEMP = 0; 
         SETFIELD(DN$LEVEL,DNAT$,DEBUGNUMCON,2);
         SETFIELD(DN$SIGNBIT,DNAT$,DEBUGNUMCON,1);
         SETFIELD(DN$LSIGN,DNAT$,DEBUGNUMCON,1);
         SETFIELD(DN$SCHAR,DNAT$,DEBUGNUMCON,1);
         SETFIELD(DN$MAJMSEC,DNAT$,DEBUGNUMCON,SREGMSEC); 
         SETFIELD(DN$BYTEOFFS,DNAT$,DEBUGNUMCON,56);
          # ATTACH A REDEFINES AUX ENTRY #
          NXT$AUX$ENT = NXT$AUX$ENT + 1;
          B<0,15>TEMP = NXT$AUX$ENT;        # AUX-ENTRY POINTER # 
          SETFIELD(AX$TTYPE,AUX$,NXT$AUX$ENT,RDEFNAME); 
          SETFIELD(AX$TNEXTPTR,AUX$,NXT$AUX$ENT,0); 
          SETFIELD(AX$RDEFNAM,AUX$,NXT$AUX$ENT,DEBUGCONTS); 
         SETFIELD(DN$ITMLEN,DNAT$,DEBUGNUMCON,19);
         SETFIELD(DN$POINT,DNAT$,DEBUGNUMCON,9);
         SETFIELD(DN$NUMLEN,DNAT$,DEBUGNUMCON,18);
         SETFIELD(DN$TYPE,DNAT$,DEBUGNUMCON,NUMERIC); 
         SETFIELD(DN$RDEF,DNAT$,DEBUGNUMCON,1); 
         SETFIELD(DN$PICSIGN,DNAT$,DEBUGNUMCON,1);
         END
         GOTO EO$CASE;
     SAVE$LEVEL: LEVEL$SAVE = VALUE$; 
         GOTO EO$CASE;
     LIT$ROUTINE: LITERAL$TEMP = VALUE$;
         GOTO EO$CASE;
     DP$EPILOGUE: BEGIN 
         CCTFNATLEN = NEXT$FNAT;
         CCTAUXTLEN = NXT$AUX$ENT;
         CCTLATLEN = NEXT$LAT;
         CCTLATDDLNGT=NEXT$LAT; 
         GOTO EO$CASE;
         END
     ST$CODE$SET: IF SYNTAXONLY EQ 0
              THEN BEGIN
                   IF GETQUICK(FN$CODEPTR,FNAT$,FNAT$INDEX)  EQ  0
                   THEN SETFIELD(FN$CODEPTR,FNAT$,
                       FNAT$INDEX,VALUE$);
                   ELSE ERR$OUT(509); 
                 END
                GOTO EO$CASE; 
    SYNC$RIGHT: 
           IF SYNTAXONLY EQ 0 THEN
           SETFIELD(DN$SYNCRGHT,DNAT$,DNAT$INDEX,1);
            GOTO EO$CASE; 
    SET$CS$SEC:  BEGIN
         LASTDATADNAT = 0;
         IF COMSTOR$SECT THEN ERR$OUT(232); 
         IF WORK$SECTION THEN ERR$OUT(239); 
         IF SECSTOR$SECT THEN ERR$OUT(239); 
         IF LINK$SECTION THEN ERR$OUT(239); 
         IF COMM$SECTION THEN ERR$OUT(239); 
         COMSTOR$SECT = TRUE; 
         FD$SD$LEGAL = FALSE; 
         CD$LEGAL = FALSE;
         DNAT$INDEX = VALUE$; 
         SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
         SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,CSSECTN); 
         SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         GOTO EO$CASE;   END
  
  
    SET$SS$SEC:  BEGIN
           LASTDATADNAT = 0;
           IF SECSTOR$SECT THEN ERR$OUT(237); 
           IF LINK$SECTION THEN ERR$OUT(238); 
           IF COMM$SECTION THEN ERR$OUT(238); 
           SECSTOR$SECT = TRUE; 
           FD$SD$LEGAL = FALSE; 
           CD$LEGAL = FALSE;
           DNAT$INDEX = VALUE$; 
           SETFIELD(DN$LINE,DNAT$,DNAT$INDEX,LINE$);
           SETFIELD(DN$LEVEL,DNAT$,DNAT$INDEX,SSSECTN); 
           SETFIELD(DN$TYPE,DNAT$,DNAT$INDEX,NONDATA);
         GOTO EO$CASE;
         END
  
SET$RECCONT$: 
#SET RECORD CONTAINS(VARYING) BIT#
          IF SYNTAXONLY EQ 0
          THEN
              BEGIN 
              SETFIELD(DN$RECCONT,DNAT$,DNAT$INDEX,1);
              END 
          GOTO EO$CASE; 
  
    ST$DEP$NAME:   BEGIN
         SETFIELD(FN$RCDEPPTR,FNAT$,FNAT$INDEX,VALUE$); 
         GOTO EO$CASE;
             END
  
     TESTFORZERO: 
         BEGIN
          TRUEFALSE = GETQUICK(PL$FIGZERO,PLT$,VALUE$); 
         GOTO EO$CASE;
         END
  
  
  
     EO$CASE: END          #  END OF D-SUBS  #
TERM
