*DECK CSSYNX                                                             E
USETEXT TSCXREF,TDLSCOM,TSCHTBL,TSCDCTB 
      PRGM DL30104;          # CONSTRAINT PROCESSOR, (1,4) OVERLAY     # E
                                                                         E
      DEF  AREA$NAME    #  4#;     # SYMBOL TABLE CODE FOR AREA        # G
      DEF  CSHDRLEN     #  1#;     # LENGTH OF CONSTRAINT HEADER       # P
      DEF  DEFINED      #  1#;     # SYMBOL TABLE FLAG - NAME          # Z
                                   # HAS BEEN DEFINED                  # N
      DEF  D170         #170#;     # DBI GR 30 CHARACTERS - TRUNCATED  # P
      DEF  D296         #296#;     # FATAL SYNTAX ERRORS               # P
      DEF  D403         #403#;     # DBI IS INVALID/UNDEFINED          # P
      DEF  D501         #501#;     # CONSTRAINT NAME NOT UNIQUE        # AE 
      DEF  D502         #502#;     # DBI NOT A PRIMARY OR ALTERNATE KEY# P
      DEF  D503         #503#;     # DBI"S DIFFER IN CHARACTERISTICS   # P
      DEF  D505         #505#;     # CYCLE DETECTED IN CONSTRAINTS     # P
      DEF  D506         #506#;     # TARGET DBI CANNOT HAVE DUPLICATES # Z
      DEF  D507         #507#;     # CONSTRAINT NAME GR 30 CHARACTERS  # P
      DEF  D508         #508#;     # DBI CANNOT DEPEND ON ITSELF       #
      DEF  ITEM$NAME    #  1#;     # SYMBOL TABLE CODE FOR DBI         # G
      DEF  REFERENCED   #  0#;     # SYMBOL TABLE FLAG - NAME HAS BEEN # G
                                   # REFERENCED                        # G
      DEF  SCCWPTR      #  0#;     # SCHEMA CONTROL WORD INDEX         # G
      DEF  SOURCE       #  0#;     # DBI IS SOURCE ITEM                # N
      DEF  TARGET       #  1#;     # DBI IS TARGET ITEM                # N
                                                                         E
      BEGIN                                                              E
                                                                         E
                                                                         Q
      BASED ARRAY CSWRKBUF [0];   # CONSTRAINT WORK BUFFER             # G
          BEGIN                                                          G
