*DECK DA2 
USETEXT CCTTEXT 
USETEXT DNTEXT
PROC DA2; 
BEGIN 
CONTROL PRESET;   #PRESET LOCAL COMMON# 
#CALL DACOMDK FOR GLOBAL DEFS AND DECLARATIONS# 
CONTROL NOLIST; 
*CALL DACOMDK 
CONTROL LIST; 
#DECLARE XDEF FOR PROCS IN PART 2#
XDEF
*CALL DAPT2 
#DECLARE XREFS FOR PARTS 1, 3 AND 4#
XREF
*CALL DAPT1 
XREF
*CALL DAPT3 
XREF
*CALL DAPT4 
PROC LEVEL66; 
BEGIN #A# 
# 
LEVEL 66 PROCESSOR. 
THIS PROCESSOR IS CALLED WHEN THE CURRENT ITEM HAS A LEVEL OF 66. 
* 
FOR EASE OF UNDERSTANDING THIS PROCESSOR, REMEMBER THAT THE 
LEVEL 66 DECLARATION IS : 
  66  DATA NAME 1 RENAMES DATA NAME 2 [THRU DATA NAME 3]
REFERENCES IN THE CODE TO NAME 2 AND 3 ARE DATA NAMES 2 AND 3 
RESPECTIVELY. 
* 
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. CHECKS THE TERMINAL PERIOD IS PRESENT. 
  B. CHECKS IF DATA NAME 2 IS SPECIFIED (AND EXITS IF NOT). 
  C. CHECKS FOR DATA NAME 2 TO BE : 
    1. WITHIN THE RECORD IMMEDIATELY PRECEDING
    2. AT LEVEL 2 THRU 49 
    3. WITHOUT OCCURS OR SUBORDINATE TO OCCURS
  ****ITEM C. ABOVE IS DONE BY A SUBROUTINE 15,"LEVEL66SR"
  ****WHICH, IF THERE IS AN ERROR EXITS DIRECTLY TO 
  **** "END$LEVEL66" AFTER SETTING THE CURRENT ITEM 
  **** TO TYPE ERROR
  D. IF DATANAME 3 IS NOT SPECIFIED, THE ENTIRE DNAT ENTRY
    FOR DATA NAME 2 IS REPLACED BY THAT OF DATA NAME 1 (AND THE 
    LEVEL IS SET TO 66).
  E. IF DATA NAME 3 IS PRESENT THE LEVEL 66 ITEM TYPE IS SET
    TO TYPE GROUP.
  F. CHECKS THAT DATA NAME 2 IS NOT THE SAME AS DATA NAME 3.
  G. REPEATS FOR DATA NAME 3 PARA: C ABOVE. 
  H. CHECKS THAT THE BOUNDARIES FOR DATA NAME 2 AND 3 ARE 
    CORRECT IN RESPECT OF EACH OTHER, AND IF OK SETS
    THE CURRENT 66 ITEM LENGTH TO THE TOTAL LENGTH OF 
    THE DATA NAME 2 AND 3 COMBINE.
  I. CALLS THE SUM$RECORD AND SUM$FILE PROCESSORS 
    DEPENDENT UPON THE LEVEL OF THE NEXT ITEM IN THE DNAT.
* 
ON ENTRY IT IS ASSUMED THAT : 
  * DNAT$PTR POINTS TO THE CURRENT 66 ITEM IN THE DNAT
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * NXT$ITM$LVL CONTAINS THE LEVEL NUMBER OF THE NEXT ITEM
    IN THE DNAT (OR 0 IF CURRENT IS LAST IN DNAT) 
# 
#LOCAL VARIABLES# 
ITEM LDNAT$NAME2 ; #DNAT PTR TO DATA NAME 2 ITEM# 
ITEM LDNAT$NAME3 ; #DNAT PTR TO DATA NAME 3 ITEM# 
ITEM LBYTE$NAME2 ; #BYTE OFFSET OF DATA NAME 2 ITEM#
ITEM LBYTE$NAME3 ; #BYTE OFFSET OF DATA NAME 3 ITEM#
ITEM LILEN$NAME2 ; #ITEM LENGTH OF DATA NAME 2 ITEM#
ITEM LILEN$NAME3 ; #ITEM LENGTH OF DATA NAME 3 ITEM#
##
ENTRY$(15,"LEVEL66"); 
IF GETQUICK(DN$TERMPER,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO TERMINAL PERIOD# 
  BEGIN #B# 
                             TRACK$(15,1502); 
  ERROR(MSG51,T$ERROR); 
  #A TERMINAL PERIOD IS REQUIRED FOR THIS ENTRY#
  END #B# 
LDNAT$NAME2=GETQUICK(DN$STRENAM,DNAT$,DNAT$PTR); #DNAT TO DN2#
                      VALUE$(15,"LDNAT$NM2=",LDNAT$NAME2);
IF LDNAT$NAME2 EQ 0 
  THEN #NO DATA NAME2 IN CLAUSE#
  GOTO END$LEVEL66; #EXIT#
LEVEL66SR(LDNAT$NAME2); #CALL SUBROUTINE TO CHECK NAME 2# 
LDNAT$NAME3=GETQUICK(DN$ENRENAM,DNAT$,DNAT$PTR); #DNAT TO DN3#
                     VALUE$(15,"LDNAT$NM3=",LDNAT$NAME3); 
IF LDNAT$NAME3 EQ 0 
  THEN #NO DATA NAME 3 IN CLAUSE# 
  BEGIN #C# 
                             TRACK$(15,1503); 
  #SET LEVEL 66 ITEM FROM ENTIRE DNAT OF RENAMED ITEM (NAME 1)# 
         COPYD4 (LDNAT$NAME2,DNAT$PTR); 
  SETFIELD(DN$LEVEL,DNAT$,DNAT$PTR,66); #RESET TO TO LVL 66#
  SETFIELD(DN$VALUE ,DNAT$,DNAT$PTR,0); #CLEAR ANY VALUE PTR# 
  SETFIELD(DN$PLTPTR,DNAT$,DNAT$PTR,0); #CLEAR ANY VALUE PTR# 
  GOTO END$LEVEL66; #EXIT#
  END #C# 
  ELSE #DATA NAME 3 PRESENT#
  BEGIN #D# 
                             TRACK$(15,1504); 
SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,GROUP); #SET TYPE TO GROUP# 
  IF LDNAT$NAME2 EQ LDNAT$NAME3 
    THEN #DATA NAME 2 IS SAME AS 3# 
    BEGIN #E# 
                             TRACK$(15,1505); 
    SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); 
    ERROR(MSG29,D$ERROR); 
    #THE TWO ITEMS REFERENCED IN A RENAMES CLAUSE MAY NOT BE THE SAME#
    GOTO END$LEVEL66; 
    END #E# 
  LEVEL66SR(LDNAT$NAME3); #CALL SUBROUTINE TO CHECK NAME 3# 
  IF SECTION EQ FDSECTN 
    THEN #CURRENTLY IN FD SECTION#
    BEGIN #F# 
    SETFIELD(DN$SUBMSEC,DNAT$,DNAT$PTR,MIN$MEM$SEC);
                             TRACK$(15,1506); 
    LBYTE$NAME2=GETQUICK(DN$BYTEOFFS,DNAT$,LDNAT$NAME2); #GET BYTE OFF# 
  SETFIELD(DN$BYTEOFFS,DNAT$,DNAT$PTR,LBYTE$NAME2); #SET NAME 1#
                     VALUE$(15,"LBYTE$NM2=",LBYTE$NAME2); 
    LBYTE$NAME3=GETQUICK(DN$BYTEOFFS,DNAT$,LDNAT$NAME3);
                     VALUE$(15,"LBYTE$NM3=",LBYTE$NAME3); 
    END #F# 
    ELSE #NOT IN FD SECTION#
    BEGIN #G# 
                             TRACK$(15,1507); 
    LBYTE$NAME2=GETQUICK(DN$LONGOFF,DNAT$,LDNAT$NAME2); 
  SETFIELD (DN$LONGOFF, DNAT$, DNAT$PTR, LBYTE$NAME2);
                     VALUE$(15,"LBYTE$NM2=",LBYTE$NAME2); 
    LBYTE$NAME3=GETQUICK(DN$LONGOFF,DNAT$,LDNAT$NAME3); 
                     VALUE$(15,"LBYTE$NM3=",LBYTE$NAME3); 
    END #G# 
  LILEN$NAME2=GETQUICK(DN$ITMLEN,DNAT$,LDNAT$NAME2);
                     VALUE$(15,"LILEN$NM2=",LILEN$NAME2); 
  LILEN$NAME3=GETQUICK(DN$ITMLEN,DNAT$,LDNAT$NAME3);
                      VALUE$(15,"LILEN$NM3=",LILEN$NAME3);
  IF LBYTE$NAME2 GR LBYTE$NAME3 #LEFT BOUNDARIES# 
    OR
    (LBYTE$NAME2 + LILEN$NAME2) 
      GR (LBYTE$NAME3+LILEN$NAME3)  #RIGHT BOUNDARIES#
    THEN #LEFT OR RIGHT BOUNDARIES ARE WRONG# 
    BEGIN #H# 
                             TRACK$(15,1508); 
    ERROR(MSG34,D$ERROR); 
    #NO PART OF THE AREA DESCRIBED BY THE SECOND DATA ITEM
    REFERENCED IN THE RENAMES CLAUSE MAY BE TO THE LEFT OF THE
    BEGINNING OF THE AREA DESCRIBED BY THE FIRST DATA ITEM, AND 
    NO PART OF THE AREA DESCRIBED BYT THE FIRST DATA ITEM MAY 
    BE TO THE RIGHT OF THE END OF THE AREA DESCRIBED BY THE 
    SECOND DATA ITEM# 
    #WHATEVER IN HELL THAT MEANS.....#
    SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,0); #SET LENGTH TO ZERO#
    SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); #SET TYPE TO ERR# 
    END #H# 
    ELSE #BOUNDARIES ARE OK#
    BEGIN #HA#
    #SET LENGTH OF RENAMING ITEM TO ENTIRE LENGTH FROM
    LEFTMOST BYTE OF NAME 2 TO RIGHTMOST BYTE OF NAME 3#
    SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,
      (LBYTE$NAME3 - LBYTE$NAME2 + LILEN$NAME3)); 
    SETFIELD(DN$REPCOUNT,DNAT$,DNAT$PTR,0); 
    END #HA#
    TGET=GETQUICK(DN$MAJMSEC,DNAT$,LDNAT$NAME2);
    SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,TGET); #SET NAME 1#
    END #D# 
