*DECK CBINDEX 
USETEXT TSBTBL
      PRGM DL30404;                # THIS IS 4,4 OVERLAY               # DL3A030
    BEGIN 
#**********************************************************************#
#                                                                      #
#                  C B I N D E X                                       #
#                                                                      #
#   BUILDS THE INDEX THAT IS REFERENCED BY THE DIRECTORY ACCESS ROUT-  #
#   INES.                                                              #
#   1. THE REALM LIST CREATED WHEN THE REALM ENTRIES WHERE BEING BUILT #
#      IS MOVED BEHINED THE DATA CONTROL ENTRIES.                      #
#   2. THEN A SCAN OF EACH RECORD ENTRY IS MADE CHECKING THE ORDINAL   #
#      NUMBER OF THE OWNER RECORD. THE FIRST SCAN CHECK FOR ORDINAL 1, #
#      THE SECOND SCAN CHECKS FOR ORDINAL 2 AND SO ON.                 #
#   3. WHEN A MATCH IS FOUND THE ADDRESS OF THE RECORD AND THE LENGTH  #
#      OF THE RECORD IS STORED IN THE RECORD LIST.                     #
#   4. WHEN ALL THE REALM ORDINAL NUMBERS HAVE BEEN EXAUSTED , CONTROL #
#      IS THEN RETURNED.                                               #
#                                                                      #
#   ENTRY CONDITIONS:                                                  #
#      NONE. THE BASED ARRAY CBWORDBUF POINTS TO THE SUB-SCHEMA IN CORE#
#      FIRSTWORD CONTAINS THE WORD ADDRESS OF THE FIRST WORD OF THE SUB#
#      SCHEMA. FIRSTWORD IS XDEF IN CNTRL. THE NUMBER OF PASSES        #
#      SCANNING THE RECORD ENTRIES IS DETERMINED BY HOW MANY REALMS    #
#      WHERE DEFINED IN THE SUB-SCHEMA. THE NUMBER OF REALMS ARE STORED#
#      IN THE CONTROL WORD ENTRY.                                      #
#                                                                      #
#**********************************************************************#
      DEF  CWPTR        #   0#;    # USED FOR REFERENCING SUBSCHEMA    #
                                   # CONTROL WORDS                     #
      DEF  QC           #   4#;    # COMPILATION MODE IS QU/CDCS       #
      DEF  DFHSHINDXLEN #  10#;    # LENGTH OF AREA HASH INDEX TABLE   #
      DEF  DFRECORD     #   2#;    # ENTRY TYPE IS RECORD              #
  
*CALL COMHDRLEN 
      XREF ITEM DDLCOMP;               # DDL COMPILATION MODE          #
      XREF ITEM FIRSTWORD;             # CONTAINS THE FIRST WORD ADDRES#
      XREF ITEM HRSLT1;                # FIRST 10 BITS OF HASH RESULT  #
      XREF ITEM HRSLT2;                # SECOND 10 BITS OF HASH RESULT #
      XREF ITEM OLD65;                 # LWA + 1 OF CURRENT OVERLAY    #
  
      XREF ITEM SBSCHMA;               # CONTAINS THE FIRST WORD ADDR  #
                                       # OF THE WORKING STORAGE AREA.  #
                                       # THE FIRST 150 WORDS IS ALLOCAT#
                                       # ED TO THE REALM LIST. THE REST#
                                       # OF CORE IS ALLOCATED TO THE SB#
                                       #SCHEMA.                        #
      XREF ITEM SBSCHML;               # LENGTH OF CM RESIDENT SUBSCH  #
      XREF ITEM ABORTFLAG;             # FLAG THAT INDICATES FATAL DIAG#
                                       # NOSTIC HAS BEEN ISSUED.       #
      XREF ITEM DDLMEM;                # CONTAINS THE LAST WORD ADDRESS#
                                       # OF THE USERS FIELD LENGTH.    #
      XREF ITEM DDLSU ;                # CONTAINS MAX STORAGE USED     #
      XREF ITEM ERRCNTR;               # TALLIES THE NUMBER OF DIAGS  # 
                                       # ISSUED.                      # 
      XREF ITEM MAXFL ;            # CONTAINS MAX FIELD LENGTH ALLOWED #
      XREF ITEM MAXSELENG;             # CONTAINS THE MAXIMUM SUB-ENTRY#
                                       # LENGTH.                       #
      XREF ITEM RELFLAG B;             # TRUE - RELATION CLAUSE WAS    #
                                       #        SPECIFIED.             #
      XREF PROC DDLPRNT;               # PRINTS INFO TO OUTPUT.       # 
      XREF PROC ABRT1;                 # ISSUES DAY MESSAGE - INNSUF   #
                                       # FIELD LENGTH- AND ABORTS RUN. #
      XREF PROC HASHDL;                #HASH NAME INTO 2-10 BIT HASH ID#
  
      XREF PROC MEMORY ;               # ISSUES FIELD LENGTH REQUEST   #
      XREF PROC SSCGLD;                # LOADS THE CODE GENERATION     #
                                       # OVERLAY.                      #
      XREF PROC RELSTAT;     # OUTPUTS RELATION STATISTICS.            #
  
      ARRAY HASH1024 [0:1023];         # HASH TABLE FOR QU/CDCS        #
        BEGIN 
        ITEM HASHR2      U(00,02,10);  # SECOND TEN BITS OF HASH RESULT#
        ITEM HASHENTRYWA U(00,12,18);  # WORD ADDRESS OF ENTRY         #
                                       # WHOSE NAME HASHED TO THIS ID  #
        ITEM HASHOCCUPF  B(00,30,01);  # TRUE - ENTRY IS IN USE        #
        ITEM HASHOVRFLW  B(00,40,01);  # TRUE - THERE IS A N OVERFLOW  #
                                       #        ENTRY FOR THIS ID      #
        ITEM HASHOVFLADR I(00,42,18);  # ADDRESS OF OVERFLOW ENTRY     #
        ITEM HASHWORD    U(00,00,60);  # WHOLE WORD                    #
        END 
  
      BASED ARRAY HASHOVFL [0:0];      #OVERFLOW HASH TABLE FOR QU/CDCS#
        BEGIN 
        ITEM OVFLHR2     U(00,02,10);  # SECOND 10 BITS OF HASH RESULT #
        ITEM OVFLENTRYWA U(00,12,18);  # WORD ADDRESS OF ENTRY WHICH   #
                                       # HASHES TO THIS ID             #
        ITEM OVFLNEXTADR I(00,42,18);  # ADDRESS OF NEXT OVERFLOW ENTRY#
        ITEM OVFLWORD    U(00,00,60);  # WHOLE WORD                    #
        END 
  
      BASED ARRAY HASHINDEX[0:0];      # HASH INDEX TABLE FOR QU/CDCS  #
        BEGIN 
        ITEM HIRORL      B(00,00,01);  # LEFT/RIGHT PART FLAG          #
        ITEM HICOUNT     U(00,30,12);  # NUMBER OF ENTRIES PER PART    #
        ITEM HIPARTLOC   U(00,42,18);  # OFFSET FROM BEGINNING OF      #
                                       # HASH RESULT TABLE TO THIS     #
                                       # PART                          #
        ITEM HIRSLTLEN   U(00,42,18);  # LENGTH OF HASH RESULT TABLE   #
        ITEM HIWORD      U(00,00,60);  # WHOLE WORD                    #
        END 
  
      BASED ARRAY HASHRESULT [0:0];    # HASH RESULT TABLE             #
        BEGIN 
        ITEM HRLVLL      U(00,00,02);  # HASH LEVEL - LEFT SIDE        #
                                       # 00 - FIRST 10 BITS            #
                                       # 01 - SECOND 10 BITS           #
        ITEM HRRSLTL     U(00,02,10);  # HASH RESULT - LEFT SIDE       #
        ITEM HRWAL       U(00,12,18);  # WORD ADDRESS OF ENTRY WHOSE   #
                                       # NAME HASHED TO THIS ENTRY     #
        ITEM HRLVLR      U(00,30,02);  # HASH LEVEL - RIGHT SIDE       #
                                       # 00 - FIRST 10 BITS            #
                                       # 01 - SECOND 10 BITS           #
        ITEM HRRSLTR     U(00,32,10);  # HASH RESULT - RIGHT SIDE      #
        ITEM HRWAR       U(00,42,18);  # WORD ADDRESS OF ENTRY WHOSE   #
                                       # NAME HASHED TO THIS ENTRY     #
        ITEM HRWORD      U(00,00,60);  # WHOLE WORD                    #
        END 
  
      BASED ARRAY HNAME [0:0];     # TEMPORARY FOR NAME TO BE HASHED   #
        BEGIN 
        ITEM HNAMEI  U(00,00,60); 
        END 
  
      BASED ARRAY KEYINFOTABLE [0:0];   # KEY INFORMATION              #
        BEGIN 
        ITEM KEYRCP       U(00,00,21);  # RELATIVE CHARACTER POSITION  #
        ITEM KEYSIZE      U(00,21,12);  # SIZE OF KEY IN CHARACTERS    #
        ITEM KEYCLASS     U(00,33,06);  # KEY ITEM DB CLASS            #
        ITEM KEYINFO      U(00,57,03);  # KEY INFORMATION BITS         #
        ITEM KEYWORD      U(00,00,60);  # WHOLE WORD                   #
        END 
  
      ARRAY DIAG300 [7];
        ITEM D300 C(0,0,10) = ["  ***313**",
                              "          ", 
                              "       NO ", 
                              "RECORD ENT", 
                              "RIES WHERE", 
                              " SPECIFIED", 
                              " FOR REALM", 
                              " -       -"];
  
      ARRAY DIAG316 [0:9];
        ITEM D316         C(00,00,10) = ["  ***316**",
                                         "          ",
                                         "    KEY CH",
                                         "ARACTERIST",
                                         "ICS NOT TH",
                                         "E SAME IN ",
                                         "ALL RECORD",
                                         " TYPES FOR",
                                         " AREA     ",
                                         "          "]; 
  
      ITEM I;                          # SCRATCH ITEM.                 #
      ITEM J;                          # SCRATCH ITEM.                 #
      ITEM K;                          # SCRATCH ITEM.                 #
      ITEM CURRKEY        U;           # INDEX INTO KEY INFO TABLE     #
      ITEM DAPTR          U;           # CURRENT WA INTO SS            #
      ITEM NUMAREAS       U;           # NUMBER OF AREAS IN SUBSCHEMA  #
      ITEM NUMITEMS       U;           # NUMBER OF ITEMS IN RECOR      #
      ITEM NUMKEYS        U;           # NUMBER OF KEY IN REALM        #
      ITEM NUMRECS        U;           # NUMBER OF RECORDS IN AREA     #
      ITEM NXTOVRADR      U;           # ADDRESS OF NEXT OVERFLOW SLOT #
      ITEM ORDNUM;                     # CONTAINS THE ORDINAL NUMBER   #
                                       # OF THE CURRENT SCAN.          #
                                       # CONTROL WORD ENTRY.           #
      ITEM OVFLTOP        B;           # TRUE - OVERFLOW TABLE IS AT FL#
      ITEM OVRADR         U;           # TEMPORARY ADDRESS OF OVERFLOW #
                                       # ENTRY                         #
      ITEM PUSEDFL        U;           # FL USED BY PREVIOUS HASHOVFL  #
      ITEM USEDFL         U;           # FL USED BY CURRENT HASHOVFL   #
      ITEM RCP            U;           # RELATIVE CHARACTER POSITION   #
      ITEM REALMLISTADR;               # CONTAINS THE WORD ADDRESS OF  #
                                       # REALM LIST ENTRY.             #
      ITEM REALMLISTPTR;               # POINTER USED WHEN REFERENCEING#
                                       # OR STORING VALUES IN THE      #
                                       # REALM LIST.                   #
      ITEM REALMLISTWA    U;           # WORD ADDRESS OF REALM LIST    #
      ITEM RECLSTADR;                  # CONTAINS THE WORD ADDRESS OF  #
                                       # FIRST RECORD LIST ENTRY.      #
      ITEM RECLSTPTR;                  # POINTER USED WHEN REFERENCEING#
                                       # OR STORING VALUES IN THE      #
                                       # RECORD LIST.                  #
      ITEM RECNBR;                     # CONTAINS THE NUMBER OF WORDS  #
                                       # OF A RECORD LIST FOR A        #
                                       # SPECIFIC REALM.               #
      ITEM RECPTR;                     # POINTER USED WHEN REFERENCEING#
                                       # THE RECORD ENTRIES.           #
      ITEM SIZE           U;           # TEMPORARY FOR COMPUTING RCP   #
      CONTROL EJECT;
      PROC BLDAREAHASH; 
  
      BEGIN 
 #
