*DECK DLRELN
USETEXT TSCXREF,TDLSCOM,TCKSCOM 
      PRGM DL30103;                # THIS IS 1,3 OVERLAY               # DL3A030
      DEF AREA$NAME #4#;
      DEF DEFINED #1#;
      DEF DFSCNAMLEN  # 2#;        # MAX WORD LENGTH OF SCHEMA NAME,   #
                                   # STARTING FROM WORD 0              #
      DEF DFSCNAMLENC #30#;        # MAX LENGTH OF SCHEMA NAME IN CHARS#
      DEF ITEM$NAME #1#;
      DEF REFERENCED #0#; 
      DEF SCCWPTR #0#;
      DEF MAXRELNS #4095#;        # MAXIMUM NUMBER OF ITEMS # 
      DEF MAXRLENTLEN #1636#;     #MAX RELATION SEARCH TABLE LENGTH FOR#
                                  #A PARTICULAR RELATION ENTRY,IN THE  #
                                  #ABSENCE OF A MEMORY MANAGEMENT SCH- #
                                  #EME.                                #
      XREF PROC DLHASH;      # GENERATES THE HASH TABLE                #
  
  
      ARRAY COMWKBUF [0:5] S(1);   # COMMON WORK BUFFER FOR READING    #
        BEGIN                      # IN AREA AND RECORD ENTRIES.       #
*CALL SCAHDDCLS 
*CALL SCRHDDCLS 
        END 
  
      ARRAY SCITWKBUF [0:10] S(1);   # WORK BUFFER TO READ IN ITEM     #
        BEGIN                        # ENTRIES.                        #
        ITEM SCITWKWRD U(0,0,60); 
*CALL SCIHDDCLS 
*CALL SCIRSDCLS 
        END 
  
      ARRAY SCDCWKBUF [0:400] S(1);  # WORK BUFFER TO READ IN DATA     #
        BEGIN                        # CONTROL ENTRIES.                #
          ITEM SCDCWKWRD U(0,0,60); 
*CALL SCDCDECLS 
        END 
  
      ARRAY SCRLWKBUF [1636] S(1); #WORKING BUFFER FOR RELATION ENTRIES#
        BEGIN 
        ITEM SCRLWKWRD U(0,0,60); 
*CALL SCRLDECLS 
        END 
  
      ARRAY DBICHRST [1] S(1);     # ARRAY USED TO STORE PICTURE,SIZE, #
        BEGIN                      # AND DATA CLASS ATTRIBUTES OF DBIS #
        ITEM DBIWORD U(0,0,60); 
        ITEM DBIPIC U(0,0,18);
        ITEM DBICLASS U(0,18,6);
        ITEM DBISIZE U(0,24,18);
        END 
      ARRAY SUBSARR [0:3];         # ARRAY USED TO STORE DBI SUBSCRIPTS#
        ITEM SUBSCRIPTS U(0,0,60);
  
      BASED ARRAY DBPSORT [0] S(1); 
        BEGIN 
        ITEM DBPSORTNME   C (00,00,07);  # SORTED DBP NAMES            #
        END 
  
      ARRAY DBPRINT [0] S(2);      # DBP NAMES FORMATTED FOR OUTPUT    #
        BEGIN 
        ITEM DBPRNTFIL    C (00,00,10) = ["          "];  # BLANK FILL #
        ITEM DBPRNTNME    C (01,00,07);                   # DBP NAME   #
        END 
  
      ITEM DBPHEAD C(72) = "0*** DATA-BASE PROCEDURE LIST FOR SCHEMA
                            ";
      ITEM ARHDPR C(30) = " *** AREA CHECKSUMS ***       "; 
      ITEM ARSBPR C(60) = "          AREA NAME
     CHECKSUM  "; 
      ITEM RLHDPR C(30) = " *** RELATION CHECKSUMS ***   "; 
      ITEM RLSBPR C(60) = "          RELATION NAME
     CHECKSUM  "; 
  
      ITEM ANYFLAG B;        # TRUE="ANY"IS SUBSCRIPT FOR SUBJECT DBI. #
      ITEM AREAADR;          # WORD ADDRESS OF AREA, SUBJECT DBI BEL-  #
                             # ONGS TO.                                #
      ITEM AREADCLENG;       # CONTAINS THE LENGTH OF AREA"S DATA      #
                             # CONTROL ENTRY.                          #
      ITEM DBICOUNT;         # CONTAINS THE COUNT OF DBIS SPECIFIED    #
                             # IN A RELATION ENTRY.                    #
      ITEM DEFLTFLAG B;      # SET IF NO SUBSCRIPTS SPECIFIED AND      #
                             # DBI IS SUBSCRIPTABLE.                   #
      ITEM ERRFLAG B;        # TRUE = ERROR ENCOUNTERED.               #
      ITEM I,J,K;            # SCRATCH VARIABLES.                      #
      ITEM L;                # SCRATCH VARIABLE                        #
      ITEM I1;               # USED TO STORE SOURCE LINE NUMBER OF    # 
                             # NEXT SOURCE INPUT RECORD.              # 
      ITEM LOOPCNT;          # CONTAINS THE LOOP COUNT                 #
      ITEM QUALFLAG B;       # DBI IS QUALIFIED.                       #
      ITEM READADR;          # CONTAINS THE WORD ADDRESS IN THE SCH-   #
                             # EMA DIRECTORY FOR A CRM GET.            #
      ITEM RELCOUNT;         # MAINTAINS THE COUNT OF RELATION ENTRIES #
                             # PROCESSED.                              #
      ITEM RELPTR;           # CONTAINS THE WORD ADDRESS OF THE NEXT   #
                             # AVAILABLE LOCATION IN THE SCHEMA DIRECT-#
                             # ORY FOR A WRITE.                        #
      ITEM RSTPTR;           # FIXED POINTER--START OF A RST.          #
      ITEM SRCLINENBR C(10); # TEMPORARY STORAGE FOR CURRENT SOURCE    #
                             # LINE NUMBER.                            #
      ITEM SUBSCOUNT;        # CONTAINS THE NUMBER OF SUBSCRIPTS SPEC- #
                             # IFIED FOR THE DBI.                      #
      ITEM SUBSMAX;          # CONTAINS THE MAXIMUM ALLOWABLE SUBS-    #
                             # CRIPTS(3).                              #
  
      SWITCH KEYSWITCH ALTKEY,PRIKEY,NOKEY,NOKEY,SORTKEY; 
  
      SWITCH SCHJUMP
          DBIINIT     , 
          DBISINIT    , 
          DIAGROUT1   , 
          DIAGROUT2   , 
          ENDREL      , 
          HASHITRL    , 
          HASHRLDBI   , 
          DBIVALID    , 
          RELINIT     , 
          RESETPTR    , 
          RESTORLNNBR , 
          SAVDBI      , 
          SAVRELNM    , 
          SAVRECNAM   , 
          SAVSUBS     , 
          SETANY      , 
          SETSRCDBI   , 
          SETTRGDBI   , 
          STLINENBR   , 
          WRITERST    ; 
  
  
  
#**********************************************************************#
#   BEGIN EXECUTION OF RELATION PROCESSING OVERLAY.                    #
      DDLDIAG = LOC( DIAGSTD ); 
      LEXWD = LOC( LEXWORD ); 
      LEXICO = LOC( LEXICON); 
      SYNTBL = LOC( SYNTBLE); 
      LBLPTR = LOC( LBLPTRS );
*IF DEF,DEBUG 
      TRACE = LOC( TRACEM );
*ENDIF
      SWITCHVECTOR = LOC( SCHJUMP );
      DCTINIT;
      STD$START;
  
  ALTKEY:        #*****************************************************#
