*DECK DL10
USETEXT TDLSCOM,TSCHTBL 
      PRGM DL30100;                # THIS IS 1,0 OVERLAY               # DL3A030
      BEGIN 
      DEF AREA$NAME #4#;
      DEF DATA$NAME #5#;
      DEF BITMASK  #30#;
      DEF DEFINED #1#;
      DEF EMPTY #0#;
      DEF ENTRYPTR   #2#; 
      DEF TEMPTR # 2 #; 
      DEF INITPTR # 4 #;
      DEF ITEM$NAME #1#;
      DEF LITERAL # 1 #;
      DEF LOCKNAME # 3#;
      DEF PROCNAME # 2 #; 
      DEF RECORD$NAME  #2#; 
      DEF REFERENCED #0#; 
      DEF SET$NAME #3#; 
      XDEF ITEM SAVARORD;    #USED FOR TEMP STORE OF AREA ORDINAL      #
      XDEF ITEM CONCATFLG B; # TRUE - CONCATENATED KEY NAME IS SUBJECT #
                             #        OF HASH ROUTINE.                 #
      XDEF ITEM MAXRECBUF;
      XDEF ITEM RELLDFLAG B;    # FOR RELATION PROCESSING.  # 
      XDEF ITEM CSDFLAG B;      # FLAG FOR CONSTRAINT PROCESSING       # D
      #  XDEF  BEGIN
          PROC CALCFL 
          PROC CONVERTCKLIT 
          PROC DBPBUILD 
          PROC DISPDECTOBIN 
          PROC HASHIT 
          PROC SYMBOLBUILD
        END     # 
      XREF
        BEGIN 
          ITEM CURLENG; 
          ITEM CURLENW; 
          ITEM DDLMEM;
          ITEM DDLSU; 
          ITEM MAXFL; 
          ITEM SYMBFWA; 
          ITEM OLD65; 
          ITEM LINENBR; 
          ITEM NBRITEM; 
          ITEM SCHBUFF; 
          PROC CLSEOUT; 
          PROC CLSESC;
          PROC DDLABT;
          PROC DDLRDSC; 
          PROC DDLRDSY; 
          PROC DDLRTSY; 
          PROC DDLRTSC; 
          PROC DD$CCON; 
          PROC DIAGDL;
      ARRAY CWORD [25] S(1);
        BEGIN 
          ITEM CURWORD C(0,0,10); 
        END 
  
          PROC DE$HSNM; 
        PROC LOADOVL; 
       END
  
      ITEM ENTRYLEN;
      ITEM EQUALNAME; 
      ITEM HRSLT; 
      ITEM I; 
      ITEM J; 
      ITEM LASTENTRY; 
      ITEM LENGTH;
      ITEM NEXTCELL;
      ITEM REFADDR; 
      ARRAY SVNAMES [2];
        ITEM SVNAME;
      ITEM SVNAMLENG; 
      ITEM SVNAMTYPE; 
      ITEM WORDADDR;
  
  
  
      XDEF PROC CONVERTCKLIT; 