* *   CBINDEX                                    PAGE  1
* *   BLDAREAHASH - BUILD AREA HASH TABLES
* *   J G SERPA                                  DATE  04/12/79 
* 
* DC  PURPOSE 
* 
*     TO BUILD ONE HASH TABLE PER AREA TO BE USED BY QU/CDCS
* 
* DC  ENTRY CONDITIONS
* 
*     TABLES HASH1024 AND HASHOVFL HAVE BEEN BUILT
* 
* DC  EXIT CONDITIONS 
* 
*     TABLES HASHINDEX AND HASHRESULT ARE BUILT 
* 
* DC  CALLING ROUTINES
* 
*     BLDHASH                BUILD HASH 
* 
* DC  CALLED ROUTINES 
* 
*     ABRT1                  ABORT DDL WITH FL EXCEEDED MESSAGE 
* 
* DC  DESCRIPTION 
* 
*     THE FIRST STEP IS TO CHECK FOR ENOUGH AVAILBLE FIELD LENGTH.
*     THERE MUST BE ENOUGH CM TO ACCOMODATE THE LARGEST POSSIBLE HASH 
*     TABLE (10 WORDS FOR THE HASH INDEX TABLE PLUS UP TO ONE WORD
*     PER ITEM AND RECORD NAMES IN THE AREA FOR THE HASH RESULT TABLE). 
*     IF THERE IS NOT ENOUGH AVAILABLE FIELD LENGTH, PROC ABRT1 IS
*     CALLED TO ABORT THE COMPILATION.
* 
*     THE HASH RESULT TABLE MAY HAVE TO IDENTICAL ENTRIES PER WORD
*     THESE ENTRIES HAVE THE SAME NAME EXCEPT FOR THE LAST CHARACTER
*     WHICH IS *L* FOR THE LEFT SIDE, AND *R* FOR THE RIGHT SIDE. 
*     THE LEFT SIDE IS FILLED UP IF LEFTPART IS TRUE, AND THE RIGHT 
*     SIDE IF LEFTPART IS FALSE.
* 
*     A PASS IS MADE THROUGH THE HASH1024 TABLE. FOR EACH ENTRY THAT
*     IS IN USE (HASHOCCUP IS SET) AN ENTRY IS MADE IN THE HASH RESULT
*     TABLE. THE INDEX INTO HASH1024 (WHICH IS THE FIRST 10 BITS OF THE 
*     HASH ID) IS MOVED TO HRRSLT, THE FIRST 10 BIT FLAG (HRLVL) IS 
*     SET TO ZERO, AND THE ENTRY WORD ADDRESS (HASHENTRYWA) IS MOVED TO 
*     HRWA. 
* 
*     THE POINTER INTO THE HASH RESULT TABLE (HRPTR) IS INCREMENTED,
*     THE NUMBER OF ENTRIES IN THE PART (NUMENTRIES) IS INCREMENTED, AND
*     THE OVERFLOW FLAG (HASHOCCUPOV) IS CHECKED. IF SET, THEN THE
*     OVERFLOW POINTER IS FOLLOWED UNTIL A ZERO POINTER IS ENCOUNTERED
*     (INDICATING END OF CHAIN). FOR EACH ENTRY IN THE OVERFLOW CHAIN 
*     OVFLHR2 (2ND 10 BITS OF HASH ID) IS MOVED TO HRRSLT, HRLVL IS 
*     SET TO INDICATE THAT THIS ENTRY IS THE 2ND 10 BITS OF THE HASH
*     RESULT, OVFLENTRYWA IS MOVED TO HRWA. NUMENTRIES AND HRPTR ARE
*     INCREMENTED.
* 
*     EACH ENTRY IN THE BODY OF THE HASH INDEX TABLE POINTS TO A
*     LOCATION IN THE HASH RESULT TABLE OF A CONTIGUOUS LIST OF DATA- 
*     BASE ELEMENT HASH IDS WITH THE SAME HIGH ORDER 3 BITS. THIS 
*     CONTIGUOUS LIST MAY CONTAIN UP TO 128 ENTRIES. ALL THE ENTRIES
*     WHICH HAVE THE SAME HIGH ORDER 3 BITS ARE CALLED A PART.
*     AT EVERY 128 ENTRIES IN THE HASH1024 TABLE ANOTHER PART IS STARTED
*     AT WHICH POINT THE HASH RESULT ENTRY IS GENERATED.
*     HIPARTLOC IS SET TO THE APPROPRIATE ENTRY IN THE HASH RESULT TABLE
*     HICOUNT IS SET TO THE NUMBER OF ENTRIES IN THAT PART (NUMENTRIES) 
*     HIRORL IS SET TO LEFTPART, HIPTR (POINTER INTO HASH INDEX TABLE)
*     IS INCREMENTED, THE POINTER INTO THE HASH RESULT TABLE (HRPTR)
*     IS SAVED IN PHRPTR AND LEFTPART IS COMPLEMENTED.
* 
*     WHEN ALL ENTRIES IN THE HASH1024 TABLE HAVE BEEN PROCESSED, THEN
*     HIRSLTLEN IS SET TO THE LENGTH OF THE HASH RESULT TABLE, DAPTR
*     IS THEN UPDATED TO REFLECT THE NEW LENGTH OF THE SUBSCHEMA
*     DIRECTORY, AND CONTROL IS RETURNED TO THE CALLING ROUTINE.
* 
 #
      ITEM BEGINHRPTR     I;       # INDEX INTO HASHRESULT TABLE OF    #
                                   # FIRST ENTRY OF CURRENT PART       #
  
      ITEM HIPTR          I;       # INDEX INTO HASHINDEX TABLE        #
      ITEM HRPTR          I;       # INDEX INTO HASHRESULT TABLE       #
      ITEM J;                      # SCRATCH LOOP VARIABLE             #
      ITEM PHRPTR         I;       # PREVIOUS INDEX INTO HASHRESULT    #
      ITEM LEFTPART       B;       # TRUE - FILLING UP LEFT SIDE OF    #
                                   # HASHRESULT TABLE                  #
                                   # FALSE IF FILLING UP RIGHT SIDE    #
      ITEM NUMENTRIES     I;       # NUMBER OF ENTRIES PER PART        #
  
  