#****************       A L T K E Y       *****************************#
#                                                                      #
#   IF DBI POSITION IS POSITION OF ALTERNATE KEY----                   #
#   IF SUBSCRIPT IS ANY OR IF DBI IS UNSUBSCRIPTABLE( ELEMENTARY ITEM  #
#   AT THE MOST DOMINANT LEVEL OR NON-REPEATING GROUPS) THEN           #
#   IF SIZES ARE THE SAME, KEY INDICATOR = ALTERNATE KEY( CODE=4 ).    #
#   IF DBI SIZE LESS, KEY INDICATOR = MAJOR PART OF ALT. KEY( CODE=3 ).#
#**********************************************************************#
      IF ANYFLAG OR (SUBSCOUNT EQ 0 AND NOT DEFLTFLAG) THEN 
        BEGIN 
        IF SCRLDBISIZE[DPTR] EQ SCDCKEYSIZ[J+1] THEN
          SCRLDBIKEYTY[DPTR] = 4; 
        ELSE
          SCRLDBIKEYTY[DPTR] = 3; 
        END 
      DPTR = DPTR + 2;
      STDYES; 
  
  DBIINIT:       #*****************************************************#
#****************       D B I I N I T       ***************************#
#                                                                      #
#     INITIALIZE POINTERS AND BUFFER FOR DBI SYNTAX CRACKING AND PR-   #
#     OCESSING.RETURN IS TO STDNO.                                     #
#**********************************************************************#
      FOR I = 0 STEP 1 UNTIL 3 DO  # ZERO OUT SUBSCRIPTS ARRAY AND     #
        BEGIN                      # NAME ARRAY.                       #
        NAME[I] = 0;
        SUBSCRIPTS[I] = 0;
        END 
      SCRLWKWRD[DPTR] = 0;
      SCRLWKWRD[DPTR + 1] = 0;
      DTEMP = "          "; 
      SUBSCOUNT = 0;               # INITIALIZE SUBSCRIPT COUNTER      #
      SUBSMAX = 3;                 # MAXIMUM ALLOWABLE SUBSCRIPTS.     #
      ANYFLAG = FALSE;
      ERRFLAG = FALSE;
      DEFLTFLAG = FALSE;
      STDNO;
  
  DBISINIT:      #*****************************************************#
#****************       D B I S I N I T       *************************#
#                                                                      #
#   INITIALIZE POINTERS AND BUFFERS FOR START OF DBI PROCESSING.       #
#**********************************************************************#
      DBIWORD[0] = 0;        # ZERO OUT DBI CHARACTERISITC STORAGE     #
      DBIWORD[1] = 0;        # ARRAY.                                  #
      DBICOUNT = 0;          # INITIALIZE COUNT OF DBIS.               #
      STDNO;
  
  DBIVALID:      #*****************************************************#
