*DECK DA4 
USETEXT DNTEXT
PROC DA4; 
BEGIN 
#CALL DACOMDK FOR GLOBAL DEFS AND DECLARATIONS# 
CONTROL NOLIST; 
*CALL DACOMDK 
CONTROL LIST; 
#DECLARE XDEFS FOR PART 4#
XDEF
*CALL DAPT4 
#DECLARE XREFS FOR PARTS 1, 2 AND 3#
XREF
*CALL DAPT1 
XREF
*CALL DAPT2 
XREF
*CALL DAPT3 
         ITEM REG1; 
         ITEM REG2; 
         ARRAY [1:14] S(1); 
               BEGIN
               ITEM ITEMLENGTH1 U(0,0,30) 
               = [1,2,2,3,3,4,5,5,6,6,7,7,8,8]; 
               ITEM ITEMLENGTH2 U(0,30,30)
               = [1,2,2,3,3,4,4,5,5,6,7,7,8,8]; 
               END
PROC TESTOCCLEN (P1); 
         BEGIN
         ITEM P1; 
         IF P1 GR 65535 
         THEN BEGIN 
              # OCCURRENCE LENGTH EXCEEDS 65535 # 
              ERROR(MSG202,D$ERROR);
              END 
         END # TESTOCCLEN # 
ITEM BITS;
ITEM BYTES; 
DEF BITSPERBYTE #6#;
CONTROL EJECT;
PROC SUM$GROUP; 
BEGIN #AA#
#SUM GROUP PROCESSOR. 
THIS PROCEDURE IS ENTERED WHEN THE FINAL ITEM OF A GROUP
HAS BEEN PROCESSED. 
THE ENTIRE PROCEDURE IS A LARGE "DO WHILE" LOOP WHICH IS REPEATEED
AS MANY TIMES AS IS NECESSARY FOR THE VARIOUS NESTED GROUPS, UP 
UNTIL THE GROUP JUST "CLEANED UP" IS AT THE SAME LEVEL AS THE NEXT
NON 77 88 ITEM. 
* 
THE OVERALL PHASES OF THE SUM GROUP PROCESSOR ARE : 
  1. CHECK IF THE CURRENT GROUP ITEM IS THAT WHICH
    CONTAINED A SYNCHRONIZED, USAGE, OR SIGN CLAUSE,
    AND IF SO, RESET THE CORRESPONDING FLAGS AND POINTERS 
    THAT WERE USED TO HAND ON THESE ATTRIBUTES TO SUBORDINATE 
    ITEMS.
  2.CHECK IF THIS GROUP ITEM OCCURS    AND IF SO....
    A. CHECK "DEPENDING ON" VALIDITY
    B. UPDATE DNAT ENTRIES FOR INDEX ITEMS FOR THIS GROUP 
    C. COMPUTES SLACK BYTES FOR THE GROUP ITEM
    D. COMPUTE GROUP ITEM LENGTH AND CREATE MAXOCCUR
      TYPE OF AUXTABLE ENTRY
    E. CHECK KEY ITEM"S VALIDITY
    F. CHECK REDEFINITION VALIDITY. 