END$LEVEL66:  
IF NXT$ITM$LVL NQ 66
  THEN #NEXT ITEM IS NOT LEVEL 66#
  BEGIN #I# 
                             TRACK$(15,1509); 
  IF NXT$ITM$LVL EQ 1 
    THEN #NEXT ITEM IS LVL1 THERE4 THIS IS END RECD#
    SUM$RECORD; #CALL SUM RECORD PROCESSOR# 
    ELSE #NEXT ITEM NOT LVL 01 OR 66# 
    BEGIN #J# 
                             TRACK$(15,1510); 
    IF NXT$ITM$LVL GR 49
      OR
      NXT$ITM$LVL EQ 0
      THEN #END DNAT OR NXT ITM LVL GREATER THAN 49#
      BEGIN #K# 
                             TRACK$(15,1511); 
      SUM$RECORD; #CALL SUM RECORD PROCESSOR# 
      IF SECTION EQ FDSECTN 
        THEN #CURRENTLY IN FD SECTION#
        SUM$FILE; #CALL SUM FILE PROCESSOR# 
      END #K# 
      ELSE #NXT ITM LEVEL LESS THAN 49# 
      ERROR(MSG28,D$ERROR); 
      #LVL 66 ENTRIES THAT REFERENCE DATA ITEMS IN A RECORD 
      MUST IMMEDIATELY FOLLOW THE LAST ENTRY IN THAT RECD#
    END #J# 
  END #I# 
EXIT$LEVEL66: 
EXIT$(15,"LEVEL66");
# 
* 
LEVEL 66 SUBROUTINE.
THIS SUBROUTINE PERFORMS CHECKS THAT ARE COMMON TO
BOTH DATA NAME 2 AND DATA NAME 3. 
# 
PROC LEVEL66SR(LDNAT$NAME); 
BEGIN #AA#
ITEM LDNAT$NAME;
##
IF LDNAT$NAME LS GRP$ST[1]
  OR
LDNAT$NAME GR DNAT$PTR
  THEN #DATA NAME IS NOT WITHIN SAME RECD AS LVL 66#
  BEGIN #AB#
                             TRACK$(15,1528); 
  ERROR(MSG48,D$ERROR); 
  #A DATA ITEM REFERENCED IN A RENAMES CLAUSE MUST BE WITHIN
  THE IMMEDIATELY PRECEDING RECORD# 
  GOTO ERR$LVL$66SR; #COMMON ERR CODING#
  END #AB#
IF GETQUICK (DN$LEVEL,DNAT$,LDNAT$NAME) EQ 1
  OR
  GETQUICK(DN$LEVEL,DNAT$,LDNAT$NAME) GR 49 
  THEN #RENAMED ITM IS EITHER LVL 1 OR GREATER THAN 49# 
  BEGIN #AC#
                             TRACK$(15,1529); 
  ERROR(MSG31,D$ERROR); 
  #A DATA ITEM REFERENCED IN A RENAMES CLAUSE MUST HAVE A 
  LEVEL NUMBER IN THE RANGE FROM 2 TO 49# 
  GOTO ERR$LVL$66SR;
  END #AC#
IF GETQUICK (DN$SDEPTH,DNAT$,LDNAT$NAME) GR 0 
  THEN #RENAMED ITEM EITHER OCCURS OR IS SUBORD TO OCCURS#
  BEGIN #AD#
                             TRACK$(15,1530); 
  ERROR(MSG32,D$ERROR); 
  #A DATA ITEM REFERENCED IN A RENAMES CLAUSE MAY NOT HAVE
  AN OCCURS CLAUSE OR BE SUBORDINATE TO A DATA ITEM THAT
  HAS AN OCCURS CLAUSE# 