#****************       D B I V A L I D       *************************#
#                                                                      #
#   MAJOR PROCESSING AND VALIDATION CHECKS FOR DBIS ARE PERFORMED      #
#   HERE.  THE VALIDATION CHECKS PERFORMED ARE:                        #
#                                                                      #
#   1)    CHECKS IF DBI IS DEFINED.----D403                            #
#   2)    CHECKS IF SUBSCRIPT ANY IS USED INCORRECTLY(SOME CHECKS      #
#         ARE ALSO MADE IN OTHER ROUTINES)----D404                     #
#   3)    CHECKS INCORRECT USE OF SUBSCRIPTS,OTHER THAN ANY(DONE IN    #
#         PROC SETBCPBWP,WHICH IS CALLED TO CALCULATE THE BEGINNING    #
#         CHARACTER AND WORD POSITIONS OF THE DBI)----D404             #
#   4)    CHECKS FOR CYCLING AND RECURSION----D411 AND D410            #
#   5)    CHECKS IF DBI BELONGS TO AREA WITH MULTIPLE RECORDS----D413  #
#   6)    CHECKS IF SUBSCRIPT ANY HAS BEEN USED ON NON-KEY DBIS        #
#         (BECAUSE ANY CAN BE USED ONLY WITH ALTERNATE KEYS)----D409   #
#                                                                      #
#   PROCESSING----DBI CHARACTER AND WORD POSITIONS IN THE RECORD ARE   #
#         CALCULATED AND STORED IN THE RST. (PROC SETBCPBWP)           #
#         DBI KEY INDICATOR IS CALCULATED AND STORED IN THE RST.       #
#         ALSO, DBI SIZE, CLASS AND OWNER AREA ADDRESS IN THE SCHEMA   #
#         DIRECTORY ARE STORED IN THE RST.                             #
#   IN CASE OF ERRORS, PROCESSING CONTINUES AS LONG AS THE EFFECT OF   #
#   SNOWBALLIG IS NOT FELT. IF, HOWEVER, THERE IS A RATHER FATAL ERROR,#
#   PROCESSING IS STOPPED AND RETURN IS TO STDNO. AT THE END OF PRO-   #
#   CESSING, RETURN IS TO STDNO IN CASE OF ERRORS, ELSE RETURN IS TO   #
#   STDYES.                                                            #
#**********************************************************************#
      IF DBIIND NQ 0 THEN 
        BEGIN 
        C<0,10>I1 = C<0,10>NBRLINE;   # STORE CURRENT LINE NUMBER. #
        NBRLINE = SRCLINENBR;         # STORE CORRECT LINE NUMBER      #
                                      # FOR DIAGNOSTIC.                #
        END 
      IF REFSTATUS EQ 0 THEN       # IF DBI NOT DEFINED,DIAGNOSE.      #
        BEGIN 
        RLDIAGFLG = TRUE; 
        DIAGDL( 403 );
        STDNO;
        END 
      SCRLDBIKEYTY[DPTR] = 0;    # SET KEY INDICATOR TO 0 INITIALLY. #
      IF SYMKCONFLGWK[2] THEN      # IF SUBJECT DBI IS DEFINED AS A    #
        BEGIN                      # CONCATENATED KEY,                 #
        DDLRDSC( SCDCWKBUF, 10, SYMWRDADDRWK[1] );
        DDLRDSC( COMWKBUF, RECDFIXW, SCDCRCENTRYA[0] ); # READ IN REC. #
        AREAADR = SCRWITHINA1[0];  # ADDR OF AREA THIS REC BELONGS TO. #
        DDLRDSC( COMWKBUF, AREAFIXW, AREAADR ); # READ IN AREA HEADER. #
        IF DBIIND NQ 0 THEN  # IF SUBJECT DBI IS A TARGET DBI,         #
          BEGIN 
          IF B<0,24>DBIWORD[0] NQ 0 THEN  #IF PICTURE AND CLASS CHAR-  #
            DIAGDL( 407 );                # ACTERISTICS DIFFER, ERROR. #
          IF B<24,18>DBIWORD[0] NQ SCDCKEYSIZ[1] THEN  # IF SIZE OF    #
            DIAGDL( 408 );  # SOURCE AND TARGET DBI NOT THE SAME,ERROR.#
          END 
        ELSE
          BEGIN 
          B<0,24>DBIWORD[0] = 0;
          B<24,18>DBIWORD[0] = SCDCKEYSIZ[1]; 
          END 
        IF SCDCKEYSIZ[1] GR 255 THEN   # IF DBI SIZE GREATER THAN      #
          BEGIN                        # 255 CHARACTERS, ERROR.        #
          RLDIAGFLG = TRUE; 
          DIAGDL( 406 );
          END 
        IF SUBSCOUNT NQ 0 OR ANYFLAG THEN  # IF SUBSCRIPTS SPECIFIED   #
          BEGIN                            # SUBJECT DBI, ERROR.       #
          RLDIAGFLG = TRUE; 
          DIAGDL( 404 );
          END 
        SCRLDBIARPTR[DPTR] = AREAADR; 
        SCRLDBICLASS[DPTR] = 0; 
        SCRLDBISIZE[DPTR] = SCDCKEYSIZ[1];
        SCRLDBIBCP[DPTR] = SCDCKEYBCP[1]; 
        SCRLDBIBWP[DPTR] = SCDCKEYBWP[1]; 
        IF SCDCKEYSORT[1] THEN
          SCRLDBIKEYTY[DPTR] = 1;      # SORT KEY FIELD. #
        ELSE
        IF SCDCKEYPRI[1] THEN 
          SCRLDBIKEYTY[DPTR] = 5;      # PRIMARY KEY FIELD. # 
        ELSE
          SCRLDBIKEYTY[DPTR] = 4;      # ALTERNATE KEY FIELD. # 
        SCRLDBIADR[DPTR+1] = SYMWRDADDRWK[1]; 
        SCRLDBICONKY[DPTR+1] = TRUE;
        GOTO CHECK1;
        END 
      SCRLDBIADR[DPTR+1] = SYMWRDADDRWK[1];  # STORE WORD ADDRESS OF   #
                                             # SUBJECT DBI IN RST.     #
      SCRLDBISUBCT[DPTR+1] = SUBSCOUNT;      # NUMBER OF SUBSCRIPTS    #
                                             # SPECIFIED.              #
  
    # WORD ADDRESS OF THE SUBJECT DBI ENTRY IN THE SCHEMA IS OBTAINED  #
    # FROM THE SYMBOLE TABLE. READ IN THIS ENTRY INTO ITEM WORK BUFFER.#
      DDLRDSC( SCITWKBUF, ITEMFIXW, SYMWRDADDRWK[1] );
  
    # THE WORD ADDRESS OF THE RECORD,THE SUBJECT DBI BELONGS TO,IS     #
    # ALSO OBTAINED FROM THE SYMBOL TABLE ENTRY OF THE SUBJECT DBI.    #
    # READ IN RECORD ENTRY FROM THE SCHEMA DIRECTORY INTO A RECORD     #
    # WORK BUFFER.                                                     #
      DDLRDSC( COMWKBUF, RECDFIXW, SYMIRECPTRWK[2] ); 
        AREAADR = SCRWITHINA1[0];  # STORE ADDRESS OF OWNER AREA.      #
  
    # READ OWNER AREA OF SUBJECT DBI,FROM SCHEMA DIRECTORY INTO WORK   #
    # BUFFER.                                                          #
      DDLRDSC( COMWKBUF, AREAFIXW, AREAADR ); 
  
    # STORE DBI PICTURE CHARACTERISTICS AND SIZE IN ARRAY # 
      DBIPIC[DBIIND] = SCITMPICINFO[0]; 
      DBICLASS[DBIIND] = SCITEMCLASS[0];
      DBISIZE[DBIIND] = SCITEMSIZE[0];
    # CHECK IF DBI SIZE IS GREATER THAN 255 CHARACTERS.                #
      IF DBISIZE[DBIIND] GR 255 THEN
        BEGIN 
        RLDIAGFLG = TRUE; 
        DIAGDL( 406 );
        END 
  
      IF DBIIND NQ 0 THEN    # IF SUBJECT DBI IS A TARGET DBI, THEN    #
        BEGIN 
        IF B<0,24>DBIWORD[0] NQ B<0,24>DBIWORD[1] THEN #IF PICTURE AND #
          DIAGDL( 407 );     # CLASS CHARACTERISTICS DIFFER, DIAGNOSE. #
  
        IF B<24,18>DBIWORD[0] NQ B<24,18>DBIWORD[1] THEN  # IF SIZE OF #
          DIAGDL( 408 );     # SOURCE AND TARGET DBIS DIFFER, DIAGNOSE #
  
        IF ANYFLAG AND SCITEMCLASS[0] EQ 1 AND SCITRLDOMPTR[0] EQ 0 
          THEN #IF "ANY" IS THE SUBSCRIPT FOR SUBJECT DBI AND IT IS AN #
          BEGIN  # ELEMENTARY ITEM WITH NO DOMINANT ITEMS,DIAGNOSE.    #
          RLDIAGFLG = TRUE; 
          DIAGDL( 404 );
          END 
        END 
  
      IF SUBSCOUNT EQ 0 THEN       # IF NO SUBSCRIPTS SPECIFIED AND    #
        BEGIN 
        IF SCITRLDOMPTR[0] NQ 0 THEN  # IF DBI IS NOT THE MOST DOMINANT#
          BEGIN                    # ITEM, STORE DEFAULT SUBSCRIPTS    #
          FOR I = 0 STEP 1 UNTIL 3 DO  #IN SUBSCRIPT ARRAY.            #
            SUBSCRIPTS[I] = 1;
          DEFLTFLAG = TRUE;        # SET FLAG TO INDICATE THE PRESENCE #
                                   # OF DEFAULT SUBSCRIPTS.            #
          SETBCPBWP;               # CALL ROUTINE TO CALCULATE BEGINN- #
                                   # ING WORD AND CHARACTER POSITIONS. #
          END 
        ELSE                       # IF DBI IS THE MOST DOMINANT ITEM  #
          BEGIN                    # THEN                              #
          SCRLDBIBWP[DPTR] = SCITEMPBWP[0]; # STORE BEGINNING WORD     #
          SCRLDBIBCP[DPTR] = SCITEMBBP[0]/6;# AND CHARACTER POSITION,  #
                 # AS STORED IN THE SCHEMA DIRECTORY, IN THE RST.      #
          IF B<2,1>SCITWKWRD[0] EQ 0 THEN   # IF DBI IS A REPEATING    #
            DEFLTFLAG = TRUE;      # GROUP OR VECTOR, SET FLAG TO IND- #
                                   # ICATE SO--FOR USE IN SETTING KEY  #
                                   # TYPES.                            #
          END 
        END 
      ELSE
        SETBCPBWP;           # CALL ROUTINE TO CALCULATE BEGINNING WORD#
                             # AND CHARACTER POSITION OF SUBJECT DBI.  #
      IF ERRFLAG THEN        # ON RETURN FROM SETBCPBWP,IF ERRFLAG SET,#
        BEGIN                # CALL DIAGNOSTIC ROUTINE TO ISSUE DIAG-  #
        RLDIAGFLG = TRUE; 
        DIAGDL( 404 );       # NOSTIC.                                 #
        END 
  
      SCRLDBISIZE[DPTR] = DBISIZE[DBIIND]; # STORE DBI SIZE IN RST     #
      SCRLDBIARPTR[DPTR] = AREAADR;        # STORE AREA ADDRESS IN RST #
      SCRLDBICLASS[DPTR] = DBICLASS[DBIIND]; # STORE DBI DATA CLASS IN #
                                             # RST.                    #
  
  CHECK1:      #   #
    # LOOP THROUGH DBI ENTRIES IN THE RST AND CHECK IF THE PRESENT  # 
    # DBI BELONGS TO AN AREA ALREADY SPECIFIED PREVIOUSLY FOR SOME  # 
    # OTHER DBI,THEN DIAGNOSE,EXCEPT IF THE PRESENT DBI IS THE SOU- # 
    # RCE DBI AND THE DBI WITH THE SAME OWNER AREA IS THE PRECEEDING# 
    # ENTRY(CYCLING). ALSO, IF THE DBIS TO THE LEFT AND RIGHT OF THE# 
    # "EQ" OPERATOR HAVE THE SAME OWNER AREA, THEN DIAGNOSE(RECURS- # 
    # ION).                                                         # 
      FOR J = RSTPTR+2+SCRELNAMLENW[RSTPTR] STEP 2 UNTIL DPTR-1 DO
        BEGIN 
        IF AREAADR EQ SCRLDBIARPTR[J] THEN
          BEGIN 
          IF J NQ DPTR-2 THEN 
            BEGIN 
            DIAGDL( 411 );         # CYCLING #
            STDNO;
            END 
          IF DBIIND EQ 1 THEN 
            BEGIN 
            DIAGDL( 410 );         # RECURSION #
            STDNO;
            END 
          END 
        ELSE
        IF J EQ DPTR-2 AND DBIIND EQ 0 THEN 
          BEGIN 
          DIAGDL( 416 );     # SOURCE AND TARGET DBIS NOT IN THE       #
          STDNO;             # SAME FILE( INCOMPLETE JOIN ), ERROR.    #
          END 
        END 
      DBICOUNT = DBICOUNT + 1;     # INCREMENT COUNT OF DBIS           #
  
      READADR = SCAREADCNTLA[0];    # WORD ADDRESS OF AREA THE SUBJECT #
                                    # DBI BELONGS TO.                  #
      DDLRDSC( SCDCWKBUF, 2, READADR ); 
      J = SCDCALTRKYPT[0];   # STORE KEY POINTER.                      #
      IF NOT SCDCRECCDFLG[0] THEN 
        BEGIN                # POSSIBLE PRESENCE OF MULTIPLE RECORDS.  #
        READADR = SCAREADCNTLA[0] + SCDCRECCDPTR[0]; #WORD ADDRESS OF  #
        DDLRDSC( SCDCWKBUF, 5, READADR );            #RECORD CODE ENTRY#
        IF SCDCRCDETYP[0] THEN     # LOCATE NEXT RECORD CODE ENTRY FLAG#
          I = 1;
        ELSE
          I = 2;
        IF SCDCRCDENEXT[I] THEN 
          BEGIN              # MULTIPLE RECORD TYPES PRESENT.          #
          RLDIAGFLG = TRUE; 
          DIAGDL( 413 );
          END 
        END 
    # IF DBI IS A NON-KEY FIELD OR IS A SOURCE DBI OR IS DEFINED AS    #
    # A CONCATENTED KEY, SKIP FURTHER PROCESSING AND RETURN.           #
      IF J EQ 0 OR DBIIND EQ 0 OR SYMKCONFLGWK[2] THEN
        BEGIN 
        DPTR = DPTR + 2;
        STDYES; 
        END 
      AREADCLENG = SCAREADCLENG[0] - J;    # EFFECTIVE                 #
                                   # LENGTH OF DATA CONTROL ENTRY OF   #
                                   # AREA, DBI BELONGS TO.             #
      READADR = SCAREADCNTLA[0] + J;   # EFFECTIVE WORD ADDRESS        #
                                   # TO START READ FOR KEY PROCESSING. #
  
      FOR I = I WHILE AREADCLENG GR 0 DO # LOOP THROUGH DATA CONTROL   #
        BEGIN    # BEGIN FOR LOOP-1 #    # ENTRIES.                    #
        IF AREADCLENG GR 400 THEN  # IF DATA CONTROL ENTRY IS GREATER  #
          I = 400;                 # THAN MAXIMUM BUFFER SIZE, THEN    #
        ELSE                       # STORE MAXIMUM LENGTH TO BE READ   #
          I = AREADCLENG;          # IN, ELSE THE ENTIRE ENTRY.        #
        AREADCLENG = AREADCLENG - I;
        DDLRDSC( SCDCWKBUF, I, READADR ); # READ IN DATA CONTROL ENTRY #
                                   # OF THE SUBJECT DBI"S OWNER AREA.  #
        READADR = READADR + I;     # WORD ADDRESS OF NEXT READ.        #
        FOR J = 0 STEP SCDCKEYNITM[J+1] DO   # LOOP THRU KEY ENTRIES.  #
          BEGIN  # BEGIN OF FOR--LOOP 2 # 
          IF SCDCKEYNITM[J+1] GR I THEN    #IF KEY ENTRY LENGTH IS GRE-#
            BEGIN                        # ATER THAN THE NUMBER OF WRDS#
            AREADCLENG = AREADCLENG + I; # LEFT IN THE BUFFER,THEN AD- #
            READADR = READADR - I;       # JUST POINTERS TO REFLECT THE#
            TEST I;                      # UNUSED PORTION OF THE ENTRY,#
            END                          # AND RETURN FOR ANOTHER READ.#
          I = I - SCDCKEYNITM[J + 1]; 
  
    # SET KEY TYPES. KEY TYPES ARE ONLY SET FOR TARGET DBIS AS CDCS    #
    # IGNORES THAT FIELD IN SOURCE DBI ENTRIES, HENCE THAT FIELD WILL  #
    # ALWAYS BE A ZERO FOR SOURCE DBIS.                                #
          IF SCRLDBIBWP[DPTR] EQ SCDCKEYBWP[J+1] AND
             SCRLDBIBCP[DPTR] EQ SCDCKEYBCP[J+1] THEN  # IF MATCHING   #
            BEGIN                  # KEY ENTRY FOUND,                  #
            IF SCRLDBISIZE[DPTR] LQ SCDCKEYSIZ[J+1] THEN
              GOTO KEYSWITCH[ ABS(2 - B<52,3>SCDCWKWRD[J+1])]; # SET   #
            END              # UP CALL FOR SWITCH                      #
          IF SCDCKEYNITM[J+1] EQ 0 THEN  # IF LAST KEY ENTRY FOR THIS  #
            BEGIN 
            AREADCLENG = 0;                 # AREA.                   # 
            TEST I; 
            END 
          END    # END OF FOR LOOP--2 # 
        END   # END OF FOR LOOP--1 #
      IF ANYFLAG THEN        # AT THIS POINT NO MATCHING KEY ENTRY HAS #
        DIAGDL( 409 );       # BEEN FOUND, AND IF ANY IS THE           #
      DPTR = DPTR + 2;
      STDYES;                # SUBSCRIPT, DIAGNOSE.                    #
  
  DIAGROUT1:     #*****************************************************#