* 
ON ENTRY IT IS ASSUMED THAT:  
  * GRP$ST[GRP$ST$PTR] CONTAINS THE DNAT POINTERS OF
    THE CURRENT GROUP ITEM. 
  * THE FOLLOWING FIELDS CONTAIN THE DNAT$PTRS OF THE LAST
    ENCOUNTERED GROUP ITEMS HAVING THE CORRESPONDING
    CLAUSES PRESENT 
    *SYNC$PTR SYNCHRONIZED CLAUSE 
    * USAGE$PTR USAGE CLAUSE
    * SIGN$PTR SIGN CLAUSE
    * VALUE$PTR VALUE CLAUSE
  * NO$SIGND$PIC =1 IF NO SIGNED PIC CLAUSE WAS FOUND 
  * SYNC$GROUP[SUB$DEPTH] =1 IF THE CURRENT SUBSCRIPT DEPTH 
    CONTAINS ONE OR MORE SYNCHRONIZED ITEMS 
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * BYTES$PER$WD =10 FOR THE CYBER
  * NAB IS THE NEXT AVAILABLE BYTE (WITHIN MSEC) AFTER THE
    LAST ITEM IN THE GROUP (BUT NOT TAKING ACCOUNT OF ANY 
    OCCURRENCES 
  * RDEF$NAB$ST[RDEF$ST$PTR] CONTAINS THE NEXT AVAILABLE BYTE 
    AFTER ALLOCATING SPACE FOR AN ITEM THAT IS SUBSEQUENTLY 
    REDEFINED 
  * OCCUR$NAME[SUB$DEPTH] CONTAINS THE DNAT PTR TO THE ITEM 
    (IF ANY) THAT HAS AN OCCURS CLAUSE AT THIS SUBSCRIPT
    DEPTH 
# 
#LOCAL VARIABLES# 
ITEM LAUX$PTR;  #AUXTABLE POINTER#
ITEM LDNAT$PTR;  #DNAT POINTER# 
ITEM LDNAT$LIOG;  #DNAT PTR OF LAST ITEM IN GROUP#
ITEM LNOCWIG;  #NUMBER OF COMPLETELY FILLED WORDS OF GRP ITEM#
ITEM LISL$BYTES;  #INTERMEDIATE SLACK BYTE FIGURE#
ITEM LDNAT$KEYN;  #TEMP DNAT PTR TO KEY DATA ITEM#
ITEM LAUX$KEYGR;  #TEMPORARY DNAT PTR TO KEYED GROUP ITEM#
##
ENTRY$(27,"SUM$GROUP"); 
FOR ZERO = 0 WHILE GRP$ST$PTR GR 0 DO #LOOP FOR ALL ENTRIES#
  BEGIN #A# #THIS BLOCK IS THE ENTIRE SUM$GROUP PROC# 
    GROUP$PTR=GRP$ST[GRP$ST$PTR]; #SET GRP PTR TO NEXT ENT IN STK#
                        VALUE$(27,"GROUPPTR=",GROUP$PTR); 
    GROUP$LEVEL=GETQUICK(DN$LEVEL,DNAT$,GROUP$PTR); 
                         VALUE$(27,"GRPLEVEL=",GROUP$LEVEL);
            #PICKUP LEVEL FROM SPECIFIED ENTRY# 
    IF NANSILVLNOFG AND NXT$ITM$LVL GR GROUP$LEVEL
       AND NXT$ITM$LVL LQ 49           # BETWEEN 01 AND 49             #
    THEN
      BEGIN 
      GOTO END$SUM$GRP; 
      END 
    IF SYNC$PTR EQ GROUP$PTR  #CHK IF CURR ENT HAS SYNC PHR#
      THEN SYNC$FLAG=0;  #CLEAR SYNC FLAG#
    IF USAGE$PTR EQ GROUP$PTR  #CHK IF CURR ENT HAD USAGE PHR#
      THEN USAGE$FLAG=0;  #CLEAR USAGE FLAG#
    IF SIGN$PTR EQ GROUP$PTR
      THEN #SIGN CLAUSE PRESENT # 
      BEGIN #B# 
                             TRACK$(27,2702); 
      IF NO$SIGND$PIC EQ 1  #CHECK IF SIGNED PIC STRING FOUND#
        THEN      #NO$SIGND$PIC LEFT =1 IF NO SIGND PC# 
        BEGIN #C# 
                             TRACK$(27,2703); 
        ERROR(MSG26,T$ERROR); 
        #WHEN A GROUP ITEM IS SPECIFIED WITH A SIGN CLAUSE
        IT MUST CONTAIN AT LEAST ONE ELEMENTARY ITEM WHOSE
        PICTURE STRING IS SIGNED# 
        NO$SIGND$PIC=0;  #RESET FLAG# 
                         VALUE$(27,"NOSIGNPC=",NO$SIGND$PIC); 
        END #C# 
      SIGN$FLAG=0;
                          VALUE$(27,"SIGNFLAG=",SIGN$FLAG); 
      END #B# 
    IF VALUE$PTR EQ GROUP$PTR #CHECK IF CURR ENT HAS VALUE PHR# 
      THEN VALUE$FLAG=0;  #YES : RESET FLAG#
    IF SECTION EQ FDSECTN 
      THEN #CURRENTLY IN FD SECTION#
      BEGIN #BB#
                             TRACK$(27,2736); 
      O$ADDR=GETQUICK(DN$BYTEOFFS,DNAT$,GROUP$PTR); 
                        VALUE$(27,"0$ADDR=",O$ADDR);
      END #BB#
      ELSE #NOT IN FD SECTION#
      BEGIN #BC#
                             TRACK$(27,2737); 
      O$ADDR=GETQUICK(DN$LONGOFF,DNAT$,GROUP$PTR);
                        VALUE$(27,"0$ADDR=",O$ADDR);
      END #BC#
    IF GETQUICK(DN$OCCURS,DNAT$,GROUP$PTR) EQ 1 
      THEN #GROUP ITEM HAS OCCURS CLAUSE# 
      BEGIN #BA#
                             TRACK$(27,2735); 
      IF GROUP$PTR EQ DEPEND$PTR
        THEN #CURRENT GRP ITM IS DEPENDED ON# 
        BEGIN #D# 
                             TRACK$(27,2704); 
        LAUX$PTR=SRCH$AUXT(GROUP$PTR,VAROCCUR); #FIND VAROCC AUXENT#
                           VALUE$(27,"LAUX$PTR=",LAUX$PTR); 
        LDNAT$PTR=GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR); #GET DNAT PTRD TO# 
                           VALUE$(27,"LDNAT$PTR=",LDNAT$PTR); 
          #CHECK THAT DNAT ENTRY IN DEPENDING ON PHRASE 
          IS NOT CONTAINED IN GRP ITEM# 
        IF LDNAT$PTR LQ DNAT$PTR AND
          LDNAT$PTR GQ GROUP$PTR
            THEN ERROR(MSG44,D$ERROR);
            #THE AREA DESCRIBED BY THE DATA ITEM REFERENCED 
            IN A DEPENDING ON PHRASE MAY NOT OVERLAP
            THE AREA DESCRIBED BY THE DATA ENTRY WHICH
            CONTAINS THE DEPENDING ON PHRASE ITSELF#
          #CHECK THE NEXT NON LVL 77/88 IS NOT
          A LVL 2 THRU 49 DATA ITEM#
        #NOTE : NXT$ITM$LVL CONTAINS THE LEVEL NUMBER OF THE
         NON 77,88 ITEM AFTER THE CURRENT GROUP#
        IF NXT$ITM$LVL GR 1 AND NXT$ITM$LVL LS 50 
          THEN ERROR(MSG41,D$ERROR);
          #WHEN THE DEPENDING ON OPTION IS USED, THAT ENTRY 
          MAY ONLY BE FOLLOWED WITHIN THAT RECORD BY
          ENTRIES THAT ARE SUBORDINATE TO IT# 
        DEPEND$FLAG=0;  #CLEAR VARIABLE BEFORE USE# 
                          VALUE$(27,"DEPNDFLAG=",DEPEND$FLAG);
        DEPEND$NAME=0;
                        VALUE$(27,"DEPNDNM=",DEPEND$NAME);
        MIN$OCCURS=0; 
                        VALUE$(27,"MINOCCRS=",MIN$OCCURS);
        END #D# 
      #SET LOCAL PTR TO CURRENT END OF GRP IN DNAT# 
      #SKIP TO NEXT NON LVL 88 NON INDEX ITEM#
      LDNAT$LIOG=DNAT$PTR; #DEFAULT IF SINGLE ITM GRP#
      FOR LDNAT$PTR=DNAT$PTR+1 STEP 1 WHILE 
          ( 
        CURR$ITM$LVL LS GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR)
        OR
        GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ 88
        OR
        GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ INDXLEVL
          ) 
        AND 
        GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) LS 50
      DO
       BEGIN #DA# 
                             TRACK$(27,2745); 
      LDNAT$LIOG=LDNAT$PTR;  #SAVE PTR TO LAST ITEM IN GRP# 
                      VALUE$(27,"LDNAT$LIG=",LDNAT$LIOG); 
      END #DA#
      IF GETQUICK(DN$INDEXED,DNAT$,GROUP$PTR) EQ 1
        THEN #GROUP HAS INDEXED CLAUSE# 
        BEGIN #E# 
                             TRACK$(27,2705); 
        #SET LOCAL PTR TO FIRST INDEX ITEM# 
        FOR LDNAT$PTR=GROUP$PTR+1 STEP 1 WHILE
          GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ INDXLEVL
          DO #FOR ALL INDEX ITEMS#
          BEGIN #F# 
                             TRACK$(27,2706); 
                           VALUE$(27,"LDNAT$PTR=",LDNAT$PTR); 
          #SET ALL INDEX ITEMS TO CONTAIN VALUE OF
          LAST ITEM INDEXED#
          SETFIELD(DN$LASIDX,DNAT$,LDNAT$PTR,LDNAT$LIOG); 
          SETFIELD(DN$FIRIDX,DNAT$,LDNAT$PTR,GROUP$PTR); #1ST ITM#
          SETFIELD(DN$IDXDEP,DNAT$,LDNAT$PTR,SUB$DEPTH); #SUBSCR D# 
          END #F# 
        END #E# 
      #SET OCCUR$MAX FROM CURRENT GROUP ITEM# 
      LAUX$PTR=SRCH$AUXT(GROUP$PTR,MAXOCCUR); 
                           VALUE$(27,"LAUX$PTR=",LAUX$PTR); 
      OCCUR$MAX=GETQUICK(AX$MAXOCCNO,AUX$,LAUX$PTR);
                        VALUE$(27,"OCCURMAX=",OCCUR$MAX); 
      IF SYNC$GROUP[SUB$DEPTH] NQ 0 
        THEN #THERE IS A SYNC ITEM IN THIS GROUP# 
        BEGIN #G# 
                             TRACK$(27,2707); 
        #COMPUTE NUMBER OF SLACK BYTES REQUIRED TO TERMINATE
        GROUP ON WORD BOUNDARY AND ALSO START NEXT
        OCCURRENCE OF GROUP IN SAME REL POSN WITHIN 
        WORD SO THAT SYNC ITEMS ARE STILL SYNC IN 
        SUBSEQUENT OCCURRENCES
        # 
        #COMPUTE NUMBER OF COMPLETE WORDS OCCUPIED BY GROUP#
        LNOCWIG=(NAB-O$ADDR)/BYTES$PER$WD;
                      VALUE$(27,"LNOCWIG=",LNOCWIG);
        #COMPUTE INTERMEDIATE SLACK BYTE FIGURE#
        LISL$BYTES=(NAB-O$ADDR)-(LNOCWIG*BYTES$PER$WD); 
                   VALUE$(27,"LISLBYTES=",LISL$BYTES);
        IF LISL$BYTES NQ 0
          THEN #SLACK BYTES ARE NEEDED# 
          BEGIN #H# 
                             TRACK$(27,2708); 
          #SET SLACK BYTES TO MODULUS 10 VALUE# 
          LISL$BYTES=BYTES$PER$WD-LISL$BYTES; 
                   VALUE$(27,"LISLBYTES=",LISL$BYTES);
          NAB=NAB+LISL$BYTES; #UPDATE NAB APPROPRIATELY#
                       VALUE$(27,"NAB=",NAB); 
          END #H# 
          SYNC$GROUP[SUB$DEPTH]=0;  #RESET "SYNC ITM IN GRP" FLG# 
                VALUE$(27,"SUBDEPTH=",SUB$DEPTH); 
                VALUE$(27,"SYNCGRP=",SYNC$GROUP[SUB$DEPTH]);
        END #G# 
      #UPDATE NAB BY TOTAL GROUP LENGTH#
      GROUP$LEN=NAB-O$ADDR;  #GRP LEN FOR 1 OCCURRENCE# 
                       VALUE$(27,"GRPLEN=",GROUP$LEN);
      TOTAL$LEN=GROUP$LEN*OCCUR$MAX;  #BY NO OF OCCURRENCES#
                        VALUE$(27,"TOTALLN=",TOTAL$LEN);
      #ONE OCCURRENCE MUST BE SUBTRACTED AS IT HAS ALREADY BEEN 
      INCLUDED IN NAB#
      NAB=NAB+(TOTAL$LEN-GROUP$LEN);
                       VALUE$(27,"NAB=",NAB); 
      #SET OCCURRENCE LENGTH AND SUBSRIPT LEVEL IN MAXOCC AUX ENT 
      FOR GROUP ITEM# 
         TESTOCCLEN (GROUP$LEN);
      SETFIELD(AX$OCCLEN,AUX$,LAUX$PTR,GROUP$LEN);
      SETFIELD(AX$SUBSLVL,AUX$,LAUX$PTR,SUB$DEPTH); 
      #EXTRACT RELEVANT FIELDS FROM CURRENT GROUP ITEM AND
      THEN CREATE NEW AUXT ENTRIES (MAXOCCUR TYPE) HANGING
      ON ALL SUBORDINATE ITEMS IN THE GROUP#
      #SET LOACL PTR TO ITEM AFTER GROUP# 
      FOR LDNAT$PTR=GROUP$PTR+1 STEP 1 WHILE
        LDNAT$PTR LQ LDNAT$LIOG  #LOOP FOR ALL ITMS IN GRP# 
        DO
        BEGIN #I# 
                             TRACK$(27,2709); 
        #CHECK NOT LEVEL 77 OR 88#
                           VALUE$(27,"LDNAT$PTR=",LDNAT$PTR); 
        IF GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) NQ 77 
          AND 
          GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) NQ 88
          THEN #ITEM IS NEITHER 77 NOR 88#
          BEGIN #J# 
                             TRACK$(27,2710); 
          LAUX$PTR=ATT$NEW$AUXT(LDNAT$PTR);  #CREATE NEW AUXENT#
                           VALUE$(27,"LAUX$PTR=",LAUX$PTR); 
          #SETUP FIELDS IN NEW ENTRY# 
          SETFIELD(AX$TTYPE,AUX$,LAUX$PTR,MAXOCCUR); #TYPE=MAX OCCUR# 
              TESTOCCLEN(GROUP$LEN);
          SETFIELD(AX$OCCLEN,AUX$,LAUX$PTR,GROUP$LEN); #OCCURRENCE LEN# 
          SETFIELD(AX$MAXOCCNO,AUX$,LAUX$PTR,OCCUR$MAX); #NO OF OCCS# 
          SETFIELD(AX$SUBSLVL,AUX$,LAUX$PTR,SUB$DEPTH);  #SUBCR LVL#
          END #J# 
        END #I# 
      IF KEY$PTR[SUB$DEPTH] EQ GROUP$PTR
        THEN #GRP ITEM HAS KEYED CLAUSE#
        BEGIN #K# 
                             TRACK$(27,2711); 
        LAUX$PTR=SRCH$AUXT(GROUP$PTR,KEYNAME); #FIND KEYNAME AUX ENT# 
                           VALUE$(27,"LAUX$PTR=",LAUX$PTR); 
        FOR ZERO = 0 WHILE LAUX$PTR NQ 0  #SRCH ALL OF AUX CHAIN# 
          DO
          BEGIN #L# 
                             TRACK$(27,2712); 
          #SET PTR TO DNAT ENTRY OF KEY ITEM# 
          LDNAT$KEYN=GETQUICK(AX$KEYNAM,AUX$,LAUX$PTR); 
                       VALUE$(27,"LDNATKEYN=",LDNAT$KEYN);
          IF LDNAT$KEYN EQ OCCUR$NAME[SUB$DEPTH]
            THEN #KEY OCCURS# 
            ERROR(MSG36,D$ERROR); 
            #THE OCCURING DATA NAME MAY ONLY BE USED
            AS A KEY WHEN THE OCCURING DATA NAME IS 
            IS AN ELEMENTARY ITEM#
          IF LDNAT$KEYN LS GROUP$PTR
           OR 
           LDNAT$KEYN GR DNAT$PTR 
            THEN #KEY IS NOT WITHIN GROUP#
            ERROR(MSG7,D$ERROR);
            #A DATA ITEM REFERENCED IN A KEY IS PHRASE
            MUST BE WITHIN THE GROUP DEFINED BY THE 
            ENTRY CONTAINING THE KEY IS PHRASE# 
            ELSE #KEY IS WITHIN GRP#
            IF GETQUICK(DN$KEY,DNAT$,LDNAT$KEYN) EQ 0 
              THEN #THIS IS FIRST TIME USE AS KEY#
              BEGIN #M# 
                             TRACK$(27,2713); 
              IF GETQUICK(DN$SDEPTH,DNAT$,LDNAT$KEYN) NQ SUB$DEPTH
                THEN #KEY NOT AT SAME SUBSCRIPT LVL AS GRP# 
                ERROR(MSG6,D$ERROR);
                #A DATA ITEM REFERENCED IN A KEY IS PHRASE
                MUST BE AT THE SAME SUPSCRIPT LEVEL 
                AS THE ITEM CONTAINING THE KEY IS PHRASE# 
                ELSE #KEY AT SAME SUBSCRIPT DPTH AS GROUP#
                BEGIN #N# 
                             TRACK$(27,2714); 
                SETFIELD(DN$KEY,DNAT$,LDNAT$KEYN,1); #SET FLAG# 
                #CREATE AUX ENTRY ON KEY DNAT PROINTING TO GRP KEYED# 
                LAUX$KEYGR=ATT$NEW$AUXT(LDNAT$KEYN); #CREATE ENTRY# 
                       VALUE$(27,"LAUXKEYGR=",LAUX$KEYGR);
                SETFIELD(AX$TTYPE,AUX$,LAUX$KEYGR,KEYGRNAM); #SET TYPE# 
                SETFIELD(AX$OCCNAM,AUX$,LAUX$KEYGR, 
                      OCCUR$NAME[SUB$DEPTH]); 
                #SET ASCENDING/DESCENDING ORDER IN NEW
                AUX ENTRY FROM ORIGINAL KEY ENTRY#
                TGET=GETQUICK(AX$ORDER,AUX$,LAUX$PTR);
                SETFIELD(AX$ORDER,AUX$,LAUX$KEYGR,TGET);
                #SIMILARLY,SET HIERARCHY (PRECEDENCE) OF KEY# 
                TGET=GETQUICK(AX$HIERCNT,AUX$,LAUX$PTR);
                SETFIELD(AX$HIERCNT,AUX$,LAUX$KEYGR,TGET);
                END #N# 
              END #M# 
              ELSE #SLIGHTLY USED KEY...UGH#
              BEGIN #O# 
                             TRACK$(27,2715); 
              ERROR(MSG55,A$ERROR); 
              #THIS ITEM IS A KEY FOR TWO OR MORE 
              OCCURRING ITEMS#
              END #O# 
          LAUX$PTR=C$SRCH$AUXT(LAUX$PTR,KEYNAME); #CONTINUE SRCH# 
                       VALUE$(27,"LAUX$PTR=",LAUX$PTR); 
          END #L# 
        END #K# 
      SUB$DEPTH=SUB$DEPTH-1;
                        VALUE$(27,"SUBDEPTH=",SUB$DEPTH); 
      END #BA#
      ELSE #THIS GRP ITM LACKS AN OCCURS CLAUSE#
      GROUP$LEN=NAB-O$ADDR;  #GRP LEN IS BASE BYTE FROM END BYTE# 
                       VALUE$(27,"GRPLEN=",GROUP$LEN);
       IF GROUP$LEVEL EQ 1
         THEN 
         BEGIN
         IF GETQUICK(DN$RDEF,DNAT$,GROUP$PTR) EQ 1
           AND
            GETQUICK(DN$EXTERNAL,DNAT$,GROUP$PTR) EQ 1
           THEN 
           BEGIN
           IF NAB GR RDEF$NAB$ST[RDEF$ST$PTR] 
             THEN 
             BEGIN
             ERROR(MSG30,T$ERROR);
             #THE SIZE OF AN ITEM WHICH REDEFINES AN ITEM FOR 
             WHICH THE EXTERNAL CLAUSE IS SPECIFIED MUST NOT
             EXCEED THE SIZE OF THE REDEFINED ITEM.#
             END
           END
         END
      #CHECK IF REDEFINES PHR IS PRESENT IN THIS GRP ITM# 
      IF GETQUICK(DN$RDEF,DNAT$,GROUP$PTR) EQ 1 
        AND 
        GROUP$LEVEL NQ 1
        THEN #CURRENT GRP ITM HAS RDEF AND IS NOT LVL 1#
        BEGIN #P# 
                             TRACK$(27,2716); 
       IF NAB NQ RDEF$NAB$ST[RDEF$ST$PTR] #CHK RDEF NQ ORIG#
          THEN
          BEGIN #PB#
          ERROR(MSG52,J$ERROR); 
          #THE REDEFINING DATA MUST SPECIFY THE SAME NUMBER 
          OF CHARACTER POSITIONS AS THE DATA ITEM BEING 
          REDEFINED. HOWEVER, THE REDEFINING DATA NEED NOT
          SPECIFY A STORAGE AREA OF THE SAME SIZE AS
          THE REDEFINED DATA# 
          #NOTE THAT NAB IS LEFT UNCHANGED DESPITE THIS ERROR#
          IF NAB LS RDEF$NAB$ST[RDEF$ST$PTR]
            THEN #REDEF SMALLER THAN ORIGINAL#
          BEGIN #PA#
          NAB=RDEF$NAB$ST[RDEF$ST$PTR]; #NAB SET TO ORIG LEN# 
                       VALUE$(27,"NAB=",NAB); 
          END #PA#
          END #PB#
        RDEF$ST$PTR=RDEF$ST$PTR-1;  #COUNTDOWN ON REDEFINE STK# 
                         VALUE$(27,"RDEFSTPTR=",RDEF$ST$PTR); 