*CALL SCCSHDDCL              SCHEMA CONSTRAINT HEADER DECLARATIONS       Z
*CALL SCCSVRDCL              SCHEMA CONSTRAINT VARIABLE DECLARATIONS     Z
          END                                                            G
                                                                         S
  
      ARRAY COMWKBUF [0:6] S(1);;   # BUFFER FOR READING IN SCHEMA ENT.#
  
                                                                         Q
      BASED ARRAY CSCYCHKTBL[0];   # WORKING BUFFER FOR CYCLE DETECTION# Q
          BEGIN                                                          Q
          ITEM CSCYWORD   U(00,00,60);                                   S
          ITEM CSCYMEMWA  U(00,00,21); # MEMBER AREA WORD ADDRESS      # Q
          ITEM CSCYOWNWA  U(00,21,21); # OWNER AREA WORD ADDRESS       # Q
          ITEM CSCYDONE   B(00,58,01); # FLAG THAT CURR ENTRY IS DONE  # S
          ITEM CSCYEXPAND B(00,59,01); # FLAG TO EXPAND CURRENT ENTRY  # BG 
          ITEM CSCYFLAGS  U(00,58,02);                                   BG 
          END                                                            Q
                                                                         Q
      ARRAY [SOURCE:TARGET];       # ARRAY TO STORE DBI CHARACTERISTICS# S
           BEGIN                                                         P
           ITEM DBIWORD  U(00,00,60);                                    P
           ITEM DBIPIC   U(00,00,18);   # ITEM PICTURE INFORMATION     # P
           ITEM DBICLASS U(00,18,06);   # ITEM CLASS                   # P
           ITEM DBISIZE  U(00,24,18);   # ITEM SIZE                    # P
           END                                                           P
                                                                         E
      ITEM CSCOUNT;          # COUNT OF CONSTRAINT ENTRIES PROCESSED   # E
      ITEM CSCYPTR;          # POINTER TO LAST ENTRY IN CSCYCHKTBL     # S
      ITEM CSHDRPTR;         # POINTER TO CONSTRAINT ENTRY HEADER WORD # O
      ITEM LASTKEY B;        # TRUE WHEN NO MORE KEYS TO PROCESS IN DC # AD 
      ITEM I;                # TEMPORARY INDEX VARIABLE                # G
      ITEM J;                # TEMPORARY INDEX VARIABLE                # P
      ITEM MEMBERWA;         # MEMBER AREA WORD ADDRESS IN DATA CONTROL# O
      ITEM OWNERWA;          # OWNER AREA WORD ADDRESS IN DATA CONTROL # O
      ITEM SRCLNBR C(10);    # TEMPORARY FOR CURRENT SOURCE LINE NUMBER# AM 
                                                                         E
      SWITCH SCHJUMP         #  SEMANTIC ROUTINES SWITCH               # E
                                                                         E
             CHKDBI   ,      # CHECK THAT DBI IS VALID                 # Z
             CHKCY    ,      # CHECK FOR CYCLES, REINITIALIZE VARIABLES# E
             CLEAR    ,      # CLEAR INCOMPLETE ENTRIES                # AD 
             CSINIT   ,      # INITIATE CONSTRAINT PROCESSING          # E
             CSEND    ,      # CHAIN ENTRIES AND TERMINATE PROCESSING  # E
             SAVDBINM ,      # SAVE DBI NAME                           # E
             SAVCSNM  ,      # SAVE CONSTRAINT NAME                    # E
             SAVRECNM ,      # SAVE RECORD NAME                        # E
             SETRELTN ,      # SET FLAG - RELATION ENTRY PRESENT       # E
             SRCDBI   ,      # SET FLAG - SOURCE DBI                   # O
             STLINENBR,      # STORE SOURCE LINE NUMBER FOR DIAGNOSTIC # AM 
             TRGDBI   ;      # SET FLAG - TARGET DBI                   # P
                                                                         E
      CONTROL EJECT;                                                     H
                                                                         AS 
      PROC CHAINENTRY;                                                   AQ 
#**********************************************************************# AQ 
#         CHAIN CURRENT CONSTRAINT ENTRY INTO EXISTING CONSTRAINT      # AQ 
#         TABLE                                                        # AQ 
#     A PASS IS MADE THROUGH THE CIT SEARCHING FOR AN AREA WORD        # BG 
#     ADDRESS THAT MATCHES THE CURRENT AREA WORD ADDRESS AND THAT      # BG 
#     HAS NOT BEEN CHAINED YES (I.E. IT"S NEXT CIT POINTER IS ZERO)    # BG 
#     THEN IT IS CHAINNED ACCORDINGLY.                                 # BG 
#                                                                      # AQ 
#**********************************************************************# AQ 
                                                                         AQ 
      BEGIN                                                              AQ 
      FOR I = 0 STEP SCCSENTLEN[I] UNTIL CSHDRPTR - 1 DO                 AQ 
          BEGIN                                                          AQ 
          J = I + SCCSNAMLENW[I] + SCCSNAMPTR[I];    # PTR TO CHAIN WD # AR 
          IF SCCSMEMNXT[J+2] EQ 0                    # IF NOT CHAINED  # AQ 
             AND SCCSAREAWA[J] EQ SCCSAREAWA[DPTR]   # MATCH FOUND     # AQ 
          THEN SCCSMEMNXT[J+2] = NEXTPTR + CSHDRPTR; # CHAIN IT        # AQ 
          IF SCCSOWNNXT[J+2] EQ 0                    # IF NOT CHAINED  # AR 
             AND SCCSAREAWA[J+1] EQ SCCSAREAWA[DPTR] # MATCH FOUND     # AQ 
          THEN SCCSOWNNXT[J+2] = NEXTPTR + CSHDRPTR; # CHAIN IT        # AQ 
          END                                                            AQ 
      END                                            #END OF CHAINENTRY# AQ 
      CONTROL EJECT;                                                     AQ 
                                                                         AQ 
      PROC CHECKCYCLE;                                                   S