#****************       D I A G R O U T 1       ***********************#
#                                                                      #
#   SET UP CALL TO DIAGNOSTIC ROUTINE WITH THE INSERTION FLAG ON SO    #
#   AS TO INSERT THE APPROPRIATE DBI TYPE( SOURCE OR TARGET) IN DIAG-  #
#   NOSTIC.                                                            #
#**********************************************************************#
      RLDIAGFLG = TRUE; 
      DIAGDL( 403 );
      STDNO;
  
  DIAGROUT2:     #*****************************************************#
#****************       D I A G R O U T 2       ***********************#
#                                                                      #
#   SET UP CALL TO DIAGNOSTIC ROUTINE WITH THE INSERTION FLAG ON SO    #
#   AS TO INSERT THE APPROPRIATE DBI TYPE( SOURCE OR TARGET) IN DIAG-  #
#   NOSTIC.                                                            #
#**********************************************************************#
      RLDIAGFLG = TRUE; 
      DIAGDL( 404 );
      STDNO;
  
  ENDREL:        #*****************************************************#
#****************       E N D R E L       *****************************#
#                                                                      #
#   CHECKS FOR FATAL SYNTAX ERRORS,AND IF FOUND DDL IS ABORTED AND NO  #
#   SCHEMA CREATED. IF THERE WERE NO SYNTAX ERRORS,THE LAST RST IS     #
#   WRITTEN AGAIN TO THE SCHEMA DIRECTORY WITH THE NEXT RST POINTER    #
#   RESET TO ZERO TO INDICATE THIS IS THE LAST RST. THE HASH TABLE IS  #
#   WRITTEN TO THE DIRECTORY AND THE REMAINING INFORMATION IS STORED   #
#   IN SCHEMA CONTROL WORD BUFFERS AND THE BUFFER WRITTEN TO THE DIR-  #
#   ECTORY. ALSO THE CHECKSUM BLOCK IS WRITTEN TO THE DIRECTORY,FILES  #
#   CLOSED, AND EXECUTION STOPPED.                                     #
#**********************************************************************#
      IF FATALERR NQ 0 THEN  # IF FATAL ERRORS ENCOUNTERED, ABORT DDL. #
        BEGIN 
        DIAGDL( 296 );
        ABORTDDL; 
        END 
      DDLRDSC( SCRLWKBUF, I, K );   # READ BACK LAST RELATION ENTRY # 
      SCRELNEXTPTR[RSTPTR] = 0;    # RESET NEXT RST POINTER TO ZERO,   #
                                   # TO INDICATE IT IS THE LAST RST.   #
      DDLRTSC( SCRLWKBUF, I, K );  # VALUES OF I + K RETAINED IN ROUT- #
                                   # INE *WRITERST                     #
      NEXTPTR = RELPTR; 
  ENDSCHEMA:     # BRANCH FROM *RELINIT, WHEN NO RELATION ENTRIES      #
                 # PRESENT.                                            #
      DLHASH;                      # GO GENERATE HASH TABLE. #
  #********************************************************************#
  # DO END OF SCHEMA COMPILATION CLEANUP FOR CHECKSUM PROCESSING       #
  #********************************************************************#
      I = 1;                                     #INDEX WITHIN SCHBUFF #
      CKSWA = 1;                       #SET WA TO START OF SCRATCH FILE#
      SCCWCKSUMWA[SCCWPTR] = NEXTPTR;        #SET CKSUM WA IN CTL WDS  #
      DDLPRNT(ARHDPR,30);              #PRINT AREA CHECKSUM            #
      DDLPRNT(ARSBPR,60);                        #HEADER LINES         #
      P<CKSBLK> = SCHBUFF;             #FOR DIRECTORY CHECKSUM BLOCK   #
      CKSWRD[0] = 0;                             #CLEAR HEADER WORD    #
      CKSARS[0] = TOTALAREAS;          #SET AREA COUNT IN HEADER       #
      CKSRLS[0] = RELCOUNT;            #SET RELATION COUNT IN HEADER   #
      WRCHECKSUM(TOTALAREAS);      #GENERATE CHECKSUM BLOCK(AREA)#
      IF RELCOUNT NQ 0 THEN                  #TEST IF ANY RELATIONS    #
        BEGIN 
        DDLPRNT(RLHDPR,30);                  #PRINT RELATION           #
        DDLPRNT(RLSBPR,60);                      #HEADER LINES         #
      WRCHECKSUM(RELCOUNT);        #GENERATE CHECKSUM BLOCK(RELATION)#
        END 
      IF I NQ 0 THEN
        BEGIN 
        DDLRTSC(CKSBLK,I,NEXTPTR);     #FLUSH BUFFER TO DIRECTORY      #
        NEXTPTR = NEXTPTR + I;         #ADJUST DIRECTORY WA            #
        END 
      SCCWDIRLENG[SCCWPTR] = NEXTPTR;   # STORE DIRECTORY LENGTH.      #
      SCITWKWRD[0] = 0; 
      SCITWKWRD[1] = 0;       # WRITE TWO WORDS OF ZEROS,#
      SCITWKWRD[2] = "***** THE ";  # PLUS ***** THE END ***** #
      SCITWKWRD[3] = " END *****";  # AT THE END OF SCHEMA     #
      DDLRTSC( SCITWKBUF, 4, NEXTPTR ); 
      SCCWNUMRELTN[SCCWPTR] = RELCOUNT;  # STORE COUNT OF RELATION ENT-#
                                         # RIES IN CONTROL WORDS BUFFER#
      SCCWMAXSELEN[SCCWPTR] = MAXSUBENTLG;  # STORE MAXIMUM SUB-ENTRY  #
                                            # LENGTH.                  #
      DDLRTSC( CWWRKBUF, CTLWDLENG, 1); # WRITE CONTROL WORDS IN SCH- # 
                                         # EMA DIRECTORY.              #
  
      FOR I = 0 STEP 1             # BLANK FILL SCHEMA NAME            #
        UNTIL DFSCNAMLEN
      DO
        RPTSCHNAME[I] = XSFW (SCCWSCHNAME[I]);
      IF SCCWDBPWRDAR[SCCWPTR] NQ 0 THEN  # DBP"S SPECIFIED IN SCHEMA  #
        BEGIN                      # SORT THE DBP"S AND WRITE TO OUTPUT#
        P<DBPSORT> = LOC(PROCTBLE[1]);
        XSST (DBPSORT, PROCTBLEWC[0]);
        C<42,30>DBPHEAD = RPTSCHNAME30[0];
        DDLPRNT (DBPHEAD, 72);     # PRINT HEADER LINE                 #
        FOR I = 0 STEP 1 UNTIL PROCTBLEWC[0] - 1 DO 
          BEGIN                    # BLANK FILL DBP NAMES AND WRITE OUT#
          DBPRNTNME[0] = XSFW (DBPSORTNME[I]);  # DBP NAME, BLANK FILL #
          DDLPRNT (DBPRINT, 17);
          END 
        END 
  
      CLSESC;                           # CLOSE SCHEMA FILE            #005840
      IF SBLFN NQ 0                     # IF SUBSCHEMA LFN SPECIFIED   #005850
      THEN LOADOVL (BASE1X, 1, 5);      # LOAD CHECKSUM CHECK OVERLAY  #005860
      SCCLCKS;                          # CLOSE CHECKSUM SCRATCH FILE  #005870
                                                                        005880
      CLSEOUT;
      STOP; 
  
  HASHITRL:      #*****************************************************#