##
        END #P# 
      #SET GROUP LENGTH IN GROUP ITEM#
          IF GROUP$LEN GR 131071
          THEN
              BEGIN 
              LINE$NO = GETQUICK(DN$LINE,DNAT$,GROUP$PTR);
             ERROR(MSG141,D$ERROR); 
              SETFIELD(DN$TYPE,DNAT$,GROUP$PTR,ERRTYPE);
              END 
      SETFIELD(DN$ITMLEN,DNAT$,GROUP$PTR,GROUP$LEN);
      GRP$ST$PTR=GRP$ST$PTR-1; #MOVE TO NXT OUTER GRP#
                          VALUE$(27,"GRPSTPTR=",GRP$ST$PTR);
      IF NXT$ITM$LVL EQ GROUP$LEVEL 
        THEN #NEXT ITEM IS AT SAME LEVEL AS THIS GROUP# 
        GOTO END$SUM$GRP; 
  END #A# 
END$SUM$GRP:  
    EXIT$(27,"SUM$GROUP");
END #AA#
NEWPAGE;
PROC SUM$ITEM;
BEGIN #A# 
#THIS PROCEDURE IS ENTERED AFTER ELEMENTARY ITEM PROCESSING 
HAS BEEN COMPLETED. 
THE OVER ALL PROCESSING IS AS FOLLOWS:  
. 
ASSIGN STORAGE FOR ITEM (ACCORDING TO WHICH SECTION 
  THE ITEM OCCURS IN). THE DNAT ENTRY IS SSET ACCORDINGLY.
IF AN OCCURS CLAUSE IS PRESENT THEN THE ASSOCIATED
  "MAX OCCURENCES" AXU TABLE ENTRY IS UPDATED.
IF AN OCCURS AND INDEX CLAUSES ARE PRESENT THEN NEW 
  AUX ENTRIES ARE CREATED FOR EACH INDEX ENTRY (DNAT) FOUND.
  (THE INDEX ITEMS FOLLOW THE ELEMENTARY ITEM"S DNAT
  ENTRY..ALL INDEX ITEMS HAVE THE SAME LEVEL NO). 
# 
  #LOCAL VARIABLES# 
  ITEM LITEM$LEN;  #ITEM LENGTH#
  ITEM LAUX$PTR;  #AUX TABLE POINTER# 
ITEM LSLACKBYTES; #SLACK BYTES TO BE ADDED TO NAB+ITEMLEN TO KEEP SYNC# 
  ITEM LDNAT$PTR; #DNAT POINTER#
  ITEM LMAXOCCNO; #MAXIMUM NO OF OCCURENCES#