ERR$LVL$66SR: #ERROR EXIT#
  SETFIELD(DN$TYPE,DNAT$,LDNAT$NAME,ERRTYPE); #SET TYPE TO ERR# 
  GOTO END$LEVEL66; #EXIT FROM SR TO FINAL PART OF PROC#
  END #AD#
END #AA# #END OF SUBROUTINE#
END #A# #END OF LEVEL66 PROCESSOR#
NEWPAGE;
PROC LEVEL77; 
BEGIN #A# 
# 
LEVEL 77 PROCESSOR. 
THIS PROCESSOR IS CALLED WHEN THE CURRENT ITEM HAS A LEVEL OF 77. 
  
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. CHECKS THAT THE LEVEL 77 ITEM IS IN THE WORKING STORAGE
    OR LINKAGE SECTION AND NOT FOLLOWED BY A LEVEL 2 THRU 49 ITEM 
  B. SETS FLAGS SUCH THAT THE CURRENT ITEM WILL APPEAR AS A SYNC RIGHT
    ELEMENTARY ITEM 
  C. CALLS THE ITEM PROCESSOR 
  D. SETS THE BYTE OFFSET OF THE CURRENT ITEM 
  E. SETS THE MAJOR MEMORY SECTION IN THE CURRENT ITEM TO EITHER
    WORKING STORAGE OR LINKAGE WHICHEVER IS APPROPRIATE 
  
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * SECTION CONTAINS THE CURRENT SECTION CODE 
# 
ITEM LNXT$ITM$LVL I; #CONTAINS DNAT$PTR TO NXT ITM IN 
                     DNAT REGARDLESS OF ITS LEVEL#
ITEM LLIN$PTR I; #PTR TO EITHER DNAT OR PLT DEP ON LINAGLIT#
ITEM LLIN$LEN I; #LENGTH OF LINAGE ITEM OR LITERAL# 
ENTRY$(16,"LEVEL77"); 
IF SAVE$NAB GQ 0 THEN 
  BEGIN 
  NAB = SAVE$NAB; 
  SAVE$NAB = -1;
  END 
LNXT$ITM$LVL=GETQUICK(DN$LEVEL,DNAT$,DNAT$PTR+1); 
IF SECTION NQ WSSECTN 
  AND 
  SECTION NQ LKSECTN
  AND 
  SECTION NQ CSSECTN
  OR
  (LNXT$ITM$LVL GQ 2
  AND 
  LNXT$ITM$LVL LQ 49) 
  THEN #ITEM NOT IN WS OR LK SECTION OR NXT ITM IS LVL 2 TO 49# 
       #AND NOT IMMEDIATELY PRECEDED BY AN FD DESCR#
  BEGIN #AB#
  ERROR(MSG100,D$ERROR);
  #A LEVEL 77 ITEM MUST BE IN THE WORKING STORAGE OR LINKAGE
  SECTION AND MUST NOT BE FOLLOWED BY A LEVEL 2 THRU 49 ITEM# 
  SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); #SET CURR ITM TO ERR# 
  GOTO END$LEVEL77; #EXIT FROM PROCESSOR# 
  END #AB#
IF GETQUICK(DN$SYNC,DNAT$,DNAT$PTR) EQ 0
  THEN #ITEM NOT SPECIFIED AS SYNC LEFT#
  BEGIN #AD#
  SETFIELD(DN$SYNC,DNAT$,DNAT$PTR,1); #FORCE SYNC RIGHT#
  IF NOT CCTLEFT77 THEN 
  SETFIELD(DN$SYNCRGHT,DNAT$,DNAT$PTR,1); 
  END #AD#
ELEMENTARY=1; #FORCE ELEMENTARY ITEM# 
                         VALUE$(16,"ELEMENTY=",ELEMENTARY); 
ITEM$PROC; #CALL ITEM PROCESSOR#
IF SECTION NQ LKSECTN 
  THEN #NOT IN LINKAGE# 
  BEGIN #B# 
                             TRACK$(16,1602); 
  IF SECTION EQ CSSECTN 
    THEN #IN COMMON STORAGE#
    SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,COMSMSEC); 
    ELSE #ASSUME WORKING STORAGE# 
    SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,WSMSEC); 
  IF GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 0
    THEN #CURRENT ITEM IS NOT REDEFINED#
    BEGIN #C# 
                             TRACK$(16,1603); 
    SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,NAB); #SET ITEM BYTE OFFSET# 
    NAB=GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR)+NAB; #UPDATE NAB#
                       VALUE$(16,"NAB=",NAB); 
    END #C# 
  END #B# 
  ELSE #SECTION IS LINKAGE# 
  BEGIN #D# 
                             TRACK$(16,1604); 
  SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,LINKMSEC); #SET TO LINKAGE MSEC# 
  SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,0); #CLEAR BYTE OFFSET#
  END #D# 
END$LEVEL77:  
EXIT$(16,"LEVEL77");
END #A# 
NEWPAGE;
PROC LEVEL88; 
BEGIN #A# 
  # 
  LEVEL 88 PROCESSOR. 
  
  PLACED HERE SOLELY FOR FIPS TESTS.  **********************************
  DIAGNOSE FILLER AS CONDITION-VARIABLE IF FIPS [ 3  #
  
  ITEM SAVE$LINE I; 
  
  IF CCTFIPSLEVEL LS 3 AND GETQUICK(DN$FILLREF,DNAT$,DNAT$PTR-1) NQ 0 
  THEN BEGIN
      SAVE$LINE = LINE$NO;
      LINE$NO = GETQUICK(DN$LINE,DNAT$,DNAT$PTR-1); 
      ERROR(205,T$ERROR); 
      LINE$NO = SAVE$LINE;
      END 
END #A# 
NEWPAGE;
PROC LVL$CD;
BEGIN #A# 
# 
COMMUNICATION DESCRIPTION PROCESSOR.
THIS PROCESSOR IS CALLED WHEN THE CURRENT ITEM HAS A LEVEL OF CDDESCR.
  
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. CHECKS FOR THE TERMINAL PERIOD ON THIS ITEM
  B. RESETS SUBSCRIPT DEPTH TO 0
  C. SETS THE ITEM"S MAJOR MEMORY SECTION 
  D. SETS UP A PTR TO THE CURRENT ITEM (CD$PTR) 
  E. FORCES  THE NEXT AVAILABLE BYTE COUNTER (NAB) TO THE NEXT
    HIGHEST WORD BOUNDARY AND ASSIGNS THIS TO THE CURRENT ITEMS 
    BYTE OFFSET 
  F. IF THE CURRENT ITEM IS FOR INITIAL INPUT, CREATES A NEW DNAT AND 
    LAT (LITERAL ATTRIBUTE TABLE) ENTRY FOR THE 87 CHARACTER LONG SPACE 
    FILLED COMMUNICATION AREA 
  G. SETS THE FIRST$R$PTR TO THE CURRENT DNAT ITEM
  
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ENTRY IN THE DNAT
  * NAB CONTAINS THE NEXT AVAILABLE BYTE FOR ALLOCATION TO
    THE CURRENT ITEM
  * CCTDNATLEN AND CCTLATLEN CONTAIN THE RESPECTIVE NUMBERS 
    OF ENTRIES IN THE TABLES
# 
#LOCAL VARIABLES# 
ITEM LSLACK$BYTES; #SLACK BYTES NEEDED TO GET NAB TO NXT BOUNDARY#
ITEM LDNAT$PTR; #PTR TO NEW ENTRY IN DNAT#
ITEM LLAT$PTR; #PTR TO NEW ENTRY IN LAT#
ENTRY$(17,"LVL$CD");
CD01COUNT = 0;  #USED IN VALUE CLAUSE PROCESSING #
SUB$DEPTH=0; #RESET SUBSCRIPT DEPTH#
                        VALUE$(17,"SUBDEPTH=",SUB$DEPTH); 
SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,CDMSEC); #SET MAJ MEM SECTION TO CD# 
CD$PTR=DNAT$PTR; #SET DNAT PTR TO THIS ITEM#
                        VALUE$(17,"CDPTR=",CD$PTR); 