# ******************************************************************** #
# NUMERIC LITERAL VALUE IS CONVERTED TO FORMAT OF THE DATA ITEM.       #
#                                                                      #
# THE LITERAL MUST CONFORM TO THE DESCRIPTION IN SECTION 3.0 OF        #
# DDLC SCHEMA REPORT OF 1/15/74.                                       #
#                                                                      #
#   ON ENTRY                                                           #
# NUMERIC LITERAL IN ARRAY CWORD, LEFT JUSTIFIED.                      #
# LENGTH OF LITERAL IN CURLENW (WORDS) AND CURLENG (CHAR).             #
# DATA ITEM INFO IN FIELDS SCITEMSIZE (SIZE IN CHAR), SCITEMCLASS      #
# AND (FOR CLASS = 3,4) THE SIGN AND DECIMAL INFO FIELDS               #
# SCITEMSLOC,SCITEMSIGN,SCITEMSIGNFG,SCITEMPTLOC,SCITEMACTLPT,         #
# SCITEMPTLEFT.                                                        #
#   ON EXIT                                                            #
# CONVERTED LITERAL IN ARRAY NAMES, LEFT JUSTIFIED ZERO-FILL.          #
#                                                                      #
# PRESENT IMPLEMENTATION DOES NOT SUPPORT FLOATING POINT LITERALS      #
# (WITH -E- IMBEDDED) AND  DATA ITEM MUST BE CLASS 3,4,12,13, OR 14.   #
# DATA ITEM IS FURTHER RESTRICTED TO HAVE NO EXPLICIT SIGN CHARACTER,  #
# AND SIGN OVERPUNCH CHARACTER IS RESTRICTED TO RIGHTMOST DIGIT.       #
#                                                                      #
# ******************************************************************** #
  
  PROC CONVERTCKLIT;
    BEGIN 
      ITEM SCLASS  U = 4;    #SOURCE ITEM CLASS-CODE.#
      ITEM SSIZE   U;        #SOURCE ITEM SIZE (BITS). #
      ITEM TSIZE   U;        #TARGET ITEM SIZE (BITS). #
      ITEM SRDECPT I;        #SOURCE DECIMAL POINT POSITION. #
      ITEM TGDECPT I;        #TARGET DECIMAL POINT POSITION. #
      ITEM SACTLPT B;        #TRUE IF SOURCE ITEM ACTUAL DECIMAL POINT.#
      ITEM SSIGNF  B;        #TRUE IF SOURCE ITEM SIGNED. # 
      ITEM TSIGNF  B;        #TRUE IF TARGET ITEM SIGNED. # 
      ITEM NEXTCHAR C(1);    #CHARACTER FROM LITERAL. # 
      ITEM FIRSTONE U;       #ORDINAL OF FIRST LITERAL CHAR TO CONVERT.#
      ITEM LASTONE U;        #ORDINAL OF LAST LITERAL CHAR TO CONVERT. #
      ITEM PREZERO B;        #TRUE UNTIL FIRST NON-ZERO DIGIT REACHED. #
      ARRAY INTERBUFF[3] S(1);
        BEGIN 
        ITEM BUFF C(0,0,40);
        ITEM BUFFWD C(0,0,10);
        ITEM BUFFINT U(0,0,60); 
        END 
  
      P<SCWORKBUF> = SCHBUFF;      # POINT TO SCHEMA DIRECTORY WORKBUF #
      ERRCODE = 0;           #INITIALIZE. # 
      SSIGNF = FALSE;        #DEFAULT, NO SIGN ON LITERAL. #
      SACTLPT = FALSE;       #DEFAULT, NO ACTUAL DECIMAL IN LITERAL. #
      FIRSTONE = 0; 
      LASTONE = 0;
      SRDECPT = CURLENG;      #DEFAULT, DECIMAL POSITION AT RIGHT END. #
      PREZERO = TRUE; 
# MOVE INCOMING ARRAY CWORD INTO ARRAY INTERBUFF. # 
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO 
        BUFFWD[I] = CURWORD[I]; 
# ZERO THE REST OF THE ARRAY. # 
      FOR I = CURLENW STEP 1 UNTIL 3 DO 
        BUFFINT[I] = 0; 
# SCAN LITERAL STRING, NOTEING SIGN OR DECIMAL PT, TRUNCATING LEADING 
    OR TRAILING ZEROES. # 
      FOR I = 0 STEP 1 UNTIL CURLENG - 1 DO 
        BEGIN 
        NEXTCHAR = C<I>BUFF[0];       #NEXT CHARACTER IN STRING. #
        IF NEXTCHAR EQ "-" THEN 
          BEGIN 
          SSIGNF = TRUE;      #REMEMBER NEGATIVE SIGN. #
          TEST;               #LOOP FOR NEXT CHARACTER. # 
          END 
        IF NEXTCHAR EQ "+" THEN 
          TEST;               #LOOP FOR NEXT CHARACTER. # 
        IF NEXTCHAR EQ "." THEN 
          BEGIN 
          SRDECPT = I;       #REMEMBER DECIMAL POSITION. #
          TEST;              #LOOP FOR NEXT CHARACTER. #
          END 
        IF NEXTCHAR NQ "0" THEN 
          BEGIN 
          LASTONE = I;       #KEEP TRACK OF LAST NON-ZERO DIGIT. #
          IF PREZERO THEN 
            BEGIN 
            FIRSTONE = I;    #POSITION OF FIRST NON-ZERO DIGIT. # 
            PREZERO = FALSE;
            END 
          END 
        END  #OF FOR LOOP. #
# SET SACTLPT TO INDICATE ACTUAL DECIMAL POINT. # 
      IF SRDECPT GQ FIRSTONE AND SRDECPT LS LASTONE THEN
        SACTLPT = TRUE; 