#     CHECK FOR SUFFICIENT FIELD LENGTH                                #
  
      J = SBSCHMA + DAPTR + NUMITEMS + NUMRECS + DFHSHINDXLEN;
      IF (OVFLTOP 
          AND J GQ NXTOVRADR) 
      THEN
        ABRT1;                     # FL OVERFLOW - ABORT DDL           #
  
      IF J GQ B<0,30>DDLMEM 
      THEN
        BEGIN                          # IF MORE STORAGE NEEDED        #
        IF  J GQ MAXFL
        THEN
          BEGIN 
          ABRT1;                       # ABORT IF TOO MUCH, ELSE       #
          END 
        MEMORY (J);                    # REQUEST WHAT IS NEEDED        #
        END 
  
      P<CBWORKBUF> = SBSCHMA + REALMADR[0];  # GET REALM ENTRY         #
      SBARHASHWA[0] = DAPTR;       # AREA HASH TABLE WORD ADDRESS      #
      P<HASHINDEX> = SBSCHMA + DAPTR;  # SET HASH INDEX TABLE LOCATION #
      P<HASHRESULT> = LOC(HASHINDEX) + DFHSHINDXLEN;  # HASH RESULT LOC#
      PHRPTR = 0;                  # INITIALIZE VARIABLES              #
      BEGINHRPTR = 0; 
      HIPTR = 2;
      LEFTPART = TRUE;
      OVRADR = 0; 
      HRPTR = 0;
      NUMENTRIES = 0; 
      FOR J = 0 STEP 1
        UNTIL 9 
      DO
        HIWORD[J] = 0;                 # ZERO OUT HASH INDEX TABLE     #
      FOR J = 0 STEP 1
        UNTIL (NUMITEMS + NUMRECS - 1)
      DO
        HRWORD[J] = 0;             # ZERO OUT HASH RESULT TABLE        #
      FOR J = 0 STEP 1
        UNTIL 1023
      DO
        BEGIN                      # GENERATE AREA HASH TABLES         #
        IF HASHOCCUPF[J]           # IF ENTRY IN USE                   #
        THEN
          BEGIN 
          IF LEFTPART              # IF FILLING UP LEFT SIDE           #
          THEN
            BEGIN 
            HRRSLTL[HRPTR] = J;    # FIRST 10 BITS OF HASH ID          #
            HRLVLL[HRPTR] = 0;     # FLAG FIRST 10 BITS                #
            HRWAL[HRPTR] = HASHENTRYWA[J];  # ENTRY WORD ADDRESS       #
            HRPTR = HRPTR + 1;
            NUMENTRIES = NUMENTRIES + 1;
            IF HASHOVRFLW[J]       # IF OVERFLOW ENTRIES EXIST         #
            THEN
              BEGIN 
              OVRADR = HASHOVFLADR[J];    # OVERFLOW ADDRESS           #
              FOR OVRADR = OVRADR 
                WHILE OVRADR NQ 0 
              DO                   # PROCESS OVERFLOW ENTRIES          #
                BEGIN 
                HRRSLTL[HRPTR] = OVFLHR2[OVRADR];  # 2ND 10 BITS       #
                HRLVLL[HRPTR]  = 1;  # FLAG 2ND 10 BITS OF HASH ID     #
                HRWAL[HRPTR] = OVFLENTRYWA[OVRADR];  # ENTRY WA        #
                NUMENTRIES = NUMENTRIES + 1;
                HRPTR = HRPTR + 1;
                OVRADR = OVFLNEXTADR[OVRADR];  # NEXT OVERFLOW ENTRY   #
                END 
              END 
            END 
          ELSE                     # FILLING UP RIGHT SIDE             #
            BEGIN 
            HRRSLTR[HRPTR] = J;    # 1ST 10 BITS OF HASH RESULT        #
            HRLVLR[HRPTR] = 0;     # FLAG FIRST 10 BITS                #
            HRWAR[HRPTR] = HASHENTRYWA[J];  # ENTRY WORD ADDRESS       #
            HRPTR = HRPTR + 1;
            NUMENTRIES = NUMENTRIES + 1;
            IF HASHOVRFLW[J]       # IF OVERFLOW ENTRIES EXIST         #
            THEN
              BEGIN 
              OVRADR = HASHOVFLADR[J];  # OVERFLOW ADDRESS             #
              FOR OVRADR = OVRADR 
                WHILE OVRADR NQ 0 
              DO
                BEGIN 
                HRRSLTR[HRPTR] = OVFLHR2[OVRADR];  # 2ND 10 BITS OF ID #
                HRLVLR[HRPTR] = 1;  # FLAG 2ND 10 BITS                 #
                HRWAR[HRPTR] = OVFLENTRYWA[OVRADR];  # ENTRY WA        #
                NUMENTRIES = NUMENTRIES + 1;
                HRPTR = HRPTR + 1;
                OVRADR = OVFLNEXTADR[OVRADR];  # NEXT OVERFLOW ENTRY   #
                END 
              END 
            END 
          END 
        IF (J+1) / 128 * 128 EQ (J+1)   # IF 128 ENTRIES FOR THIS PART #
        THEN
          BEGIN 
          IF NUMENTRIES NQ 0              # IF ANY ENTRIES IN THIS PART#
          THEN
            BEGIN 
            HIWORD[HIPTR] = 0;           # CLEAR ENTRY BEFORE USING    #
            HIPARTLOC[HIPTR] = BEGINHRPTR;   # SET PART LOCATION       #
            HICOUNT[HIPTR] = NUMENTRIES;  # NUM OF ENTRIES IN THIS PART#
            HIRORL[HIPTR] = NOT LEFTPART;   # SET LEFT/RIGHT SIDE FLAG #
            BEGINHRPTR = PHRPTR;         # SAVE FIRST INDEX            #
            NUMENTRIES = 0;              # CLEAR NUMBER OF ENTRIES     #
            PHRPTR == HRPTR;
            LEFTPART = NOT LEFTPART;     # FLAG FILLING OTHER SIDE     #
            END 
          HIPTR = HIPTR + 1;
          END 
        END 
      IF PHRPTR GR HRPTR           # IF PREVIOUS PART GR CURRENT PART  #
      THEN
        HRPTR = PHRPTR;            # USE LENGTH OF GREATER PART        #
      HIRSLTLEN[0] = HRPTR;        # LENGTH OF HASH RESULT TABLE       #
      DAPTR = DAPTR + HRPTR + DFHSHINDXLEN;  # NEXT WORD ADDRESS       #
      RETURN; 
  
      END  # BLDAREAHASH #
      CONTROL EJECT;
      PROC BLDHASH; 
      BEGIN 
 #