LSLACK$BYTES=CAL$SL$BYTES(NAB); #CALCULATE SLACK BYTES NEEDED#
                      VALUE$(17,"LSLACKBYT=",LSLACK$BYTES); 
NAB=NAB+LSLACK$BYTES; 
                       VALUE$(17,"NAB=",NAB); 
CD$OFFSET=NAB; #SET COMM DESCRIPTION OFFSET#
                        VALUE$(17,"CDOFFSET=",CD$OFFSET); 
NAB = NAB + GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR); 
SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,CD$OFFSET); #SET BYTE OFFSET#
IF GETQUICK(DN$CDINP,DNAT$,DNAT$PTR) EQ 1 
  AND 
  GETQUICK(DN$CDINIT,DNAT$,DNAT$PTR) EQ 1 
  THEN #CURRENT ITEM IS FOR INITIAL INPUT#
  BEGIN #B# 
                             TRACK$(17,1702); 
  NAB = NAB + 87; 
  LDNAT$PTR=CCTDNATLEN+1; #SET PTR TO NEXT AVAILABLE ENTRY# 
                           VALUE$(17,"LDNAT$PTR=",LDNAT$PTR); 
  CCTDNATLEN=LDNAT$PTR; 
                           VALUE$(17,"CCTDNATLN=",CCTDNATLEN);
  LLAT$PTR=CCTLATLEN+1; #SET PTR TO NEXT AVAILABLE ENTRY# 
                      VALUE$(17,"LLAT$PTR=",LLAT$PTR);
  #SETUP NEW DNAT ENTRY#
  SETFIELD(DN$ITMLEN,DNAT$,LDNAT$PTR,87); #ITEM LENGTH IS 87 CHARS# 
  SETFIELD(DN$TYPE,DNAT$,LDNAT$PTR,GROUP); #TYPE GROUP# 
  SETFIELD(DN$LEVEL,DNAT$,LDNAT$PTR,66); #LEVEL 66# 
  SETFIELD(DN$MAJMSEC,DNAT$,LDNAT$PTR,CDMSEC); #SET MAJOR MEM SECTION#
  SETFIELD(DN$LONGOFF,DNAT$,LDNAT$PTR,CD$OFFSET); #SET BYTE OFFSET# 
  END #B# 
FIRST$R$PTR=DNAT$PTR; #SET CURR ITM AS FIRST IN RECD# 
                        VALUE$(17,"FIRSTRPTR=",FIRST$R$PTR);
EXIT$(17,"LVL$CD"); 
END #A# 
NEWPAGE;
PROC LVL$CDDN;
BEGIN #A# 
# 
COMMUNICATION DESRCIPTION DATA NAME PROCESSOR.
THIS PROCESSOR IS CALLED WHEN THE CURENT ITEM HAS A LEVEL 
OF CDDATANAME.
* 
THE PROCESSOR SETS THE MAJOR MEMORY SECTION AND BYTE OFFSET 
IN THE CURRENT ITEM.
* 
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * CDMSEC CONTAINS THE APPROPRIATE MSEC CODE 
  * CD$OFFSET CONTAINS THE VALUE OF NAB AT THE TIME 
    THE CD DESCRIPTION WAS PROCESSED
# 
ENTRY$(18,"LVL$CDDN");
SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,CDMSEC); #SET MAJOR MEM SECTION# 
SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR, 
    (GETQUICK(DN$LONGOFF,DNAT$,DNAT$PTR)+CD$OFFSET)); #SET BYTE OFFSET# 
EXIT$(18,"LVL$CDDN"); 
END #A# 
NEWPAGE;
PROC LEVEL$FDSD;
BEGIN #A# 
# 
FILE / SORT DESCRIPTION PROCESSOR.
THIS PROCESSOR IS CALLED WHEN THE CURRENT ITEM HAS A LEVEL OF 
FDDESCR OR SDDESCR. 
* 
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. RESETS VARIABLES USED DURING THE PROCESSING OF SUBSEQUENT
    ENTRIES 
  B. PERFORMS BASIC SYNTACTIC CHECKING ON ACCESS AND PROCESSING MODE
    CLAUSES 
  C. BUILDS TEMP DNAT ENTRIES FOR REPORT WRITER CLAUSES 
  D. ASSIGNS A MINOR MEMORY SECTION TO THE AUX TABLE CHAIN OF 
    SAME RECORD AREA ITEMS
  E. CHECKS THE RELATIONSHIP BETWEEN CURRENT ITE"S SAME AREA, 
    SAME RECORD AREA, AND SAME SORT AREA CLAUSES BY SCANNING
    AUXTABLE CHAINS OF ENTRIES
  F. PERFORMS SYNTACTIC CHECKING FOR REPORT WRITER CLAUSES
  G. CHECKS VALIDITY OF REPORT NAMES AND WHERE NECESSARY ADDS 
    ENTRIES TO THE FDRD TABLE 
  H. PERFORMS SYNTACTIC CHECKING ON OPTIONAL AND RERUN CLAUSES
* 
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * LVEL$NO CONTAINS THE LVEL NO OF THE CURRENT ITEM
  * MIN$MEM$SEC CONTAINS THE MINOR MEMORY SECTION FOR THE CURRENT 
    FILE