# ADJUST DECIMAL POINT TO REFLECT DISTANCE FROM LAST CHAR IN STRING.# 
      IF SRDECPT LQ LASTONE THEN
        SRDECPT = LASTONE - SRDECPT;
      ELSE
        SRDECPT = LASTONE - SRDECPT + 1;
      IF SSIGNF THEN        #MUST APPLY SIGN OVERPUNCH TO LAST DIGIT. # 
        BEGIN 
        I = C<LASTONE>BUFF[0];     #GET VALUE OF LAST CHAR IN STRING. # 
        IF I EQ O"33" THEN
          I = O"110";        #WANT DISPLAY 33 TO BECOME DISPLAY 66. # 
        C<LASTONE>BUFF[0] = I - O"22"; #DISPLAY CODE FOR SIGN OVERPUNCH#
        END 
# SET UP REMAINING PARAMETERS FOR CONVERSION ROUTINE. # 
      TSIZE = 6 * SCITEMSIZE[IPTR];    #TARGET ITEM SIZE IN BITS. # 
      SSIZE = 6 * (LASTONE + 1 - FIRSTONE); #SOURCE LITERAL SIZE, BITS.#
      FIRSTONE = 6 * FIRSTONE;         #BEGIN BIT POS, SOURCE LITERAL. #
      IF SCITEMPTLEFT[IPTR] THEN
        TGDECPT = SCITEMPTLOC[IPTR];   #PT TO LEFT . POSITION POSITIVE.#
      ELSE
        TGDECPT = - SCITEMPTLOC[IPTR]; #PT TO RIGHT, POSITION NEG.# 
      IF (SACTLPT AND SSIZE GR 114) OR (NOT SACTLPT AND SSIZE GR 108) 
        THEN BEGIN
        ERRCODE = O"660";    #LITERAL TOO LONG. # 
        RETURN; 
        END 
# ZERO OUT TARGET BUFFER #
      FOR I = 0 STEP 1 UNTIL 3  DO
        NAME[I] = 0;
# CALL FOR CONVERSION, STORING RESULT IN ARRAY CWORD. # 
      DD$CCON(ERRCODE,SCLASS,SCITEMCLASS[IPTR], 
        LOC(INTERBUFF),LOC(NAMES),FIRSTONE,0, 
        SSIZE,TSIZE,0,0,
        SRDECPT,TGDECPT,SACTLPT,SCITEMACTLPT[IPTR], 
       SSIGNF, SCITEMSIGNFG [IPTR] ); 
      RETURN;                   #EXIT PROC CONVERTCKLIT#
    END          #OF PROC CONVERTCKLIT# 
  
  
      XDEF PROC CALCFL; 
      PROC CALCFL;
#****************************************************************#
# CALCFL IS CALLED BY CLSESC TO COMPUTE THE FIELD LENGTH REQUIRED#
# BY THIS SCHEMA BUILD.  MAXRECBUF AND NEXTCELL (SYMBOL TABLE    #
# SIZE) ARE USED FOR THE CALCULATION.                            #
      BEGIN 
      I = MAXRECBUF + 63;                        #ROUND TO NEXT PRU    #
      J = NEXTCELL + 63;                         #ROUND TO NEXT PRU    #
      IF(I * 3) GR J THEN                        #RECSZ GR 1/4 CM USED #
        LENGTH = I / 64 * 4;                     #USE RECBUF AS BASE   #
      ELSE
        LENGTH = (J + J/3) / 64;                 #USE SYMTBL AS BASE   #
        IF(MAXRECBUF + 30) * 4 GR LENGTH * 64 THEN
          LENGTH = LENGTH + 2;                   #EXTRA FOR CKBUFOVF   #
                                                 #CALC FL REQUIRED     #
      DDLSU = (LENGTH + (SCHBUFF + 63)/64) * 64;
      RETURN; 
      END 
  
  
  
#******************************************************************#
      XDEF PROC SYMBOLBUILD;
  PROC SYMBOLBUILD; 
    BEGIN 
      DDLRTSY(SYMBUFDF,ENTRYLEN,SYMENTRY);
      RETURN; 
    END 
  
  
  
XDEF PROC DBPBUILD; 
  PROC DBPBUILD;