#****************       H A S H I T R L       *************************#
#                                                                      #
#   SET UP CALL TO HASHIT TO CREATE A SYMBOL TABLE ENTRY FOR THE       #
#   RELATION NAME BEING DEFINED. THE NAME TYPE IS SET TO THAT OF AN    #
#   AREA NAME TO INSURE UNIQUENESS OF RELATION NAMES AMONG BOTH AREA   #
#   AND RELATION NAMES. RETURN IS TO STDYES.                           #
#**********************************************************************#
      NAMETYPE = AREA$NAME;  # SET TYPE TO AREA. #
      REFDEF = DEFINED;      # SET INDICATOR FOR A DEFINITION. #
      CURWORDADDR = RELPTR;  # ADDRESS OF RELATION ENTRY IN SCHEMA     #
                             # DIRECTORY -- STORED IN THE SYMBOL TABLE.#
      NAMELENC = CURLENG;    # LENGTH OF NAME IN CHARS. # 
      NAMELENW = CURLENW;    # LENGTH OF NAME IN WORDS. # 
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO   # STORE NAME FOR CALL    #
        NAME[I] = CURWORD[I];                 # TO HASHING ROUTINE.    #
      HASHIT;                # HASH ROUTINE  #
      STDNO;
  
  HASHRLDBI:     #*****************************************************#
#****************       H A S H R L D B I       ***********************#
#                                                                      #
#   SET UP REMAINING PARAMETERS AND CALL HASH ROUTINE FOR DBI REF-     #
#   ERENCE. RETURN IS TO STDNO.                                        #
#**********************************************************************#
      NAMETYPE = ITEM$NAME; 
      REFDEF = REFERENCED;
      CURWORDADDR = RELPTR + DPTR;
      HASHIT; 
      STDNO;
  
  NOKEY:         #*****************************************************#
#****************       N O K E Y       *******************************#
#                                                                      #
#   PADDING FOR SWITCH VECTOR---NO PROCESSING.                         #
#   THIS ROUTINE MAY BE CALLED IN THE EVENT THAT ERRORS WERE ENCOUN-   #
#   TERED PREVIOUSLY IN PROCESSING THE CURRENT RELATION ENTRY, HENCE   #
#   RETURN WILL BE TO STDNO.                                           #
#**********************************************************************#
      STDNO;
  
  PRIKEY:        #*****************************************************#
#****************       P R I K E Y       *****************************#
#                                                                      #
#   DBI POSITION IS POSITION OF PRIMARY KEY----                        #
#   IF SIZES ARE THE SAME, KEY INDICATOR = PRIMARY KEY(CODE = 5)       #
#   IF DBI SIZE LESS, KEY INDICATOR = MAJOR PART OF PRIMARY KEY(CODE=2)#
#   IF SUBSCRIPT ON DBI IS ANY---ILLEGAL                               #
#**********************************************************************#
      IF ANYFLAG THEN 
        DIAGDL( 409 );
      IF SCRLDBISIZE[DPTR] EQ SCDCKEYSIZ[J+1] THEN
        SCRLDBIKEYTY[DPTR] = 5;    # PRIMARY KEY #
      ELSE
        SCRLDBIKEYTY[DPTR] = 2;    # MAJOR PART OF PRIMARY KEY.#
      DPTR = DPTR + 2;
      STDYES; 
  
  RELINIT:       #*****************************************************#
#****************       R E L I N I T       ***************************#
#                                                                      #
#   INITIALIZE ENTIRE RELATION SECTION.                                #
#**********************************************************************#
      IF NOT RELLDFLAG THEN  # IF NO RELATION ENTRIES SPECIFIED, CLOSE #
        GOTO ENDSCHEMA;      # FILES AND STOP PROCESSING.              #
      RELPTR = NEXTPTR;      # SET POINTER TO NEXT AVAILABLE ADDRESS   #
                             # ON THE SCHEMA DIRECTORY.                #
      SCCWRELADDR[SCCWPTR] = RELPTR;  # ADDR OF START OF RELATION ENTRY#
      DPTR = 0;              # VARIABLE POINTER FOR RELATION WORK BUFF.#
      RELCOUNT = 0;          # COUNT OF RELATION ENTRIES.              #
      STDNO;
  
  RESETPTR:      #*****************************************************#
#****************       R E S E T P T R       *************************#
#                                                                      #
#   IF A RELATION ENTRY IS IN ERROR,ALL THE POINTERS ARE RESET AND     #
#   BUFFERS ZEROED OUT IN ANTICIPATION OF A NEW ENTRY. RETURN IS TO    #
#   STDNO.                                                             #
  