# 
#LOCAL VARIABLES# 
ITEM LAUX$PTR; #AUX TABLE POINTER#
ITEM LAUX$SAMAREA; #AUX TABLE PTR FOR SAME AREA CHAIN#
ITEM SAREA$FILENM; #HOLDS DNAT PTR OF ITM IN SAME AREA CHAIN# 
ITEM LAUX$SAMREC; #AUX$TABLE PTR FOR SAME RECORD AREA CHAIN#
ITEM LAUX$SRTREC; #AUX TABLE PTR FOR SAME SORT RECORD AREA# 
ITEM LFDRDT$PTR; #POINTER TO THE FDRD TABLE#
ITEM LAUX$REPORT; #AUX TABLE PTR TO REPORTS CAHAIN FOR CURR ITM#
##
ENTRY$(19,"LEVEL$FDSD");
IF GETQUICK(DN$TERMPER,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO TERMINAL PERIOD# 
  ERROR(MSG51,T$ERROR); 
  #A TERMINAL PERIOD IS REQUIRED FOR THIS DATA ENTRY# 
SUB$DEPTH=0; #RESET SUBSCRIPT DEPTH#
                        VALUE$(19,"SUBDEPTH=",SUB$DEPTH); 
MAJ$MEM$SEC=FDMSEC; #SET MAJOR MSEC TO FD#
                       VALUE$(19,"MAJMSEC=",MAJ$MEM$SEC); 
MIN$MEM$SEC=SVD$MIN$MSEC+1; #MINOR MSEC SET TO VALUE SAVE BEFORE
      SAME AREA PROCESSING (IF ANY)#
                       VALUE$(19,"MINMSEC=",MIN$MEM$SEC); 
FD$PTR=DNAT$PTR; #CURRENT ITEM IS FD ITEM#
                       VALUE$(19,"FDPTR=",FD$PTR);
MAX$REC$LEN=0; #INITIALIZE MAX AND MIN RECD LENGTHS#
                          VALUE$(19,"MAXRECLN=",MAX$REC$LEN); 
MIN$REC$LEN=10000000; 
                         VALUE$(19,"MINRECLN=",MIN$REC$LEN);
FNAT$PTR=GETQUICK(DN$FNATPTR,DNAT$,DNAT$PTR); #SETUP PTR TO FNAT ENTRY# 
                          VALUE$(19,"FNAT$PTR=",FNAT$PTR);
FNAT$LINE=GETQUICK(FN$LINE,FNAT$,FNAT$PTR); #GET SELECT SRCE LINE#
                     VALUE$(19,"FNAT$LINE=",FNAT$LINE); 
#SET PTR FROM FNAT TO CURR ITM# 
SETFIELD(FN$DNATPTR,FNAT$,FNAT$PTR,DNAT$PTR); 
IF GETQUICK(FN$SELECT,FNAT$,FNAT$PTR) EQ 0
  THEN #NO SELECT GIVEN FOR THIS FILE#
  BEGIN 
  ERROR(MSG92,D$ERROR); 
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
  #THIS FILE IS NOT NAMED IN ANY SELECT CLAUSE# 
IF GETQUICK(FN$ASSIGN,FNAT$,FNAT$PTR) EQ 0
  THEN #NO ASSIGN GIVEN FOR THIS FILE#
  BEGIN 
  ERROR(MSG136,D$ERROR);
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FILE#
  END 
IF GETQUICK(DN$ACC,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO ACCESS MODE CLAUSE#
  SETFIELD(FN$ACCESS,FNAT$,FNAT$PTR,SEQACCESS); #DEFAULT IS SEQ#
IF GETQUICK(DN$ORG,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO ORGANISATION CLAUSE# 
  SETFIELD(FN$ORG,FNAT$,FNAT$PTR,SEQUENTIAL); #DEFAULT TO SEQ#
IF GETQUICK(DN$REPORTS,DNAT$,DNAT$PTR) EQ 1 
  AND 
  GETQUICK(FN$ORG,FNAT$,FNAT$PTR) NQ SEQUENTIAL 
  THEN #FILE HAS NO REPORTS CL AND IS NOT SEQ#
  BEGIN 
  ERROR$F(MSG117,D$ERROR);
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
  #IF A REPORTS CLAUSE IS SPECIFIED THE FILE MUST HAVE
  SEQUENTIAL ORGANISATION#
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ INDEXED 
  OR
GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ DIRECT 
  OR
  GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ ACTUAL$KEY 
  THEN #ORG IS INDEXED DIRECT OR ACTUAL#
  BEGIN #BA#
                                      TRACK$(19,1935);
  IF GETQUICK(FN$ALTKPTR,FNAT$,FNAT$PTR) NQ 0 
    AND 
    GETQUICK(FN$2DASSIGN,FNAT$,FNAT$PTR) EQ 0 
    THEN #ALTERNATE KEYS PRESENT BUT NO SECOND IMPL NAME# 
    BEGIN 
    ERROR$F(MSG102,D$ERROR);
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #A SECOND IMPLEMENTOR NAME IS REQUIRED FOR ORGANISATIONS
    INDEXED DIRECT AND  ACTUAL KEY IF ALTERNATE KEYS ARE
    SPECIFIED#
  END #BA#
  ELSE #ORG IS NOT INDEXED, DIRECT, OR ACTUAL-KEY # 
    BEGIN 
    IF GETQUICK(FN$2DASSIGN,FNAT$,FNAT$PTR) NQ 0
      THEN # TWO FILES ASSIGNED TO A FILE WHICH IS NOT A INDEXED DIRECT#
      BEGIN #OR ACTUAL-KEY FILE ISSUE A TRIVIAL DIAGNOSTIC #
      ERROR(MSG275,D$ERROR);
      END 
    END 
TGET=GETQUICK(FN$CODEPTR,FNAT$,FNAT$PTR); 
IF TGET NQ 0
  THEN #CODESET CLAUSE PRESENT# 
  IF GETQUICK(DN$LEVEL,DNAT$,TGET) NQ ALPHNAME
    AND 
    GETQUICK(DN$ANTYPE,DNAT$,TGET) EQ ANLITERAL 
    THEN #OBJECT OF CODESET CLAUSE IS NOT AN ALPHABET NAME OR IS LIT# 
    BEGIN 
    ERROR(MSG121,D$ERROR);
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #THE CODESET CLAUSE MUST REFERENCE AN ALPHABET NAME AND THAT
    ALPHABET NAME MAY NOT HAVE THE LITERAL PHRASE IN IT#
IF GETQUICK(FN$MFILPOS,FNAT$,FNAT$PTR) NQ 0 
  AND 
  GETQUICK(FN$LABELREC,FNAT$,FNAT$PTR) NQ STANDARD
  THEN #MULTIPLE FILE HAS NON STANDARD LABELS#
    BEGIN 
  ERROR(MSG119,D$ERROR);
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
  #MULTIPLE FILE TAPES MUST HAVE STANDARD LABELS# 
IF GETQUICK(DN$LABREC,DNAT$,DNAT$PTR) EQ 0
  AND 
  CURR$ITM$LVL EQ FDDESCR 
  THEN #NO LABEL RECS CLAUSE IN FD DESCRIPTION# 
  ERROR(MSG60,D$ERROR); 
  #A LABEL RECORDS CLAUSE IS REQUIRED ON AN FD DESCRIPTION ENTRY# 
IF GETQUICK(FN$PROCMODE,FNAT$,FNAT$PTR) EQ RANDOM 
  THEN #RANDOM PROCESSING MODE SPECIFIED# 
  ERROR$F(MSG61,D$ERROR); 
  #RANDOM PROCESSING MODE IS NOT IMPLEMENTED IN THE COMPILER# 
#SET PTR TO SAME REC CHAIN# 
LAUX$PTR=GETQUICK(FN$SRECPTR,FNAT$,FNAT$PTR); 
                           VALUE$(19,"LAUX$PTR=",LAUX$PTR); 
IF LAUX$PTR NQ 0
  THEN #SAME RECD AUX CHAIN EXISTS# 
  BEGIN #C# 
                             TRACK$(19,1903); 
  IF GETQUICK(AX$RECMSEC,AUX$,LAUX$PTR) EQ 0
    THEN #NO MINOR MSEC ASSIGNED FOR THIS CHAIN#
    BEGIN #D# 
                             TRACK$(19,1904); 
    SETFIELD(AX$RECMSEC,AUX$,LAUX$PTR,MIN$MEM$SEC); #SET MINOR MSEC#
    SVD$MIN$MSEC=MIN$MEM$SEC; #SAVE COPY OF MINOR MSEC# 
                      VALUE$(19,"SVDMINMSC=",SVD$MIN$MSEC); 
    END #D# 
    ELSE #MINOR MSEC ALREADY ASSIGNED FOR THIS CHAIN# 
    BEGIN #DA#
    MIN$MEM$SEC=GETQUICK(AX$RECMSEC,AUX$,LAUX$PTR); #SET MINOR MSEC#
                       VALUE$(19,"MINMSEC=",MIN$MEM$SEC); 
    END #DA#
  END #C# 
  ELSE #NO CHAIN OF AUX ENTRIES#
  BEGIN #DB#
  SVD$MIN$MSEC=MIN$MEM$SEC; #SAVE MINOR MSEC# 
                      VALUE$(19,"SVDMINMSC=",SVD$MIN$MSEC); 
  END #DB#
FOR LAUX$SAMAREA=GETQUICK(FN$SAREAPTR,FNAT$,FNAT$PTR) 
  WHILE LAUX$SAMAREA NQ 0 
  DO #FOR ALL ENTRIES IN SAME AREA CHAIN# 
  BEGIN #E# 
                             TRACK$(19,1905); 
                      VALUE$(19,"LAUXSMARE=",LAUX$SAMAREA); 
  SAREA$FILENM=GETQUICK(AX$SAMARANAM,AUX$,LAUX$SAMAREA); #GET NM PTR# 
                      VALUE$(19,"SAREAFLNM=",SAREA$FILENM); 
  LAUX$SAMREC=GETQUICK(FN$SRECPTR,FNAT$,FNAT$PTR); #GET SM REC PTR# 
                      VALUE$(19,"LAUXSMREC=",LAUX$SAMREC);
  IF LAUX$SAMREC NQ 0 
    THEN #THERE IS A SAME RECD CHAIN# 
    BEGIN #F# 
                             TRACK$(19,1906); 
    FOR ZERO = 0 WHILE LAUX$SAMREC NQ 0 
      DO #FOR ALL ITMS IN SAME RECD CHAIN#
      BEGIN #G# 
                             TRACK$(19,1907); 
      IF SAREA$FILENM EQ GETQUICK(AX$SAMRECNAM,AUX$,LAUX$SAMREC)
        THEN #CURR SAME AREA FILE IS IN SAME REC CHAIN# 
        GOTO FILE$OK; #SKIP OUT OF THIS FOR LOOP# 
      LAUX$SAMREC=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$SAMREC); #NXT IN CHN#
                      VALUE$(19,"LAUXSMREC=",LAUX$SAMREC);
      END #G# 
    ERROR(MSG62,D$ERROR); 
    #IF A FILE APPEARS IN BOTH A SAME AREA CLAUSE AND A SAME RECORD 
    AREA CLAUSE, ALL THE FILES IN THE SAME AREA CLAUSE MUST 
    MUST APPEAR IN THE SAME RECORD AREA CLAUSE# 
    END #F# 
FILE$OK:  
  IF CURR$ITM$LVL EQ FDDESCR
    THEN #CURRENT ITEM IS NOT AN SD#
    BEGIN #H# 
                             TRACK$(19,1908); 
    LAUX$SRTREC=GETQUICK(FN$SSORTPTR,FNAT$,FNAT$PTR); #GET SM SRT PTR#
                      VALUE$(19,"LAUXSRREC=",LAUX$SRTREC);
    IF LAUX$SRTREC NQ 0 
      THEN #THERE IS SAME SORT CHAIN# 
      BEGIN #I# 
                             TRACK$(19,1909); 
      FOR ZERO = 0 WHILE LAUX$SRTREC NQ 0 
        DO #FOR ALL ENTRIES IN SAME SORT CHAIN# 
        BEGIN #J# 
                             TRACK$(19,1910); 
        IF SAREA$FILENM EQ
          GETQUICK(AX$SAMSRTNAM,AUX$,LAUX$SRTREC) 
          THEN #CURR SM AREA FILE IS IN CHAIN#
          GOTO SORT$OK; #SKIP OUT OF THIS FOR LOOP# 
          LAUX$SRTREC=
            GETQUICK(AX$TNEXTPTR,AUX$,LAUX$SRTREC); #MV TO NXT ITM# 
                      VALUE$(19,"LAUXSRREC=",LAUX$SRTREC);
        END #J# 
      ERROR(MSG63,D$ERROR); 
      #IF A FILE APPEARS BOTH IN A SAME AREA CLAUSE AND A 
      SAME SORT OR SORT/MERGE CLAUSE, ALL THE FILES IN THE SAME 
      AREA CLAUSE MUST APPEAR IN THE SAME SORT OR SORT/MERGE
      AREA CLAUSE#
SORT$OK:  
      END #I# 
    END #H# 
LAUX$SAMAREA=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$SAMAREA); #MV TO NXT ITM# 
                      VALUE$(19,"LAUXSMARE=",LAUX$SAMAREA); 
  END #E# 
IF GETQUICK(DN$REPORTS,DNAT$,DNAT$PTR) EQ 1 
  THEN #REPORTS CLAUSE PRESENT# 
  BEGIN #K# 
                             TRACK$(19,1911); 
  IF GETQUICK(DN$LINAGE,DNAT$,DNAT$PTR) EQ 1
    THEN #LINAGE CLAUSE PRESENT#
  BEGIN 
    ERROR(MSG64,D$ERROR); 
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
    #THE REPORT CLAUSE AND LINAGE CLAUSE MAY NOT BOTH BE USED 
    IN A FILE DESCRIPTION ENTRY#
  IF GETQUICK(DN$DATREC,DNAT$,DNAT$PTR) EQ 1
    THEN #DATA RECORDS CLAUSE PRESENT#
    BEGIN 
    ERROR(MSG65,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #THE REPORT CLAUSE AND DATA RECORDS CLAUSE MAY NOT BOTH BE USED 
    IN A FILE DESCRIPTION ENTRY#
  IF GETQUICK(FN$ACCESS,FNAT$,FNAT$PTR) NQ SEQACCESS
    THEN #ACCESS MODE IS NOT SEQUENTIAL#
    BEGIN 
    ERROR$F(MSG66,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #WHEN A REPORT CLAUSE IS USED IN A FILE DESCRIPTION, THE ACCESS 
    MODE MUST BE SEQUENTIAL#
  FOR LAUX$REPORT=GETQUICK(FN$RPTPTR,FNAT$,FNAT$PTR)
    WHILE LAUX$REPORT NQ 0
    DO #FOR ALL REPORTS FOR THIS FILE#
    BEGIN #L# 
                             TRACK$(19,1912); 
                       VALUE$(19,"LAUX$RPT=",LAUX$REPORT);
    FOR LFDRDT$PTR=1 STEP 1 UNTIL CCTFDRDLEN
      DO #FOR ALL ENTRIES IN FDRD TABLE#
      BEGIN #M# 
                       VALUE$(19,"LFDRDTPTR=",LFDRDT$PTR);
                             TRACK$(19,1913); 
      IF GETQUICK(FR$REPTNAME,FDRDT$,LFDRDT$PTR) EQ 
        GETQUICK(AX$RPTNAM,AUX$,LAUX$REPORT)
        THEN #THIS REPORT ALREADY IN THE FDRD#
        BEGIN #N# 
                             TRACK$(19,1914); 
        ERROR(MSG93,D$ERROR); 
        SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
        #REPORT NAMES CAN ONLY BE ASSOCIATED WITH ONE FILE# 
        GOTO SKIP$IT; #EXIT FROM FOR LOOP#
        END #N# 
      END #M# 
    #CREATE NEW ENTRY IN FDRD FOR CURRENT DNAT ITEM#
    CCTFDRDLEN=CCTFDRDLEN+1; #INCREASE TABLE LENGTH#
    SETFIELD(FR$FILENAME,FDRDT$,CCTFDRDLEN,DNAT$PTR); #PTR TO CURR ITM# 
    #SET PTR TO FNAT ENTRY OF CURR ITEM#
    SETFIELD(FR$FNATPTR,FDRDT$,CCTFDRDLEN,FNAT$PTR);
    #SET MINOR MEMORY SECTION#
    SETFIELD(FR$FILEMSEC,FDRDT$,CCTFDRDLEN,MIN$MEM$SEC);
    TGET=GETQUICK(AX$RPTNAM,AUX$,LAUX$REPORT); #PTR TO AUX ENTRY# 
    SETFIELD(FR$REPTNAME,FDRDT$,CCTFDRDLEN,TGET); 
SKIP$IT:  
    LAUX$REPORT=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$REPORT); #MV TO NXT ITM# 
                       VALUE$(19,"LAUX$RPT=",LAUX$REPORT);
    END #L# 
  END #K# 
IF GETQUICK(FN$OPTIONAL,FNAT$,FNAT$PTR) EQ 1
  AND 
  GETQUICK(FN$ACCESS,FNAT$,FNAT$PTR) NQ SEQACCESS 
  THEN #FILE IS OPTIONAL BUT ACCESS NOT SEQUENTIAL# 
  BEGIN 
  ERROR$F(MSG67,D$ERROR); 
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
  #WHEN A FILE IS DESCRIBED AS OPTIONAL THE ACCESS MODE MUST
  BE SEQUENTIAL#
IF GETQUICK(FN$RRUNEOR,FNAT$,FNAT$PTR) EQ 1 
  AND 
  GETQUICK(FN$ACCESS,FNAT$,FNAT$PTR) NQ SEQACCESS 
  THEN #RERUN AT END REEL REQUIRED BUT ACCESS NOT SEQUENTIAL# 
  BEGIN 
  ERROR$F(MSG68,D$ERROR); 
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
  #WHEN RERUN ON END OF REEL IS SPECIFIED FOR A FILE THE ACCESS MODE
  MUST BE SEQUENTIAL# 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ SEQUENTIAL
  AND 
  GETQUICK(FN$ACCESS,FNAT$,FNAT$PTR) NQ SEQACCESS 
  THEN #FOR ORG SEQ ACCESS MUST BE SEQ# 
  BEGIN 
  ERROR$F(MSG125,D$ERROR);
  SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
  END 
  #ACCESS MODE RANDOM OR DYNAMIC IS NOT ALLOWED WITH FILES
  THAT ARE ORGANIZATION SEQUENTIAL# 
SETFIELD(FN$SMSECNO,FNAT$,FNAT$PTR,MIN$MEM$SEC); #SET MINOR MSEC NO#
FIRST$R$PTR=DNAT$PTR+1; #FIRST RECD STARTS WITH NEXT ITM# 
                        VALUE$(19,"FIRSTRPTR=",FIRST$R$PTR);
##
FIXPARTSIZE=0;
TRAILSIZE=0;
DEPONDNAT=0;
DEPONCOUNT=0; 
NUMRECS=0;
EXIT$(19,"LEVEL$FDSD"); 
END #A# 
NEWPAGE;
PROC LEVEL$INDX;
BEGIN #A# 
# 
INDEX PROCESSOR.
THIS PROCESSOR IS CALLED WHEN THE CURRENT ITEM HAS ALEVEL 
OF "INDXLVL". 
* 
THE PROCESSOR SETS THE ITEM"S MAJOR MEMORY SECTION, THE BYTE OFFSET 
AND THE TYPE. 
* 
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * NAB$INDEX CONTAINS THE NEXT AVAILABLE BYTE FOR
    ALLOCATION TO THE CURRENT ITEM
# 
ENTRY$(20,"LEVEL$INDX");
SETFIELD(DN$MAJMSEC,DNAT$,DNAT$PTR,INDEXMSEC); #SET MAJ MSEC# 
SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,NAB$INDEX); #SET BYTE OFFSET#
NAB$INDEX=NAB$INDEX+BYTES$PER$WD; #UPDATE NAB BY 1 WD#
                        VALUE$(20,"NABINDX=",NAB$INDEX);
SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,INDXNAME); #SET TYPE# 
EXIT$(20,"LEVEL$INDX"); 
END #A# 
NEWPAGE;
PROC LVL$SELECT;
BEGIN #A# 
# 
LEVEL SELECT PROCESSOR. 
  