#**********************************************************************#
#  BUILDS A TABLE STORING UNIQUE DATA BASE PROCEDURE NAMES AS THEY     #
#   ARE FOUND IN SYNTAX CRACKING.  UNIQUENESS IS DETERMINED BY DOING   #
#   A SEQUENTIAL SEARCH OF STORED NAMES AND COMPARING EACH WITH THE    #
#   CONTENTS OF CURWORD, IF COMPARE IS SHOWN TO BE UNEQUAL TO ALL      #
#   NAMES IN THE LIST, CURWORD[0] IS ADDED AT FIRS EMPTY WORD.        # 
#   RETURNS TO CALLING ROUTINE.                                        #
#**********************************************************************#
      BEGIN 
        FOR I = 1 STEP 1 UNTIL UNIQPROCNMS DO 
          BEGIN 
            IF B<0,42>PROCTBLEPNME [I]  EQ  B<0,42>CURWORD [0]
              THEN RETURN;
          END 
         UNIQPROCNMS = UNIQPROCNMS + 1; 
      IF UNIQPROCNMS GQ PROCTBLENG
        THEN
        BEGIN 
        DIAGDL (107); 
        DDLSU = MAXFL;                      #SET FL FOR ABORT CONDITION#
        CLSEOUT;
        CLSESC; 
        DDLABT (0); 
        END 
      B<0,42>PROCTBLEPNME [UNIQPROCNMS] = B<0,42>CURWORD [0]; 
      END 
  
  
  
      XDEF PROC DISPDECTOBIN; 
      PROC DISPDECTOBIN;
# *******************************************************************#
# CONVERT A DISPLAY CODED NUMBER IN THE CELL DTEMP TO BINARY IN ITEMP#
      BEGIN 
        ITEMP = 0;
        FOR I = 0 STEP 1 UNTIL 19 DO
          BEGIN 
          J = C<I,1>DTEMP;
          IF J EQ O"55"  OR  J EQ 0 
            THEN RETURN;
          ITEMP = ITEMP * 10  + J - O"33";
        END 
      END 
  
  
  
  
  
      XDEF PROC HASHIT; 
          PROC HASHIT;
#***************************** H A S H I T **************************#
           BEGIN
  
              REFSTATUS = 0;
              DUPDEFINE = 0;
#     IN ADDITION IF NAMEQUAL IS SET TO 1 INDICATING THAT THE          #
#     NAME IS QUALIFIED     THE QUALIFYING NAME IS HASHED              #
#     AND ITS LOCATION IS HASHED AND SYMSEARCH IS THEN CALLED          #
#     TO FIND ITS LOCATION IN THE SYMBOL TABLE.  ITS LOCATION          #
#     IS STORED IN RECPTR AND WILL BE USED IN THE SEARCH FOR THE       #
#     NAME TO MATCH IT AGAINST THE DOMINAMT POINTER.                   #
          IF NAMEQUAL EQ 1 THEN 
        BEGIN 
          DE$HSNM(QUALNAMES, QUALNAMELENW, HRSLT);
          FOR I = 0  STEP 1  UNTIL NAMELENW - 1  DO 
            SVNAME [I] = NAME [I];
          FOR I = 0  STEP 1  UNTIL QUALNAMELENW - 1  DO 
            NAME [I] = QUALNAME [I];
          SVNAMLENG = NAMELENW; 
          NAMELENW = QUALNAMELENW;
          SVNAMTYPE = NAMETYPE; 
          NAMETYPE = RECORD$NAME;   # QUALIFIER MUST BE RECORD #
          NAMEQUAL = 0; 
          SYMSEARCH;                # GET SYMBOL TABLE FOR QUALIFIER #
          DOMPTR = SYMWRDADDRWK [1];  # GET RECORD ADDRESS #
          NAMEQUAL = 1; 
          NAMETYPE = SVNAMTYPE; 
          DUPDEFINE = 0;
          REFSTATUS = 0;
          NAMELENW = SVNAMLENG; 
          FOR I = 0  STEP 1  UNTIL NAMELENW - 1  DO 
            NAME [I] = SVNAME [I];
          END 
  
# NOW HASH THE NAME OF THE ITEM ITSELF AND CALL SYMSEARCH TO FIND # 
# THE SYMBOL TABLE ENTRY FOR THE ITEM                             # 
  
        DE$HSNM(NAMES, NAMELENW, HRSLT);
      XREF PROC SNATCHO;
  
      CTREFAR = 0;    # ZERO COUNT OF REFERENCES #
          SYMSEARCH;
      NAMEQUAL = 0; 
      RETURN; 
#*******************************************************************# 
  
#     PROC SYMSEARCH TAKES THE INPUT NAME AND HASH TABLE LOCATION AND  #
#     SEARCHES THE SYMBOL TABLE FOR EITHER AN EXISTING REFERENCE OR    #
#     DEFINITION AND IF SO UPDATES THE CORRESPONDING ENTRY.  IF        #
#     IT DOES NOT FIND THE NAME IT THEN MAKES AN ENTRY INTO THE        #
#     SYMBOL TABLE.                                                    #
  
  PROC SYMSEARCH; 