##
  ENTRY$(28,"SUM$ITEM");
  IF SECTION NQ FDSECTN 
  THEN #NOT IN FDSECTION# 
    SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,NAB);
  ELSE #IN FD SECTION#
  BEGIN #B# 
                             TRACK$(28,2802); 
    IF NAB GR 32767 
    THEN
    BEGIN 
      ERF = 1;
    END 
    IF NAB LQ 65535 
    THEN #NAB WITHIN LIMITS FOR A RECORD# 
      SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$PTR,NAB); #STORE NAB# 
    ELSE #NAB OUTSIDE LIMITS FOR A RECORD#
      SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$PTR,0); #NO FURTHER SETTING # 
  END #B# 
  LITEM$LEN=GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR); #SET LCL ITEM LEN#
                       VALUE$(28,"LITEMLEN=",LITEM$LEN);
  IF GETQUICK(DN$OCCURS,DNAT$,DNAT$PTR) EQ 1
    THEN #OCCURS CLAUSE PRESENT # 
    BEGIN #C# 
                             TRACK$(28,2803); 
    LAUX$PTR=SRCH$AUXT(DNAT$PTR,MAXOCCUR); #SET LCL PTR TO MAXOCC ENT#
                           VALUE$(28,"LAUX$PTR=",LAUX$PTR); 
    IF GETQUICK(DN$SYNC,DNAT$,DNAT$PTR) EQ 1
      THEN #ITEM IS SYNC# 
  IF GETQUICK(DN$SYNCRGHT,DNAT$,DNAT$PTR) EQ 1
   THEN LSLACKBYTES = CAL$SL$BYTES(LITEM$LEN);
    ELSE
      LSLACKBYTES=CAL$SL$BYTES(NAB+LITEM$LEN);
      ELSE #ITEM NOT SYNC#
      LSLACKBYTES=0;
                  VALUE$(28,"LSLACKBYT=",LSLACKBYTES);
    #SET AUX ENT OCCLEN TO ITEM LENGTH + SLACK BYTES# 
    TESTOCCLEN(LITEM$LEN+LSLACKBYTES);
    SETFIELD(AX$OCCLEN,AUX$,LAUX$PTR,(LITEM$LEN+LSLACKBYTES));
    #SET AUX ENT SUBSCRIPT LEVEL# 
    SETFIELD(AX$SUBSLVL,AUX$,LAUX$PTR,SUB$DEPTH); 
    #SET LOCAL VARIABLE FROM AUX ENTRY# 
    LMAXOCCNO=GETQUICK(AX$MAXOCCNO,AUX$,LAUX$PTR);
                        VALUE$(28,"LMAXOCCNO=",LMAXOCCNO);
    IF GETQUICK(DN$INDEXED,DNAT$,DNAT$PTR) EQ 1 
      THEN #INDEXED CLAUSE PRESENT# 
      BEGIN #CA#
                             TRACK$(28,2840); 
        FOR LDNAT$PTR=DNAT$PTR+1 STEP 1 WHILE 
          GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ INDXLEVL
          DO
          BEGIN #D#  #BLOCK BELOW DONE FOR ALL INDX ITEMS#
                             TRACK$(28,2804); 
                                  VALUE$(28,"LDNAT$PTR=",LDNAT$PTR);
          LAUX$PTR=ATT$NEW$AUXT(LDNAT$PTR); #MAKE NEW AUXENT# 
                           VALUE$(28,"LAUX$PTR=",LAUX$PTR); 
          SETFIELD(AX$TTYPE,AUX$,LAUX$PTR,MAXOCCUR); #SET TYPE# 
         TESTOCCLEN(LITEM$LEN+LSLACKBYTES); 
          SETFIELD(AX$OCCLEN,AUX$,LAUX$PTR,(LITEM$LEN+LSLACKBYTES));
          SETFIELD(AX$MAXOCCNO,AUX$,LAUX$PTR,LMAXOCCNO); #SET MX OC NO# 
          SETFIELD(AX$SUBSLVL,AUX$,LAUX$PTR,SUB$DEPTH); #SUBSCR LVL#
          END #D# 
        END #CA#
    IF((LITEM$LEN+LSLACKBYTES))*LMAXOCCNO LQ 131071 
      THEN #ITEM LENGTH WITHIN LIMITS#
      BEGIN #CB#
      LITEM$LEN=(LITEM$LEN+LSLACKBYTES)*LMAXOCCNO; #ACTL ITM LEN# 
                       VALUE$(28,"LITEMLEN=",LITEM$LEN);
  IF GETQUICK(DN$SYNCRGHT,DNAT$,DNAT$PTR) EQ 1
  THEN  LITEM$LEN = LITEM$LEN - LSLACKBYTES;
      SYNC$GROUP[SUB$DEPTH] = 0;
      SUB$DEPTH=SUB$DEPTH-1;  #BACKUP SUBSCRIPT DEPTH BY 1# 
                        VALUE$(28,"SUBDEPTH=",SUB$DEPTH); 
      END #CB#
      ELSE BEGIN
           #THIS DATA-ITEM REQUIRES MORE THAN#
           #65535 CHARACTERS OF STORAGE#
           ERROR(MSG141,D$ERROR); 
           END
    END #C# 
  IF CURR$ITM$LVL EQ 1
    THEN
    BEGIN 
    IF GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 1
      AND 
       GETQUICK(DN$EXTERNAL,DNAT$,DNAT$PTR) EQ 1
      THEN
      BEGIN 
      IF NAB+LITEM$LEN GR RDEF$NAB$ST[RDEF$ST$PTR]
        THEN
        BEGIN 
        ERROR(MSG30,T$ERROR); 
        #THE SIZE OF AN ITEM WHICH REDEFINES AN ITEM FOR
        WHICH THE EXTERNAL CLAUSE IS SPECIFIED MUST NOT 
        EXCEED THE SIZE OF THE REDEFINED ITEM.# 
        END 
      END 
    END 
  IF GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 1
    THEN #REDEFINES CLAUSE PRESENT# 
    BEGIN #E# 
                             TRACK$(28,2805); 
    IF NAB+LITEM$LEN NQ RDEF$NAB$ST[RDEF$ST$PTR]
       #RDEF$NAB$ST HOLDS ORIGINAL NAB BEFORE RDEF# 
      THEN #RDEF UNEQUAL TO ORIG# 
      BEGIN #EB#
      ERROR(MSG52,J$ERROR); 
      #THE REDEFINING DATA MUST SPECIFY THE SAME NUMBER OF
      CHARACTER POSITIONS AS THE DATA ITEM BEING REDEFINED
      HOWEVER, IN THIS COMPILER, THE REDEFINING DATA NEED 
      NOT SPECIFY A STORAGE AREA OF THE SAME SIZE AS THE
      REDEFINED DATA# 
      IF NAB+LITEM$LEN LS RDEF$NAB$ST[RDEF$ST$PTR]
        THEN #RDEF SMALLER THAN ORIG# 
      BEGIN #EA#
                             TRACK$(28,2850); 
      LITEM$LEN=RDEF$NAB$ST[RDEF$ST$PTR]-NAB; #RDEFD ITM LEN USED#
                       VALUE$(28,"LITEMLEN=",LITEM$LEN);
      END #EA#
      END #EB#
    RDEF$ST$PTR=RDEF$ST$PTR-1;  #BACKUP RDEF STACK PTR# 
                         VALUE$(28,"RDEFSTPTR=",RDEF$ST$PTR); 
    END #E# 
  NAB=NAB+LITEM$LEN;  #UPDATE NAB WITH ITEM LENGTH# 
                       VALUE$(28,"NAB=",NAB); 
  IF GETQUICK(DN$SYNC,DNAT$,DNAT$PTR) EQ 1 #ITM SYNC L OR R#
    THEN
    BEGIN #EB#
                             TRACK$(28,2851); 
    NAB=NAB+CAL$SL$BYTES(NAB);  #ENSURE NAB SET TO WD BOUNDARY# 
                       VALUE$(28,"NAB=",NAB); 
    END #EB#
    EXIT$(28,"SUM$ITEM"); 