#**********************************************************************# S
#                CHECK FOR CYCLES                                      # S
#                                                                      # S
#     THIS PROCEDURE CHECKS FOR INVALID CYCLING IN CONSTRAINTS.        # S
#     CONSTRAINTS WHERE THE SOURCE AND TARGET DBI"S BELONG TO THE      # S
#     SAME AREA ARE NOT CONSIDERED  CYCLES AND ARE THEREFORE IGNORED.  # S
#     A PASS IS MADE THROUGH THE "CSCYCHKTBL" AND THE "EXPAND" BITS    # BH 
#     (CSCYEXPAND) ARE SET FOR ALL ENTRIES WHOSE  MEMBER AREA WORD     # BH 
#     ADDRESS (CSCYMEMWA) MATCH THE CURRENT OWNER AREA WORD ADDRESS    # BH 
#     (CSCYOWNWA). THEN A SEARCH IS MADE FOR ANOTHER ENTRY WHERE THE   # BH 
#     "EXPAND" BIT IS SET AND IT"S OWNER AREA WORD ADDRSS IS COMPAR    # BH 
#     ED AGAINST THE MEMBER AREA WORD ADDRESSES OF THE REMAINING       # BH 
#     ENTRIES. THIS IS REPEATED UNTIL ALL ENTRIES ARE SEARCHED.        # BH 
#     EACH TIME THIS IS DONE, THE "DONE" BIT (CSCYDONE) IS SET FOR     # BH 
#     THE ENTRY WHOSE OWNER AREA WORD ADDRESS IS BEING COMPARED. IF    # BH 
#     AT ANY TIME IN THE ABOVE PROCESS, BOTH THE "EXPAND" AND THE      # BH 
#     "DONE" BITS ARE SET FOR A PARTICULAR ENTRY, A CYCLE IS PRESENT   # BH 
#     AND DIAGNOSTIC 505 IS ISSUED                                     # BI 
#                                                                      # S
#**********************************************************************# S
                                                                         S
      ITEM ENDL B;           # FLAG FOR LOOP CONTROL                   # S
      ITEM K;                # DUMMY INDEX VARIABLE                    # S
                                                                         S
      BEGIN                                                              S
      IF MEMBERWA EQ OWNERWA                                             S
      THEN BEGIN                                                         AM 
           IF SCCSKEYWA[DPTR-1] EQ SCCSKEYWA[DPTR-2]  # IF SAME KEY WA # BF 
           THEN BEGIN                                 # THEN CYCLE     # BG 
                DIAGDL(D508);                         # WAS DETECTED   #
                END                                                      AM 
           SCCSSUBTYP[CSHDRPTR] = 2;   #                               # AN 
           RETURN;                                                       BF 
           END                                                           AM 
      ELSE SCCSSUBTYP[CSHDRPTR] = 1;   # INTER RECORD CONSTRAINT       # AN 
      CSCYMEMWA[CSCYPTR] = MEMBERWA;   # MEMBER AREA WORD ADDRESS      # S
      CSCYOWNWA[CSCYPTR] = OWNERWA;    # OWNER AREA WORD ADDRESS       # S
      CSCYWORD[CSCYPTR-1] = 0;                                           S
      J = CSCYPTR;                                                       S
      ENDL = FALSE;                                                      S
      FOR K = 0 WHILE NOT ENDL DO                                        S
          BEGIN                                                          S
          CSCYDONE[J] = TRUE;                    # ENTRY IS DONE       # S
          CSCYEXPAND[J] = FALSE;                                         S
          FOR I = CSCYPTR STEP 1 UNTIL 0 DO      # STEP THRU TABLE     # S
              BEGIN                              # FLAGGING ENTRIES    # S
              IF CSCYOWNWA[J] EQ CSCYMEMWA[I]    # TO BE EXPANDED      # S
              THEN BEGIN                                                 S
                   CSCYEXPAND[I] = TRUE;         # ENTRY TO BE EXPANDED# S
                   ENDL = TRUE;                                          S
                   END                                                   S
              IF CSCYEXPAND[I] AND CSCYDONE[I]   # CYCLE DETECTED      # S
              THEN BEGIN                                                 S
                   DIAGDL(D505);                 # ISSUE DIAGNOSTIC    # S
                   ENDL = TRUE;                  # TERMINATE           # S
                   TEST K;                       #          LOOP       # S
                                                                         S
                   END                                                   S
              END                                                        T
          ENDL = NOT ENDL;                                               S