#**********************************************************************#
      FOR I = 0 STEP 1 UNTIL DPTR DO   # ZERO OUT RELATION WORK        #
        SCRLWKWRD[I] = 0;              # BUFFER.                       #
      DPTR = 0; 
      RSTPTR = 0; 
      STDNO;
  
  RESTORLNNBR:   #*****************************************************#
#****************       R E S T O R L N N B R       *******************#
#                                                                      #
#   RESTORES THE CURRENT LINE NUMBER OF SOURCE INPUT RECORD.           #
#**********************************************************************#
      C<0,10>NBRLINE = C<0,10>I1; 
      STDNO;
  
  SAVDBI:        #*****************************************************#
#****************       S A V D B I       *****************************#
#                                                                      #
#   STORE DBI NAME IN ARRAY NAMES FOR CALL TO ROUTINE HASHIT.ALSO      #
#   STORE LENGTH OF NAME IN WORDS AND CHARACTERS.CHECK IF NAME LONGER  #
#   THEN 30 CHARACTERS.IF SO, ISSUE CALL TO DIAGNOSTIC ROUTINE AND     #
#   CONTINUE PROCESSING.RETURN IS TO STDNO.                            #
#**********************************************************************#
      IF CURLENG GR 30 THEN        # IF DBI NAME IS GREATER THAN 30    #
        BEGIN                      # CHARACTERS,CALL DIAGNOSTIC ROUTINE#
        CURLENG = 30;              # OF NAME TO MAXIMUM OF 30 CHARACT- #
        CURLENW = 3;               # ERS.                              #
        END 
      FOR I = 0 STEP 1 UNTIL CURLENW-1 DO   # STORE NAME FOR CALL TO   #
        NAME[I] = CURWORD[I];               # HASH ROUTINE.            #
      NAMELENC = CURLENG; 
      NAMELENW = CURLENW; 
      STDNO;
  
  SAVRELNM:      #*****************************************************#
#****************       S A V R E L N M       *************************#
#                                                                      #
#   CHECKS IF THE RELATION NAME IS UNIQUE AMONG AREA AND RELATION      #
#   NAMES. IF NOT UNIQUE,RETURN IS TO STDNO.ALSO,CHECKS TO SEE IF THE  #
#   RELATION NAME IS NOT LONGER THAN 30 CHARACTERS. IF SO,NAME IS TR-  #
#   UNCATED TO 30 CHARACTERS AND AN INFORMATION DIAGNOSTIC ISSUED.     #
#   THE RELATION NAME IS STORED IN THE RST WORK BUFFER ALONG WITH ITS  #
#   LENGTH IN CHARACTERS AND WORDS.RETURN IS TO STDYES.                #
#**********************************************************************#
      IF DUPDEFINE EQ 1 THEN       # IF NAME NOT UNIQUE(DETERMINED IN  #
        STDNO;                     # ROUTINE HASIT),RETURN.            #
      IF CURLENG GR 30 THEN        # IF NAME LONGER THAN 30 CHARS,     #
        BEGIN                      # ISSUE DIAGNOSTIC AND ADJUST LEN-  #
        DIAGDL( 401 );             # GTH TO MAXIMUM OF 30 CHARACTERS.  #
        CURLENW = 3;
        CURLENG = 30; 
        END 
      SCRELDATATYP[DPTR] = 10;     # SET DATA TYPE FOR RELATION ENTRY, #
      SCRELNAMLENW[DPTR] = CURLENW;# LENGTH OF NAME IN WORDS AND       #
      SCRELNAMLENC[DPTR] = CURLENG;# LENGTH IN CHARS, IN RST BUFFER.   #
      RSTPTR = DPTR;         # SET POINTER TO START OF RELATION ENTRY  #
      DPTR = DPTR + 2;
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO  # STORE RELATION NAME IN  #
        SCRELNAME[RSTPTR+I] = CURWORD[I];    # RST BUFFER              #
      DPTR = DPTR + RSTPTR + CURLENW;  # SET POINTER TO NEXT AVAILABLE #
                                       # WORD ADDRESS.                 #
      STDYES; 
  
  SAVRECNAM:     #*****************************************************#
#****************       S A V R E C N A M       ***********************#
#                                                                      #
#   SET UP PARAMETERS FOR RECORD NAME QUALIFIER FOR CALL TO HASH       #
#   ROUTINE. RETURN IS TO STDYES.                                      #
#                                                                      #
#**********************************************************************#
      NAMEQUAL = 1; 
      QUALFLAG = TRUE;
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO 
        QUALNAME[I] = CURWORD[I]; 
      QUALNAMELENW = CURLENW; 
      QUALNAMELENC = CURLENG; 
      SCRLDBIQUAL[DPTR+1] = TRUE;  # SUBJECT DBI IS QUALIFIED.         #
      STDYES; 
  
  SAVSUBS:       #*****************************************************#
#****************       S A V S U B S       ***************************#
#                                                                      #
#   STORES THE SUBSCRIPTS SPECIFIED FOR THE DBI IN A SUBSCRIPTS ARRAY. #
#   ALSO, CHECKS TO SEE IF THE NUMBER OF SUBSCRIPTS DOES NOT EXCEED THE#
#   MAXIMUM OF 3 ALLOWABLE SUBSCRIPTS AND SUBSCRIPT VALUES ARE GREATER #
#   THEN ZERO--RETURN STDNO. ELSE, RETURN IS TO STDYES.                #
#**********************************************************************#
      SUBSCOUNT = SUBSCOUNT + 1;   # INCREMENT COUNT OF SUBSCRIPTS.    #
      IF SUBSCOUNT GR SUBSMAX THEN # IF NUMBER OF SUBSCRIPTS EXCEEDS   #
        BEGIN                      # THE MAXIMUM ALLOWABLE NUMBER, CALL#
        RLDIAGFLG = TRUE; 
        DIAGDL( 404 );             # ROUTINE TO DIAGNOSE               #
        STDNO;
        END 
      C<0,CURLENG>DTEMP = C<0,CURLENG>CURWORD[0]; # STORE SUBSCRIPT FOR#
                                   # CALL TO CONVERSION ROUTINE.       #
      DISPDECTOBIN;                # CALL ROUTINE TO CONVERT SUBSCRIPT #
                                   # TO BINARY.VALUE RETURNED IN ITEMP #
      IF ITEMP LQ 0 THEN           # IF SUBSCRIPT VALUE IS ZERO OR LESS#
        BEGIN                      # CALL ROUTINE TO DIAGNOSE          #
        RLDIAGFLG = TRUE; 
        DIAGDL( 404 );
        STDNO;
        END 
      SUBSCRIPTS[SUBSCOUNT - 1] = ITEMP;  # STORE SUBSCRIPT IN SUBS-   #
                                          # CRIPT ARRAY.               #
    # STORE SUBSCRIPT IN RST #
      B<22+(SUBSCOUNT-1)*12,12>SCRLDBISUBS[DPTR+1] = ITEMP; 
      STDYES; 
  
  SETANY:        #*****************************************************#
#****************       S E T A N Y       *****************************#
#                                                                      #
#   A FLAG IS SET TO INDICATE THAT "ANY" IS THE SUBSCRIPT SPECIFIED    #
#   WITH THE SUBJECT DBI. IF SUBJECT DBI IS THE SOURCE DBI,ISSUE DIAG- #
#   NOSTIC,AND THE FLAG IS NOT SET. RETURN IS TO STDYES.               #
#**********************************************************************#
      IF DBIIND EQ 0 THEN    # IF SUBJECT DBI IS TO THE LEFT OF THE"EQ"#
        DIAGDL( 405 );       # OPERATOR,DIAGNOSE. ELSE                 #
      ELSE
        BEGIN 
        ANYFLAG = TRUE;      # SET FLAG TO INDICATE THAT "ANY" IS SUBS-#
        SCRLDBIANYFG[DPTR+1] = TRUE;   # SET FLAG IN RST FOR DBI.      #
        END 
                             # CRIPT FOR SUBJECT DBI.                  #
      STDYES; 
  
  SETSRCDBI:     #*****************************************************#