END #A# 
NEWPAGE;
PROC SUM$RECORD;
BEGIN #A# 
# 
SUM RECORD PROCESSOR. 
THIS PROCESOR IS ENTERED WHENEVER THE PROCESSING OF THE LAST ITEM 
IN A RECORD HAS BEEN COMPLETED (THE SUM ITEM PROCESSOR HAVING 
BEEN CALLED PREVIOUSLY).
  
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. SET THE LRECORD$PTR TO THE 01 DNAT ITEM (WHICH WILL EITHER BE THE
    CURRENT ITEM IF IT IS LEVEL 01, OR BE POINTED TO BY THE FIRST 
    ENTRY IN GRP$ST.
  B. ASSUMING THAT THE RECORD IS NOT IN THE FD SECTION AND IS A 
    REDEFINITION, THE RECORD LENGTH WILL BE THE LARGER OF EITHER
    THE REDEFINITION OR THE ORIGINAL ITEM 
  C. THE LRECORD$LEN IS COMPUTED BY SUBTRACTING THE 01 ITEM"S LENGTH
    FROM THE CURRENT SETTING OF NAB 
  D. IF THE RECORD IS IN THE FD SECTION THE LRECORD$LEN WILL BE 
    USED TO UPDATE THE MAXIMUM AND MINIMUM RECORD LENGTHS FOR 
    THE CURRENT FILE (ASSUMING THAT LRECORD$LEN IS EITHER THE 
    LARGEST OR SMALLEST ENCOUNTERED THUS FAR) 
  E. IF THE RECORD IS AN INPUT RECORDS IN THE COMMUNICATION SECTION 
    BUT THE LENGTH IS NOT 87 CHARS AN ERROR MESSAGE WILL BE GIVEN 
  F. IF THE RECORD IS A GROUP, THE LRECORD$LEN WILL BE STORED IN THE
    DNAT FOR THE RECORD 
  G. IF THE NO$SIGND$PIC INDICATES THAT NO SIGNED PICTURE CLAUSE
    HAS BEEN ENCOUNTERED THEN AN ERROR MESSAGE WILL BE GIVEN
  H. ALL PTRS AND FLAGS ASSOCIATED WITH RECORD PROCESSING ARE CLEARED 
  
ON ENTRY IT IS ASSUMED THAT:  
  * CURR$ITM$LVL CONTAINS THE CURRENT ITEMS LEVEL NO
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * GRP$ST[1] POINTS TO THE LEVEL 1 ITEM OF THE RECORD
  * RDEF$NAB$ST[RDEF$ST$PTR] CONTAINS THE NAB VALUE AFTER 
    A REDEFINTION OF THE RECORD WAS PROCESSED 
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * ELEMENTARY = 1 IF THE CURRENT ITEM IS ELEMENTARY (0= GROUP) 
  * NO$SIGND$PIC = 1 IF THE GROUP ITEM CONTAINS A SIGN CLAUSE 
    BUT NO SIGNED PICTURE CLAUSE HAS BEEN FOUND YET 
# 
#LOCAL VARIABLES# 
ITEM LRECORD$LEN; #CONTAINS RECORD LENGTH#
ITEM LRECORD$PTR; #CONTAINS DNAT PTR TO LVL 1 ITEM# 
ITEM LAUX$PTR; #PTR TO SUB OCC DEP ENTRY# 
ITEM LAON$PTR; #DNAT OF AUX OCCURS NAME ENTRY IN SUBOCCDEP AUXENT#
ITEM LDEPONDNAT;  #TEMP DNAT OF DEPENDED ON ITEM# 
     ITEM I;
     ITEM J;
     ITEM LENGTH; 
     ITEM MINOCCURS;
     ITEM SMALLESTREC;
     ITEM LONGESTREC; 
##
ENTRY$(29,"SUM$RECORD");
IF CURR$ITM$LVL NQ 1
  THEN #CURRENT ITEM NOT LVL 1 THEREFORE GRP RECD#
  BEGIN #BA#
                             TRACK$(29,2935); 
  LRECORD$PTR=GRP$ST[1]; #GET DNAT OF LVL 01 ITM# 
                        VALUE$(29,"LRECPTR=",LRECORD$PTR);
  END #BA#
  ELSE #CURRENT ITEM IS 01# 
  BEGIN #BB#
                             TRACK$(29,2936); 
  LRECORD$PTR=DNAT$PTR; #SET GROUP OTR TO CURR ITM# 
                        VALUE$(29,"LRECPTR=",LRECORD$PTR);
  END #BB#
   LINE$NO = GETQUICK(DN$LINE,DNAT$,LRECORD$PTR); 
IF SECTION NQ FDSECTN 
  THEN #NOT CURRENTLY IN FD SECTION#
  BEGIN #B# 
                             TRACK$(29,2902); 
  IF GETQUICK(DN$RDEF,DNAT$,LRECORD$PTR) EQ 1 
  AND CURR$ITM$LVL NQ 1 
    THEN #REDEF IN LEVEL 1 ITM# 
    BEGIN #C# 
                             TRACK$(29,2903); 
    IF NAB LS RDEF$NAB$ST[RDEF$ST$PTR]
      THEN #ORIGINAL DEF SMALLER THAN REDEF#
      BEGIN #CA#
                             TRACK$(29,2940); 
      NAB=RDEF$NAB$ST[RDEF$ST$PTR]; #SET NAB TO LARGER# 
                       VALUE$(29,"NAB=",NAB); 
      END #CA#
    END #C# 
  #CALCULATE RECORD LENGTH USING BYTE OFFSETS#
  LRECORD$LEN=NAB-(GETQUICK(DN$LONGOFF,DNAT$,LRECORD$PTR)); 
                        VALUE$(29,"LRECDLEN=",LRECORD$LEN); 
  END #B# 
  ELSE #CURRENTLY IN FD SECTION#
   BEGIN #D#
     IF ERF EQ 1
     THEN 
     BEGIN
       ERROR(MSG140,D$ERROR); 
       ERF = 0; 
     END
     LONGESTREC = NAB - GETQUICK(DN$BYTEOFFS,DNAT$,LRECORD$PTR);
     SMALLESTREC = LONGESTREC;
   LRECORD$LEN = LONGESTREC;
  #SET VARIABLES FOR USE IN SUMFILE PROCESSOR TO SET FN$VARTYPE#
  NUMRECS=NUMRECS+1;   #INCREASE NUMBER OF RECORDS IN THIS FILE#
  IF GETQUICK(DN$TYPE,DNAT$,LRECORD$PTR) EQ VARGROUP
    THEN #LEVEL1 IS VARIABLE GROUP# 
    BEGIN #EA#
    LAUX$PTR=SRCH$AUXT(LRECORD$PTR,SUBOCCDEP);
    LAON$PTR=GETQUICK(AX$OCCNAM,AUX$,LAUX$PTR); 
                    VALUE$(29,"SODAUX=",LAUX$PTR);
                    VALUE$(29,"ONDNAT=",LAON$PTR);
    IF DEPONCOUNT EQ 0
      THEN #THIS IS FIRST VGRP IN FD# 
      BEGIN #EB#
      FIXPARTSIZE=GETQUICK(DN$BYTEOFFS,DNAT$,LAON$PTR); 
      TRAILSIZE=GETQUICK(DN$ITMLEN,DNAT$,LAON$PTR); 
      DEPONDNAT=GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR);
      DEPONCOUNT=DEPONCOUNT+1;
          VALUE$(29,"FXPART=",GETQUICK(DN$BYTEOFFS,DNAT$,LAON$PTR));
          VALUE$(29,"TSIZE=",GETQUICK(DN$ITMLEN,DNAT$,LAON$PTR)); 
          VALUE$(29,"DODNAT=",GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR)); 
          VALUE$(29,"DOCOUNT=",DEPONCOUNT); 
      END #EB#
      ELSE #NOT FIRST VARGROUP IN FD# 
      BEGIN #EC#
          VALUE$(29,"FXPART=",GETQUICK(DN$BYTEOFFS,DNAT$,LAON$PTR));
          VALUE$(29,"TSIZE=",GETQUICK(DN$ITMLEN,DNAT$,LAON$PTR)); 
          VALUE$(29,"DODNAT=",GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR)); 
          VALUE$(29,"DOCOUNT=",DEPONCOUNT); 
      LDEPONDNAT=GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR); 
      IF
      FIXPARTSIZE NQ GETQUICK(DN$BYTEOFFS,DNAT$,LAON$PTR) 
      OR TRAILSIZE NQ GETQUICK(DN$ITMLEN,DNAT$,LAON$PTR)
      OR GETQUICK(DN$MAJMSEC,DNAT$,DEPONDNAT) 
         NQ 
         GETQUICK(DN$MAJMSEC,DNAT$,LDEPONDNAT)
      OR GETQUICK(DN$SUBMSEC,DNAT$,DEPONDNAT) 
         NQ 
         GETQUICK(DN$SUBMSEC,DNAT$,LDEPONDNAT)
      OR GETQUICK(DN$BYTEOFFS,DNAT$,DEPONDNAT)
         NQ 
         GETQUICK(DN$BYTEOFFS,DNAT$,LDEPONDNAT) 
      OR GETQUICK(DN$ITMLEN,DNAT$,DEPONDNAT)
         NQ 
         GETQUICK(DN$ITMLEN,DNAT$,LDEPONDNAT) 
        THEN #THIS VGRP DISSIMILAR FROM FIRST#
        BEGIN #ED#
        SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNVGMS); #MULT SPEC# 
         VALUE$(29,"FN$VT=",GETQUICK(FN$VARTYPE,FNAT$,FNAT$PTR)); 
        END #ED#
      DEPONCOUNT=DEPONCOUNT+1;
      END #EC#
         J = GETQUICK(DN$SDEPTH,DNAT$,LAON$PTR);
         FOR I = GETQUICK(DN$AUXREF,DNAT$,LAON$PTR) 
         WHILE I NQ 0 
         DO BEGIN 
            IF GETQUICK(AX$TTYPE,AUX$,I) EQ MAXOCCUR AND
               GETQUICK(AX$SUBSLVL,AUX$,I) EQ J 
            THEN  LENGTH = GETQUICK(AX$OCCLEN,AUX$,I);
            IF GETQUICK(AX$TTYPE,AUX$,I) EQ VAROCCUR
            THEN MINOCCURS = GETQUICK(AX$MINOCCNO,AUX$,I);
            I = GETQUICK(AX$TNEXTPTR,AUX$,I); 
            END 
         SMALLESTREC = GETQUICK(DN$BYTEOFFS,DNAT$,LAON$PTR) 
                       + LENGTH * MINOCCURS;
    END #EA#
    ELSE #LEVEL 1 NOT V GRP#
    BEGIN #EE#
    IF DEPONCOUNT NQ 0
      THEN #THIS IS NOT FIRST 01 OF FD# 
      BEGIN #EF#
      SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNVGMS); #MULT SPEC# 
      END #EF#
    END #EE#
    IF LONGESTREC GR MAX$REC$LEN
   THEN MAX$REC$LEN = LONGESTREC; 
    IF SMALLESTREC LS MIN$REC$LEN 
    THEN MIN$REC$LEN = SMALLESTREC; 
    IF GETQUICK(DN$RECCONT,DNAT$,FD$PTR) EQ 1 
    THEN BEGIN
         IF GETQUICK(FN$RCTMIN,FNAT$,FNAT$PTR) GR SMALLESTREC 
         THEN BEGIN 
              #THE MINIMUM RECORD LENGTH DEFINED BY#
              #THIS RECORD DESCRIPTION IS LESS THAN THE#
              #MINIMUM RECORD LENGTH SPECIFIED IN#
              #THE RECORD CONTAINS CLAUSE FOR THIS FILE#
              ERROR(MSG79,T$ERROR); 
              END 
         IF GETQUICK(FN$RCTMAX,FNAT$,FNAT$PTR) LS LONGESTREC
            AND GETQUICK(FN$RCTMAX,FNAT$,FNAT$PTR) NQ 0 
         THEN BEGIN 
              #THE MAXIMUM RECORD LENGTH DEFINED# 
              #BY THIS RECORD DESCRIPTION IS GREATER# 
              #THAN THE MAXIMUM RECORD LENGTH#
              #SPECIFIED IN THE RECORD CONTAINS#
              #CLAUSE FOR THIS FILE#
              ERROR(MSG78,T$ERROR); 
              END 
         END
  END #D# 
  IF SECTION EQ CDSECTN 
    THEN #CURRENTLY IN COMM SECTION#
    BEGIN #E# 
                             TRACK$(29,2905); 
    IF GETQUICK(DN$CDINP,DNAT$,CD$PTR) EQ 1 
      AND 
      LRECORD$LEN NQ 87 
      THEN #RECORD IS INPUT BUT LENGTH NOT 87#
      ERROR(MSG27,D$ERROR); 
      #AN INPUT RECORD IN THE COMMUNICATION SECTION MUST BE 
      87 CHARACTERS LONG# 
          SETFIELD(DN$ITMLEN,DNAT$,CD$PTR,LRECORD$LEN); 
    END #E# 
IF CURR$ITM$LVL NQ 1
  THEN #CURRENT RECORD IS GROUP#
  SETFIELD(DN$ITMLEN,DNAT$,LRECORD$PTR,LRECORD$LEN); #SET RECD LEN# 
IF NO$SIGND$PIC EQ 1
  THEN #NO SIGNED PIC CLAUSE FOUND IN RECORD# 
  ERROR(MSG26,T$ERROR); 
  #WHEN A GROUP ITEM CONTAINS A SIGN CLAUSE THERE MUST BE 
    AT LEAST ONE ITEM WHOSE PICTURE IS SIGNED#
SUB$DEPTH=0; #INITIALISE VARIABLES# 
GRP$ST$PTR=0; 
RDEF$ST$PTR=0;
SYNC$FLAG=0;
SYNCR$FLAG=0; 
USAGE$FLAG=0; 
  
SIGN$FLAG=0;
NO$SIGND$PIC=0; 
                         VALUE$(29,"NOSIGNPC=",NO$SIGND$PIC); 
##
EXIT$(29,"SUM$RECORD"); 
END #A# 
NEWPAGE;
PROC SYNC$PROC; 
BEGIN #A# 
# 
SYNCHRONIZED PROCESSOR. 
THIS PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS:  
  A. IF THE CURRENT ITEM IS SUBORDINATE TO A SYNCHRONIZED 
    GROUP ITEM THEN THE ATTRIBUTE IS HANDED DOWN
  B. IF THE CURRENT ITEM IS SUBORDINATE TO  GROUP WITH
    A VALUE CLAUSE AN ERROR MESSAGE IS GENERATED
  C. IF THE CURRENT ITEM IS A GROUP THEN FLAGS ARE SET TO ENABLE
    THE SYNCHRONIZED ATTRIBUTE TO BE HANDED DOWN
  D. THE SLACK BYTES NECESSARY FOR THE SPECIFIED LEFT/RIGHT SYNC
    ARE CALCULATED
  E. THE CURRENT ITEM IS CHECKED TO SEE IF IT IS THE FIRST
    ELEMENTARY ITEM IN A GROUP WHICH HAS A REDEFINES CLAUSE 
    ...OR IF THE CURRENT ITEM HAS A REDEFINES CLAUSE. IF EITHER 
    ARE TRUE THE ORIGINAL ITEM FO WHICH A REDEFINITION IS BEING 
    MADE IS CHECKED FOR "PROPER BOUNDARY ALIGNMENT". THIS 
    MEANS HAVING THE SAME LEFTMOST CHARACTER POSITION AS THE
    CURRENT ITEM (INCLUDING ANY SLACK BYTES). 
  F. ALL SUPERIOR GROUP ITEMS HAVING THE SAME LEFTMOST CHARACTER
    POSITION AS THE CURRENT ITEM (THEIR BYTE OFFSET = NAB) HAVE 
    THEIR BYTE OFFSET INCREMENTED BY THE CALCULATED NUMBER
    OF SLACK BYTES. 
  G. THE FLAG ENTRIES IN AN ARRAY ARE SET FROM SUBSCRIPT LEVEL 1
    TO THE CURRENT SUBSCRIPT DEPTH TO SHOW THAT A SYNCHRONIZED
    GROUP HAS BEEN FOUND
* 
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * ELEMENTARY =1 IF THE CURRENT ITEM IS ELEMENTARY (0= GROUP)
  * THE FOLLOWING FLAGS ARE SET ACCORDING TO A PREVIOUS 
    SUPERIOR GROUP ITEM : 
    * SYNC$FLAG SYNCHRONIZED
    * SYNCR$FLAG SYNCHRONIZED RIGHT 
    * VALUE$FLAG VALUE CLAUSE 
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * GRP$ST CONTAINS THE DNAT$PTRS TO SUPERIOR GROUPS
  * GRP$ST$PTR CONTAINS THE SUBSCRIPT TO ACCESS THE LAST
    ENCOUNTERED SUPERIOR GROUP IN THE GRP$ST
  * NAB CONTAINS THE NEXT AVAILABLE BYTE TO BE ALLOCATED
    TO THE CURRENT ITEM 