* *   CBINDEX                                    PAGE  1
* *   BLDHASH - BUILD HASH TABLE
* *   J G SERPA                                  DATE  04/12/79 
* 
* DC  PURPOSE 
* 
*     TO HASH ALL RECORD AND ITEM NAMES WITHIN AN AREA
* 
* DC  ENTRY CONDITIONS
* 
*     REALMLIST AND RECORDLIST HAVE BEEN BUILT AND SUBSCHEMA
*     DIRECTORY IS IN CORE
* 
* DC  EXIT CONDITIONS 
* 
*     NAME HAS BEEN HASHED BY DHASH 
* 
* DC  CALLING ROUTINES
* 
*     CBINDEX 
* 
* DC  CALLED ROUTINES 
* 
*     DHASH                  HASH NAME AND UPDATE HASH1024 AND HASHOVFL 
*     BLDAREAHASH            BUILD AREA HASH TABLE
* 
* DC  DESCRIPTION 
* 
*     THREE NESTED LOOPS ARE USED.
*     OUTER LOOP IS FOR NUMBER OF AREAS IN THE SUBSCHEMA. 
*     MIDDLE LOOP IS FOR NUMBER OF RECORDS IN EACH AREA.
*     INNER LOOP IS FOR NUMBER OF ITEMS IN EACH RECORD. 
* 
*     FOR EACH REALM ENTRY IN THE REALM LIST THE FOLLOWING IS DONE: 
* 
*     FOR EACH RECORD AND ITEM NAMES WITHIN THE AREA, PROC DHASH IS 
*     CALLED TO HASH THE NAME AND GENERATE THE APPROPRIATE HASH TABLE 
*     ENTRIES.
*     WHEN ALL NAES HAVE BEEN PROCESSED, PROC BLDAREAHASH IS CALLED TO
*     GENERATE THE AREA HASH TABLE WHICH IS CARRIED IN THE DIRECTORY. 
* 
 #
  
  
  
      ITEM I;                      # SCRATCH LOOP VARIABLE             #
      ITEM J;                      # SCRATCH LOOP VARIABLE             #
      ITEM K;                      # SCRATCH LOOP VARIABLE             #
  
      PUSEDFL = 0;                 # INITIALIZE VARIABLES              #
      USEDFL = 0; 
      P<HASHOVFL> = 0;
      NXTOVRADR = OLD65;           # HASHOVFL STARTS AT OLD65          #
      OVFLWORD[NXTOVRADR] = 0;         # ZERO OUT BEFORE USING         #
      REALMLISTWA = SBSCHMA + SBCWRLMLSTAD[CWPTR];  # REALM LIST FWA   #
      NUMAREAS = SBCWNUMAREAS[CWPTR];  # NUMBER OF AREAS IN SUBSCHEMA  #
      FOR I = 0 STEP 1
        UNTIL NUMAREAS - 1
      DO
        BEGIN 
        P<REALMLIST> = REALMLISTWA + I * DFSBRLMLST;  #PTR TO REALMLIST#
        OVFLTOP = FALSE;             # OVERFLOW TABLE IS NOT FROM TOP  #
        P<RECORDLIST> = REALMLISTWA + REALMRECLIST[0];  # RECORD LIST  #
        FOR J = 0 STEP 1
          UNTIL 1023
        DO
          HASHWORD[J] = 0;         # ZERO OUT ENTIRE HASH TABLE        #
        NUMRECS = REALMRECLEN[0] / DFSBRECLST;   # NUMBER OF RECORDS   #
        FOR J = 1 STEP 1
          UNTIL NUMRECS 
        DO
          BEGIN 
          P<CBWORKBUF> = SBSCHMA + RECLISTLADR[0];  # POSITION TO REC  #
          NUMITEMS = SBRECNBRITMS[0];     # NUMBER OF ITEMS IN RECORD  #
          P<HNAME> = LOC(SBRECNAME[SBRECNAMEPTR[0]]); 
          SBRECSYNADR[0] = 0;              # ZERO OUT SYNONYM ADDRESS  #
          DHASH (HNAME, SBRECNMELENW[0]);  # HASH RECORD NAME          #
  
          P<CBWORKBUF> = LOC(CBWORKBUF) + SBRECNXITEMP[0];  #FIRST ITEM#
          FOR K = 1 STEP 1
            UNTIL NUMITEMS         # STEP THRU ALL ITEMS               #
          DO
            BEGIN 
            P<HNAME> = LOC(SBITMNAME[SBITMNAMEPTR[0]]); 
            SBITMSYNADDR[0] = 0;            # ZERO OUT SYNONYM ADDRESS #
            DHASH (HNAME, SBITMNELENW[0]);  # HASH ITEM NAME           #
  
            P<CBWORKBUF> = LOC(CBWORKBUF) + SBITMNEXTP[0];  # NEXT ITEM#
            END 
          P<RECORDLIST> = LOC(RECORDLIST) + DFSBRECLST;  # NEXT RECORD #
          END 
        BLDAREAHASH;               # BUILD AREA HASH TABLE             #
        IF USEDFL GR PUSEDFL          # IF CURRENT HSHOVFL GR PREVIOUS #
        THEN
          BEGIN 
          PUSEDFL = USEDFL;        # SAVE FL USED                      #
          USEDFL = 0;              # ZERO OUT CURRENT LENGTH OF HSHOVLF#
          END 
  
        END 
      END  # BLDHASH #
      CONTROL EJECT;
      PROC DHASH (NAME, LENGTH);
  
      BEGIN 
 #