#                                                                      # BH 
#     FIND NEXT ENTRY TO BE EXPANDED                                   # BH 
#          #                                                             BI 
          FOR I = CSCYPTR STEP 1 UNTIL 0 DO                              S
              BEGIN                                                      S
              IF CSCYEXPAND[I]                                           S
              THEN BEGIN                                                 S
                   J = I;                                                S
                   TEST K;                                               S
                                                                         S
                   END                                                   S
              END                                                        S
          END                                                            S
      FOR I = CSCYPTR STEP 1 UNTIL 0 DO                                  S
          CSCYFLAGS[I] = 0;                 # CLEAR FLAGS              # S
      CSCYPTR = CSCYPTR - 1;                # POINT TO NEXT ENTRY      # S
      END                                   # END OF CHECKCYCLE        # S
      CONTROL EJECT;                                                     S
                                                                         T
      PROC CHECKFL;                                                      S
#**********************************************************************# S
#                CHECK FOR FIELD LENGTH EXCEEDED                       # S
#                                                                      # S
#     IF FIELD LENGTH HAS BEEN EXCEEDED, THE RUN IS ABORTED            # S
#                                                                      # S
#**********************************************************************# S
                                                                         S
      BEGIN                                                              S
      IF (OLD65 + DPTR - CSCYPTR) GQ SYMBFWA     # FL EXCEEDED         # AN 
      THEN ABRT1;                                # ABORT RUN           # S
      END                                        # END OF CHECKFL      # S
      CONTROL EJECT;                                                     S
                                                                         BE 
#**********************************************************************# E
#                                                                      # E
#         BEGIN EXECUTION OF CONSTRAINTS PROCESSING OVERLAY            # E
#                                                                      # E
#                                                                      # E
      BEGIN                                                              E
      DDLDIAG = LOC(DIAGSTD);      # SET POINTERS NEEDED BY CTLSTD     # E
      LEXWD   = LOC(LEXWORD);      # AND CTLSCAN                       # E
      LEXICO  = LOC(LEXICON);                                            E
      SYNTBL  = LOC(SYNTBLE);                                            E
      LBLPTR  = LOC(LBLPTRS);                                            E
*IF DEF,DEBUG,1                                                          L
      TRACE   = LOC(TRACEM);                                             Z
      SWITCHVECTOR = LOC(SCHJUMP);                                       E
      DCTINIT;                     #                                   # E
      STD$START;                   # START SCANNER                     # E
      END                                                                E
                                                                         F
                                                                         F
CHKDBI:                                                                  E
              #********************************************************# E