# 
#LOCAL VARIABLES# 
ITEM LISL$BYTES; #SLACK BYTES NEEDED FOR SYNC#
ITEM LAUX$PTR; #PTR TO AUX ENT OF SUP GRP WITH  RDEF CLAUSE#
ITEM LBYTEOFFS; #TEMP STORAGE FOR BYTE OFFSET OF ITMS IN DNAT#
ITEM LDNAT$PTR; #DNAT PTR OF SUP GRP ITM WITH REDEFINES#
ITEM LGRP$ST$PTR; #TEMP STORAGE FOR GRP$ST$PTR# 
ITEM LSYNCNAB; #TEMP STORAGE FOR (LISL$BYTES+NAB)#
ITEM LSUB$DEPTH; #TEMP STORAGE FOR SUB$DEPTH# 
ITEM LPARTWD;  #NO OF PARTIAL WORD CHARACTERS#
ITEM I  I;    #SEARCH VARIABLE FOR PROPER REDEF. ITEM#
ITEM RTYPE;   #TRIAL REDEF ITEM"S TYPE# 
ITEM RLEVEL;  #TRIAL REDEF ITEM"S LEVEL#
ITEM CTYPE;   #CURRENT ITEM"S TYPE# 
##
ENTRY$(30,"SYNC$PROC"); 
IF GETQUICK(DN$SYNC,DNAT$,DNAT$PTR) EQ 0
  THEN #CURRENT ITEM DOES NOT HAVE SYNC CLAUSE# 
  BEGIN #B# 
                             TRACK$(30,3002); 
  IF SYNC$FLAG EQ 0 
    THEN #NO SUPERIOR GRP WITH SYNC CLAUSE# 
    GOTO END$SYNC$PR; #EXIT FROM PROCESSOR# 
    ELSE #SUPERIOR SYNC CLAUSE# 
    SETFIELD(DN$SYNC,DNAT$,DNAT$PTR,1); #FORCE CURR ITM SYNC# 
  IF SYNCR$FLAG NQ 0
    THEN #SYNC RIGHT CLAUSE#
    SETFIELD(DN$SYNCRGHT,DNAT$,DNAT$PTR,1); #SET SYNC RIGHT#
  END #B# 
IF VALUE$FLAG EQ 1
  THEN #SUPERIOR GRP ITM WITH VALUE CLAUSE# 
  ERROR(MSG8,T$ERROR);
  #A VALUE CLAUSE MAY NOT BE USED FOR A GROUP WHOSE SUBORDINATE 
  ITEMS CONTAIN A JUSTIFIED, SYNCHRONIZED OR USAGE CLAUSE 
  (OTHER THAN USAGE IS DISPLAY)#
IF ELEMENTARY EQ 0
  THEN #CURRENT ITEM IS A GROUP#
  BEGIN #C# 
                             TRACK$(30,3003); 
  ERROR(MSG40,J$ERROR); 
  #SYNCHRONIZED AT GROUP LEVEL IS NON-STANDARD# 
  IF SYNC$FLAG EQ 0 
    THEN #NO SUPERIOR GRP WITH SYNC CLAUSE# 
    BEGIN #D# 
                             TRACK$(30,3004); 
    #STORE ATTRIBUTES FOR SUBORDINATE ITEMS#
    SYNC$FLAG=1; #FLAG SYNC CLAUSE# 
                         VALUE$(30,"SYNCFLAG=",SYNC$FLAG);
    SYNCR$FLAG=GETQUICK(DN$SYNCRGHT,DNAT$,DNAT$PTR); #FLAG SYNC RIGHT#
                         VALUE$(30,"SYNCRFLAG=",SYNCR$FLAG);
    SYNC$PTR=DNAT$PTR; #SAVE DNAT OF SYNC GRP ITM#
                       VALUE$(30,"SYNCPTR=",SYNC$PTR);
    END #D# 
  GOTO END$SYNC$PR; #EXIT FROM PROCESSOR# 
  END #C# 
IF CURR$ITM$LVL EQ 1 THEN 
    BEGIN 
    SETFIELD (DN$SYNCRGHT,DNAT$,DNAT$PTR,0);
    GOTO END$SYNC$PR; 
    END 
LISL$BYTES=CAL$SL$BYTES(NAB); #COMPUTE SLACK BYTES TO NXT WD BDY# 
                   VALUE$(30,"LISLBYTES=",LISL$BYTES);
IF GETQUICK(DN$SYNCRGHT,DNAT$,DNAT$PTR) EQ 1
  THEN #CURRENT ITEM IS SYNC RIGHT# 
  BEGIN #CA#
  LPARTWD = GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR)
        - (((GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR)) / 10) * 10); 
                      VALUE$(30,"LPARTWD=",LPARTWD);
  IF LPARTWD NQ 0 
    THEN #ITEMLEN IS NOT EXACT MULTIPLE OF 10#
    LISL$BYTES=LISL$BYTES + (10 - LPARTWD); 
                   VALUE$(30,"LISLBYTES=",LISL$BYTES);
  END #CA#
LAUX$PTR=0; #CLEAR PTR FLAG PRIOR TO USE# 
                           VALUE$(30,"LAUX$PTR=",LAUX$PTR); 
IF GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 1
THEN LAUX$PTR = SRCH$AUXT (DNAT$PTR, RDEFNAME); 
ELSE
IF GRP$ST$PTR NQ 0
  THEN # CURR ITM IS SUBORDINATE TO A GROUP#
  BEGIN #E# 
                             TRACK$(30,3005); 
  FOR LGRP$ST$PTR=GRP$ST$PTR STEP -1 WHILE LGRP$ST$PTR NQ 0 
    DO #FOR ALL SUPERIOR GRP ITMS#
    BEGIN #F# 
                             TRACK$(30,3006); 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
    IF SECTION EQ FDSECTN 
      THEN #CURRENTLY IN FD SECTION#
      BEGIN #FC#
                             TRACK$(30,3057); 
      LBYTEOFFS=GETQUICK(DN$BYTEOFFS,DNAT$,GRP$ST[GRP$ST$PTR]); 
                  VALUE$(30,"LBYTEOFFS=",LBYTEOFFS);
      END #FC#
      ELSE #NOT IN FD SECTION#
      BEGIN #FD#
                             TRACK$(30,3058); 
      LBYTEOFFS=GETQUICK(DN$LONGOFF,DNAT$,GRP$ST[GRP$ST$PTR]);
                  VALUE$(30,"LBYTEOFFS=",LBYTEOFFS);
      END #FD#
    IF LBYTEOFFS EQ NAB 
      THEN #CURR ITM IS 1ST ELEMENTARY IN GRP#
      BEGIN #FA#
                             TRACK$(30,3055); 
      IF GETQUICK(DN$RDEF,DNAT$,GRP$ST[GRP$ST$PTR]) EQ 1
        THEN #THIS GROUP HAS REDEFINES# 
        #SET FLAG FOR ORIGINAL ITEM BOUNDARY CHECKING#
        BEGIN #FB#
                             TRACK$(30,3056); 
        LAUX$PTR=SRCH$AUXT(GRP$ST[GRP$ST$PTR],RDEFNAME);
                           VALUE$(30,"LAUX$PTR=",LAUX$PTR); 
        LGRP$ST$PTR=1; #FORCE EXIT FROM FOR LOOP# 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
        END #FB#
      END #FA#
      ELSE #CURR ITM NOT 1ST ELEMENTARY IN GROUP# 
      BEGIN #FE#
                             TRACK$(30,3059); 
      LGRP$ST$PTR=1; #FORCE EXIT# 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
     END #FE# 
    END #F# 
  END #E# 
IF LAUX$PTR NQ 0
  THEN #ORIG ITM TO BE CHKD FOR "PROPER BOUNDARY ALIGNMENT" # 
  BEGIN #G# 
                             TRACK$(30,3007); 
  LDNAT$PTR=GETQUICK(AX$RDEFNAM,AUX$,LAUX$PTR); #GET ORIG ITM DNAT# 
  
  CTYPE = GETQUICK(DN$TYPE, DNAT$, DNAT$PTR);  #GET ITEM TYPE#
  
  FOR  I = LDNAT$PTR STEP 1 UNTIL DNAT$PTR  DO
    BEGIN 
                           VALUE$(30, "I=", I); 
    RTYPE = GETQUICK(DN$TYPE, DNAT$, I);  #GET TRIAL TYPE#
    RLEVEL = GETQUICK(DN$LEVEL, DNAT$, I);  #AND LEVEL# 
  
    IF  RLEVEL NQ 88 AND RLEVEL NQ 66  THEN #CHECK FOR MATCHED TYPES# 
      BEGIN 
      IF  CTYPE NQ GROUP AND RTYPE NQ GROUP  THEN 
        BEGIN 
                           TRACK$(30,3008); 
        LDNAT$PTR = I;       #SAVE THE CURRENT POINTER# 
        I = DNAT$PTR;        #FORCE EXIT# 
        END 
      ELSE
        BEGIN 
        IF  CTYPE EQ GROUP AND RTYPE EQ GROUP  THEN 
          BEGIN 
                           TRACK$(30,3009); 
          LDNAT$PTR = I;
          I = DNAT$PTR;      #SAME AS ABOVE, FORCE EXIT#
          END 
        END 
      END  #RLEVEL NQ 88 AND 66#
    END   #FOR I = LDANT$PTR, ETC.# 
                           VALUE$(30,"LDNAT$PTR=",LDNAT$PTR); 
  IF SECTION EQ FDSECTN 
    THEN #CURRENTLY IN FD SECTION#
    BEGIN #GB#
                             TRACK$(30,3061); 
    LBYTEOFFS=GETQUICK(DN$BYTEOFFS,DNAT$,LDNAT$PTR);
                  VALUE$(30,"LBYTEOFFS=",LBYTEOFFS);
    END #GB#
    ELSE #NOT IN FD SECTION#
    BEGIN #GC#
                             TRACK$(30,3062); 
    LBYTEOFFS=GETQUICK(DN$LONGOFF,DNAT$,LDNAT$PTR); 
                  VALUE$(30,"LBYTEOFFS=",LBYTEOFFS);
    END #GC#
VALUE$(30,"ORIGSLAK=",CAL$SL$BYTES(LBYTEOFFS)); #DXX# 
  IF GETQUICK (DN$SYNC, DNAT$, LDNAT$PTR) EQ 0
    AND GETQUICK (DN$LEVEL, DNAT$, DNAT$PTR) NQ 77
    THEN #ORIGINAL ITEM"S NAB NOT PROPERLY ALIGNED WITH RESPECT 
        TO SYNCHRONIZED NAB OF CURRENT ITEM#
    ERROR(MSG9,D$ERROR);
  END #G# 