* *   CBINDEX                                    PAGE  1
* *   DHASH - HASH NAME AND UPDATE HASH1024 AND HASHOVFL TABLES 
* *   J G SERPA                                  DATE  04/24/79 
* 
* DC  PURPOSE 
* 
*     TO HASH A NAME END ENTER ITS HASH ID INTO HASH1024 OR HASHOVFL
*     TABLES
* 
* DC  ENTRY CONDITIONS
* 
*     NAME              CONTAINS NAME TO BE HASHED
*     LENGTH            CONTAINS LENGTH IN WORD OF NAME 
* 
* DC  EXIT CONDITIONS 
* 
*     HASH ID OF NAME HAS BEEN ENTERED INTO HASH1024 OR HASHOVFL TABLES 
* 
* DC  CALLING ROUTINES
* 
*     BLDHASH 
* 
* DC  CALLED ROUTINES 
* 
*     ABRT1             ABORT DDL WITH *FL EXCEEDED* MESSAGE
*     HASHDL            HASH NAME INTO 2-10 BIT HASH ID 
*     SAMESYNCHAIN      SET SAMENAME/SYNONYM POINTER
* 
* DC  DESCRIPTION 
* 
*     HASHDL IS CALLED TO HASH THE NAME INTO 2-10 BIT HASH ID WHICH 
*     ARE RETURNED IN HRSLT1 AND HRSLT2.
*     HRSLT1 IS USED AS AN INDEX INTO TABLE HASH1024. IF THAT ENTRY 
*     IS NOT IN USE (HASHOCCUPF = FALSE) THEN IT IS SET TO TRUE, THE
*     ENTRY WORD ADDRESS IS STORED INTO HASHENTRYWA, HRSLT2 IS SAVED
*     IN HASHR2 AND CONTROL IS RETURNED TO THE CALLING  ROUTINE.
* 
*     IF THE OVERFLOW (HASHOCCUPOV) FLAG IS NOT SET (MEANING THAT THIS
*     IS THE FIRST OVERFLOW FOR THIS ENTRY) THEN HASHOCCUPOV IS SET, THE
*     OVERFLOW ADDRESS (HASHOVFLADR) IS SET TO THE NEXT OVERFLOW ADDRESS
*     (NXTOVRADR), HASHR2  TO OVFLHR2 AND HASHENTRYWA IS MOVED TO 
*     OVFLENTRYWA.
* 
*     IF THE OVERFLOW FLAG IS SET, THEN THE OVERFLOW TABLE IS SEARCHED
*     FOR AN ENTRY WITH A MATCHING ID (HRSLT2). IF ONE IS FOUND, THEN 
*     SAMESYNCHAIN IS CALLED TO SET SAMENAME/SYNONYM POINTER, AND 
*     RETURN IS MADE TO THE CALLING ROUTINE.
*     IF THE END OF THE OVERFLOW TABLE IS REACHED (OVFLNXTADR = 0)
*     THEN THE ENTRY MUST BE ADDED TO THE OVERFLOW TABLE. 
* 
*     IF THE OVERFLOW FLAG WAS NOT SET, THE ENTRY MUST ALSO BE ADDED
*     TO THE OVERFLOW TABLE.
* 
*     THE FOLLOWING PROCESSING IS COMMON TO BOTH CASES. 
* 
*     A NEW ENTRY IS CREATED IN THE OVERFLOW TABLE. BEFORE UPDATING 
*     NXTOVRADR, A CHECK IS MADE FOR FL OVERFLOW. AN OVERFLOW CONDITION 
*     OCCURS IF AT ANY TIME NXTOVRADR OVERLAPS THE SUBSCHEMA DIRECTORY. 
*     IN WHICH CASE *ABRT1* IS CALLED TO ABORT THE RUN. 
* 
*     * THE OVERFLOW TABLE INITIALLY OCCUPIES THE CM AREA BETWEEN 
*     OLD65 AND HHA (SUBSCHEMA DIRECTORY STARTS AT HHA). IF AT ANY TIME 
*     THIS AREA IS EXHAUSTED, THEN CM AREA BETWEEN LWA+1 OF SUBSCHEMA 
*     AND FL-5 IS USED, STARTING FROM FL-5 AND GROWING TOWARDS LWA+1. * 
* 
*     IF OVFLTOP IS SET (INDICATING THAT THE OVERFLOW IS BETWEEN LWA+1
*     AND FL-5) THEN NXTOVRADR IS DECREMENTED BY 1, OTHERWISE (IT IS
*     BETWEEN OLD65+1 AND HHA) IT IS INCREMENTED BY 1. IF THIS CAUSED 
*     THE LOW CM SPACE TO BE EXHAUSTED, NXTOVRADR IS SET TO FL-5 AND
*     AND OVFLTOP IS SET TO TRUE. 
* 
 #
  
  
      ARRAY NAME [0:2];;           # NAME TO BE HASHED                 #
  
      ITEM LENGTH         I;       # LENGTH IN WORDS OF NAME TO BE     #
                                   # HASHED                            #
  
      ITEM J;                      # SCRATCH LOOP VARIABLE             #
# 
# 
      HASHDL (LOC(NAME), LENGTH);  # HASH NAME                         #
  
      IF NOT HASHOCCUPF[HRSLT1]    # IF SLOT NOT YET OCCUPIED          #
      THEN
        BEGIN 
        HASHOCCUPF[HRSLT1] = TRUE;  # SET OCCUPIED FLAG                #
        HASHENTRYWA[HRSLT1] = LOC(CBWORKBUF) - SBSCHMA;  # ENTRY WA    #
        HASHR2[HRSLT1] = HRSLT2;   # SAVE SECOND 10 BITS OF HASH ID    #
        RETURN; 
  
        END 
  
#     SLOT ALREADY OCCUPIED                                            #
  
      IF NOT HASHOVRFLW[HRSLT1]    # IF NOT OVERFLOWED YET             #
      THEN
        BEGIN 
        HASHOVRFLW[HRSLT1] = TRUE;  # SET OVERFLOW FLAG                #
        HASHOVFLADR[HRSLT1] = NXTOVRADR;  # SET ADDRESS OF OVERFLOW    #
        OVFLHR2[NXTOVRADR] = HASHR2[HRSLT1];  # 2ND 10 BITS OF HASH ID #
        OVFLENTRYWA[NXTOVRADR] = HASHENTRYWA[HRSLT1];  # ENTRY WA      #
        OVRADR = NXTOVRADR;        # SAVE OVERFLOW ADDRESS             #
        GETNXTOVRADR;              # GET ADDRESS OF NEXT OVERFLOW ENTRY#
        IF HRSLT2 EQ HASHR2[HRSLT1]  # IF SAME NAME OR SYNONYM         #
        THEN
          BEGIN 
          SAMESYNCHAIN;            # SET SAME NAME SYNONYM POINTERS    #
  
          RETURN; 
  
          END 
        ELSE
          BEGIN 
          OVFLNEXTADR[OVRADR] = NXTOVRADR;  # SET OVERFLOW ADDRESS     #
          OVFLHR2[NXTOVRADR] = HRSLT2;  # 2ND 10 BITS OF HASH ID       #
          OVFLENTRYWA[NXTOVRADR] = LOC(CBWORKBUF) - SBSCHMA;  #ENTRY WA#
          END 
        GETNXTOVRADR;              # GET NEXT OVERFLOW ADDRESS         #
  
        RETURN; 
  
        END 
      ELSE
        BEGIN                      # ALREADY OVERFLOWED ONCE           #
        OVRADR = HASHOVFLADR[HRSLT1];  # ADDRESS OF OVERFLOW ENTRY     #
        J =1;                      # FORCE ONCE THRU LOOP              #
        FOR J = J 
          WHILE J NQ 0
        DO
          BEGIN 
          IF OVFLHR2[OVRADR] EQ HRSLT2  # IF SAME 2ND 10 BITS          #
          THEN
            BEGIN 
            SAMESYNCHAIN;          # SET SAME NAME SYNONYM POINTERS    #
  
            RETURN; 
  
            END 
          J = OVFLNEXTADR[OVRADR];  # ADDRESS OF NEXT OVERFLOW ENTRY   #
          IF J NQ 0                # IF AN OVERFLOW ENTRY EXISTS       #
          THEN
            OVRADR = J;            # SAVE ADDRESS OF OVERFLOW ENTRY    #
          END 
        OVFLNEXTADR[OVRADR] = NXTOVRADR;  # ADDRESS OF OVERFLOW ENTRY  #
        OVFLHR2[NXTOVRADR] = HRSLT2;  # SAVE 2ND 10 BITS OF HASH ID    #
        OVFLENTRYWA[NXTOVRADR] = LOC(CBWORKBUF) - SBSCHMA;  # ENTRY WA #
        GETNXTOVRADR; 
  
        RETURN; 
  
        END 
      END # DHASH # 
  
  
  
      PROC GETNXTOVRADR;
      BEGIN 
      IF NXTOVRADR GQ SBSCHMA      # IF OVERFLOW OVERLAPS SUBSCHEMA    #
        AND NXTOVRADR LQ (DAPTR + SBSCHMA)
      THEN
        ABRT1;                      # FL EXCEEDED - ABORT DDL          #
  
      IF OVFLTOP                    # IF OVERFLOW IS FROM THE TOP      #
      THEN
        BEGIN 
        NXTOVRADR = NXTOVRADR - 1;  # MUST DECREMENT ADDRESS           #
        USEDFL = USEDFL + 1;       # ACCUMULATE FL                     #
        END 
      ELSE                          # OVERFLOW IS BELOW HHA            #
        BEGIN 
        NXTOVRADR = NXTOVRADR + 1;  # MUST INCREMENT ADDRESS           #
        IF NXTOVRADR GQ SBSCHMA     # IF LOW SPACE EXCEEDED            #
        THEN
          BEGIN 
          NXTOVRADR = B<0,30>DDLMEM - 5;  # MUST START FROM FL         #
                                          # 5 WORDS USED FOR PADDING   #
          OVFLTOP = TRUE;           # OVERFLOW IS FROM TOP             #
          END 
        END 
      OVFLWORD[NXTOVRADR] = 0;
      RETURN; 
      END  # GETNXTOVRADR # 
      CONTROL EJECT;
      PROC FLAGKEYS;
  
      BEGIN 
 #