#**********************************************************************#
#     IF THE CORRESPONDING CELL IN THE HASH TABLE IS EMPTY THEN THIS   #
#     NAME CAN BE ENTERED INTO THE SYMBOL TABLE.  OTHERWISE THE        #
#     CORRESPONDING CELL CONTAINS THE 6RM WORD ADDRESS OF A            #
#     POSSIBLE LIST OF NAMES IN THE SYMBOL TABLE THAT COULD QUALIFY AS #
#     A MATCH WITH THE INCOMING NAME.                                  #
#**********************************************************************#
              BEGIN 
  
              IF  HASHOCCUP[HRSLT]   EQ EMPTY THEN GOTO ENTERHASHTBL; 
                 ELSE WORDADDR = HASHENTRY[HRSLT];
#*********************  G E T N E X T N A M E  ************************#
#**********************************************************************#
          GETNEXTNAME:  
              DDLRDSY(SYMBUFWK,7,WORDADDR); 
              EQUALNAME = 0;
              IF NAMELENW EQ  SYMNAMLENWK[1] THEN 
              BEGIN 
                FOR I=0 STEP 1 UNTIL NAMELENW - 1 DO
                  BEGIN 
                    IF NAME[I] NQ SYMNAMEWK[4 + I] THEN 
                       GOTO EQNAME;     #  NAMES ARE NOT DUPLICATES   # 
                  END 
                EQUALNAME = 1;
              END 
  
  EQNAME:                                   #   # 
  
#     IF THE NAMES ARE NOT EQUAL THEN THE SYNONYM CHAIN IS SEARCHED.   #
  
              IF EQUALNAME EQ 0 THEN GOTO SRCHSYNCHAIN; 
# IF NAME IS EQUAL BUT TYPES ARE NOT....                 #
# GOT TO SEARCH THE SAME NAME CHAIN                      #
      IF NAMETYPE NQ SYMNAMTYPEWK [0] 
        THEN BEGIN
          GOTO SRCHSAMCHAIN;
        END 
  
          IF SYMDEFWK[0] EQ DEFINED AND REFDEF EQ REFERENCED THEN 
                    BEGIN 
                      IF NAMETYPE EQ ITEM$NAME  AND  NAMEQUAL EQ 1
                        THEN BEGIN
#     IF THE NAME IS EQUAL AND IT IS QUALIFIED THEN COMPARE THE        #
#     LOCATION OF THE QUALIFYING NAME IN THE SYMBOL TABLE WITH THE     #
#     DOMINANT ITEM LOCATION.  IF THEY ARE EQUAL A HIT HAS BEEN        #
#     MADE.  IF NOT THEN SEARCH THE SAME CHAIN SOME MORE.              #
                          IF DOMPTR NQ SYMIRECPTRWK[2]
                            THEN GOTO SRCHSAMCHAIN; 
                        END 
# IF NAME IS AN ITEM NAME AND IT IS NOT QUALIFIED, RETURN WITH  # 
# REFSTATUS = 0 IF SAME NAME POINTER IS NOT ZERO.               # 
                      IF NAMETYPE EQ ITEM$NAME  AND  NAMEQUAL EQ 0
                        THEN
                        IF SYMNEXTSAMWK [0] NQ 0
                          THEN BEGIN DIAGDL (279); RETURN; END
                      REFSTATUS = 1;         # NAME FOUND # 
                      GOTO CONTREF; 
                    END 
               IF REFDEF EQ DEFINED AND 
                 SYMDEFWK[0] EQ REFDEF THEN 
                  BEGIN 
                    IF NAMETYPE EQ ITEM$NAME THEN 
                      IF NOT CONCATFLG THEN 
                        IF RECPTR NQ SYMIRECPTRWK[TEMPTR] THEN
                    GOTO SRCHSAMCHAIN;
                    DUPDEFINE = 1;
                    RETURN; 
                  END 
                IF SYMDEFWK[0] EQ REFERENCED AND REFDEF EQ DEFINED THEN 
                 BEGIN
                  #  WE HAVE ALREADY ENCOUNTERED 1 OR MORE REFS, NOW  # 
                  #  WE ARE CRACKING THE DEF AND SETTING THE ENTRY.   # 
                  SYMDEFWK[0] = REFDEF;  # WHICH IS DEFINED           # 
                  SYMSRCLINEWK[1] = LINENBR - 1;
                  SYMWRDADDRWK[1] = CURWORDADDR;
                  DDLRTSY ( SYMBUFWK, 2, WORDADDR );
                  FOR I=0 STEP 1 UNTIL 7 DO 
                    SYMBUFWORDDF[I] = SYMBUFWORDWK[I];
                  RETURN; 
                 END
  CONTREF:   #  # 