IF LISL$BYTES NQ 0
  THEN #UPDATE TO SUPERIOR GRP ITMS NECESSARY#
  BEGIN #GA#
                             TRACK$(30,3060); 
    LSYNCNAB = NAB + CAL$SL$BYTES(NAB); #ADJUST TO WORD BOUNDARY# 
                  VALUE$(30,"LSYNCNAB=",LSYNCNAB);
  FOR LGRP$ST$PTR=GRP$ST$PTR STEP -1 WHILE LGRP$ST$PTR NQ 0 
    DO #FOR ALL SUPERIOR GROUPS#
    BEGIN #H# 
                             TRACK$(30,3008); 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
    IF SECTION EQ FDSECTN 
      THEN #CURRENTLY IN FD SECTION#
      BEGIN #I# 
                             TRACK$(30,3009); 
      IF GETQUICK(DN$BYTEOFFS,DNAT$,GRP$ST[LGRP$ST$PTR]) EQ NAB 
        AND GETQUICK(DN$LEVEL,DNAT$,GRP$ST[LGRP$ST$PTR]) NQ 1 
        THEN #SUP GRP HAS SAME NAB AS CURR ITM# 
        #SET SUP GRP BYTEOFFSET TO INCLUDE SLACKBYTES#
        SETFIELD(DN$BYTEOFFS,DNAT$,GRP$ST[LGRP$ST$PTR],LSYNCNAB); 
        ELSE #SUPERIOR GRP DOES NOT HAVE SAME NAB AS CURR ITM#
        BEGIN #IA#
                             TRACK$(30,3065); 
        LGRP$ST$PTR=1; #FORCE EXIT FROM FOR LOOP# 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
        END #IA#
      END #I# 
      ELSE #NOT IN FD SECTION#
      BEGIN #J# 
                             TRACK$(30,3010); 
      IF GETQUICK(DN$LONGOFF,DNAT$,GRP$ST[LGRP$ST$PTR]) EQ NAB
        AND GETQUICK(DN$LEVEL,DNAT$,GRP$ST[LGRP$ST$PTR]) NQ 1 
        THEN #SUPERIOR GRP HAS SAME NAB AS CURR ITM#
        #ADD SLACK BYTES TO SUP GRP BYTE OFFSET#
        SETFIELD(DN$LONGOFF,DNAT$,GRP$ST[LGRP$ST$PTR],LSYNCNAB);
        ELSE #SUP GRP ITM DOES NOT HAVE SAME NAB AS CURR ITM# 
        BEGIN #JA#
                             TRACK$(30,3070); 
        LGRP$ST$PTR=1; #FORCE EXIT FROM FOR LOOP# 
                      VALUE$(30,"LGRPSTPTR=",LGRP$ST$PTR);
        END #JA#
      END #J# 
    END #H# 
  END #GA#
IF GETQUICK(DN$RDEF, DNAT$, DNAT$PTR) NQ 1 THEN 
  BEGIN #L# 
  NAB=NAB+LISL$BYTES; #SYNCHRONISE NAB# 
  SYNC$BYTES=0; #CLEAR SO THAT REDEF$PROC ADDS 0 TO NAB#
  END #L# 
    SYNC$BYTES = 0; 
                         VALUE$(30,"NAB=",NAB); 
                         VALUE$(30,"SYNCBYT=",SYNC$BYTES);
FOR LSUB$DEPTH=1 STEP 1 UNTIL GETQUICK(DN$SDEPTH,DNAT$,DNAT$PTR)
  DO #FOR ALL SUPERIOR SUBSCR DEPTHS DOWN TO CURRENT# 
  BEGIN #K# 
                             TRACK$(30,3011); 
                  VALUE$(30,"LSUBDPTH=",LSUB$DEPTH);
  SYNC$GROUP[LSUB$DEPTH]=1; 
  END #K# 
END$SYNC$PR:  
EXIT$(30,"SYNC$PROC");
END #A# 
NEWPAGE;
PROC USAGE$PROC;
BEGIN #A# 
# 
USAGE PROCESSOR 
* 
THIS PROCESSOR MAKES SYNTACTIC CHECKS RELATED TO THE USAGE CLAUSE 
IN THE CURRENT ITEM (OR A SUPERIOR GROUP ITEM) ISSUING THE
APPROPRIATE ERROR MESSAGES. 
NOTE THAT A GROUP ITEM HAVING A USAGE CLAUSE PASSES THAT USAGE
ON TO SUBORDINATE ITEMS.
* 
THE PROCESSOR ASSUMES THAT :  
  * DNAT$PTR POINTS TO THE CURRENT ENTRY IN THE DNAT
  * THE FOLLOWING FIELDS ARE SET TO REFLECT SUPERIOR
    GROUP ITEM ATTRIBUTES 
    * USAGE$FLAG = 1 IS USAGE CLAUSE PRESENT
    * USAGE$PTR CONTAINS DNAT PTR OF SUPERIOR GROUP ITEM
      WITH USAGE CLAUSE IF ANY
    * GROUP$USAGE CONTAINS USAGE TYPE 
    * VALUE$FLAG =1 IF VALUE CLAUSE PRESENT 
  * 
  * ELEMENTARY =1 IF CURRENT ITEM IS ELEMENTARY (0= GROUP)
# 
#LOCAL VARIABLES# 
  ITEM L9PS; #NUMBER OF 9"S AND P"S IN COMP-1 CHECK#
  ITEM LDN$NUMLEN; #NUMERIC LENGTH FOR COMP-1 CHECK#
  ITEM LDN$POINT; #POINT LOCATION FOR COMP-1 CHECK# 
  SWITCH USAGE$SWITCH UNULL,UDISP,UCOMP,UCOMP1,UCOMP2,UCOMP4, 
                   UINDEX,UBIT; 
  ARRAY DT$VALS [7];
    BEGIN 
    ITEM DATA$TYPE I (0,0,60) = 
            [NULL,NULL,NUMERIC,COMP1,COMP2, 
                   COMP4,INDXDATA,BOOLBIT]; 
    END 