#**********************************************************************# E
#             CHECK THAT DBI IS VALID                                  # Z
#                                                                      # F
#     THE FOLLOWING DIAGNOSTICS MAY BE ISSUED                          # Z
#             403 - DBI IS INVALID/UNDEFINED                           # Z
#             502 - DBI IS NOT A PRIMARY/ALTERNATE KEY                 # Z
#             506 - OWNER CANNOT HAVE DUPLICATES                       # Z
#                                                                      # E
      NBRLINE == SRCLNBR; 
      NAMETYPE = ITEM$NAME;                                              E
      REFDEF = REFERENCED;                                               E
      CURWORDADDR = NEXTPTR + CSHDRPTR;                                  AD 
      HASHIT;                                                            E
      IF REFSTATUS EQ 0            # IF DBI NOT DEFINED                # E
      THEN BEGIN                                                         E
           RLDIAGFLG = TRUE;                                             E
           DIAGDL(D403);           # DBI IS UNDEFINED                  # T
           SRCLNBR == NBRLINE;     # RESTORE SOURCE LINE NUMBER        #
           STDNO;                  # RETURN                            # E
           END                                                           E
      IF SYMKCONFLGWK[2]                         # CONCATENATED KEY    # O
      THEN BEGIN                                                         O
           DDLRDSC(SCDCENTRY,10,SYMWRDADDRWK[1]);     # KEY DC ENTRY   # P
           DBISIZE[DBIIND] = SCDCKEYSIZ[1];           # SIZE IN CHARS  # P
           DDLRDSC(SCWORKBUF,RECDFIXW,SCDCRCENTRYA[0]);# RECORD ENTRY  #
           SCCSKEYORD[DPTR] = SCDCKEYCNORD[2];        # KEY ORDINAL    # BG 
           SCCSAREAWA[DPTR] = SCRWITHINA1[0];         # AREA WA        # AE 
           SCCSCONKEY[DPTR] = TRUE;                   # SET CONCAT FLAG# BG 
           DDLRDSC(SCWORKBUF,AREAFIXW,SCRWITHINA1[0]); # READ AREA ENT.#
           IF SCAREACSTR[0] EQ 0                      # IF FIRST CON   # AI 
           THEN BEGIN                                 # STRAINT        # BG 
                SCAREACSTR[0] = NEXTPTR + CSHDRPTR;   # CSTR WORD ADDR # AI 
                DDLRTSC(SCWORKBUF,AREAFIXW,SCCSAREAWA[DPTR]); 
                END                                                      AI 
           IF DBIIND EQ SOURCE                        # IF SOURCE DBI  # AH 
           THEN MEMBERWA = SCCSAREAWA[DPTR];          # MEMBER AREA WA # AE 
           ELSE BEGIN                                 # IF TARGET DBI  # O
                OWNERWA = SCCSAREAWA[DPTR];           # OWNER AREA WA  # AE 
                IF SCDCKEYDUPS[1] AND NOT SCDCKEYNOT[1] # DUPLICATES   # AD 
                THEN DIAGDL(D506); # DUPS NOT ALLOWED FOR TARGET DBI   # P
                END                                                      O
           END                                                           O
      ELSE BEGIN                                                         O
           DDLRDSC(SCWORKBUF,RECDFIXW,SYMIRECPTRWK[2]);# REC DC ENTRY  #
           SCCSAREAWA[DPTR] = SCRWITHINA1[0];         # AREA WORD ADDR # AE 
           DDLRDSC(SCWORKBUF,AREAFIXW,SCRWITHINA1[0]); # AREA DC ENTRY #
           IF SCAREACSTR[0] EQ 0                      # IF FIRST CON   # AI 
           THEN BEGIN                                 # STRAINT        # AI 
                SCAREACSTR[0] = NEXTPTR + CSHDRPTR;   # CSTR WORD ADDR # AI 
                DDLRTSC(SCWORKBUF,AREAFIXW,SCCSAREAWA[DPTR]); 
                END                                                      AI 
           DDLRDSC(SCDCENTRY,SCAREADCLENG[0],SCAREADCNTLA[0]);           O
           I = SCDCALTRKYPT[0];     # OFFSET POINTER TO THE KEY ENTRY  # O
           LASTKEY = FALSE;                                              O
           FOR J = 1 STEP 1 WHILE NOT LASTKEY DO                         O
                BEGIN                                                    O
                IF SCDCKEYDNADR[I+2] EQ SYMWRDADDRWK[1] # MATCHING WA  # AK 
                   AND SCDCKEYIMBED[I+1]         # IMBEDDED KEY        # AK 
                   AND NOT SCDCKEYCONCT[I+1]     # NOT CONCATENATED    # AK 
                THEN BEGIN                                               AK 
                     SCCSKEYORD[DPTR] = J;       # KEY ORDINAL         # AK 
                     SCCSKEYWA[DPTR] = I + SCAREADCNTLA[0];              AK 
                     LASTKEY = TRUE;             # TERMINATE           # AK 
                     TEST J;                     #         LOOP        # AK 
                                                                         AK 
                     END                                                 AK 
                ELSE BEGIN                                               AL 
                     IF SCDCKEYNITM[I+1] EQ 0    # NO MORE KEYS        # BG 
                     THEN BEGIN                  # AND KEY NOT FOUND   # BG 
                          RLDIAGFLG = TRUE;      # INSERT SOURCE/TARGET# BG 
                          DIAGDL(D502);          # ISSUE DIAGNOSTIC    # BG 
                          NBRLINE == SRCLNBR; 
                          STDNO;
                                                                         BG 
                          END                                            BG 
                     ELSE I = I + SCDCKEYNITM[I+1];  # NEXT KEY        # BG 
                     END                                                 O
                END                                                      O
           DDLRDSC(SCWORKBUF,ITEMFIXW,SYMWRDADDRWK[1]); 
           DBIPIC[DBIIND]   = SCITMPICINFO[0];   # PICTURE INFORMATION # Z
           DBICLASS[DBIIND] = SCITEMCLASS[0];    # ITEM CLASS          # Z
           DBISIZE[DBIIND]  = SCITEMSIZE[0];     # ITEM SIZE           # Z
           IF DBIIND EQ SOURCE                   # IF SOURCE DBI       # P
           THEN MEMBERWA = SCCSAREAWA[DPTR];     # MEMBER AREA WA      # AI 
           ELSE BEGIN                            # IF TARGET DBI       # P
                OWNERWA = SCCSAREAWA[DPTR];      # OWNER AREA WA       # AL 
                IF SCDCKEYDUPS[I+1] AND NOT SCDCKEYNOT[I+1] #DUPLICATES# AD 
                THEN DIAGDL(D506); # DUPS NOT ALLOWED FOR TARGET DBI"S#  P
                END                                                      P
           END                                                           O
      CHAINENTRY;                      # CHAIN CURRENT AREA INTO ICT   # AR 
      DPTR = DPTR + 1;                                                   AD 
      SRCLNBR == NBRLINE;              # RESTORE SOURCE LINE NUMBER    #
      STDNO;                                                             E
                                                                         E
                                                                         E