* *   CBINDEX                                    PAGE  1
* *   FLAGKEYS - SET KEY FLAG IN AL KEY ITEMS IN ALL RECORD TYPES 
* *   J G SERPA                                  DATE  07/04/79 
* 
* DC  PURPOSE 
* 
*     TO SET PRIMARY, ALTERNATE AND MAJOR KEY FLAGS IN ALL RECORD TYPES 
* 
* DC  ENTRY CONDITIONS
* 
*     REALMLIST AND RECORD LIST HAVE BEEN BUILT, AND SUBSHEMA 
*     DIRECTORY IS IN CORE. 
* 
* DC  EXIT CONDITIONS 
* 
*     ALL KEY FLAGS ARE SET IN ALL RECORD TYPES 
* 
* DC  CALLING ROUTINES
* 
*     CBINDEX 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     ALL KEYS (PRIMARY, ALTERNATE AND MAJOR) MUST HAVE THE SAME BWP, 
*     BCP, SIZE AND CLASS.
* 
*     PROCESSING IS IDENTICAL FOR ALL THE REALMS. 
* 
*     IF THE REALM HAS ONLY ONE RECORD TYPE, THE REALM IS SKIPPED, AND
*     PROCESSING CONTINUES WITH THE NEXT REALM. 
* 
*     A PASS IS MADE THROUGH THE FIRST RECORD, AND FOR EACH ITEM WHICH
*     IS A KEY, AN ENTRY IS MADE IN THE KEYINFOTABLE, WHICH CONTAINS
*     KEY RCP (RELATIVE CHARACTER POSITION), SIZE OF KEY ITEM, CLASS
*     AND KEY INFORMATION BITS (PRIMARY, ALTERNATE, MAJOR). WHEN ALL
*     ITEMS HAVE BEEN CHECKED, VARIABLE NUMKEYS CONTAINS THE NUMBER OF
*     KEYS PRESENT IN THE RECORD. ALL SUBSEQUENT RECORDS MUST HAVE THE
*     SAME NUMBER OF KEYS.
* 
*     FOR EACH SUBSEQUENT RECORD, THE RCP OF EACH ITEM IS COMPUTED. 
*     IF IT MATCHES ANY OF THE KEY RCPS AND IT HAS THE SAME CLASS 
*     AND SAME USE SIZE, IT IS A KEY, THEREFORE THE KEY INFORMATION 
*     BITS ARE SET FROM THE KEYINFOTABLE. 
* 
*     IF THE NUMBER OF KEYS IN ANY RECORD TYPE DOES NOT MATCH THE FIRST 
*     RECORD TYPE, DIAGNOSTIC 314 IS ISSUED.
* 
 #
  
  
#     B E G I N  E X E C U T A B L E  C O D E  F O R  F L A G K E Y S  #
  
      P<KEYINFOTABLE> = LOC(HASH1024);  # KEY INFO OVERLAYS HASH TABLE #
      REALMLISTWA = SBSCHMA + SBCWRLMLSTAD[CWPTR];  # REALM LIST WA    #
      NUMAREAS = SBCWNUMAREAS[CWPTR];  # NUMBER OF AREAS IN SUBSCHEMA  #
      FOR I = 0 STEP 1                 # PROCESS ALL AREAS             #
        UNTIL NUMAREAS - 1
      DO
        BEGIN 
        P<REALMLIST> = REALMLISTWA + I * DFSBRLMLST;  #PTR TO REALMLIST#
        P<RECORDLIST> = REALMLISTWA + REALMRECLIST[0];  # RECORD LIST  #
        NUMRECS = REALMRECLEN[0] / DFSBRECLST;  # NUMBER OF RECORDS    #
        IF NUMRECS EQ 1                # IF ONLY ONE RECORD IN AREA    #
        THEN
          TEST I;                      # THERE IS NOTHING TO PROCESS   #
  
        RCP = 0;                       # RESET RELATIVE CHAR POSITION  #
        SIZE = 0;                      # RESET SIZE                    #
        P<CBWORKBUF> = SBSCHMA + RECLISTLADR[0];  # POSITION TO RECORD #
        NUMITEMS = SBRECNBRITMS[0];    # NUMBER OF ITEMS               #
        NUMKEYS = 0;                   # NUMBER OF KEYS PROCESSED      #
        P<CBWORKBUF> = LOC(CBWORKBUF) + SBRECNXITEMP[0];  # 1ST ITEM   #
        FOR J = 1 STEP 1
          UNTIL NUMITEMS               # PROCESS ALL ITEMS             #
        DO
          BEGIN 
          RCP = RCP + SIZE;            # RELATIVE CHARACTER POSITION   #
          IF SBITMDBCLASS[0] GQ 10     # IF ITEM IS WORD ADJUSTED      #
            OR SBITMSYNJINF[0] NQ 0 
          THEN
            RCP = (RCP + 9) / 10 * 10;  # ADJUST TO WORD BOUNDARY      #
          IF SBITMKEYINFO[0] NQ 0      # IF ITEM IS KEY                #
          THEN
            BEGIN 
            KEYWORD[NUMKEYS] = 0;      # ZERO OUT BEFORE USING         #
            KEYRCP[NUMKEYS] = RCP;     # RELATIVE CHARACTER POSITION   #
            KEYSIZE[NUMKEYS] = SBITMUSESIZE[0];  # SIZE OF KEY         #
            KEYCLASS[NUMKEYS] = SBITMDBCLASS[0];  # CLASS OF KEY ITEM  #
            KEYINFO[NUMKEYS] = SBITMKEYINFO[0];  # KEY INFO            #
            NUMKEYS = NUMKEYS + 1;
            END 
          SIZE = SBITMUSESIZE[0];      # SAVE SIZE                     #
          P<CBWORKBUF> = LOC(CBWORKBUF) + SBITMNEXTP[0];  # NEXT ITEM  #
          END 
        P<RECORDLIST> = LOC(RECORDLIST) + DFSBRECLST;  # NEXT RECORD   #
  
#     PROCESS SUBSEQUENT RECORD TYPES                                  #
  
        FOR J = 1 STEP 1
          UNTIL NUMRECS - 1            # 1ST RECORD ALREADY PROCESSED  #
        DO
          BEGIN 
          P<CBWORKBUF> = SBSCHMA + RECLISTLADR[0];  # POSITION TO REC  #
          SIZE = 0; 
          RCP = 0;
          CURRKEY = 0;
          NUMITEMS = SBRECNBRITMS[0];  # NUMBER OF ITEMS IN RECORD     #
          P<CBWORKBUF> = LOC(CBWORKBUF) + SBRECNXITEMP[0];  # 1ST ITEM #
          FOR K = 1 STEP 1
            UNTIL NUMITEMS
          DO
            BEGIN 
            RCP = RCP + SIZE;          # ACCUMULATE REL CHAR POSITION  #
            IF SBITMDBCLASS[0] GQ 10  # IF ITEM IS WORD ADJUSTED       #
              OR SBITMSYNJINF[0] NQ 0 
            THEN
              RCP = (RCP + 9) / 10 * 10;  # ADJUST TO WORD BOUNDARY    #
            IF RCP EQ KEYRCP[CURRKEY]  # IF ITEM HAS SAME RCP AS KEY   #
              AND SBITMDBCLASS[0] EQ KEYCLASS[CURRKEY]  #AND SAME CLASS#
              AND SBITMUSESIZE[0] EQ KEYSIZE[CURRKEY]   #AND SAME SIZE #
            THEN
              BEGIN 
              SBITMKEYINFO[0] = KEYINFO[CURRKEY];  # KEY INFORMTION    #
              CURRKEY = CURRKEY + 1;     # INCREMENT KEY TABLE INDEX   #
              END 
            SIZE = SBITMUSESIZE[0];    # SAVE SIZE                     #
            P<CBWORKBUF> = LOC(CBWORKBUF) + SBITMNEXTP[0];  # NEXT ITEM#
            END 
          IF CURRKEY NQ NUMKEYS          # IF NUMBER OF KEYS DONT MATCH#
          THEN
            BEGIN 
            FOR K = 0 STEP 6         # MOVE REALM NAME TO DIAGNOSTIC   #
              UNTIL 36
            DO
              IF B<K,6>REALMLISTNME[0] NQ 0 
              THEN
                B<K,6>D316[9] = B<K,6>REALMLISTNME[0];
            DDLPRNT (DIAG316, 100);    # ISSUE DIAGNOSTIC              #
  
            D316[9] = "          ";    # BLANK OUT NAME                #
            ERRCNTR = ERRCNTR + 1;     # INCREMENT ERROR COUNTER       #
            ABORTFLAG = 1;             # SET ABORT FLAG                #
            END 
          P<RECORDLIST> = LOC(RECORDLIST) + DFSBRECLST;  # NEXT RECORD #
          END 
        END 
      RETURN; 
      END  # FLAGKEYS # 
      CONTROL EJECT;
      PROC SAMESYNCHAIN;
  
      BEGIN 
 #