ENTRY$(31,"USAGE$PROC");
IF GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ 0 
  THEN #USAGE CLAUSE PRESENT# 
  BEGIN #B# 
                             TRACK$(31,3102); 
  IF USAGE$FLAG EQ 1
    THEN #SUPERIOR GRP ITEM HAS USAGE CLAUSE ALSO#
    BEGIN #C# 
                             TRACK$(31,3103); 
    IF GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ GROUP$USAGE 
      THEN #THERE IS DISAGREEMENT BETWEEN SUPERIOR AND SUBORDINATE# 
      ERROR(MSG46,D$ERROR); 
      #CONFLICTS HAVE BEEN DETECTED BETWEEN GROUP 
      AND SUBORDINATE USAGE DECLARATIONS# 
    END #C# 
    ELSE #NO SUPERIOR USAGE CLAUSE# 
    BEGIN #D# 
                             TRACK$(31,3104); 
    IF ELEMENTARY EQ 0
      THEN #ITEM IS GROUP#
      BEGIN #E# #EXTRACT SUPERIOR GROUP ATTRIBUTES# 
                             TRACK$(31,3105); 
      USAGE$FLAG=1; #FLAG TO SHOW PRESENCE OF GRP ATTRIBUTES# 
                          VALUE$(31,"USAGEFLG=",USAGE$FLAG);
  
      USAGE$PTR=DNAT$PTR; #POINTER TO THIS GRP ITEM#
                       VALUE$(31,"USAGEFLG=",USAGE$PTR);
      GROUP$USAGE=GETQUICK(DN$USAGE,DNAT$,DNAT$PTR); #GRP USAGE TYPE# 
                        VALUE$(31,"GRPUSAGE=",GROUP$USAGE); 
      END #E# 
    END #D# 
  END #B# 
  ELSE #NO USAGE CLAUSE IN CURRENT ITEM#
  BEGIN #F# 
                             TRACK$(31,3106); 
  IF USAGE$FLAG EQ 1
    THEN #SUPERIOR GROUP ITEM : SO HAND ON ATTRIBUTES#
    SETFIELD(DN$USAGE,DNAT$,DNAT$PTR,GROUP$USAGE); #USAGE TYPE# 
    ELSE #NO SUPERIOR USAGE#
    BEGIN #G# 
                             TRACK$(31,3107); 
    IF ELEMENTARY EQ 1
      THEN #ITEM IS ELEMENTARY# 
      SETFIELD(DN$USAGE,DNAT$,DNAT$PTR,DISPUSE); #SET DEFLT USAGE DISP# 
    END #G# 
  END #F# 
  IF ELEMENTARY EQ 0
    THEN #ITEM IS GROUP#
    SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,GROUP);  #SET TYPE TO GROUP#
    ELSE #ITEM IS ELEMENTARY# 
    BEGIN #FA#
                            TRACK$(31,3155);
    IF GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ DISPUSE 
      THEN #ITEM USAGE IS NOT DISPLAY#
      BEGIN #H# 
                             TRACK$(31,3108); 
      IF VALUE$FLAG EQ 1
        THEN #SUPERIOR VALUE CLAUSE PRESENT#
        ERROR(MSG8,T$ERROR);
        #A VALUE CLAUSE MAY NOT BE USED FOR A GROUP ITEM
        WHOSE SUBORDINATE ITEMS CONTAIN A JUSTIFIED,
        SYNCHRONIZED OR USAGE (OTHER THAN DISPLAY) CLAUSE#
      #SPLIT OUT ACCORDING TO VALUE OF DN$USAGE#
      GOTO USAGE$SWITCH[GETQUICK(DN$USAGE,DNAT$,DNAT$PTR)]; 
      ##
      UNULL: UDISP: #NO ACTION NEEDED#
      GOTO END$SPLIT; 
      ##
      UCOMP:  #USAGE  IS COMPUTATIONAL# 
      IF GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ NUMERIC
        THEN #TYPE IS NOT NUMERIC#
        BEGIN #I# 
                             TRACK$(31,3109); 
        ERROR(MSG1,D$ERROR);
        #A NUMERIC PICTURE IS REQUIRED FOR THIS ITEM# 
        SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); #SET TO ERROR#
        END #I# 
      GOTO END$SPLIT; 
      UCOMP1:   #USAGE IS COMPUTATIONAL 1#
      IF GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ NUMERIC
        THEN #TYPE IS NOT NUMERIC#
        BEGIN #J# 
                             TRACK$(31,3110); 
        ERROR(MSG1,D$ERROR);
        #A NUMERIC PICTURE IS REQUIRED FOR THIS ITEM# 
        SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); #SET TO ERR#
        END #J# 
        ELSE #TYPE IS NUMERIC#
        BEGIN #K# 
                             TRACK$(31,3111); 
        LDN$NUMLEN=GETQUICK(DN$NUMLEN,DNAT$,DNAT$PTR);
        LDN$POINT=GETQUICK(DN$POINT,DNAT$,DNAT$PTR);
        IF LDN$POINT GR LDN$NUMLEN
          THEN #DEC PT ON LEFT - PPP999#
          L9PS=LDN$POINT; #USE LARGER OF TWO# 
          ELSE #DEC PT EMBEDDED OR ON RIGHT#
          IF LDN$POINT LS 0 
            THEN #DECPT ON RIGHT - 999PPP#
            L9PS=LDN$NUMLEN - LDN$POINT; #POINT IS -VE# 
            ELSE #DECPT EMBEDDED 999V999# 
            L9PS=LDN$NUMLEN;
        IF L9PS GQ 15 
          THEN #9"S AND P"S TOTAL TO 15 OR MORE#
          ERROR(MSG101,D$ERROR);
          #THE NUMBER OF 9"S AND P"S IN A COMP-1 ITEM 
          MUST TOTAL  LESS THAN 15# 
        IF GETQUICK(DN$NUMLEN,DNAT$,DNAT$PTR) LS 15 
          THEN #NUMERIC LENGTH LESS THAN 15 DIGITS# 
          SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,10); #SET TO 1 WD#
          ELSE #NUMERIC LENGTH GREATER THAN 15 DIGITS#
          SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,20); #SET TO 2 WDS# 
        SETFIELD(DN$SYNC,DNAT$,DNAT$PTR,1); #FORCE SYNC#
        END #K# 
      GOTO END$SPLIT; 
    UCOMP2:   #USAGE COMP2# 
      SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,10); #SET LEN TO 1 WD#
      SETFIELD(DN$SYNC,DNAT$,DNAT$PTR,1); #FORCE SYNC#
      GOTO END$SPLIT; 
     UINDEX:     #USAGE INDEX#
      SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,10); #LENGTH TO 1 WD# 
     SETFIELD(DN$NUMLEN,DNAT$,DNAT$PTR,6);  #NUMERIC LENGTH 6#
     SETFIELD(DN$SYNC,DNAT$,DNAT$PTR,1); #FORCE SYNC# 
     GOTO END$SPLIT;
 UCOMP4:  
          #USAGE IS COMPUTATIONAL-4#
          IF GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ NUMERIC
          THEN BEGIN
               # A NUMERIC PICTURE IS REQUIRED# 
               #FOR THIS ITEM#
               ERROR(MSG1,D$ERROR); 
               SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE);
               GOTO END$SPLIT;
               END
         LDN$NUMLEN = GETQUICK (DN$NUMLEN,DNAT$,DNAT$PTR);
         LDN$POINT = GETQUICK(DN$POINT,DNAT$,DNAT$PTR); 
         IF LDN$POINT GR LDN$NUMLEN 
         THEN  BEGIN
               #PPP999# 
               L9PS = LDN$POINT;
               END
         ELSE  BEGIN
               IF LDN$POINT LS 0
               THEN  BEGIN
                     #999PPP# 
                     L9PS = LDN$NUMLEN - LDN$POINT; 
                     END
               ELSE  BEGIN
                     #999V999#
                     L9PS = LDN$NUMLEN; 
                     END
               END
         IF L9PS GQ 15
         THEN  BEGIN
               #SUM OF 9-S AND P-S CANNOT EXCEED# 
               #15 DIGITS FOR COMP-4 ITEMS# 
               ERROR(MSG99,D$ERROR);
               SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE);
               GOTO END$SPLIT;
               END
         REG1 = GETQUICK(DN$NUMLEN,DNAT$,DNAT$PTR); 
         IF GETQUICK(DN$PICSIGN,DNAT$,DNAT$PTR) EQ 1
         THEN  BEGIN
               #PICTURE CONTAINS THE CHARACTER S# 
               REG2 = ITEMLENGTH1[REG1];
               END
         ELSE  BEGIN
               #PICTURE DOES NOT CONTAINS THE CHARACTER S#
               REG2 = ITEMLENGTH2[REG1];
               END
         SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,REG2); 
         GOTO END$SPLIT;
 UBIT:    #USAGE IS BIT#
          IF  GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ BOOLDSP 
          THEN
              BEGIN 
              ERROR(MSG33,D$ERROR); 
              SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); 
              GOTO  END$SPLIT;
              END 
          BITS = GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR);
          BYTES = (BITS+ BITSPERBYTE - 1) / BITSPERBYTE;
          SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,BYTES); 
          SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,BOOLBIT) ;
          SETFIELD(DN$BITLEN,DNAT$,DNAT$PTR,BITS);
          GOTO  END$SPLIT;
      ##
      END$SPLIT: #COMMON CODING AFTER SPLIT#
  IF GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ ERRTYPE
    AND 
    GETQUICK(DN$TYPE,DNAT$,DNAT$PTR) NQ DISPUSE 
    THEN #TYPE IS NEITHER ERROR NOR DISPLAY#
    #SET TYPE ACCORDING TO USAGE# 
    SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,
        (DATA$TYPE[GETQUICK(DN$USAGE,DNAT$,DNAT$PTR)])); #WOW#
     END #H#
    END #FA#
IF SECTION EQ FDSECTN 
  AND 
  FNAT$PTR GR 0 
  AND 
  GETQUICK(FN$CODEPTR,FNAT$,FNAT$PTR) NQ 0
  AND 
  GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ DISPUSE
  AND 
  GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ NULL 
  THEN #ITEM IN CODE SET FILE IS NOT DISPLAY OR GROUP#
  ERROR(MSG115,D$ERROR);
  #IF THE CODESET CLAUSE IS SPECIFIED ALL DATA ITEMS MUST 
  BE USAGE DISPLAY# 
END$USAGE:  
  EXIT$(31,"USAGE$PROC"); 
END #A# 
  
NEWPAGE;
PROC VALUE$PROC;
BEGIN #A# 
# 
THIS PROCESSOR PERFORMS BASIC SYNTACTIC CHECKING ON THE 
VALIDITY OF THE VALUE CLAUSE IN THE CURRENT ITEM. 
* 
ON ENTRY, IT IS ASSUMED THAT :  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * VALUE$FLAG = 1 IF A SUPERIOR GROUP ITEM HAS A VALUE CLAUSE
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * ELEMENTARY = 1 IF THE CURRENT ITEM IS ELEMENTARY (0= GRP) 
  * SUB$DEPTH NZ IF ITEM OCCURS OR IS SUBORD TO OCC"G ITM 
  * RDEF$ST$PTR NZ IF ITEM IS SUBORD TO A REDEFINES 
# 
ENTRY$(32,"VALUE$PROC");
IF GETQUICK(DN$VALUE,DNAT$,DNAT$PTR) EQ 1 
  THEN #VALUE CLAUSE PRESENT# 
  BEGIN #B# 
                             TRACK$(32,3202); 
  IF VALUE$FLAG EQ 1
    THEN #SUPERIOR GRP ITM HAS VALUE CLAUSE#
    ERROR(MSG19,D$ERROR); 
    #A VALUE CLAUSE IS NOT ALLOWED WITH GROUP ENTRIES 
    IF IT APPEARS AT GROUP LEVEL# 
    ELSE #NO SUPERIOR VALUE CLAUSE# 
    BEGIN #C# 
                             TRACK$(32,3203); 
    IF ELEMENTARY EQ 0
      THEN #ITEM IS GROUP#
      BEGIN #D# #EXTRACT GROUP ATTRIBUTES FOR SUBORDS#
                             TRACK$(32,3204); 
      VALUE$FLAG=1; 
                          VALUE$(32,"VALUEFLG=",VALUE$FLAG);
      VALUE$PTR=DNAT$PTR; #PTR TO GRP ITM WITH VALUE# 
                       VALUE$(32,"VALUEPTR=",VALUE$PTR);
      END #D# 
    IF SECTION EQ FDSECTN 
      OR
      SECTION EQ LKSECTN
      THEN #CURRENT SECTION EITHER FILE DEF OR COMMUNICATION# 
      BEGIN 
      ERROR(MSG20,D$ERROR); 
      #IN THE FILE OR COMMUNICATION SECTION THE VALUE 
      CLAUSE IS ONLY ALLOWED WITH CONDITION NAMES#
      SETFIELD(DN$VALUE,DNAT$,DNAT$PTR,0);   # SET AS NO VALUE HERE # 
      END 
IF SECTION EQ CDSECTN AND CD01COUNT GR 1
THEN BEGIN
     # ONLY THE FIRST REDEFINITION MAY CONTAIN VALUE CLAUSES #
     ERROR(MSG203,D$ERROR); 
     END
    IF (GETQUICK(DN$EXTERNAL,DNAT$,DNAT$PTR) EQ 1 
      OR (GRP$ST$PTR NQ 0 
        AND GETQUICK(DN$EXTERNAL,DNAT$,GRP$ST[GRP$ST$PTR]) EQ 1)) 
      AND (SECTION EQ WSSECTN)
      THEN
      ERROR(MSG43,T$ERROR); 
      #THE VALUE CLAUSE MUST NOT BE USED IN ANY DATA DESCRIPTION
      ENTRY WHICH INCLUDES, OR IS SUBORDINATE TO AN ENTRY WHICH 
      INCLUDES, THE EXTERNAL CLAUSE.# 
    IF SUB$DEPTH NQ 0 
      THEN #ITEM OCCURS#
      ERROR(MSG37,D$ERROR); 
      #THE VALUE CLAUSE MAY NOT BE USED IN AN ENTRY THAT
      CONTAINS AN OCCURS CLAUSE OR IN AN ENTRY THAT IS
      SUBORDINATE TO AN ENTRY THAT CONTAINS AN OCCURS CLAUSE# 
    IF (GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 1 
        OR RDEF$ST$PTR NQ 0)
      AND 
      (SECTION EQ WSSECTN OR SECTION EQ LKSECTN)
      THEN #ITEM HAS RDEF OR IS SUBORD TO AN RDEF, AND
           IS IN WORKING STORAGE OR LINKAGE#
      ERROR(MSG38,D$ERROR); 
      #THE VALUE CLAUSE MAY NOT BE USED IN AN ENTRY THAT CONTAINS 
      A REDEFINES CLAUSE OR IN AN ENTRY THAT IS SUBORDINATE TO
      AN ENTRY THAT CONTAINS A REDEFINES CLAUSE#
    IF GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) EQ INDEXUSE
      THEN #ITEM IS USAGE INDEX#
      ERROR(MSG16,D$ERROR); 
      #A JUSTIFIED, PICTURE, VALUE OR BLANK WHEN ZERO CLAUSE
      IS NOT ALLOWED WITH A DATA ITEM WHOSE USAGE IS INDEX# 
    END #C# 
  END #B# 
EXIT$(32,"VALUE$PROC"); 
END #A# 
END #D-ANALYZER#
TERM