#****************       S E T S R C D B I       ***********************#
#                                                                      #
#   SETS A FLAG TO INDICATE THAT THE SUBJECT DATA-BASE-IDENTIFIER      #
#   IS A SOURCE DBI( TO THE LEFT OF THE "EQ"OPERATOR ).                #
#**********************************************************************#
      DBIIND = 0; 
      STDNO;
  
  SETTRGDBI:     #*****************************************************#
#****************       S E T T R G D B I       ***********************#
#                                                                      #
#   SETS A FLAG TO INDICATE THAT THE SUBJECT DATA-BASE-IDENTIFIER      #
#   IS A TARGET DBI( TO THE RIGHT OF THE EQ OPERATOR ).                #
#**********************************************************************#
      DBIIND = 1; 
      STDNO;
  
  SORTKEY:       #*****************************************************#
#****************       S O R T K E Y       ***************************#
#                                                                      #
#   IF DBI POSITION IS POSITION OF SORT KEY----                        #
#   IF SIZES ARE THE SAME, KEY INDICATOR = SORT KEY( CODE = 1).        #
#   IF SUBSCRIPT ON DBI IS ANY---ILLEGAL                               #
#**********************************************************************#
      IF ANYFLAG THEN 
        DIAGDL( 409 );
      IF SCRLDBISIZE[DPTR] EQ SCDCKEYSIZ[J+1] THEN
        SCRLDBIKEYTY[DPTR] = 1; 
      DPTR = DPTR + 2;
      STDYES; 
  
  STLINENBR:     #*****************************************************#
#****************       S T L I N E N B R       ***********************#
#                                                                      #
#   THE CURRENT SOURCE LINE NUMBER IS TEMPORARILY STORED FOR USE BY    #
#   THE DIAGNOSTIC ROUTINE DDLDIAG WHEN CALLED IN SEMANTIC ROUTINE     #
#   *DBIVALID. THIS IS DONE BECAUSE IF AT THAT POINT THE NEXT SYNTAX   #
#   ELEMENT STARTS IN THE NEXT LINE, THE DIAGNOSTIC ISSUED FROM        #
#   *DBIVALID CONTAINS THE WRONG LINE NUMBER(POINTS TO NEXT LINE).     #
#**********************************************************************#
      SRCLINENBR = NBRLINE; 
      STDNO;
  
  WRITERST:      #*****************************************************#
#****************       W R I T E R S T       *************************#
#                                                                      #
#   THE RELATION SEARCH TABLE BUILT IS WRITTEN TO THE DIRECTORY POIN-  #
#   TERS ARE ADJUSTED AND THE COUNT OF RELATION ENTRIES IS UPDATED.    #
#   RETURN IS TO STDNO.                                                #
#**********************************************************************#
      I = DPTR - RSTPTR;     # NO.OF WORDS OCCUPIED BY RST BUILT.      #
      IF I GR MAXRLENTLEN THEN
        DIAGDL( 295 );       # MAX RELATION ENTRY LENGTH EXCEEDED      #
      SCRELNEXTPTR[RSTPTR] = I;    # OFFSET POINTER TO NEXT RELATION   #
                                   # ENTRY.                            #
      SCRELMAXRANK[RSTPTR] = (DBICOUNT -2)/2 + 2;  # STORE COUNT OF    #
                             # THE NUMBER OF AREAS TRAVERSED IN THIS   #
                             # RELATION ENTRY.                         #
      SCRELORD[RSTPTR] = RELCOUNT + 1; # SET ORDINAL IN RELATION ENTRY #
      DDLRTSC( SCRLWKBUF, I, RELPTR); # WRITE RST TO SCHEMA DIRECTORY. #
    #******************************************************************#
    # CHECKSUM RELATION ENTRY JUST WRITTEN TO DIRECTORY, AFTER FIRST   #
    # ERASING AREA ENTRY WORD ADDRESSES IN DBI ENTRIES.                #
    #******************************************************************#
      IF FATALERR EQ 0 THEN                                              DL3A006
      BEGIN 
      CHECKSUM[0] = 0;                 # SET NEW CHECKSUM BASE         #
      CKSNAME[0] = " ";                # SET BLANK FILL FOR NAME       #
                                       # RELATION NAME TO CHECKSUM REC #
      CKSNAME[0] = C<0,SCRELNAMLENC[RSTPTR]> SCRELNAM30[RSTPTR];
      SCRELORD[RSTPTR] = 0;        #ERASE RELATION ORDINAL# 
      CKSPTR = RSTPTR + SCRELNAMLENW[RSTPTR] + 2; #POINT TO DBIS       #
      FOR J = CKSPTR STEP 2 UNTIL SCRELNEXTPTR[RSTPTR]-1 DO  #DBI LOOP #
        BEGIN 
        SCRLDBIARPTR[J] = 0;                     #ERASE WA-S IN DBIS   #
        SCRLWKWRD[J+1] = 0;                      #ERASE EXHIBIT WORD   #
        END 
      CKSWA = ((TOTALAREAS+RELCOUNT) * CKSRECLEN)+1;  #COMPUTE WA      #
                                       # CHECKSUM RELATION             #
      CHECKSUM[0] = CKSUM(CHECKSUM[0],LOC(SCRLWKBUF), 
                    SCRELNEXTPTR[RSTPTR]);
      SCWRCKS(CKSREC,CKSWA);           #WRITE CHECKSUM REC TO SCR FILE #
      END 
      K = RELPTR;            # WORD ADDRESS OF RST JUST WRITTEN.IF     #
                             # LAST RST, THE NEXT POINTER MUST BE RE-  #
                             # SET TO ZERO IN ROUTINE *ENDREL.         #
      RELCOUNT = RELCOUNT + 1;     # UPDATE COUNT OF RELATION ENTRIES. #
# CHECK IF NUMBER OF RELATIONS EXCEEDES THE MAXIMUM.                   #
      IF RELCOUNT EQ MAXRELNS + 1 THEN
        DIAGDL( 292 );
      RELPTR = RELPTR + I;   # WORD ADDRESS OF THE NEXT AVAILABLE LOC- #
      DPTR = 0; 
      STDNO;
  
  PROC ABORTDDL;
#**********************************************************************#
#                       A B O R T D D L                                #
#                                                                      #
#   THIS PROCEDURE CLOSES SCHEMA AND SYMBOL TABLE FILES, AND CALLS A   #
#   COMPASS ROUTINE TO CLOSE OUTPUT AND ABORT DDL WITH THE MESSAGE---  #
#   FATAL SYNTAX ERRORS.                                               #
#**********************************************************************#
    BEGIN 
      XREF PROC DDLABT; 
      DDLSU = MAXFL;                        #SET FL FOR ABORT CONDITION#
      CLSEOUT;
      CLSESC; 
      DDLABT( 0 );
    END 
  
  PROC WRCHECKSUM(COUNT); 
#**********************************************************************#
#                        W R C H E C K S U M                           #
#                                                                      #
#   WRITES THE CHECKSUM BLOCK TO THE SCHEMA DIRECTORY WORKING BUFFER.  #
#   IN CASE OF BUFFER OVERFLOW, WRITES THE CURRENT BLOCK TO THE        #
#   SCHEMA DIRECTORY AND CONTINUES WITH THE NEXT BLOCK.                #
#**********************************************************************#
    BEGIN 
      ITEM COUNT;            #COUNT OF AREAS/RELATIONS# 
      ITEM J1,K1,L1;         #SCRATCH VARIABLES#
  
      CKSFIL[0] = " ";       # BLANK FILL # 
      CKSFILL[0] = " ";      # BLANK FILL # 
      FOR J1 = 1 STEP 1 UNTIL COUNT DO
        BEGIN 
        SCRDCKS(CKSREC,CKSWA);     #READ CHECKSUM SCRATCH FILE# 
        CKSPRNM[0] = CKSNAME[0];   #30 CHARACTER AREA NAME# 
        OCT20(CHECKSUM[0],CKSPRNT,5);  #CHECKSUM VAL-20 OCTAL DIGITS# 
        DDLPRNT(CKSPRNT,70);       #PRINT CHECKSUM# 
        FOR L1 = 0 STEP 1 UNTIL CKSRECLEN-1 DO
          BEGIN              #ADD NAME + CHECKSUM TO DIRECTORY BLOCK# 
          CKSWRD[I] = CKSWORD[L1];
          I = I + 1;
          END 
        CKSWA = CKSWA + CKSRECLEN;   #INDEX TO NEXT CHECKSUM RECORD#
        IF I GQ LGSCHBF-4 THEN
          BEGIN              #NO MORE BUFFER SPACE# 
          DDLRTSC(CKSBLK,I,NEXTPTR);   #FLUSH BUFFER TO DIRECTORY#
          NEXTPTR = NEXTPTR + I;       #ADJUST DIRECTORY WA#
          I = 0;
          END 
        END 
      RETURN; 
    END          #END OF PROC#
  PROC SETBCPBWP; 