* *   CBINDEX                                    PAGE  1
* *   SAMESYNCHAIN - GENERATE SAME NAME AND SYNONYM POINTERS
* *   J G SERPA                                  DATE  04/30/79 
* 
* DC  PURPOSE 
* 
*     TO GENERATE SAMENAME/SYNONYM POINTERS 
* 
* DC  ENTRY CONDITIONS
* 
*     HNAME          CONTAINS NAME TO BE MATCHED
* 
* DC  EXIT CONDITIONS 
* 
*     SAMENAME OR SYNONYM POINTER HAS BEEN SET
* 
* DC  CALLING ROUTINES
* 
*     DHASH 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     ADDRESS OF CBWORKBUF IS SAVED IN SAVDBADDR AND CBWORKBUF IS 
*     RELOCATED TO THE ADDRESS OF THE ENTRY WHICH IS A SAMENAME/SYNONYM 
*     OF THE CURRENT ITEM.
*     THE NAMES ARE CHECKED. IF THEY ARE EQUAL, THEN THE SAMENAME 
*     POINTER MUST BE SET. THIS IS DONE BY FOLLOWING THE CURRENT ITEM 
*     SAMENAME POINTER UNTIL A ZERO ADDRESS IS FOUND. THEN SBITMSAMEPTR 
*     IS SET TO SAVDBADDR (ADDRESS OF CURRENT ITEM ENTRY).
*     IF THE NAMES DO NOT MATCH (IT IS A SYNONYM) THEN THE SYNONYM
*     POINTER MUST BE SET. THE CURRENT ITEM SYNONYM POINTER IS FOLLOWED 
*     UNTIL A ZERO ADDRESS IS FOUND. THEN SBITMSYNADDR IS SET TO
*     SAVDBADDR (ADDRESS OF CURRENT ITEM ENTRY).
* 
*     CBWORKBUF IS THEN RESET TO SAVDBADDR AND CONTROL IS RETURNED
*     TO THE CALLING ROUTINE. 
* 
 #
  
      ITEM EQNAME         B;       # TEMPORARY FLAG - TRUE = NAMES ARE #
                                   # EQUAL                             #
      ITEM K;                      # SCRATCH LOOP VARIABLE             #
      ITEM PTR            U;       # CONTAINS SAMENAME/SYNONYM PTR     #
      ITEM SAVDBADDR      I;       # FOR SAVING ADDRESS OF ITEM ENTRY  #
  
  
      SAVDBADDR = LOC(CBWORKBUF);          # SAVE BASE ADDRESS         #
      P<CBWORKBUF> = SBSCHMA + OVFLENTRYWA[OVRADR];  # RESET BASE      #
      EQNAME = TRUE;                       # ASSUME NAMES MATCH        #
      IF SBITMENTRY[0] EQ DFRECORD         # IF ENTRY IS A RECORD      #
      THEN
        BEGIN 
        FOR K = 0 STEP 1           # COMPARE NAMES                     #
          UNTIL SBRECNMELENW[0] - 1 
        DO
          BEGIN 
          IF SBRECNAME[K+SBRECNAMEPTR[0]] NQ HNAMEI[K]  # DO NOT MATCH #
          THEN
            EQNAME = FALSE;        # FLAG NAMES NOT EQUAL (SYNONYM)    #
          END 
        END 
      ELSE                         # ENTRY MUST BE ITEM                #
        BEGIN 
        FOR K = 0 STEP 1           # COMPARE NAMES                     #
          UNTIL SBITMNELENW[0] - 1
        DO
          BEGIN 
          IF SBITMNAME[K+SBITMNAMEPTR[0]] NQ HNAMEI[K]  # DO NOT MATCH #
          THEN
            EQNAME = FALSE;        # FLAG NAMES NOT EQUAL (SYNONYM)    #
          END 
        END 
      IF EQNAME                    # IF NAMES ARE EQUAL (SAMENAME)     #
      THEN
        BEGIN                      # MUST SET SAME NAME ADDRESS        #
        IF SBITMENTRY[0] EQ DFRECORD  # IF RECORD ENTRY                #
        THEN
          PTR = SBRECSMENMEA[0];   # GET RECORD SAME NAME ADDRESS      #
        ELSE                       # IT IS ITEM                        #
          PTR = SBITMSAMEPTR[0];   # GET ITEM SAME NAME ADDRESS        #
        FOR K = K 
          WHILE PTR NQ 0           # FIND ENTRY WITH ZERO SAMENAME ADDR#
        DO
          BEGIN 
          P<CBWORKBUF> = PTR + SBSCHMA;   # RESET TO SAMENAME ENTRY    #
          IF SBITMENTRY[0] EQ DFRECORD    # IF ENTRY IS A RECORD       #
          THEN
            PTR = SBRECSMENMEA[0];   # GET RECORD SAMENAME ADDRESS     #
          ELSE                       # ENTRY IS ITEM                   #
            PTR = SBITMSAMEPTR[0];   # GET ITEM SAMENAME ADDRESS       #
          END 
        IF SBITMENTRY[0] EQ DFRECORD     # IF ENTRY IS A RECORD        #
        THEN
          SBRECSMENMEA[0] = SAVDBADDR - SBSCHMA;  # REC SAMENAME PTR   #
        ELSE
          SBITMSAMEPTR[0] = SAVDBADDR - SBSCHMA;  # ITEM SAMENAME PTR  #
        END 
      ELSE                         # NAMES NOT EQUAL (SYNONYM)         #
        BEGIN 
        IF SBITMENTRY[0] EQ DFRECORD  # IF RECORD ENTRY                #
        THEN
          PTR = SBRECSYNADR[0];    # GET RECORD SYNONYM ADDRESS        #
        ELSE                       # IT IS ITEM ENTRY                  #
          PTR = SBITMSYNADDR[0];   # GET ITEM SYNONYM ADDRESS          #
        FOR K = K 
          WHILE PTR NQ 0           # FIND ENTRY WITH ZERO SYNONYM ADDR #
        DO
          BEGIN 
          P<CBWORKBUF> = PTR + SBSCHMA;   # RESET TO SYNONYM ENTRY     #
          IF SBITMENTRY[0] EQ DFRECORD    # IF ENTRY IS RECORD         #
          THEN
            PTR = SBRECSYNADR[0];       # GET RECORD SYNONYM ADDRESS   #
          ELSE                          # ENTRY IS ITEM                #
            PTR = SBITMSYNADDR[0];      # GET ITEM SYNONYM ADDRESS     #
          END 
        IF SBITMENTRY[0] EQ DFRECORD    # IF ENTRY IS RECORD           #
        THEN
          SBRECSYNADR[0] = SAVDBADDR - SBSCHMA;   # REC SYNONYM PTR    #
        ELSE                                      # ENTRY IS ITEM      #
          SBITMSYNADDR[0] = SAVDBADDR - SBSCHMA;  # ITEM SYNONYM PTR   #
        END 
      P<CBWORKBUF> = SAVDBADDR;         # RESTORE BASE ADDRESS         #
      RETURN; 
  
      END  # SAMESYNCHAIN # 
      CONTROL EJECT;
  
  