THIS PROCESSOR IS ENTERED IMMEDIATELY AFTER THE NEXT ITEM 
IN THE DNAT HAS COME UP FOR PROCESSING. 
* 
THE PROCESSOR EXAMINES THE LEVEL NUMBER OF THE CURRENT ITEM 
AND CALLS ONE OF SEVERAL PROCESSORS ACCORDING 
TO THE VALUE. 
* 
ON ENTRY IT IS ASSUMED THAT:  
  * CURR$ITM$LVL CONTAINS THE LEVEL NUMBER OF THE CURRENT ITEM
* 
NOTE: FOR EASE OF CODING A DEF MACRO IS USED TO REPLACE THE CODE
"IF CURR$ITM$LVL EQ (A) THEN (B)" 
WHERE A IS THE VALUE OF LEVLE$NO AND B IS A PROCEDURE.
# 
DEF L(VALUE,PROCN) #IF CURR$ITM$LVL EQ VALUE
                         THEN BEGIN 
                         PROCN; 
                         GOTO END$LEV$SEL; END#;
ENTRY$(21,"LEVELSELCT");
  L(1,LEVEL1) 
  IF CURR$ITM$LVL GR 1 AND CURR$ITM$LVL LS 50 THEN
                        BEGIN 
                        LEVEL2$49;
                        GOTO END$LEV$SEL; 
                        END 
  L(77,LEVEL77) 
  L(66,LEVEL66) 
  L(88,LEVEL88);
  L(FDDESCR,LEVEL$FDSD) 
  L(SDDESCR,LEVEL$FDSD) 
  L(INDXLEVL,LEVEL$INDX)
  L(CDDESCR,LVL$CD) 
  L(CDDATANAME,LVL$CDDN)
  L(FDSECTN,LVL$SECTN)
  L(WSSECTN,LVL$SECTN)
  L(LKSECTN,LVL$SECTN)
  L(CDSECTN,LVL$SECTN)
  L(CSSECTN,LVL$SECTN)
  L(SSSECTN,LVL$SECTN)