# SOME CODE MUST BE ADDED FOR DDL 3.0 WHEN NAME IS EQUAL,  #
# ENTRY IS FOR REFERENCE ONLY, AND REFDEF IS REFERENCED.   #
# THIS CASE WONT WORK NOW.                                 #
                  IF SYMBUFWORDWK[3] NQ 0 THEN
                    GOTO ADDTOREFLIST;
                  SYMRFBBPWK[3] = BBPLOC; 
                 SYMRFSRCLWK[3] = LINENBR - 1;
                  SYMRFWAWK[3] = CURWORDADDR; 
                  SYMPTR = WORDADDR + 3;
                  DDLRTSY(SYMBUFWORDWK[3],1,SYMPTR);
                  RETURN; 
  
#**********************************************************************#
#*********************** S R C H S A M C H A I N **********************#
#     SRCHSAMCHAIN.  SEARCHES THE SAME NAME CHAIN AND IF THE END OF THE#
#     SAME NAME CHAIN IS REACHED UPDATES THE NEXT SAME NAME POINTER    #
#     TO POINT TO THE NEXT POSITION AT WHICH THE INCOMING NAME WILL BE #
#     STORED IN THE SYMBOL TABLE.  OTHERWISE IT TAKES THE CONTENTS OF  #
#     THE NEXT SAME NAME POINTER AND STORES IT IN THE 6RM WORD         #
#     ADDRESS FOR THE NEXT NAME ACCESS.                                #
#**********************************************************************#
  
          SRCHSAMCHAIN: 
              IF SYMNEXTSAMWK[0] EQ EMPTY THEN
                BEGIN 
                 SYMNEXTSAMWK[0] = NEXTCELL;
                 GOTO REWRITELAST ; 
                END 
              WORDADDR = SYMNEXTSAMWK[0]; 
              GOTO GETNEXTNAME; 
  
#*************************  S R C H S Y N C H A I N  ******************#
#**********************************************************************#
#     SRCHSYNCHAIN.  THIS IS SIMILAR TO SRCHSAMCHAIN EXCEPT THE        #
#     SYNONYN CHAIN IS BEING SEARCHED.                                 #
  
          SRCHSYNCHAIN: 
              IF SYMNEXTSYNWK[0] EQ EMPTY THEN
                BEGIN 
                 SYMNEXTSYNWK[0] = NEXTCELL;
                 GOTO REWRITELAST;
                END 
              WORDADDR = SYMNEXTSYNWK[0]; 
              GOTO GETNEXTNAME; 
  
#     CHECKREFDEF.  THIS CHECKS AND CAUSES THE FOLLOWING TO BE DONE    #
#        IF THE INCOMING ITEM IS A REFERENCE IT IS ADDED TO THE        #
#        REFERENCE LIST FOR THE NAMED ITEM.                            #
#        IF THE INCOMING ITEM IS A DEFINITION AND THE CORRESPONDING    #
#        ITEM IN THE SYMBOL TABLE    WAS A REFERENCE THEN THE SYMBOL   #
#        TABLE ENTRY IS UPDATED TO THE INCOMING ITEM                   #
#        IF THE INCOMING ITEM IS A DEFINITION AND THE CORRESPONDING    #
#        ITEM IN THE SYMBOL TABLE IS ALSO A DEFINITION THEN A DOUBLY   #
#        DEFINED SYMBOL HAS OCCURRED, AND A DIAGNOSTIC IS ISSUED.      #
  
          CHECKREFDEF:  
              IF REFDEF EQ REFERENCED THEN
               GOTO ADDTOREFLIST; 
              IF SYMDEFWK[0] EQ REFERENCED THEN 
               GOTO UPDTSYMBUFWK; 
              DIAGDL(321);
              RETURN; 
  
#        THE UPDATED NEXT POINTER FOR EITHER THE SYNONYM OR SAME       #
#        NAME CHAIN IS WRITTEN BEFORE THE INCOMING ITEM IS TO BE ADDED #
#        BY STORESYM TO THE SYMBOL TABLE.                              #
  
          REWRITELAST:  
              DDLRTSY(SYMBUFWK,1,WORDADDR); 
  