CHKCY:                                                                   E
              #********************************************************# E
#**********************************************************************# E
#             CHECK FOR CYCLES AND REINITIALIZE VARIABLES              # E
#                                                                      # E
#     CHECK FOR CYCLES AND REINITIALIZE POINTERS AND VARIABLES BEFORE  # E
#     STARTING ON A NEW CONSTRAINT ENTRY.                              # E
#     IF CYCLING IS DETECTED, DIAGNOSTIC 505 IS ISSUED                 # E
#     IF DBI"S HAVE DIFFERENT CHARACTERISTICS, DIAGNOSTIC 503 IS ISSUED# Q
#                                                                      # E
      CHECKCYCLE;                                                        S
      CHECKFL;                                                           S
      IF DBIWORD[SOURCE] NQ DBIWORD[TARGET]                              P
      THEN DIAGDL(D503);     # DBI"S HAVE DIFFERENT CHARACTERISTICS    # P
      SCCSENTLEN[CSHDRPTR] = DPTR - CSHDRPTR + 1;     # ENTRY LENGTH   # AD 
      DBIWORD[SOURCE] = 0;             # CLEAR DBI CHARACTERISTICS     # P
      DBIWORD[TARGET] = 0;                                               P
      DPTR = DPTR + 1;                                                   AI 
      CSHDRPTR = DPTR;                 # RESET HEADER POINTER          # AL 
      STDNO;                                                             E
                                                                         AD 
                                                                         AD 
CLEAR:                                                                   AD 
               #*******************************************************# AD 
#**********************************************************************# AD 
#             CLEAR INCOMPLETE ENTRIES                                 # AD 
#                                                                      # AD 
      FOR I = CSHDRPTR STEP 1 UNTIL DPTR DO                              AD 
          SCCSTRNAME[I] = 0;                                             AD 
      MEMBERWA = 0;                                                      AD 
      OWNERWA = 0;                                                       AD 
      DPTR = CSHDRPTR;                                                   AK 
      CSCOUNT = CSCOUNT - 1;                                             AJ 
      STDNO;                                                             AD 
                                                                         E
                                                                         E
CSINIT:                                                                  E
              #********************************************************# E
#**********************************************************************# E
#             INITIALIZE CONSTRAINT SECTION                            # E
#                                                                      # E
      P<CSWRKBUF> = OLD65;         # CONSTRAINT WSA STARTS AT LWA+1    # P
      P<CSCYCHKTBL> = SYMBFWA - 1; # CYCLE CHECK TABLE                 # Q
      P<SCWORKBUF> = LOC(COMWKBUF); # SCHEMA ENTRIES WORK BUFFER       #
      CSCYPTR = 0;                 # LAST ENTRY IN CYCLE TABLE         # S
      DPTR = 0;                                                          AD 
      CSHDRPTR = 0;                # NEXT HEADER IN CSWRKBUF           # AB 
      SCCWCITWA[SCCWPTR] = NEXTPTR;# WORD ADDRESS OF FIRST CIT         # BG 
      CSCOUNT = 0;                 # NUMBER OF CONSTRAINT ENTRIES      # AI 
      DBIWORD[SOURCE] = 0;         # SOURCE DBI CHARACTERISTICS        # P
      DBIWORD[TARGET] = 0;         # TARGET DBI CHARACTERISTICS        # P
      FOR I = 0 STEP 1 UNTIL (SYMBFWA - OLD65 - 1) DO                    Y
           SCCSTRNAME[I] = 0;      # ZERO OUT AVAILABLE CORE           # Z
      STDNO;                                                             G
                                                                         E
                                                                         E