L(DBFSSECTN,LVL$SECTN)
  L(RDSECTN,CLOSEDOWN)
  # 
   ALL ENTRIES WITH LEVEL NUMBER = 0 (EXCEPT LINAGE-COUNTER ENTRIES)
   HAVE THEIR TYPE FIELDS SET TO ERRTYPE NOW TO PROTECT THE INNOCENT
   LATER. LINAGE-COUNTER ENTRIES ARE PROCESSED LATER BY CLOSEDOWN.
  # 
  IF CURR$ITM$LVL EQ 0
  AND GETQUICK(DN$LEVEL,DNAT$,DNAT$PTR-1) NQ FDDESCR
    THEN #STRANGE ENTRY IN DNAT#
  SETFIELD(DN$TYPE,DNAT$,DNAT$PTR,ERRTYPE); #SET TO ERROR#
END$LEV$SEL:  
EXIT$(21,"LEVELSELCT"); 
END #A# 
NEWPAGE;
PROC LVL$SECTN; 
BEGIN #A# 
# 
SECTION PROCESSOR.
THIS PROCESSOR IS CALLED WHEN THE CURENT ITEM"S LEVEL IS
  FDSECTN 
WSSECTN 
  LKSECTN 
  CSSECTN 
  SSSECTN 
  
THE PROCESSOR PERFORMS THE FOLLOWING FUNCTIONS: 
  A. SETS THE APPROPRIATE DNAT PTR IN THE CTT TO THE FIRST ELEMENT
    OF WHICHEVER SECTION HAS JUST BEEN FINISHED.
  B. SETS "SECTION" TO THE CURRENT SECTION CODE.
  C. FOR WS, CS, SS AND CD SECTIONS THE CCT ARRAY CCTMSECLEN
    IS SET USING THE APPROPRIATE MSEC AS SUBSCRIPT AND THE VALUE
    OF NAB AT THE END OF THE SECTION AS THE VALUE TO BE ENTERED 
    INTO THE ARRAY. 
  D. FOR ALL SECTIONS, SETS THE NAB AND MAJ$MEM$SEC FIELDS AS 
    APPROPRIATE.
  