#        STORSYM.  DOES THE FOLLOWING.                                 #
#                                                                      #
#           1  CLEARS THE SYMBOL TABLE WORK BUFFER.                    #
#           2  BECAUSE THERE ARE FOUR LISTS 1 FOR EACH CLASS OF        #
#              NAMES, I.E. ITEM, RECORD, SET AND AREA, INTERLEAVED     #
#              IN THE SYMBOL TABLE THE LAST ENTRY FOR THE INCOMING     #
#              NAME TYPE MUST BE LOCATED AND ITS NEXT POINTER          #
#              UPDATED TO THE NEXT AVAILABLE LOCATION AT WHICH THE NEW #
#              ENTRY WILL BE BUILT.  THE TWO OPERATIONS -              #
#              UPDATE OF THE LAST ENTRY LOCATION AND, THE NEW ENTRY    #
#              LOCATION, ARE ACCOMPLISHED WITH AN EXCHANGE OPERATION   #
#              IF AFTER THE OPERATION LASTENTRY IS EMPTY THEN THE      #
#              CORRESPONDING NAME TYPE WAS THE FIRST OF THAT TYPE      #
#              TO ENTER THE SYMBOL TABLE.                              #
#           3  THE SYMBOL TABLE ENTRY IS BUILT IN SYMBUFWK             #
#              AND IF THE NAME IS A DEFINITION IT IS FLAGGED AS        #
#              SUCH AND ITS RECORD POINTER IS STORED.  IF IT IS        #
#              A REFERENCE IT IS ALSO ADDED TO ITS ASSOCIATED          #
#              REFERENCE LIST AT STOREFRSTREF.                         #
#           4   IF IT IS A DEFINITION THEN THERE WILL BE FURTHER       #
#              ADDITIONS TO THIS ENTRY FROM THE SEMANTIC ROUTINES      #
#              SO SUMBUFWK IS TRANSFERRED TO SYMBUFDF (DEFINED).       #
#           5  THE CONTENTS OF SYMBUFWK ARE THEN WRITTEN OUT,          #
#              BECAUSE DURING THE SYNTAX ANALYSIS OTHER NAMES          #
#              IN CLAUSES ASSOCIATED WITH THE DEFINED NAME             #
#              MUST     BE ENTERED IN THE SYMBOL TABLE.                #
  
          STORESYM: 
              FOR I=0 STEP 1 UNTIL 7 DO 
                SYMBUFWORDWK[I] = 0;
              SYMDEFWK[0] = REFDEF; 
              SYMNAMLENWK[1] = NAMELENW;
              SYMNAMTYPEWK[0] = NAMETYPE; 
              SYMNEXTWK[0] = NEXTCELL + NAMELENW + 4; 
      IF CONCATFLG THEN      # SET FLAG TO INDICATE THAT SUBJECT ENTRY #
        SYMKCONFLGWK[2] = TRUE;  # REPRESENTS A CONCATENTED KEY.       #
          IF NAMETYPE EQ AREA$NAME THEN 
            SYMARORDWK[2] = TOTALAREAS+1; #SET AREA ORDNL IN SYMBOL TBL#
              FOR I = 0 STEP 1 UNTIL NAMELENW - 1 DO
                 SYMNAMEWK[I+4] = NAME[I];
              IF REFDEF EQ REFERENCED THEN GOTO STORFRSTREF;
              NUMNAMES = NUMNAMES + 1;
              SYMSRCLINEWK[1] = LINENBR - 1;
              SYMRECPTRWK[1] = CURWORDADDR; 
              FOR I=0 STEP 1 UNTIL 7 DO 
                SYMBUFWORDDF[I] = SYMBUFWORDWK[I];
              SYMENTRY = NEXTCELL;
              GOTO  WRITSYMENTRY; 
  
#        THE FIRST REFERENCE TO THIS NAME IS STORED INTO  THE          #
#        SYMBOL TABLE.  THE BEGINNING BIT LOCATION AND WORD LOCATION   #
#        IN THE DIRECTORY TABLE ARE RECORDED SO THAT EVENTUALLY        #
#        WHEN THE NAME IS DEFINED ITS LOCATION IN THE DIRECTORY        #
#        CAN BE UPDATED.  THE SOURCE LINE NUMBER IS RECORDED           #
#        FOR USE IN DIAGNOSTICS.                                       #
#                                                                      #
  
          STORFRSTREF:  
              SYMNEXTREFWK[3] = 0;
              SYMRFBBPWK[3] = BBPLOC; 
              SYMRFSRCLWK[3] = LINENBR - 1; 
              SYMRFWAWK[3] = CURWORDADDR; 
              SYMPTR = NEXTCELL;
  
           WRITSYMENTRY:  
              LENGTH = SYMNAMLENWK[1] + 4;
              ENTRYLEN = LENGTH;
              DDLRTSY(SYMBUFWK,LENGTH,NEXTCELL);
              LASTENTRY = NEXTCELL; 
              NEXTCELL = NEXTCELL + LENGTH; 
              RETURN; 
  