CSEND:                                                                   E
              #********************************************************# E
#**********************************************************************# E
#             TERMINATE CONSTRAINT PROCESSING                          # E
#                                                                      # E
#     TERMINATE THE PROCESSING OF THE CONSTRAINT SECTION. CONTROL      #
#     WORDS ARE UPDATED TO REFLECT CIT INFORMATION, AND OVERLAY (1,3)  #
#     IS LOADED                                                        #
#                                                                      # E
      SCCWCSNUM[SCCWPTR] = CSCOUNT;         # SET NUMBER OF CONSTRAINTS# E
      SCCWCITLEN[SCCWPTR] = DPTR;           # LENGTH OF CIT            # BH 
      DDLRTSC(CSWRKBUF,DPTR,NEXTPTR);       # WRITE CONSTRAINTS OUT    # AD 
      NEXTPTR = NEXTPTR + DPTR;                                          AD 
      LOADOVL(BASE1X, 1, 3);                # LOAD AND EXECUTE (1,3)   # BI 
                                                                         E
                                                                         E
SAVDBINM:                                                                E
              #********************************************************# E
#**********************************************************************# E
#             SAVE DBI NAME.                                           # E
#                                                                      # O
#     STORE DBI NAME IN ARRAY NAMES FOR CALL TO ROUTINE HASHIT.        # E
#     THE LENGTH OF NAME IN WORDS AND CHARACTERS IS ALSO STORED.       # E
#     IF NAME LENGTH IS GREATER THAN 30 CHARACTERS, IT IS TRUNCATED    # E
#     AND DIAGNOSTIC 170 IS ISSUED.                                    # E
#                                                                      # E
      IF CURLENG GR 30                                                   E
      THEN BEGIN                                                         E
           CURLENG = 30;           # TRUNCATE                          # E
           CURLENW = 3;            #         AND                       # E
           DIAGDL(D170);           #             ISSUE DIAGNOSTIC      # Z
           END                                                           E
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO  # STORE NAME              # E
          NAME[I] = CURWORD[I];                                          E
      NAMELENC = CURLENG;                                                E
      NAMELENW = CURLENW;                                                E
      STDNO;                                                             E
                                                                         E
                                                                         E
SAVCSNM:                                                                 E
              #********************************************************# E
#**********************************************************************# E
#             SAVE THE CONSTRAINT NAME                                 # E
#                                                                      # E
#     CHECKS IF THE CONSTRAINT NAME IS UNIQUE AMONG AREA AND RELATIONS # AD 
#     NAMES. IF NOT UNIQUE RETURN IS TO STDNO. ALSO CHECK IF THE       # E
#     CONSTRAINT NAME IS LONGER THAN 30 CHARACTERS. IF SO, THE NAME    # E
#     IS TRUNCATED TO 30 CHARACTERS AND INFORMATIVE DIAGNOSTIC IS      # P
#     ISSUED. THE CONSTRAINT NAME IS STORED IN THE CONSTRAINT ENTRY    # E
#     TABLE ALONG WITH ITS LENGTH IN CHARACTERS AND WORDS. RETURN      # E
#     IS TO STDYES.                                                    # E
#                                                                      # E
      CSCOUNT = CSCOUNT + 1;           # INCR NUMBER OF CONSTRAINTS    # AJ 
      NAMETYPE = AREA$NAME;            # SET TYPE TO AREA              # G
      REFDEF = DEFINED;                # INDICATOR IS DEFINITION       # E
      CURWORDADDR = NEXTPTR + DPTR;    # ADDRESS OF CONSTRAINT ENTRY   # AD 
                                       # IN SCHEMA DIRECTORY - STORED  # E
                                       # IN SYMBOL TABLE.              # E
      NAMELENC = CURLENG;              # LENGTH OF NAME IN CHARACTERS  # E
      NAMELENW = CURLENW;              # LENGTH OF NAME IN WORDS       # E
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO # STORE NAME FOR CALL TO   # E
           NAME[I] = CURWORD[I];       # HASHIT                        # Z
      HASHIT;                          # HASH NAME                     # Z
      IF DUPDEFINE EQ 1                # IF NAME NOT UNIQUE            # E
      THEN DIAGDL(D501);                                                 AD 
      IF CURLENG GR 30                 # IF NAME LONGER THAN 30 CHARS  # E
      THEN BEGIN                                                         E
           DIAGDL(D507);               # CONSTRAINT NAME GR 30 CHARS   # T
           CURLENW = 3;                # ADJUST LENGTH TO 30 CHARACTERS# E
           CURLENG = 30;                                                 E
           END                                                           E
      SCCSDATATYP[CSHDRPTR] = 11;      # DATA TYPE FOR CONSTRAINTS     # O
      SCCSNAMLENW[CSHDRPTR] = CURLENW; # LENGTH OF NAME IN WORDS       # O
      SCCSNAMLENC[CSHDRPTR] = CURLENG; # LENGTH OF NAME IN CHARACTERS  # O
      SCCSCITORD[CSHDRPTR]  = CSCOUNT; # CONSTRAINT ORDINAL NUMBER     # BH 
      DPTR = CSHDRPTR + CSHDRLEN;                                        AD 
      SCCSNAMPTR[CSHDRPTR] = DPTR - CSHDRPTR; # POINTER TO NAME        # AD 
      FOR I = 0 STEP 1 UNTIL CURLENW-1 DO     # STORE CONSTRAINT NAME  # BI 
           SCCSTRNAME[DPTR+I] = CURWORD[I];                              AD 
      DPTR = DPTR + CURLENW;                                             AD 
      STDNO;                                                             AD 
                                                                         E
                                                                         E