ON ENTRY IT IS ASSUMED THAT:  
  * DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT 
  * NAB/NAB ARE SET TO THEIR FINAL VALUES AT THE END
    OF THE PREVIOUS SECTION"S PROCESSING. 
  * SECTION CONTAINS THE SECTION CODE OF THE PREVIOUS SECTION.
  * CURR$ITM$LVL CONTAINS THE LEVEL NUMBER OF THE CURRENT ITEM. 
# 
ENTRY$(33,"LVL$SECTN"); 
#SET APPROPRIATE CCT POINTER ACCORDING TO CURR$ITM$LVL# 
IF CURR$ITM$LVL EQ FDSECTN
  THEN CCTFDDNATPTR=DNAT$PTR; 
  ELSE IF CURR$ITM$LVL EQ CSSECTN 
    THEN CCTCSDNATPTR = DNAT$PTR;   #CS#
    ELSE IF CURR$ITM$LVL EQ WSSECTN 
      THEN CCTWSDNATPTR = DNAT$PTR;   #WS#
      ELSE IF CURR$ITM$LVL EQ SSSECTN 
        THEN CCTSSDNATPTR = DNAT$PTR;   #SS#
        ELSE IF CURR$ITM$LVL EQ LKSECTN 
          THEN CCTLKDNATPTR = DNAT$PTR;   #LK#
          ELSE CCTCDDNATPTR = DNAT$PTR;   #CD#
  
#SET ENTRY OF CCTMSECLEN ACCCORDING TO SECTION JUST PROCESSED#
IF SECTION EQ FDSECTN 
    THEN CCTMSECLEN[FDMSEC]=CCTMSECLEN[FDMSEC] + NAB; 
    #NOTE THE ABOVE CAUSES THE FD ENTRY IN THE CCTMSECLEN ARRAY 
    TO INCLUDE BOTH THE REAL FD SECTION AND THE DATABASE FILE SECTION#
   ELSE IF SECTION EQ CSSECTN 
    THEN
      BEGIN 
      CCTMSECLEN[COMSMSEC] = NAB;   #CS#
      IF NAB GR WORDLIMITX10 THEN ERROR(MSG144,D$ERROR);
      END 
    ELSE IF SECTION EQ WSSECTN
      THEN
        BEGIN 
        CCTMSECLEN[WSMSEC] = NAB;   #WS#
        IF NAB GR WORDLIMITX10  THEN ERROR(MSG145,D$ERROR); 
        END 
      ELSE IF SECTION EQ SSSECTN
          THEN
            BEGIN 
            CCTMSECLEN[SECSMSEC] = NAB;   #SS#
            IF NAB GR WORDLIMITX10 THEN ERROR(MSG146,D$ERROR);
            END 
        ELSE IF SECTION EQ LKSECTN
          THEN CCTMSECLEN[LINKMSEC] = NAB;   #LK# 
          ELSE CCTMSECLEN[CDMSEC] = NAB;   #CD# 
  
SECTION=CURR$ITM$LVL; #UPDATE SECTION CODE TO CURRENT SECTION#
                          VALUE$(33,"SECTION=",SECTION);
NAB=0; #RESET NAB#
                       VALUE$(33,"NAB=",NAB); 
IF SECTION EQ DBFSSECTN 
  THEN #ABOUT TO PROCESS DATABASE FILE SECTION# 
  SECTION=FDSECTN; #D-ANALYSER WILL PROCESS AS THO" FD SECTION# 
#SET MAJOR AND MINOR MSEC AS APPROPRIATE FOR NEXT SECTION#
IF SECTION EQ FDSECTN 
  THEN #FD# 
  BEGIN #C# 
#MIN$MEM$SEC AND SVD$MEM$SEC ARE NO LONGER SET TO ZERO HERE.
(THEY ARE DECLARED I=0). THIS CAUSES THE MINOR MEM SEC TO BE UNIQUE 
WITHIN BOTH THE FD SECTION AND THE DATABASE FILE SECTION.#
  MAJ$MEM$SEC = FDMSEC; 
  END #C# 
  ELSE
  IF SECTION EQ CSSECTN 
    THEN MAJ$MEM$SEC = COMSMSEC;   #CS# 
    ELSE IF SECTION EQ WSSECTN
      THEN MAJ$MEM$SEC = WSMSEC;
      ELSE IF SECTION EQ SSSECTN
        THEN MAJ$MEM$SEC = SECSMSEC;   #SS# 
        ELSE IF SECTION EQ LKSECTN
          THEN MAJ$MEM$SEC = LINKMSEC;   #LK# 
          ELSE MAJ$MEM$SEC = CDMSEC;
                       VALUE$(33,"MAJMSEC=",MAJ$MEM$SEC); 
          IF  SECTION EQ LKSECTN AND NOT CCTSUBPROGR
          THEN  ERROR(708,D$ERROR); 
EXIT$(33,"LVL$SECTN");
END #A# 
END #D-ANALYZER PART2#
TERM