#     B E G I N   C B I N D E X   E X E C U T A B L E   C O D E        #
  
  
      P<CBWORKBUF> = SBSCHMA; # SET THE ADDRESS OF THE SUB-SCHEMA.     #
      IF RELFLAG THEN         # IF RELATION ENTRIES PRESENT, CALL ROUT-#
        RELSTAT;             # INE TO PRINT RELATION STATISTICS ON THE #
                             # OUTPUT LISTING.                         #
      P<REALMLIST> = FIRSTWORD;     # WORD ADDRESS WHERE THE REALM LIST#
                                   # IS TO BE BUILT.                   #
      J = SBCWSBLENG[CWPTR]; # USE THE SUB-SCHEMA LENGTH AS THE POINTER#
                             # TO THE NEXT AVAILABLE WORD.             #
      SBCWMAXSELEN[CWPTR] = MAXSELENG;  # STORE MAX. SUB-ENTRY LENGTH. #
      SBCWRLMLSTAD[CWPTR] = J;   # STORE THE FIRST WORD ADDRESS OF THE #
                                 # REALM LIST.                         #
      K = (SBCWNUMAREAS[CWPTR] + SBCWNUMRELS[CWPTR]) * 4 - 1; # CALCUL-#
                 # ATE THE LENGTH OF THE REALM LIST.                   #
      I = ((FIRSTWORD + 2 * (K+1) + J + SBCWNUMBERCS + 63) / 64) * 64 ; 
      IF  I GR DDLSU  THEN
        DDLSU = I ;                    # UPDATE STORAGE USED           #
      IF  I GR B<0,30> DDLMEM  THEN 
        BEGIN                          # IF MORE STORAGE NEEDED        #
          IF  I GR MAXFL  THEN
            ABRT1 ;                    # ABORT IF TOO MUCH, ELSE       #
          MEMORY (I) ;                 # REQUEST WHAT IS NEEDED        #
        END 
      IF  (SBSCHMA + J + K + 1 + SBCWNUMBERCS) GR B<0,30> DDLMEM  THEN
        BEGIN 
          P<CBWORKBUF> = FIRSTWORD + K + 1 ;
          SBSCHMA = SBSCHMA - P<CBWORKBUF> ;         # MOVE SUB-SCHEMA #
          FOR  I = 0 STEP 1 UNTIL J  DO              # DOWN TOWARD THE #
            BUFWORD [I] = BUFWORD [I+SBSCHMA] ;      # REALMLIST ARRAY #
          SBSCHMA = P<CBWORKBUF> ;
        END 
      FOR I=0 STEP 1 UNTIL K DO # MOVE THE REALM LIST FROM THE BEGINING#
                             # OF THE CBWORKBUF TO THE END.            #
        BUFWORD[J+I] = REALMLISTNME[I]; 
      RECLSTADR = J + K + 1; # CALCULATE THE ADDRESS OF THE RECORD LIST#
      P<RECORDLIST> = SBSCHMA + RECLSTADR; # WORD ADDRESS OF THE       #
                                             # RECORD LIST.            #
      P<REALMLIST> = SBSCHMA + J; # RE-ADJUST THE REALM LIST           #
                                          # TO ITS NEW LOCATION        #
      REALMLISTADR = J; # SAVE THE WORD ADDRESS OF THE REALM LIST.     #
    CONTSCAN:   #    #
      RECPTR = SBCWFRSTRECA[CWPTR]; # SET THE RECORD POINTER TO THE    #
                           # RECORD ENTRY IN THE SUB-SCHEMA.           #
      ORDNUM = ORDNUM + 1; # INCREMENT THE ORDINAL NUMBER FOR THE SCAN.#
      REALMRECLIST[REALMLISTPTR] = (RECLSTADR+RECLSTPTR) - REALMLISTADR;
           # STORE THE ADDRESS OF THE RECORD LIST INTO THE REALM LIST.# 
      RECLISTWRD[RECLSTPTR] = 0;
      FOR I=0 STEP 1 UNTIL SBCWNUMBERCS[CWPTR] - 1 DO # READ FROM      #
               # RECORD TO RECORD SEARCHING FOR A MATCH ON ORDINAL NUMB#
        BEGIN 
          J = SBRECNXRECP[RECPTR]; # GET THE NEXT RECORD POINTER.      #
          IF J EQ 0 THEN # CHECK IF THERE IS A NEXT RECORD.            #
            J = SBCWDCADDR[CWPTR] - RECPTR; # THERE IS NO NEXT RECORD  #
                # THEREFORE RECORD LENGTH HAS TO BE CALCULATED.        #
          K = SBRECWITHINO[RECPTR]; 
          IF K EQ ORDNUM THEN 
            BEGIN # COMPARE THE ORDINAL NUMBER IN THE RECORD ENTRY     #
                  # AGAINST THE CONTENTS OF ORDNUM.                    #
              RECLISTLADR[RECLSTPTR] = RECPTR; # STORE THE REC ADDRESS.#
              RECLISTLLENG[RECLSTPTR] = J; # STORE THE RECORD LENGTH.  #
              RECNBR = RECNBR + 1;  # INCREMENT THE RECLIST LENGTH     #
                                    # COUNTER.                         #
              RECLSTPTR = RECLSTPTR + 1;  # INCREMENT COUNTER TO NEXT  #
              RECLISTWRD[RECLSTPTR] = 0; # WORD.                       #
            END 
          RECPTR = RECPTR + J; # INCREMENT POINTER TO THE NEXT RECORD  #
                               # ENTRY .                               #
        END 
      IF RECNBR EQ 0 AND REALMADR LS SBCWFRSTRECA[CWPTR] THEN 
                        # CHECK IF THERE WHERE ANY RECORD ENTRIES      #
        BEGIN # SPECIFIED FOR THE RELAM NAME NOW BEING PROCESSED.      #
          J = SBARLENGCHAR[REALMADR[REALMLISTPTR]]; # GET THE CHARACTER#
                  # LENGTH OF THE SUBJECT REALM NAME.                  #
          IF J GR 7 THEN
            J= 7; 
          C<2,7>D300[7] = O"55555555555555";
          C<2,J>D300[7] = C<0,J>REALMLISTNME[REALMLISTPTR]; 
          DDLPRNT(DIAG300,80);
          ERRCNTR = ERRCNTR + 1;
          ABORTFLAG = 1;
        END 
      REALMRECLEN[REALMLISTPTR] = RECNBR; # STORE THE LENGTH OF THE    #
                                          # RECORD LIST.               #
      RECNBR = 0;   # REINITIALIZE THE COUNTER.                        #
      IF ORDNUM EQ SBCWNUMAREAS[CWPTR] THEN # CHECK IF SCANNED FOR ALL #
                                            # REALMS.                  #
        BEGIN 
          SBCWSBLENG[CWPTR] = RECLSTADR + RECLSTPTR + 1;
          IF DDLCOMP EQ QC         # IF COMPILATION MODE IS QU/CDCS    #
          THEN
            BEGIN 
            DAPTR = SBCWSBLENG[CWPTR];
            BLDHASH;                    # BUILD AREA HASH TABLES       #
            P<CBWORKBUF> = SBSCHMA;     # REPOSITION SUBSCHEMA         #
            SBCWSBLENG[CWPTR] = DAPTR;  # SUBSCHEMA LENGTH             #
            DDLSU = DDLSU + PUSEDFL;    # ACCUMULATE STORAGE USED      #
  
            FLAGKEYS;                  # FLAG KEYS IN ALL RECORD TYPES #
  
            P<CBWORKBUF> = SBSCHMA;    # REPOSITION SUBSCHEMA DIRECTORY#
            END 
          SBSCHML = SBCWSBLENG[CWPTR];
          SSCGLD;    # CALL ROUTINE TO LOAD CODE GENERATOR OVERLAY #
        END 
      REALMLISTPTR = REALMLISTPTR + 4; # INCREMENT POINTER TO THE NEXT #
                             # REALM LIST ENTRY                        #
      GOTO CONTSCAN;
    END 
  TERM; 