#**********************************************************************#
#                       S E T B C P B W P                              #
#                                                                      #
#   ENTRY CONDITIONS:  1) JOIN DBI PRESENT IN WORKING STORAGE AREA.    #
#                      2) DEFLTFLAG SET IF THE FOLL. CONDITIONS MET -- #
#                         A) NO SUBSCRIPTS SPECIFIED ON THE JOIN DBI + #
#                            DBI IS NOT THE MOST DOMINANT ITEM.        #
#                         B) ANY IS SUBSCRIPT ON JOIN DBI AND DBI IS   #
#                            NOT THE MOST DOMINANT ITEM.               #
#                      3) SUBSCOUNT CONTAINS THE TOTAL NUMBER OF SUB-  #
#                         SCRIPTS SPECIFIED ON JOIN DBI.               #
#                                                                      #
#   EXIT CONDITIONS:   1) IN CASE OF AN ABNORMAL TERMINATION,ERRFLAG   #
#                         SET AND RETURN.                              #
#                      2) NORMAL TERMINATION--- SET BCP + BWP + RETURN #
#                                                                      #
#   GENERAL DESCRIPTION:                                               #
#                                                                      #
#   CALCULATES THE BEGINNING CHARACTER POSITION AND THE BEGINNING WORD #
#   POSITION OF A SUBSCRIPTED DATA-BASE- IDENTIFIER. ALSO, IF THE NO.OF#
#   SUBSCRIPTS DO NOT CORRESPOND TO THE HIERARCHIAL ORDER OF DOMINANT  #
#   GROUPS OF THE DBI, AND IF THE NO. OF OCCURANCES, IF ANY, OF THESE  #
#   DOMINANT GROUPS EXCEED THE CORRESPONDING SUBSCRIPT VALUES, AN ERROR#
#   FLAG IS SET AND A RETURN IS MADE TO THE CALLING ROUTINE.           #
#**********************************************************************#
    BEGIN 
      ITEM ACCUM;        # CONTAINS THE ACCUMULATED POSITION OF A DBI  #
                         # FROM THE START OF THE RECORD, IN CHARS.     #
      ITEM DOMADR;       # CONTAINS THE WORD ADDRESS OF THE DOMINANT   #
                         # ITEM AS IT RESIDES IN THE SCHEMA DIRECTORY. #
      ITEM DOMLVLCNT;    # CONTAINS THE LEVEL OF NESTING OF A DBI.     #
      ITEM SUBSDECR;     # CONTAINS THE ACTIVE COUNT OF THE NUMBER OF  #
                         # SUBSCRIPTS DURING PROCESSING.               #
      ACCUM = 0;
      DOMLVLCNT = 1;
      ERRFLAG = FALSE;
      IF DEFLTFLAG THEN 
        BEGIN 
        SUBSDECR = 1; 
        SUBSCOUNT = 1;
        END 
      ELSE
        SUBSDECR = SUBSCOUNT; 
      DOMADR = SYMWRDADDRWK[1];    # INITIALIZE TO ADDRESS OF SUBJECT  #
                                   # DBI.                              #
  
      IF SCITMDATATYP[0] EQ 5 OR SCITMDATATYP[0] EQ 7 THEN # IF DBI    #
        BEGIN     # IS A VECTOR,THEN IF CORRESPONDING SUBSCRIPT IS GR- #
        IF SUBSCRIPTS[SUBSCOUNT-1] GR SCITMINTVAL[0] THEN  #EATER THAN #
          BEGIN   # THE OCCURS VALUE,SET                               #
          ERRFLAG = TRUE;   # ERROR FLAG AND RETURN TO CALLING         #
          RETURN;           # ROUTINE.                                 #
          END 
        ACCUM = (SUBSCRIPTS[SUBSCOUNT-1] - 1) * SCITEMSIZE[0] + 
               (SCITEMBBP[0]/6) + (SCITEMPBWP[0] * 10); 
        SUBSDECR = SUBSDECR - 1;
        SUBSCOUNT = SUBSCOUNT - 1;  # ADJUST COUNT OF SUBSCRIPTS.      #
        DOMADR = DOMADR - SCITRLDOMPTR[0];  # ADDR OF DOMINANT ITEM.   #
        DDLRDSC( SCITWKBUF, ITEMFIXW, DOMADR ); # READ IN DOMINANT ITEM#
        END 
  
      IF SCITMDATATYP[0] EQ 1 THEN  # IF DBI IS ELEMENTARY ITEM THEN   #
        BEGIN 
        ACCUM = SCITEMPBWP[0] * 10 + SCITEMBBP[0]/6;  # CALCULATE NO.  #
              # OF CHARS. TO THE IMMEDIATE DOMINANT LEVEL.             #
        DOMADR = DOMADR - SCITRLDOMPTR[0];  # ADDR OF DOMINANT ITEM.   #
        DDLRDSC( SCITWKBUF, ITEMFIXW, DOMADR ); # READ IN DOMINANT ITEM#
        END 
  
      FOR I = I WHILE SUBSDECR GR 0 DO  # LOOP THRU DOMINANT GROUPS    #
        BEGIN   # BEGIN OF LOOP # 
        IF SCITMINTVAL[0] LS SUBSCRIPTS[SUBSDECR-1] THEN # IF SUBSCRIPT#
          BEGIN   # VALUE FOR THIS LEVEL IS GREATER THAN THE MAX. NO.  #
          ERRFLAG = TRUE; # OF OCCURS SPECIFIED, SET ERROR FLAG AND    #
          RETURN;         # RETURN TO CALLING ROUTINE.                 #
          END 
        ACCUM = ACCUM + (SUBSCRIPTS[SUBSDECR-1]-1) * SCITEMSIZE[0]
                      + (SCITEMPBWP[0] * 10) + SCITEMBBP[0]/6 ; 
        IF SCITRLDOMPTR[0] NQ 0 THEN  # TEST FOR DOMINANT LEVEL COUNT- #
          DOMLVLCNT = DOMLVLCNT + 1;  # IF POSITIVE, INCREMENT COUNT.  #
        ELSE     # IF AT HIGHEST DOMINANT LEVEL, SET LOOP VARIABLE     #
          BEGIN          # AT EXIT VALUE AND TEST LOOP.                #
          SUBSDECR = 0; 
          TEST; 
          END 
        IF NOT DEFLTFLAG THEN 
          SUBSDECR = SUBSDECR - 1;
        DOMADR = DOMADR - SCITRLDOMPTR[0];   # DOMINANT ADDRESS. #
        DDLRDSC( SCITWKBUF, ITEMFIXW, DOMADR ); # READ IN DOMINANT ITEM#
        END    # END OF LOOP #
  
      IF NOT DEFLTFLAG THEN   # IF DBI HAS SUBSCRIPTS ASSOCIATED WITH  #
        BEGIN                 # IT, THEN                               #
        IF DOMLVLCNT NQ SUBSCOUNT THEN  # IF THE NUMBER OF SUBSCRIPTS  #
          BEGIN               # DO NOT MATCH THE MAXIMUM LEVEL OF NEXT-#
          ERRFLAG = TRUE;     # ING, THEN SET ERROR FLAG AND RETURN TO #
          RETURN;             # CALLING ROUTINE.                       #
          END 
        END 
      SCRLDBIBWP[DPTR] = ACCUM/10;  # STORE BEGINNING WORD POSITION. #
      SCRLDBIBCP[DPTR] = ACCUM - SCRLDBIBWP[DPTR] * 10; #STORE     #
                                          # BEGINNING CHAR. POSITION.  #
    END   # END OF PROC  #
    TERM; 