#        THE ADDITIONAL DEFINITION INFO IS ADDED AND TRANSFERRED       #
#        TO SYMBUFDF                                                   #
  
          UPDTSYMBUFWK: 
              SYMRECPTRWK[2] = RECPTR;
              SYMDEFWK[0] = DEFINED;
              FOR I=0 STEP 1 UNTIL 2 DO 
              SYMBUFWORDDF[I] = SYMBUFWORDWK[I];
              SYMENTRY = WORDADDR;
              DDLRTSY(SYMBUFWK,3,WORDADDR); 
              RETURN; 
  
#        PICK UP THE HEAD OF THE REFERENCE LIST FOR THIS NAME          #
  
          ADDTOREFLIST: 
              SYMPTR = WORDADDR;
      IF NAMETYPE EQ ITEM$NAME THEN 
        RETURN; 
              REFADDR = WORDADDR + 3; 
      CTREFAR = 1;
               SYMBUFWORDWK[0] = SYMBUFWORDWK[3]; 
  
#        SEARCH FOR THE END OF THE LIST AND WHEN LOCATED UPDATE        #
#        THE NEXT REF POINTER TO POINT TO THE NEW REFERENCE            #
  
          CHECKREFNEXT: 
              IF SYMNEXTREFWK[0] EQ 0 THEN
                BEGIN 
              SYMNEXTREFWK[0] = NEXTCELL; 
              DDLRTSY(SYMBUFWK,1,REFADDR);
                 GOTO UPDATEREF;
                END 
              REFADDR = SYMNEXTREFWK[0];
              DDLRDSY(SYMBUFWK,1,REFADDR);
      CTREFAR = CTREFAR + 1;
              GOTO CHECKREFNEXT;
  
#     BUILD THE NEW REFERENCE AND WRITE IT OUT                         #
  
          UPDATEREF:  
              SYMREFWK [0] = 1; 
              SYMBUFWORDWK[0] = 0;
              SYMRFBBPWK[0] = BBPLOC; 
             SYMRFSRCLWK[0] = LINENBR - 1;
              SYMRFWAWK[0] = CURWORDADDR; 
              DDLRTSY(SYMBUFWK,1,NEXTCELL); 
                #  HAVE TO ADD 1 TO SYMNEXT IN ORDER TO CHAIN THRU  # 
                #  WITHOUT ENDING UP WITH A 1 LINE REF ENTRY.....   # 
              DDLRDSY ( SYMBUFWK, 1, LASTENTRY);
              SYMNEXTWK[0] = SYMNEXTWK[0] + 1;
              NEXTCELL = NEXTCELL + 1;
              DDLRTSY ( SYMBUFWK, 1, LASTENTRY);
              RETURN; 
  
#        STORE THE WORD ADDRESS OF THE SYMBOL TABLE ENTRY FOR THE      #
#         INCOMING NAME AND GO TO STORE SYM.                           #
  
          ENTERHASHTBL: 
              HASHENTRY[HRSLT] = NEXTCELL;
              HASHOCCUP[HRSLT] = 1; 
              GOTO STORESYM;
           END
        END 
  
  
  
  XDEF PROC SUBENTLG; 
  PROC SUBENTLG(PARAM); 
#**********************************************************************#
#   COMPUTES THE SUB-ENTRY LENGTH OF SCHEMA SUB-ENTRIES.               #
#**********************************************************************#
    BEGIN 
      ITEM I;                # SCRATCH VARIABLE # 
      ITEM PARAM;            # START OF A PARTICULAR SUB-ENTRY #
  
      I = DPTR - PARAM;            # SUB-ENTRY LENGTH # 
      IF I GR MAXSUBENTLG THEN
        MAXSUBENTLG = I;           # CURRENT SUB-ENTRY LENGTH EXCEEDES #
                                   # THE PREVIOUS MAXIMUM.             #
      RETURN; 
    END 
  
  
# *********************************************************************#
# BEGIN EXECUTION OF DL10 OVERLAY                        #
      NBRITEM = NBRITEM * 10; 
      BASE1X = OLD65; 
      LOADOVL ( BASE1X, 1, 1 ); 
      END 
  TERM; 