SAVRECNM:                                                                E
              #********************************************************# E
#**********************************************************************# E
#             SAVE RECORD NAME                                         # E
#                                                                      # F
#     AND SET UP PARAMETERS FOR RECORD NAME QUALIFIER FOR CALL         # E
#     TO HASH ROUTINE.                                                 # E
#     RETURN IS TO STDNO.                                              # E
#                                                                      # E
      NAMEQUAL = 1;                                                      E
      FOR I = 0 STEP 1 UNTIL CURLENW - 1 DO                              E
          QUALNAME[I] = CURWORD[I];                                      E
      QUALNAMELENW = CURLENW;                                            E
      QUALNAMELENC = CURLENG;                                            G
      STDNO;                                                             E
                                                                         E
                                                                         E
SETRELTN:                                                                E
              #********************************************************# E
#**********************************************************************# E
#             SET FLAG - RELATION ENTRIES PRESENT                      # E
#                                                                      # E
      RELLDFLAG = TRUE;                                                  E
      STDNO;                                                             G
                                                                         E
                                                                         E
SRCDBI:                                                                  E
              #********************************************************# E
#**********************************************************************# E
#         SET FLAG INDICATING SOURCE DBI                               # O
#                                                                      # O
#     DBIIND IS SET TO INDICATE THAT THIS IS MEMBER DBI                # O
#                                                                      # E
      DBIIND = SOURCE;                                                   N
      STDNO;                                                             E
                                                                         AM 
                                                                         AM 
STLINENBR:                                                               AM 
              #********************************************************# AM 
#**********************************************************************# AM 
#             STORE SOURCE LINE NUMBER                                 # AM 
#                                                                      # AM 
#     THE CURRENT SOURCE LINE NUMBER IS TEMPORARILY STORED FOR USE     # AM 
#     BY THE DIAGNOSTIC ROUTINE *DIAGDL* WHEN CALLED FROM SEMANTIC     # AM 
#     ROUTINE *CHKDBI*. THIS AVOIDS GETTING NEXT LINE NUMBER IF A      # AM 
#     DIAGNOSTIC IS ISSUED                                             # AM 
#                                                                      # AM 
       SRCLNBR = NBRLINE;                                                AM 
       STDNO;                                                            AM 
                                                                         E
                                                                         E
TRGDBI:                                                                  E
              #********************************************************# E
#**********************************************************************# E
#         SET FLAG INDICATING TARGET DBI                               # O
#                                                                      # O
#     DBIIND IS SET TO INDICATE THAT THIS IS OWNER DBI                 # O
#                                                                      # E
      DBIIND = TARGET;                                                   N
      STDNO;                                                             E
                                                                         E
      END                                                                E
      TERM                                                               E
