*DECK DB$CPRO 
USETEXT CDCSCTX 
      PROC DB$CPRO((CAORD),(FC),(OLDREC),(NEWREC)); 
      BEGIN 
 #
* *   DB$CPRO -- CONSTRAINTS PROCESSOR           PAGE  1
* *   W.P. CEAGLIO                               DATE  11/09/78 
* *   BOB MCALLESTER                             DATE  02/29/84 
* * 
* 
* DC  PURPOSE 
* 
*     VERIFIES THAT DEFINED DATA INTEGRITY CONSTRAINTS FOR A FILE ARE 
*     NOT VIOLATED AS A RESULT OF PERFORMING THE SPECIFIED FUNCTION 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*     NOTES ON PARAMETERS IN THE CALL 
* 
*     - CAORD IS VALUE RECORDED IN THE RSB (RSFCAORD) 
* 
*     - FC IS VALUE RECORDED IN THE RCB 
* 
*     - OLDREC IS UNDEFINED FOR A WRITE FUNCTION
* 
*     - NEWREC IS UNDEFINED FOR A DELETE FUNCTION 
* 
# 
      ITEM CAORD   I;              # ORDINAL OF AREA BEING UPDATED     #
      ITEM FC      I;              # FUNCTION CODE                     #
      ITEM OLDREC  I;              # LOC OF OLD (OR UNMODIFIED) RECORD #
      ITEM NEWREC  I;              # LOC OF NEW (OR MODIFIED) RECORD   #
# 
*     ASSUMPTIONS 
* 
* 
*     P<RSB>        POINTER SET ON ENTRY
*     P<CSFIXED>    POINTER SET ON ENTRY
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   -- CONTROL IS RETURNED TO THE I/O SYMBIONT.  FOLLOWING 
*                 POINTERS ARE RESET TO THE VALUES ON ENTRY TO THIS 
*                 PROCEDURE-- 
* 
*                   P<RSARBLK>
*                   P<CSAREBLK> 
*                   P<OFT>
*                   P<UFT>
*                   P<FKL>
*                   P<FPT>
* 
*     ABNORMAL -- DB$ERR IS CALLED TO ISSUE AN ERROR (CONTROL IS NOT
*                 RETURNED TO THE I/O SYMBIONT) 
* 
* DC  CALLING ROUTINES
* 
*     I/O UPDATE SYMBIONTS
* 
*       DB$DEL$ -- DELETE 
*       DB$REW$ -- REWRITE
*       DB$WR2$ -- WRITE
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ERR;            # ERROR PROCESSOR                   #
      XREF PROC DB$FKLA;           # ALLOCATE SPACE IN THE FKL         #
      XREF PROC DB$FLOP;           # GENERATE FLOW POINT               #
      XREF PROC DB$FSIO;           # SELECT AND SET A FIT              #
      XREF PROC DB$FTDX;           # CRM -EOI- PROCESSOR               #
      XREF PROC DB$FTEX;           # CRM ERROR PROCESSOR               #
      XREF ITEM DB$FTSM B;         # DB$FTEX SWITCH TO SUPPRESS MSG    #
      XREF PROC DB$MBA;            # ALLOCATE AUTOMATIC CMM BLOCK      #
      XREF PROC DB$MBF;            # RELEASE AUTOMATIC CMM BLOCK       #
      XREF FUNC DB$NEED;           # COMPUTE ADDITIONAL UFT NEEDS      #
      XREF PROC DB$POP;            # RESTORE ITEM FROM RCB PUSH-DOWN ST#
      XREF PROC DB$POP2;           # RESTORE TWO ITEMS FROM RCB STACK  #
      XREF PROC DB$POP3;           # RESTORE THREE ITEMS FROM RCB STACK#
      XREF PROC DB$PSH2;           # SAVE TWO ITEMS IN RCB STACK       #
      XREF PROC DB$PSH3;           # SAVE THREE ITEMS IN RCB STACK     #
      XREF PROC DB$PUNT;           # CDCS INTERNAL ERROR               #
      XREF PROC DB$PUSH;           # SAVE AN ITEM IN RCB PUSH-DOWN STK #
      XREF ITEM DB$RA0;            # PARAMETER TERMINATOR              #
# 
* 
*     INTERNAL PROCS/FUNCS
* 
*     PROC CSPTERC      SUB-PROCESSOR FOR INTER-RECORD CONSTRAINT 
* 
*     PROC CSPTRAC      SUB-PROCESSOR FOR INTRA-RECORD CONSTRAINT 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<RSARBLK>    POINTS TO A BASIC OR EXTENDED AREA CONTROL BLOCK
*     P<CSAREBLK>   POINTS TO A BASIC OR EXTENDED AREA WORK BLOCK 
*     P<CSAKEYTB>   POINTS TO KEY TABLE FOR BASIC OR EXTEND AREA
* 
* 
* DC  DESCRIPTION 
* 
*     - CONSTRAINT TERMS MUST BE PRIMARY OR ALTERNATE KEYS. 
* 
*     - THE AREA CONTROL (RSB) AND WORK (CST) BLOCK POINTERS ARE SETUP. 
*       THE ENTIRE CONSTRAINT DEPENDENCY LIST IS PROCESSED SEQUENTIALLY.
*       FOR EACH CONSTRAINT TYPE, A PARTICULAR SUB-PROCESSOR IS CALLED, 
*       I.E, THERE IS A SEPARATE SUB-PROCESSOR FOR INTER-RECORD AND 
*       INTRA-RECORD CONSTRAINT TYPES.  THE SUB-PROCESSOR DETERMINES
*       WHETHER A FILE ACCESS IS REQUIRED OR NOT BASED ON THE FUNCTION
*       BEING PERFORMED AND THE NATURE OF THE DEPENDENCY. 
* 
*     - IF A FILE ACCESS IS REQUIRED, THE APPROPRIATE ENTRY IN THE
*       EXTENDED AREA CONTROL BLOCK IS SETUP.  IF THE FILE INVOLVED IS
*       NOT ALREADY OPEN (FPT POINTER IS ZERO), AN FPT IS ALLOCATED AND 
*       INITIALIZED USING INFORMATION FROM THE CORRESPONDING OFT ENTRY. 
*       PRIOR TO THE ACCESS, THE NECESSARY FIT FIELDS (RKW,RKP,KA,KP,KL)
*       ARE COMPLETED.  THE ACCESS WILL ALWAYS BE RANDOM ON THE BASIS 
*       OF PRIMARY OR ALTERNATE KEY.  IF ALTERNATE, THE INDEX ONLY FLAG 
*       IN THE FIT IS SET.  THIS IS DONE BECAUSE THE RC (RECORD COUNT)
*       FIELD IN THE FIT, WHICH IS SET ON A SUCCESSFUL INDEX-ONLY TYPE
*       RETRIEVAL, IS USED LATER IN EVALUATING THE STATUS OF THE ACCESS.
* 
*     - AFTER ANY FILE ACCESS, THE CONSTRAINT STATUS IS SET ACCORDING 
*       TO THE FUNCTION AND THE RESULT OF THE ACCESS.  IF EITHER A
*       CONSTRAINT VIOLATION OR A CRM I/O ERROR OCCURRED, THE ERROR 
*       PROCESSOR IS CALLED TO ISSUE A DIAGNOSTIC--IN THIS CASE CONTROL 
*       IS NOT RETURNED TO THE CALLING SYMBIONT.
* 
*     - ALL PROCESSING OF CONSTRAINTS MUST BE COMPLETED WITHOUT 
*       INTERRUPTION. 
*       IF AN INTERRUPTION DOES OCCUR, IT INVALIDATES ALL CONSTRAINT
*       PROCESSING THAT HAS BEEN DONE TO THAT POINT.
*       IF A CONSTRAINT IS DEPENDENT ON A RECORD THAT HAS BEEN UPDATED
*       AS PART OF AN UNCOMMITTED TRANSACTION, CONSTRAINT PROCESSING IS 
*       DELAYED UNTIL THE TRANSACTION HAS BEEN COMMITTED (OR DROPPED) 
*       AND THEN ALL CONSTRAINT PROCESSING IS REPEATED FROM THE 
*       BEGINNING.
*       THE RECORD LOCKING MECHANISM IS USED TO RECOGNIZE THE SITUATION 
*       AND TO PROVIDE THE DELAY. 
 #
  
  
  
  
#     THE FOLLOWING COMDECKS ARE USED--                                #
  
#       CDCSCOMMN       CDCS COMMON                                    #
#       CSTARDCLS       CST AREA DECLARATIONS                          #
  
      CONTROL NOLIST; 
*CALL CSTARDCLS 
      CONTROL LIST; 
  
#     LOCAL ITEMS AND DEFS                                             #
  
      ITEM AC      I;              # ACCESS CHECK CONSTANT (0 OR 1)    #
      ITEM ALTPTR  I;              # VALUE FOR RSARALT                 #
      ITEM AOFFSET I;              # OFFSET IN RSB TO AREA CONTROL BLK #
      ITEM AORDX   I;              # CURRENT EXTENDED AREA ORDINAL     #
      ITEM ARID    I;              # SAVE AREA ID NUMBER               #
      ITEM CONSTAT I;              # STATUS OF CONSTRAINT CHECK        #
      ITEM I       I;              # SCRATCH -- USED FOR LOOPS         #
      ITEM I2      I;              # SCRATCH -- USED FOR LOOPS         #
      ITEM IOBUF   I;              # BUFFER LOCATION FOR FILE ACCESS   #
      ITEM KBCP    I;              # KEY BEGINNING CHARACTER POSITION  #
      ITEM KBWP    I;              # KEY BEGINNING WORD POSITION       #
      ITEM KEYA    I;              # KEY ADDRESS                       #
      ITEM KORDB   I;              # CURRENT BASIC KEY ORDINAL         #
      ITEM KORDX   I;              # CURRENT EXTENDED KEY ORDINAL      #
      ITEM NEED    I;              # NUMBER OF NEW UFT'S NEEDED        #
      ITEM ND      I;              # NUMBER ENTRIES IN DEPENDENCY LIST #
      ITEM NDXFLAG B;              # THE ACCESSES ARE INDEX FILE ONLY  #
      ITEM OFTLOC  I;              # SAVE LOCATION OF MAIN OFT         #
      ITEM SAVEARB I;              # SAVE RSB AREA CONTROL BLOCK PTR   #
      ITEM SAVEOFF I;              # SAVE OFFSET IN RSB TO AREA CT BLK #
      ITEM SINK    I;              # A SINK FOR GETKINFO PARAMETERS    #
      ITEM SUBTYP  I;              # USED FOR SIMULATED CASE PROCESSING#
  
      BASED ARRAY FIT;;            # DUMMY FIT FOR FILE ACCESSING      #
  
  
      DEF DFCONOK #0#;             # STATUS FOR NO CONSTRAINT VIOLATION#
      DEF DFCONFL #1#;             # STATUS FOR CONSTRAINT VIOLATION   #
      DEF DFCONER #2#;             # STATUS FOR CONSTRAINT I/O ERROR   #
      DEF DFCONFT #3#;             # OUTSTANDING FATAL ERROR           #
      DEF DFCONDW #4#;             # STATUS FOR CONSTRAINT AREA DOWN  # 
      DEF DFRCZERO #0#;            # ACCESS CONSTRAINT = 0             #
      DEF DFRCONE #1#;             # ACCESS CONSTRAINT = 1             #
      DEF DFAKERR #O"445"#;        # AAM ERROR CODE FOR NO ALT KEY     #
      DEF DFPKERR #O"506"#;        # AAM ERROR CODE FOR NO PRIME KEY   #
      DEF CASE #GOTO#;             # SIMULATED CASE DEFINITION         #
      DEF OF # #;                  # PART OF SIMULATED CASE DEFINITION #
  
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   G E T K I N F O .      #
#                                                                      #
#**********************************************************************#
  
  
      PROC GETKINFO((AORD),(KORD),KBWP,KBCP,KLEN,KTYP); 
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   GETKINFO - EXTRACT KEY ATTRIBUTES 
* *   W.P. CEAGLIO                               DATE  11/09/78 
* 
* DC  PURPOSE 
* 
*     THIS PROCEDURE EXTRACTS INFORMATION FOR A SPECIFIED KEY FROM THE
*     AREA KEY TABLE FOR A SPECIFIED AREA 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
# 
      ITEM AORD    I;              # CONTAINS AREA ORDINAL             #
      ITEM KORD    I;              # CONTAINS KEY ORDINAL              #
      ITEM KBWP    I;              # CONTAINS BEG WORD OF KEY (OUTPUT) #
      ITEM KBCP    I;              # CONTAINS BEG CHAR OF KEY (OUTPUT) #
      ITEM KLEN    I;              # CONTAINS KEY LENGTH (OUTPUT)      #
      ITEM KTYP    I;              # CONTAINS KEY TYPE (OUTPUT)        #
# 
* 
*     ASSUMPTIONS 
* 
*     CELLS IN CDCSCOMMN
* 
*         P<RSB>        POINTER ASSUMED SET ON ENTRY
*         P<CSFIXED>    POINTER ASSUMED SET ON ENTRY
* 
* DC  EXIT CONDITIONS 
* 
*     KBWP          KEY BEGINNING WORD POSITION 
*     KBCP          KEY BEGINNING CHARACTER POSITION
*     KLEN          KEY LENGTH (CHARACTERS) 
*     KTYP          KEY TYPE
* 
* DC  CALLING ROUTINES
* 
*     COMPKEY                COMPARE CONSTRAINT ITEMS 
*     DB$CPRO                CONSTRAINT PROCESSOR - MAIN ROUTINE
* 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<RSARBLK>
*     P<CSAREBLK> 
*     P<CSAKEYTB> 
* 
* DC  DESCRIPTION 
* 
*     THE AREA KEY TABLE IS LOCATED IN THE CST.  THE APPROPRIATE ENTRY
*     IN THE TABLE IS POINTED TO BY USING THE AREA ORDINAL TO LOCATE
*     THE AREA CONTROL BLOCK IN THE RSB AND FROM THAT TO POINT TO THE 
*     CORRESPONDING CST WORK BLOCK ENTRY.  THE KEY TABLE OFFSET AND THE 
*     KEY ORDINAL ARE THEN USED TO POINT TO THE KEY ENTRY, FROM WHICH 
*     THE ATTRIBUTES ARE EXTRACTED. 
* 
 #
  
  
  
#     B E G I N   G E T K I N F O   E X E C U T A B L E   C O D E .    #
  
  
      P<RSARBLK> = LOC(RSB) + DFRSBFIX + (AORD - 1)*DFARECON; 
      P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP [0];
      P<CSAKEYTB> = LOC(CSAREBLK) + CSAKEYPT [0] + (KORD - 1)*DFAREKEY; 
      KBWP = CSAKBWP [0]; 
      KBCP = CSAKBCP [0]; 
      KLEN = CSAKLENC [0];
      KTYP = CSAKTYPE [0];
      RETURN; 
      END  #GETKINFO# 
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   F U N C T I O N   -   C O M P K E Y .          #
#                                                                      #
#**********************************************************************#
  
  
      FUNC COMPKEY((AORDA),(KORDA),(RECA),(AORDB),(KORDB),(RECB)) I;
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   COMPKEY - COMPARE CONSTRAINT ITEMS
* *   W.P. CEAGLIO                               DATE  11/15/78 
* 
* DC  PURPOSE 
* 
*     COMPARE THE CONSTRAINT ITEMS IN THE SPECIFIED RECORDS AND SET 
*     RESULT (EQUAL OR NOT EQUAL) 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
# 
      ITEM  AORDA  I;              # ORDINAL OF FIRST AREA             #
      ITEM  KORDA  I;              # ORDINAL OF FIRST KEY              #
      ITEM RECA    I;              # LOCATION OF FIRST RECORD          #
      ITEM  AORDB  I;              # ORDINAL OF SECOND AREA            #
      ITEM  KORDB  I;              # ORDINAL OF SECOND KEY             #
      ITEM RECB    I;              # LOCATION OF SECOND RECORD         #
# 
* 
*     ASSUMPTIONS 
* 
*     P<RSB>        POINTER ASSUMED SET 
*     P<CSFIXED>    POINTER ASSUMED SET 
* 
* DC  EXIT CONDITIONS 
* 
*     COMPKEY 
* 
*       0       ITEMS EQUAL 
*       1       ITEMS NOT EQUAL 
* 
* DC  CALLING ROUTINES
* 
*     INTERNAL PROCS/FUNCS
* 
*     PROC CSPTERC      SUB-PROCESSOR FOR INTER-RECORD CONSTRAINT 
* 
*     PROC CSPTRAC      SUB-PROCESSOR FOR INTRA-RECORD CONSTRAINT 
* 
* DC  CALLED ROUTINES 
* 
*     INTERNAL PROCS/FUNCS
* 
*     GETKINFO - EXTRACT KEY ATTRIBUTES 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     THE KEY ATTRIBUTES FOR EACH ITEM ARE OBTAINED BY CALLING THE
*     PROCEDURE GETKINFO.  THEN THE LOCATION OF THE ITEMS WITHIN THEIR
*     RESPECTIVE RECORDS ARE SETUP FOR THE COMPARISON.  THE ITEMS ARE 
*     COMPARED CHARACTER BY CHARACTER AND THE RESULT SET ACCORDINGLY. 
* 
 #
  
#     LOCAL ITEMS AND ARRAYS                                           #
  
      ITEM KBWPA   I;              # KEY WORD POSITION IN 1ST RECORD   #
      ITEM KBCPA   I;              # KEY CHAR POSITION IN 1ST RECORD   #
      ITEM KLENA   I;              # KEY LENGTH (CHARS) IN 1ST RECORD  #
      ITEM KTYPA   I;              # KEY TYPE IN 1ST RECORD            #
      ITEM KBWPB   I;              # KEY WORD POSITION IN 2ND RECORD   #
      ITEM KBCPB   I;              # KEY CHAR POSITION IN 2ND RECORD   #
      ITEM KLENB   I;              # KEY LENGTH (CHARS) IN 2ND RECORD  #
      ITEM KTYPB   I;              # KEY TYPE IN 2ND RECORD            #
  
      BASED ARRAY KEYLOCA;         # BASE FOR KEY WITHIN RECORD        #
        BEGIN 
        ITEM KVLA  C(0,0,240);     # RECORD KEY                        #
        END 
  
      BASED ARRAY KEYLOCB;         # BASE FOR KEY WITHIN RECORD        #
        BEGIN 
        ITEM KVLB  C(0,0,240);     # RECORD KEY                        #
        END 
  
  
  
#     B E G I N   C O M P K E Y   E X E C U T A B L E   C O D E .      #
  
  
  
#     GET KEY ATTRIBUTES FOR CONSTRAINT ITEMS AND SETUP FOR COMPARE    #
  
      GETKINFO(AORDA,KORDA,KBWPA,KBCPA,KLENA,KTYPA);
      GETKINFO(AORDB,KORDB,KBWPB,KBCPB,KLENB,KTYPB);
  
#     PERFORM COMPARISON AND RECORD RESULT                             #
  
      P<KEYLOCA> = RECA + KBWPA;
      P<KEYLOCB> = RECB + KBWPB;
      IF KLENA EQ KLENB 
        AND KTYPA EQ KTYPB
      THEN
        BEGIN 
        IF C<KBCPA,KLENA>KVLA EQ C<KBCPB,KLENB>KVLB 
        THEN
          BEGIN 
          COMPKEY = 0;
          END 
        ELSE
          BEGIN 
          COMPKEY = 1;
          END 
        END 
  
      ELSE
        BEGIN 
        COMPKEY = 1;
        END 
  
      RETURN; 
      END  #COMPKEY#
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   G E T L O C K .        #
#                                                                      #
#**********************************************************************#
  
  
      PROC GETLOCK; 
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   GETLOCK - GET A RECORD LOCK 
* *   BOB MCALLESTER                             DATE  02/13/84 
* 
* DC  PURPOSE 
* 
*     TO DO THE REQUIRED PROCESSING TO GET A RECORD LOCK. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     P<RSARBLK> IS SET.
* 
*     FOR ALTERNATE KEY PROCESSING -
*     P<FIT> DEFINES A FIT THAT IS READY TO PERFORM A GET AN ALTERNATE
*     KEY INDEX RECORD. 
* 
*     FOR PRIMARY KEY PROCESSING -
*     UFFITKA CONTAINS THE PRIMARY KEY ADDRESS. 
*     UFFITKP CONTAINS THE PRIMARY KEY BEGINNING CHARACTER POSITION.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL - THE SPECIFIED RECORD IS LOCKED.
* 
*     IF THE LOCK IS NOT IMMEDIATELY AVAILABLE, 
*       GO TO "RESTART" AND REPROCESS ALL CONSTRAINT ENTRIES. 
* 
* DC  CALLING ROUTINES
* 
*     ACCESSCK               ACCESS CONSTRAINT FILE TO CHECK CONSTRAINT 
*     LOKOLDO                LOCK OLD OWNER RECORD
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$LOK;            # SET A RECORD LOCK                 #
      XREF PROC GET;               # CALL CRM TO GET A RECORD          #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
* 
* 
* DC  DESCRIPTION 
* 
*     IF THE KEY OF ACCESS IS AN ALTERNATE KEY, GET THE INDEX RECORD. 
*     IT CONTAINS THE PRIMARY KEY.
*     IF THE KEY OF ACCESS IS THE PRIMARY KEY, MOVE THAT KEY VALUE
*     TO THE I-O BUFFER.
*     IN EITHER CASE THE PRIMARY KEY VALUE IS LEFT JUSTIFIED AT IOBUF.
*     REQUEST THE RECORD LOCK.
* 
*     IF THE RECORD IS LOCKED, THE REQUEST WILL BE DELAYED UNTIL THE
*     LOCK IS RELEASED, THEN DB$LOK RETURNS WITH LOKSTATUS = FALSE. 
*     THIS INDICATES THAT AN INTERRUPTION HAS OCCURRED AND THE
*     VALIDITY OF ANY CONSTRAINTS ALREADY PROCESSED CAN NO LONGER 
*     ASSUMED.
*     IT IS ALSO NECESSARY TO RESTORE THE VALUES OF ALL LOCAL VARIABLES 
*     THAT WERE IN USE. 
*     IT IS NECESSARY TO RESTART THE CONSTRAINT PROCESSING FROM THE 
*     BEGINNING.
* 
*     IF THE REQUESTING JOB IS A TIME CRITICAL JOB SUCH AS 'TAF', 
*     DB$LOK WILL EXIT VIA DB$ERR IF THE RECORD IS FOUND LOCKED.
* 
*     IN EACH INSTANCE OF ITS USE, GETLOCK IS LOCKING AN OWNER RECORD.
 #
  
#     LOCAL VARIABLES.                                                 #
  
      BASED ARRAY SOURCE;          # SOURCE ARRAY FOR STRING MOVE      #
        ITEM SSTRING C(00,00,240);
  
      BASED ARRAY TARGET;          # TARGET ARRAY FOR STRING MOVE      #
        ITEM TSTRING C(00,00,240);
  
  
  
#     B E G I N   G E T L O C K   E X E C U T A B L E   C O D E .      #
  
      IF NDXFLAG
      THEN
        BEGIN 
        UFFITNDX[0] = TRUE; 
        GET(FIT, DB$RA0);          # GET THE INDEX RECORD              #
        UFFITNDX[0] = FALSE;
        IF UFFITES NQ 0 
        THEN                       # RETURN I/O ERROR                  #
          BEGIN 
          FPFITES[0] = UFFITES[0];
          CONSTAT = DFCONER;
          RETURN; 
  
          END 
        END 
      ELSE
        BEGIN                      # MOVE THE PRIMARY KEY TO THE IOBUF #
        P<TARGET> = IOBUF;
        P<SOURCE> = UFFITKA[0]; 
        C<0,UFFITKL[0]>TSTRING[0] = C<UFFITKP[0],UFFITKL[0]>SSTRING[0]; 
        END 
  
      DB$PUSH(OFTLOC);
      DB$LOK(IOBUF, 0, TRUE);      # LOCK THE SPECIFIED RECORD         #
      DB$POP(OFTLOC); 
  
      IF NOT LOKSTATUS
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("CPRO-RS"); 
        CONTROL ENDIF;
  
        DB$POP2(SAVEOFF, NEWREC); 
        DB$POP3(OLDREC, FC, CAORD); 
        GOTO RESTART; 
  
        END 
      END   #GETLOCK# 
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   O P E N I F            #
#                                                                      #
#**********************************************************************#
  
  
      PROC OPENIF;
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   OPENIF - OPEN FILE IF NOT ALEADY OPEN 
* *   BOB MCALLESTER                             DATE  02/15/84 
* 
* DC  PURPOSE 
* 
*     OPEN THE AREA IF IT IS NOT ALREADY OPEN.
*     INITIALIZE THE FIT. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     AORDX        CONTAINS CURRENT EXTENDED AREA ORDINAL.
*     IOBUF        CONTAINS ADDRESS OF CONSTRAINTS I/O BUFFER 
*     P<RSB>       ASSUMED SET ON ENTRY 
*     P<CSFIXED>   ASSUMED SET ON ENTRY 
* 
* DC  EXIT CONDITIONS 
* 
*     P<FIT> POINTS TO THE OPEN FILE FIT. 
* 
* DC  CALLING ROUTINES
* 
*     ACCESSCK               ACCESS CONSTRAINT FILE.
*     LOKOLDO                LOCK OLD OWNER RECORD
* 
* DC  CALLED ROUTINES 
* 
# 
      XREF PROC DB$DPIF;           # DATA BASE PROCEDURE INTERFACE     #
      XREF FUNC DB$LNK;            # ALLOCATE AND LINK CMM BLOCK       #
      XREF PROC DB$OPNM;           # INTERFACE TO CRM OPEN FUNCTION    #
# 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<RSARBLK>
*     P<CSAREBLK> 
*     P<OFT>
*     P<UFT>
*     P<FKL>
*     P<FPT>
* 
* DC  DESCRIPTION 
* 
*     - THE APPROPRIATE ENTRIES IN THE EXTENDED AREA SEGMENTS OF THE
*       RSB AND THE CST ARE SETUP, AND THE ENTRY IN THE AREA KEY TABLE
*       IS ESTABLISHED. 
* 
*     - IF THE FILE IS NOT ALREADY OPENED (RSARFPT = 0), THEN AN FPT IS 
*       ALLOCATED AND INITIALIZED USING INFORMATION IN THE OFT ENTRY
*       FOR THIS FILE.  IN ADDITION, OTHER FIT FIELDS (ADDRESSES OF THE 
*       HASHING AND COMPRESSION/DECOMPRESSION ROUTINES) ARE SETUP IF
*       NECESSARY.  FINALLY, CRM IS CALLED TO OPEN THE FILE.
 #
  
  
#     LOCAL ITEMS AND ARRAYS                                           #
  
      ITEM INDX    I;              # SCRATCH -- FOR LOOPS              #
  
  
  
  
  
#     B E G I N   O P E N I F   E X E C U T A B L E   C O D E .        #
  
  
#     SET CST AREA BLOCK POINTER.                                      #
  
      P<RSARBLK> = LOC(RSB) + DFRSBFIX + (AORDX - 1)*DFARECON;
      P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP [0];
  
#----------------------------------------------------------------------#
#                                                                      #
#     OPEN FILE IF REQUIRED.  IF THE CORRESPONDING OFT ENTRY INDICATES #
#     THE AREA IS "DOWN", THEN RETURN AN I/O ERROR  OTHERWISE, ALLOCATE#
#     A FPT AND INITIALIZE IT.  LOAD ANY REQUIRED HASH AND COMPRESSION/#
#     DECOMPRESSION ROUTINES BEFORE CALLING CRM TO OPEN THE FILE.      #
#                                                                      #
#----------------------------------------------------------------------#
      OFTLOC = RCOFTLOC[0]; 
      P<OFT> = RSAROFIT [0];
      IF OFSTATUS[0] NQ S"UP" 
        AND OFSTATUS[0] NQ S"IDLING"
      THEN
        BEGIN 
        CONSTAT = DFCONER;
        RETURN;                    # CONSTRAINING AREA IS NOT UP.      #
  
        END 
      RCOFTLOC[0] = LOC(OFT); 
  
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
      IF RSARFPT[0] EQ 0
      THEN
        BEGIN 
        RSARRQ1[0] = TRUE;
        DB$FKLA;             # ALLOCATE AN FPT FOR THE FILE.           #
        FPFTEX[0] = DFFTEX0; # FLAG TO SUPRESS DB$FTEX EXECUTION.      #
        FPCFPOS[0] = TRUE;   # FLAG TO CAUSE DB$FPOS CALL ON FIRST     #
                             # SEQUENTIAL OPERATION.                   #
        FPFITPD[0] = 3; 
        FPFTDX[0] = DFFTDX1;
  
#----------------------------------------------------------------------#
#                                                                      #
#     IF THERE ARE ANY EXTENDED AREA CONTROL BLOCKS THAT MIGHT BE      #
#     USED FOR CONSTRAINT PROCESSING, THEN SCAN THE CONTROL BLOCKS     #
#     FOR AN INSTANCE OF THIS AREA THAT IS ALREADY OPEN.               #
#                                                                      #
#     IF ONE IS FOUND AND ITS RSARALT POINTER IS NEGATIVE, IT IS       #
#     POINTING TO THE FIRST CONTROL BLOCK THAT WAS OPENED.             #
#     USE THAT POINTER.                                                #
#     OTHERWISE, IT WAS THE FIRST ONE OPENED, POINT TO IT.             #
#                                                                      #
#----------------------------------------------------------------------#
  
        IF CSFEXTNO[0] GR 0 
        THEN
          BEGIN 
          ARID = RSARID[0]; 
          SAVEARB = P<RSARBLK>; 
          ALTPTR = 0; 
  
          FOR AOFFSET=DFRSBFIX + (CSFARENO[0] -1) * DFARECON
          STEP -DFARECON  UNTIL DFRSBFIX
          DO
            BEGIN 
            P<RSARBLK> = LOC(RSB) + AOFFSET;
            IF ARID EQ RSARID[0]
              AND P<RSARBLK> NQ SAVEARB 
              AND RSARFPT[0] NQ 0 
            THEN
              BEGIN                # FOUND ANOTHER STATUS BLOCK FOR    #
                                   # THE SAME AREA ID                  #
              AOFFSET = DFRSBFIX;  # THEN TERMINATE THE SCAN           #
              ALTPTR = RSARALT[0];
  
              CONTROL IFGR DFFLOP,0;
                DB$FLOP("CPRO-NA"); 
              CONTROL ENDIF;
  
              IF ALTPTR GQ 0
              THEN
                BEGIN 
                ALTPTR = LOC(RSB) - LOC(RSARALT[0]);
                END 
              END 
            END 
          P<RSARBLK> = SAVEARB; 
          RSARALT[0] = ALTPTR;
          END 
  
        OFOPENS[0] = OFOPENS[0] + 1;
        IF OFOPENS[0] GR OFUSERS[0] 
        THEN
          BEGIN 
          DB$PUNT(" DB$CPRO 1");
          END 
        NEED = DB$NEED; 
        P<UFT> = LOC(OFUFT[0]); 
  
        FOR NEED = NEED STEP -1 UNTIL 1 
        DO
          BEGIN 
          IF UFWORD[0] NQ DFNPTR
          THEN
            BEGIN 
            P<UFT> = DB$LNK(LOC(OFUFT[0]),DFUFTSIZE); 
# 
*           COPY FIT FROM OFT ENTRY TO UFT ENTRY
# 
            FOR I2 = DFFITSIZE -1 STEP -1 UNTIL 0 
            DO
              BEGIN 
              UFFIT[I2] = OFFIT[I2];
              END 
            END 
          ELSE
            BEGIN 
            UFWORD[0] = LOC(UFT);  # CLEAR WORD WHILE SETTING NEXT     #
            UFPRIOR[0] = LOC(UFT);
            END 
  
          UFFITDX[0] = LOC(DB$FTDX);
          UFFITEX[0] = LOC(DB$FTEX);
          UFFITBFS[0] = ((UFFITMBL[0]+639)/640*64) * BFNUMBER;
          IF OFFITXN[0] NQ 0
          THEN
            BEGIN 
            UFFITBFS[0]= UFFITBFS[0] * 2; 
            END 
          UFFITFWB[0]= 0; 
          UFFITBZF[0]= 0; 
  
#----------------------------------------------------------------------#
#                                                                      #
#     THE FILE IS OPENED FOR I-O.                                      #
#     THIS PERMITS A RECORD LOCK TO BE OBTAINED AND HELD DURING        #
#     TRANSACTION PROCESSING.                                          #
#     SET THE RELATIVE POSITION FIELD TO -EQ- SO THAT THE START WILL   #
#     POSITION TO THE RECORD OF INTEREST, OR REPORT AN ERROR.          #
#                                                                      #
#----------------------------------------------------------------------#
          UFFITPD[0] = 3; 
          UFFITREL[0] = 1;
  
          UFFITWD26[0] = 0;        # CLEAR WORDS USED BY BAM           #
          UFFITWD27[0] = 0; 
          UFFITWD34[0] = 0; 
          UFFITSTAT[0] = 1; 
          UFFITOF [0] = 0;
          UFFITOC[0] = 0;          # FILE IS NOT OPENED.               #
          P<FIT> = LOC(UFFIT[0]); 
          IF SADBPPTR[SALX] NQ 0
          THEN
            BEGIN                  # DATABASE PROCEDURES FOR OPEN      #
            DB$DPIF(DFDPHASH);
            DB$DPIF(DFDPCOMP);
            DB$DPIF(DFDPBOPN);
            END 
  
          DB$OPNM(FIT,DB$RA0);     # OPEN THE FILE                     #
  
          IF UFFITES[0] NQ 0
          THEN
            BEGIN 
            FPFITES[0] = UFFITES[0];
            CONSTAT = DFCONER;     # ERROR DURING OPEN                 #
            RETURN; 
  
            END 
          END 
        END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     PREPARE THE FIT FOR A FILE ACCESS BY COMPLETING THE PERTINENT    #
#     FIELDS (RKW,RKP,KA,KL,KP).  IF THE ACCESS INVOLVES AN ALTERNATE  #
#     KEY, THE INDEX-ONLY FLAG IN THE FIT IS SET.                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      DB$FSIO;
      P<FIT> = LOC(UFFIT[0]); 
      UFFITWSA[0] = IOBUF;
      FPFTEX[0] = DFFTEX0;   # FLAG TO SUPPRESS DB$FTEX EXECUTION      #
      P<CSAKEYTB> = LOC(CSAREBLK) + CSAKEYPT[0] + (KORDX -1)*DFAREKEY;
      UFFITMKL [0] = 0; 
      UFFITRKW [0] = CSAKBWP [0]; 
      UFFITRKP [0] = CSAKBCP [0]; 
      UFFITKL [0] = CSAKLENC [0]; 
      UFFITKA [0] = KEYA; 
      UFFITKP [0] = KBCP; 
      NDXFLAG = NOT CSAKPRIM[0];
  
      END    #OPENIF# 
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   A C C E S S C K .      #
#                                                                      #
#**********************************************************************#
  
  
      PROC ACCESSCK;
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   ACCESSCK - ACCESS CONSTRAINT FILE 
* *   W.P. CEAGLIO                               DATE  11/09/78 
* 
* DC  PURPOSE 
* 
*     ACCESSES THE SPECIFIED CONSTRAINT FILE BY A SPECIFIED KEY AND 
*     SETS THE CONSTRAINT STATUS ACCORDING TO THE RESULT OF THE ACCESS
*     AND A SPECIFIED ACCESS CONSTRAINT 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     THE FOLLOWING VARIABLES SPECIFY THE FILE ACCESS PARAMETERS. 
* 
*     AC           CONTAINS ACCESS CONSTRAINT CONSTANT (0 OR 1) 
*     AORDX        CONTAINS THE SPECIFIED EXTENDED AREA ORDINAL 
*     KBCP         CONTAINS BEGINNING CHARACTER POSITION OF KEY 
*     KEYA         CONTAINS WORD ADDRESS OF KEY OF ACCESS 
*     KORDX        CONTAINS THE SPECIFIED KEY ORDINAL 
* 
*     IOBUF        CONTAINS ADDRESS OF CONSTRAINTS I/O BUFFER 
*     P<RSB>       ASSUMED SET ON ENTRY 
*     P<CSFIXED>   ASSUMED SET ON ENTRY 
* 
* DC  EXIT CONDITIONS 
* 
*     CONSTAT      SET TO INDICATE CONSTRAINT STATUS AS FOLLOWS-- 
* 
*                     VALUE  MEANING
*                     -----  -------
* 
*                      0     CONSTRAINT SATISFIED 
* 
*                      1     CONSTRAINT VIOLATED
* 
*                      2     OTHER (I/O) CONSTRAINT ERROR 
* 
*                      3     OUTSTANDING FATAL ERROR
* 
*                      4     CONSTRAINT AREA DOWN 
* 
* DC  CALLING ROUTINES
* 
*     PROC CSPTERC      SUB-PROCESSOR FOR INTER-RECORD CONSTRAINT 
*     PROC CSPTRAC      SUB-PROCESSOR FOR INTRA-RECORD CONSTRAINT 
* 
* DC  CALLED ROUTINES 
* 
# 
      XREF PROC DB$LOKD;           # DELETE LOCKS ON THE AREA          #
      XREF PROC STARTM;            # CRM START FUNCTION PROCESSOR      #
# 
*          PROC GETLOCK              GET A RECORD LOCK
*          PROC OPENIF               OPEN FILE IF IT IS NOT ALREADY 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     P<RSARBLK>
*     P<CSAREBLK> 
*     P<CSAKEYTB> 
*     P<OFT>
*     P<UFT>
* 
* DC  DESCRIPTION 
* 
* 
*     - IF THE BAD FILE FLAG IN UFT IS SET BY AAM, THE OFSTATUS WILL
*       BE SET TO INDICATE THE AREA IS BAD STRUCTURALLY. IN THIS CASE 
*       NO USER CAN ACCESS THE AREA.
* 
*     - PRIOR TO ACCESSING THE FILE, THE FIT FIELDS PERTAINING TO KEY 
*       ACCESS (RKW,RKP,KA,KP,KL) ARE ESTABLISHED.  ALSO, THE INDEX 
*       ONLY FLAG IS SET IF ACCESS IS BY ALTERNATE KEY.  CRM IS CALLED
*       TO RANDOMLY ACCESS THE FILE.
* 
*     - UPON RETURN FROM CRM, THE ES FIELD IN THE FIT IS EXAMINED AND 
*       THE RECORD COUNT (RC) IN THE FIT IS USED IN THE ANALYSIS. 
* 
*     - IF THE RESULT OF THE FILE ACCESS WAS A CRM ERROR OTHER THAN A 
*       KEY NOT FOUND STATUS, THE CONSTRAINT STATUS IS SET AS SUCH. 
*       OTHERWISE, ADDITIONAL CHECKING IS NEEDED BASED ON THE RECORD
*       COUNT AND THE CONSTRAINT FACTOR.  POSSIBLE OUTCOMES ARE GIVEN 
*       IN THE FOLLOWING TABLE. 
* 
*       AC    RC   INTERPRETATION 
*       --    --   -------------- 
* 
*       0     0    CONSTRAINT SATISFIED 
* 
*       0     "0   CONSTRAINT VIOLATED
* 
*       1     1    CONSTRAINT SATISFIED 
* 
*       1     "1   CONSTRAINT VIOLATED
* 
 #
  
  
  
#     LOCAL ITEMS AND ARRAYS                                           #
  
      ITEM RC      I;              # COUNT OF RECORDS SATISFYING ACCESS#
  
  
  
#     B E G I N   A C C E S S C K   E X E C U T A B L E   C O D E .    #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("CPRO-A1"); 
      CONTROL ENDIF;
  
      OPENIF;                      # OPEN FILE IF NOT OPEN ALREADY     #
  
      IF CONSTAT NQ DFCONOK        # IF ERROR DURING OPEN              #
      THEN
        BEGIN 
        RETURN;                    # CONSTRAINING AREA IS NOT UP.      #
  
        END 
  
#     CHECK OUTSTANDING ERRORS BEFORE GET                              #
  
      IF FPFITFNF [0] 
      THEN
        BEGIN 
        RCOFTLOC[0] = OFTLOC; 
        CONSTAT = DFCONFT;
        RETURN; 
  
        END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     CALL STARTM TO POSITION FILE AND SET THE RC FIELD IN THE FIT.    #
#     IF THE FIT IS SET FOR INDEX ONLY, THE RECORD COUNT IS IN THE     #
#     RC FIELD.                                                        #
#     IF THE START IS BY PRIMARY KEY THE COUNT IS ONE.                 #
#     IF AN ERROR OF PRIMARY OR SECONDARY "KEY NOT FOUND" IS RETURNED  #
#     THEN THE RECORD COUNT IS ZERO.                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      UFFITNDX[0] = NDXFLAG;
      STARTM(FIT, DB$RA0);
      UFFITNDX[0] = FALSE;
  
      IF UFFITES[0] EQ 0
      THEN                   # NO ERROR                                #
        BEGIN 
        IF NDXFLAG
        THEN                 # FOUND ONE OR MORE ALTERNATE KEY RECORDS #
          BEGIN 
          RC = UFFITRC[0];
          END 
        ELSE
          BEGIN              # ACCESSED BY PRIMARY KEY, COUNT IS ONE   #
          RC = 1; 
          END 
        END 
      ELSE
        BEGIN 
        IF UFFITES EQ DFPKERR 
          OR UFFITES EQ DFAKERR 
        THEN
          BEGIN              # NO RECORD WAS FOUND                     #
          RC = 0; 
          UFFITES[0] = 0;    # ERASE THE ERROR STATUS                  #
          END 
        ELSE
          BEGIN              # FOR OTHER ERRORS, RETURN AN ERROR       #
  
          CONTROL IFGR DFFLOP,0;
            XREF FUNC DB$COCT C(10);
            ITEM EFLOP C(10) = "CPRO000   ";
            C<4,3>EFLOP = DB$COCT(UFFITES[0],3);
            DB$FLOP(EFLOP); 
          CONTROL ENDIF;
  
          RCOFTLOC[0] = OFTLOC; 
          CONSTAT = DFCONER;
          RETURN; 
  
          END 
        END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     IF AC IS ZERO, AN OWNER RECORD IS BEING REMOVED.                 #
#     THE CONSTRAINT IS SATISFIED IF THE COUNT OF MEMBER RECORDS IS    #
#     ZERO.                                                            #
#     IF AC IS ONE, A MEMBER RECORD IS BEING ADDED.                    #
#     THE CONSTRAINT IS SATISFIED IF THE COUNT OF OWNER RECORDS IS ONE.#
#                                                                      #
#     THE EXCEPTION TO THE ABOVE RULES IS WHEN AN OWNER IS BEING       #
#     REMOVED AND THAT RECORD IS A MEMBER OF ITS OWN GROUP.            #
#     IN THAT CASE THE OWNER RECORD MUST BE THE ONLY MEMBER OF ITS     #
#     MEMBER GROUP, AND AC IS SET TO ONE.                              #
#                                                                      #
#     THEREFORE THE CONSTRAINT IS SATISFIED IF AC EQUALS RC.           #
#     IF NOT, SET THE RETURN CODE FOR A CONSTRAINT ERROR.              #
#                                                                      #
#----------------------------------------------------------------------#
  
      IF AC EQ RC 
      THEN
        BEGIN 
  
#----------------------------------------------------------------------#
#                                                                      #
#     THE CONSTRAINT IS SATISFIED.                                     #
#     IF ADDING A MEMBER RECORD, GET A LOCK ON THE OWNER RECORD.       #
#     THIS WILL INSURE THAT THERE IS NO EXISTING LOCK ON THE OWNER     #
#     RECORD.                                                          #
#     A LOCK ON THE OWNER RECORD COULD INDICATE THAT IT WAS ADDED      #
#     AS PART OF A TRANSACTION WHICH IS NOT COMMITTED YET.             #
#                                                                      #
#----------------------------------------------------------------------#
  
        IF CSADMEMB[0]
        THEN
          BEGIN 
          GETLOCK;                 # LOCK THE NEW OWNER RECORD         #
          DB$LOKD(FALSE);          # RETURN THE OWNER RECORD LOCK      #
                                   # DB$LOKD IS NO-OP DURING TRANSACTN #
          END 
        END 
      ELSE
        BEGIN 
        CONSTAT = DFCONFL;
        END 
  
      RCOFTLOC[0] = OFTLOC; 
      RETURN; 
  
      END  #ACCESSCK# 
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   L O K O L D O .        #
#                                                                      #
#**********************************************************************#
  
  
      PROC LOKOLDO; 
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   LOKOLDO - LOCK OLD OWNER
* *   BOB MCALLESTER                             DATE  02/13/84 
* 
* DC  PURPOSE 
* 
*     WHEN A MEMBER RECORD IS DELETED (OR REWRITTEN CHANGING OWNERS)
*     DURING A TRANSACTION, THE OLD OWNER IS LOCKED.
*     THIS WILL PREVENT THE OLD OWNER FROM BEING DELETED UNTIL THE
*     TRANSACTION HAS BEEN COMMITTED. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     AORDX        CONTAINS CURRENT AREA ORDINAL
*     KBCP         CONTAINS BEGINNING CHARACTER POSITION OF KEY 
*     KEYA         CONTAINS WORD ADDRESS OF KEY OF ACCESS 
*     P<RSARBLK>   IS SET 
* 
* DC  EXIT CONDITIONS 
* 
*     IF IN A TRANSACTION, THE OLD OWNER RECORD IS LOCKED.
* 
* DC  CALLING ROUTINES
* 
*     CSPTERC                SUB-PROCESSOR FOR INTER-RECORD CONSTRAINT
*     CSPTRAC                SUB-PROCESSOR FOR INTRA-RECORD CONSTRAINT
* 
* DC  CALLED ROUTINES 
* 
*     GETLOCK                LOCK THE SPECIFIED RECORD
*     OPENIF                 OPEN THE FILE IF NOT OPEN
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     RSARALT 
* 
* DC  DESCRIPTION 
* 
*     OPEN FILE SPECIFIED BY AORD, IF IT IS NOT ALREADY OPEN. 
*     LOCK THE SPECIFIED OWNER RECORD.
 #
  
  
  
#     B E G I N   L O K O L D O   E X E C U T A B L E   C O D E .      #
  
  
      IF TQARTX EQ 0               # IF NOT IN A TRANSACTION           #
        OR CONSTAT NQ DFCONOK      # OR ALREADY HAVE AN ERROR          #
      THEN
        BEGIN 
        RETURN;                    # RETURN                            #
  
        END 
  
      OPENIF;                      # OPEN FILE IF NOT ALREADY OPEN     #
  
      IF CONSTAT NQ DFCONOK 
      THEN
        BEGIN 
        RCOFTLOC[0] = OFTLOC; 
        RETURN;                    # ERROR DURING OPEN                 #
  
        END 
  
      GETLOCK;                     # LOCK THE OLD OWNER RECORD         #
      RCOFTLOC[0] = OFTLOC; 
      RETURN; 
  
      END    #LOKOLDO#
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   C S P T E R C .        #
#                                                                      #
#**********************************************************************#
  
  
      PROC CSPTERC; 
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   CSPTERC - SUB-PROCESSOR FOR INTER-RECORD CONSTRAINT 
* *   W.P. CEAGLIO                               DATE  11/09/78 
* 
* DC  PURPOSE 
* 
*     CONTROLS THE PROCESSING OF AN INTER-RECORD CONSTRAINT TYPE
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     CAORD         AREA ORDINAL SUPPLIED IN CALL TO MAIN PROCEDURE 
*     FC            FUNCTION CODE SUPPLIED IN CALL TO MAIN PROCEDURE
*     OLDREC        ADDRESS OF OLD RECORD PASSED TO MAIN PROCEDURE
*     NEWREC        ADDRESS OF NEW RECORD PASSED TO MAIN PROCEDURE
*     P<CSADEPTB>   SET TO CONSTRAINT DEPENDENCY LIST ENTRY 
* 
* DC  EXIT CONDITIONS 
* 
*     CONSTAT       SET TO CONSTRAINT STATUS
* 
* DC  CALLING ROUTINES
* 
*     DB$CPRO           MAIN PROCEDURE
* 
* DC  CALLED ROUTINES 
* 
*     FUNC ACCESSCK     ACCESS CONSTRAINT FILE
*     FUNC COMPKEY      COMPARE CONSTRAINT ITEMS
*     PROC LOKOLDO      LOCK OLD OWNER
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     CONSTAT 
* 
* DC  DESCRIPTION 
* 
*     - WHETHER A FILE ACCESS IS NEEDED IS DETERMINED BY THE FUNCTION 
*       CODE AND THE TYPE OF DEPENDENCY.  THE DEPENDENCY TYPE (OWNER OR 
*       MEMBER) REFERS TO THE ROLE OF THE CURRENT (BASIC) AREA IN THE 
*       UPDATE OPERATION BEING PERFORMED.  IN THE EVENT A FILE ACCESS IS
*       REQUIRED, PROCEDURE ACCESSCK IS CALLED TO PERFORM THE ACCESS
*       AND TO SET CONSTAT ACCORDINGLY. 
* 
*     - IF THE FUNCTION IS A WRITE OPERATION AND THE DEPENDENCY TYPE IS 
*       MEMBER, THEN A FILE ACCESS IS REQUIRED. 
* 
*     - IF THE FUNCTION CODE IS A DELETE OPERATION AND THE DEPENDENCY 
*       TYPE IS OWNER, THEN A FILE ACCESS IS REQUIRED.
* 
*     - IF THE FUNCTION CODE IS A REWRITE OPERATION AND THE CONSTRAINT
*       ITEM WAS MODIFIED, THEN A FILE ACCESS IS REQUIRED IN ANY CASE.
*       MODIFICATION IS DETERMINED BY COMPARING THE CONSTRAINT ITEMS IN 
*       OLD AND NEW RECORDS--THE BASIC KEY ORDINAL IS USED FOR THIS.
*       IF THE DEPENDENCY TYPE IS MEMBER, THEN THE ACCESSING STRATEGY 
*       IS AS FOR THE WRITE FUNCTION--THE ACCESS KEY IS THE VALUE OF
*       THE CONSTRAINT ITEM IN THE NEW RECORD.  FOR AN OWNER TYPE OF
*       DEPENDENCY, THE ACCESS STRATEGY IS AS FOR THE DELETE OPERATION, 
*       WITH THE ACCESS KEY BEING THE VALUE OF THE CONSTRAINT ITEM
*       IN THE OLD RECORD.
* 
 #
  
  
  
  
#     B E G I N   C S P T E R C   E X E C U T A B L E   C O D E .      #
  
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("CPRO-TE"); 
      CONTROL ENDIF;
  
  
      IF FC EQ DFWR2
      THEN
        BEGIN 
        IF CSADOWNR [0] 
        THEN
          BEGIN 
          RETURN; 
  
          END 
  
#----------------------------------------------------------------------#
#                                                                      #
#       A MEMBER DEPENDENCY CONSTRAINT EXISTS ON A WRITE OPERATION.  IT#
#       IS REQUIRED TO ACCESS THE OWNER IDENTIFIED BY THE EXTENDED AREA#
#       ORDINAL IN THE LIST ENTRY, AND USING THE VALUE OF THE KEY FOR  #
#       THE CONSTRAINT ITEM IDENTIFIED BY THE BASIC KEY ORDINAL IN     #
#       THE LIST ENTRY.  THE ACCESS CONSTRAINT IS ONE (RECORD).        #
#                                                                      #
#----------------------------------------------------------------------#
  
#       ACCESS CONSTRAINT FILE AND SET STATUS                          #
  
        KEYA = NEWREC + KBWP; 
        ACCESSCK; 
        RETURN; 
  
        END 
  
      IF FC EQ DFDEL
      THEN
        BEGIN 
        IF CSADMEMB [0] 
        THEN
          BEGIN 
          LOKOLDO;                   # LOCK OLD OWNER RECORD           #
          RETURN; 
  
          END 
  
#----------------------------------------------------------------------#
#                                                                      #
#       AN OWNER DEPENDENCY EXISTS ON A DELETE OPERATION.  NEED TO     #
#       ACCESS THE MEMBER IDENTIFIED BY THE EXTENDED AREA ORDINAL IN   #
#       THE DEPENDENCY LIST ENTRY USING THE VALUE FOR THE CONSTRAINT   #
#       ITEM IDENTIFIED BY THE BASIC KEY ORDINAL. THE ACCESS CONSTRAINT#
#       CONSTRAINT IS ZERO.                                            #
#                                                                      #
#----------------------------------------------------------------------#
  
#       ACCESS CONSTRAINT FILE AND SET STATUS                          #
  
        AC = DFRCZERO;
        ACCESSCK; 
        RETURN; 
  
        END 
  
      IF FC NQ DFREW
      THEN
        BEGIN 
        DB$PUNT("DB$CPRO 2"); 
  
        END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     DETERMINE IF CONSTRAINT ITEM WAS MODIFIED.  IF NOT, NO FURTHER   #
#     PROCESSING FOR THE CURRENT DEPENDENCY ENTRY IS REQUIRED.         #
#     OTHERWISE, A FILE ACCESS IS PERFORMED USING AS THE ACCESS KEY    #
#     THE VALUE OF THE CONSTRAINT ITEM IN THE NEW OR OLD RECORD,       #
#     DEPENDING ON WHETHER A MEMBER OR OWNER DEPENDENCY TYPE IS BEING  #
#     PROCESSED. THE ACCESS CONSTRAINT IS EITHER ONE OR ZERO DEPENDING #
#     ON WHETHER A MEMBER OR OWNER DEPENDENCY IS BEING PROCESSED.      #
#                                                                      #
#----------------------------------------------------------------------#
  
#     COMPARE CONSTRAINT ITEMS                                         #
  
      IF COMPKEY(CAORD,KORDB,OLDREC,CAORD,KORDB,NEWREC) EQ 0
      THEN
        BEGIN 
        RETURN; 
  
        END 
  
#     THE CONSTRAINT ITEM WAS  MODIFIED                                #
  
      IF CSADMEMB [0] 
      THEN
        BEGIN 
  
#       ACCESS FILE USING VALUE OF KEY IN NEW RECORD                   #
  
        KEYA = NEWREC + KBWP; 
        ACCESSCK; 
        KEYA = OLDREC + KBWP; 
        LOKOLDO;                   # LOCK OLD OWNER RECORD             #
        END 
  
      ELSE
        BEGIN 
  
#       ACCESS FILE USING VALUE OF KEY IN OLD RECORD                   #
  
        AC = DFRCZERO;
        ACCESSCK; 
        END 
  
  
      END  #CSPTERC#
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   C S P T R A C .        #
#                                                                      #
#**********************************************************************#
  
  
      PROC CSPTRAC; 
      BEGIN 
 #
* *   DB$CPRO                                    PAGE  1
* *   CSPTRAC - SUB-PROCESSOR FOR INTRA-RECORD CONSTRAINT 
* *   W.P. CEAGLIO                               DATE  11/09/78 
* 
* DC  PURPOSE 
* 
*     CONTROLS THE PROCESSING OF AN INTRA-RECORD CONSTRAINT TYPE
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     CAORD         AREA ORDINAL SUPPLIED IN CALL TO MAIN PROCEDURE 
*     FC            FUNCTION CODE SUPPLIED IN CALL TO MAIN PROCEDURE
*     OLDREC        ADDRESS OF OLD RECORD PASSED TO MAIN PROCEDURE
*     NEWREC        ADDRESS OF NEW RECORD PASSED TO MAIN PROCEDURE
*     P<CSADEPTB>   SET TO CONSTRAINT DEPENDENCY LIST ENTRY 
* 
* DC  EXIT CONDITIONS 
* 
*     CONSTAT       SET TO CONSTRAINT STATUS
* 
* DC  CALLING ROUTINES
* 
*     DB$CPRO           MAIN PROCEDURE
* 
* DC  CALLED ROUTINES 
* 
*     FUNC ACCESSCK     ACCESS CONSTRAINT FILE
*     FUNC COMPKEY      COMPARE CONSTRAINT ITEMS
*     PROC DB$PUNT      INTERNAL ERROR PROCESSOR
*     PROC LOKOLDO      LOCK OLD OWNER
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     CONSTAT 
* 
* DC  DESCRIPTION 
* 
*     - FILE ACCESSING TO VERIFY CONSTRAINTS IS DEPENDENT ON THE
*       FUNCTION CODE, THE TYPE OF DEPENDENCY, AND WHETHER OR NOT THE 
*       CONSTRAINT ITEMS IN THE RECORD WERE MODIFIED.  ALSO, SPECIAL
*       CASING IS REQUIRED TO DETECT THE SITUATION WHERE THE CONSTRAINT 
*       ITEMS ARE EQUAL--THIS REPRESENTS A RECORD AT THE HIGHEST LEVEL
*       OF THE CONSTRAINT HIERARCHY.
* 
*     - IF THE FUNCTION IS A WRITE OPERATION, THE DEPENDENCY TYPE IS
*       MEMBER, AND THE CONSTRAINT ITEMS ARE NOT EQUAL, THEN A FILE 
*       ACCESS IS REQUIRED. 
* 
*     - IF THE FUNCTION CODE IS A DELETE OPERATION, AND THE DEPENDENCY
*       TYPE IS OWNER, A FILE ACCESS IS REQUIRED.  INTERPRETATION OF
*       OF THE RESULT OF THE ACCESS IS DIFFERENT FOR THE OWNER AT THE 
*       HIGHEST LEVEL AND AN INTERMEDIATE OWNER--THE ACCESS CONSTRAINTS 
*       ARE 1 AND 0, RESPECTIVELY.
* 
*     - IF THE FUNCTION CODE IS A REWRITE OPERATION, CONSTRAINT CHECKS
*       ARE PERFORMED BY MEANS OF A DECISION TABLE BECAUSE OF THE NUMBER
*       OF POSSIBILITIES INVOLVING THE CONSTRAINT ITEMS.
* 
 #
  
  
  
#     LOCAL ITEMS AND ARRAYS                                           #
  
  
#     THE FOLLOWING ARRAY IS USED TO DETERMINE THE SITUATION NUMBER IN #
#     PROCESSING AN INTRA-RECORD CONSTRAINT FOR A REWRITE FUNCTION     #
  
      ARRAY SIT [0:0] S(1); 
        BEGIN 
        ITEM SITNUM  I(00,00,60);  # ENTIRE WORD                       #
        ITEM SITBOBN U(00,56,01);  # BASIC-OLD VS BASIC-NEW            #
        ITEM SITEOEN U(00,57,01);  # EXT-OLD VS EXT-NEW                #
        ITEM SITBOEO U(00,58,01);  # BASIC-OLD VS EXT-OLD              #
        ITEM SITBNEN U(00,59,01);  # BASIC-NEW VS EXT-NEW              #
        END 
  
#     THE FOLLOWING SWITCH IS USED IN THE EXECUTION OF A SIMULATED CASE#
#     STATEMENT                                                        #
  
      SWITCH SITUATION SIT00,SIT01,SIT02,SIT03,SIT04,SIT05,SIT06,SIT07, 
                       SIT08,SIT09,SIT10,SIT11,SIT12,SIT13,SIT14,SIT15; 
  
  
  
  
#     B E G I N   C S P T R A C   E X E C U T A B L E   C O D E .      #
  
  
  
  
      IF FC EQ DFWR2
      THEN
        BEGIN 
        IF CSADOWNR [0] 
        THEN
          BEGIN 
          RETURN; 
  
          END 
#----------------------------------------------------------------------#
#                                                                      #
#       A MEMBER DEPENDENCY EXISTS ON A WRITE OPERATION.  FIRST, IT IS #
#       NECESSARY TO DETERMINE IF THE RECORD BEING WRITTEN IS AT THE   #
#       HIGHEST LEVEL OF THE CONSTRAINT HIERARCHY.  THIS IS DONE BY    #
#       COMPARING THE CONSTRAINT ITEMS IN THE RECORD--IF THEY ARE EQUAL#
#       NO FURTHER CONSTRAINT CHECKING IS REQUIRED.  OTHERWISE, A FILE #
#       ACCESS IS PERFORMED USING THE VALUE OF THE KEY FOR THE BASIC   #
#       KEY ORDINAL--THE ACCESS CONSTRAINT IS ONE.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
#       COMPARE CONSTRAINT ITEMS                                       #
  
        IF COMPKEY(CAORD,KORDB,NEWREC,CAORD,KORDX,NEWREC) EQ 0
        THEN
          BEGIN 
          RETURN; 
  
          END 
  
#       ACCESS CONSTRAINT FILE AND SET STATUS                          #
  
        KEYA = NEWREC + KBWP; 
        ACCESSCK; 
        RETURN; 
  
        END 
  
      IF FC EQ DFDEL
      THEN
        BEGIN 
        IF CSADMEMB [0] 
        THEN
          BEGIN 
          LOKOLDO;                 # LOCK OLD OWNER RECORD             #
          RETURN; 
  
          END 
  
#----------------------------------------------------------------------#
#                                                                      #
#       AN OWNER DEPENDENCY EXISTS ON A DELETE OPERATION.  THE RESULT  #
#       OF THE REQUIRED FILE ACCESS IS INTERPRETED AS FOLLOWS--IF THE  #
#       RECORD IS THE HIGHEST LEVEL OWNER (CONSTRAINT ITEMS EQUAL) AND #
#       AT MOST ONE RECORD WITH THE KEY WAS FOUND, THEN THE CONSTRAINT #
#       IS FOUND TO BE SATISFIED. OTHERWISE, IF NO RECORD WITH THE KEY #
#       WAS FOUND, THE CONSTRAINT IS SATISFIED.                        #
#                                                                      #
#----------------------------------------------------------------------#
  
#       COMPARE CONSTRAINT ITEMS IN RECORD BEING DELETED AND USE THE   #
#       APPLICABLE ACCESS FACTOR (1 OR 0) IN THE FILE ACCESS           #
  
        IF COMPKEY(CAORD,KORDB,OLDREC,CAORD,KORDX,OLDREC) NQ 0
        THEN
          BEGIN 
          AC = DFRCZERO;
          END 
        ACCESSCK; 
        RETURN; 
  
        END 
  
#----------------------------------------------------------------------#
#                                                                      #
#       AN OWNER OR MEMBER DEPENDENCY EXISTS ON A REWRITE OPERATION.   #
#       THE METHOD FOR VERIFICATION IS A DECISION TABLE BASED ON THE   #
#       RESULTS OF THE COMPARISON OF THE CONSTRAINT ITEMS IN THE OLD   #
#       AND NEW (MODIFIED) RECORDS. THE ACTION(S) TAKEN MAY ALSO DEPEND#
#       ON WHETHER AN OWNER OR MEMBER ENTRY IS BEING PROCESSED. IT     #
#       SHOULD BE NOTED THAT THERE ARE ALWAYS TWO ENTRIES IN THE       #
#       DEPENDENCY LIST FOR AN INTRA-RECORD CONSTRAINT--AN OWNER AND A #
#       MEMBER ENTRY.                                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      IF FC NQ DFREW
      THEN
        BEGIN 
        RETURN; 
  
        END 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     PERFORM ALL COMPARISONS OF THE CONSTRAINT ITEMS IN THE OLD AND   #
#     NEW RECORDS AND SET THE SITUATION NUMBER ACCORDINGLY.  POSSIBLE  #
#     OUTCOMES ARE SHOWN IN THE FOLLOWING TABLE.  INTERNALLY, "Y" IS   #
#     REPRESENTED BY 0, "N" BY 1.  THE TERMS "BAS-OLD", "BAS-NEW",     #
#     "EXT-OLD", "EXT-NEW" REFER TO THE CONSTRAINT ITEMS IN THE OLD AND#
#     NEW (MODIFIED) RECORDS FROM THE PERSPECTIVE OF AN OWNER ENTRY,   #
#     I.E, "BAS" REFERS TO THE OWNER ITEM AND "EXT" TO THE MEMBER.     #
#                                                                      #
#----------------------------------------------------------------------#
#                                                                      #
#            BAS-OLD  EXT-OLD  BAS-OLD  BAS-NEW                        #
#     SIT       VS       VS       VS       VS                          #
#     NBR    BAS-NEW  EXT-NEW  EXT-OLD  EXT-NEW  ACTION                #
#     ---    -------  -------  -------   ------  -------               #
#     00        Y        Y        Y        Y     RETURN                #
#     01        Y        Y        Y        N     INTERNAL ERROR        #
#     02        Y        Y        N        Y     INTERNAL ERROR        #
#     03        Y        Y        N        N     RETURN                #
#     04        Y        N        Y        Y     INTERNAL ERROR        #
#     05        Y        N        Y        N     ACCESS OWNER USING AS #
#                                                THE KEY THE VALUE OF  #
#                                                EXT-NEW. IF THERE IS  #
#                                                NO RECORD WITH THAT   #
#                                                KEY, THEN DIAGNOSE A  #
#                                                CONSTRAINT VIOLATION. #
#     06        Y        N        N        Y     RETURN                #
#     07        Y        N        N        N     ACCESS OWNER USING AS #
#                                                THE KEY THE VALUE OF  #
#                                                EXT-NEW. IF THERE IS  #
#                                                NO RECORD WITH THAT   #
#                                                KEY, THEN DIAGNOSE A  #
#                                                CONSTRAINT VIOLATION. #
#     08        N        Y        Y        Y     INTERNAL ERROR        #
#     09        N        Y        Y        N     CONSTRAINT VIOLATION  #
#     10        N        Y        N        Y     CONSTRAINT VIOLATION  #
#     11        N        Y        N        N     ACCESS MEMBER USING AS#
#                                                THE KEY THE VALUE OF  #
#                                                BAS-OLD. IF THERE ARE #
#                                                ONE OR MORE RECORDS   #
#                                                WITH THAT KEY, ISSUE  #
#                                                CONSTRAINT VIOLATION  #
#     12        N        N        Y        Y     ACCESS MEMBER USING AS#
#                                                THE KEY THE VALUE OF  #
#                                                BAS-OLD. IF THERE IS  #
#                                                MORE THAN ONE RECORD  #
#                                                WITH THAT KEY, ISSUE, #
#                                                CONSTRAINT VIOLATION  #
#     13        N        N        Y        N     ACCESS OWNER USING AS #
#                                                THE KEY THE VALUE OF  #
#                                                EXT-NEW. IF THERE IS  #
#                                                NO RECORD WITH THAT   #
#                                                KEY, THEN DIAGNOSE A  #
#                                                CONSTRAINT VIOLATION. #
#                                                ACCESS MEMBER USING AS#
#                                                THE KEY THE VALUE OF  #
#                                                BAS-OLD. IF THERE IS  #
#                                                MORE THAN ONE RECORD  #
#                                                WITH THAT KEY, ISSUE, #
#                                                CONSTRAINT VIOLATION  #
#     14        N        N        N        Y     ACCESS MEMBER USING AS#
#                                                THE KEY THE VALUE OF  #
#                                                BAS-OLD. IF THERE ARE #
#                                                ONE OR MORE RECORDS   #
#                                                WITH THAT KEY, ISSUE  #
#                                                CONSTRAINT VIOLATION  #
#     15        N        N        N        N     ACCESS OWNER USING AS #
#                                                THE KEY THE VALUE OF  #
#                                                EXT-NEW. IF THERE IS  #
#                                                NO RECORD WITH THAT   #
#                                                KEY, THEN DIAGNOSE A  #
#                                                CONSTRAINT VIOLATION  #
#                                                ACCESS MEMBER USING AS#
#                                                THE KEY THE VALUE OF  #
#                                                BAS-OLD. IF THERE ARE #
#                                                ONE OR MORE RECORDS   #
#                                                WITH THAT KEY, ISSUE  #
#                                                CONSTRAINT VIOLATION  #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
#     PERFORM COMPARISONS OF CONSTRAINT ITEMS AND SET SITUATION NUMBER #
  
      SITNUM = 0; 
      SITBOEO [0] = COMPKEY(CAORD,KORDB,OLDREC,CAORD,KORDX,OLDREC); 
      SITBNEN [0] = COMPKEY(CAORD,KORDB,NEWREC,CAORD,KORDX,NEWREC); 
      IF CSADOWNR [0] 
      THEN
        BEGIN 
        SITBOBN [0] = COMPKEY(CAORD,KORDB,OLDREC,CAORD,KORDB,NEWREC); 
        SITEOEN [0] = COMPKEY(CAORD,KORDX,OLDREC,CAORD,KORDX,NEWREC); 
        END 
      ELSE
        BEGIN 
        SITBOBN [0] = COMPKEY(CAORD,KORDX,OLDREC,CAORD,KORDX,NEWREC); 
        SITEOEN [0] = COMPKEY(CAORD,KORDB,OLDREC,CAORD,KORDB,NEWREC); 
        END 
  
#     PERFORM ACTION(S) INDICATED BY SITUATION NUMBER                  #
  
      CONTROL IFGR DFFLOP,0;
        ITEM FLOPPER C(10) = "CPRO*00   ";
        B<30,12>FLOPPER = O"3333" + SITNUM; 
        IF SITNUM GQ 10 THEN
          B<30,12>FLOPPER = B<30,12>FLOPPER +64 -10;
        DB$FLOP(FLOPPER); 
      CONTROL ENDIF;
  
      CASE SITUATION [SITNUM] OF ;
      BEGIN 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 00,03 REQUIRE NO ACCESS CHECK -- CONSTRAINT SATISFIED #
#                                                                      #
#----------------------------------------------------------------------#
SIT00:  
SIT03:  
      CONSTAT = DFCONOK;
      GOTO CASEN; 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 01, 02, 04 AND 08 -- INTERNAL ERROR                   #
#                                                                      #
#----------------------------------------------------------------------#
SIT01:  
SIT02:  
SIT04:  
SIT08:  
      DB$PUNT("DB$CPRO 4"); 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 05,07 REQUIRE ACCESS CHECK IF PROCESSING A MEMBER TYPE#
#     CONSTRAINT--ACCESS CONSTRAINT = 1.                               #
#                                                                      #
#----------------------------------------------------------------------#
SIT05:  
SIT07:  
      IF CSADMEMB [0] 
      THEN
        BEGIN 
        KEYA = NEWREC + KBWP; 
        ACCESSCK; 
        KEYA = OLDREC + KBWP; 
        LOKOLDO;                   # LOCK OLD OWNER RECORD             #
        END 
      GOTO CASEN; 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATION 06 -- NO CONSTRAINT VIOLATION, BUT LOCK OLD OWNER.     #
#                                                                      #
#----------------------------------------------------------------------#
SIT06:  
      IF CSADMEMB[0]
      THEN
        BEGIN 
        LOKOLDO;                   # LOCK OLD OWNER RECORD             #
        END 
      GOTO CASEN; 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 09-10 REPRESENT CONSTRAINT VIOLATIONS                 #
#                                                                      #
#----------------------------------------------------------------------#
SIT09:  
SIT10:  
      CONSTAT = DFCONFL;
      GOTO CASEN; 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 11,14 REQUIRE ACCESS CHECK IF PROCESSING OWNER TYPE   #
#     CONSTRAINT--ACCESS CONSTRAINT = 0.                               #
#                                                                      #
#----------------------------------------------------------------------#
SIT11:  
SIT14:  
      AC = DFRCZERO;               # SET ACCESS CONSTRAINT TO ZERO     #
                                   # FALL THROUGH INTO SITUATION 12    #
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATION 12 REQUIRES ACCESS CHECK IF PROCESSING AN OWNER ENTRY--#
#     ACCESS CONSTRAINT = 1.                                           #
#                                                                      #
#----------------------------------------------------------------------#
SIT12:  
      IF CSADOWNR [0] 
      THEN
        BEGIN 
        ACCESSCK; 
        END 
      GOTO CASEN; 
#----------------------------------------------------------------------#
#                                                                      #
#     SITUATIONS 13,15 REQUIRE TWO ACCESS CHECKS (FOR OWNER AND MEMBER #
#     TYPE CONSTRAINT)--IN BOTH CASES THE ACCESS CONSTRAINT = 1.       #
#                                                                      #
#----------------------------------------------------------------------#
SIT13:  
SIT15:  
      IF CSADMEMB [0] 
      THEN
        BEGIN 
        KEYA = NEWREC + KBWP; 
        END 
      ACCESSCK; 
      GOTO CASEN; 
  
CASEN:  
      RETURN; 
      END 
  
      END  #CSPTRAC#
  
  
#**********************************************************************#
#     E N D   O F   I N T E R N A L   P R O C E D U R E S .            #
#**********************************************************************#
  
  
  
#     B E G I N   D B $ C P R O   E X E C U T A B L E   C O D E .      #
  
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("CPRO");
      CONTROL ENDIF;
  
#----------------------------------------------------------------------#
#                                                                      #
#     START OF MAIN PROCEDURE EXECUTABLE CODE                          #
#                                                                      #
#     POINT TO THE CONSTRAINT DEPENDENCY LIST IN THE CST AREA WORK     #
#     BLOCK ENTRY (AFTER SAVING THE CURRENT CONTROL BLOCK POINTER)     #
#                                                                      #
#----------------------------------------------------------------------#
  
      DB$PUSH(DB$CPRO); 
  
#     ALLOCATE I/O BUFFER FOR CONSTRAINT FILE ACCESSING                #
  
      DB$MBA((CSFEXREC[0] +9) /10, IOBUF);
  
      RCMLOK[0] = TRUE; 
      SAVEOFF = LOC(RSARBLK) - LOC(RSB);
  
 RESTART:                    # RESTART DB$CPRO AFTER A DB$LOK INTERRUPT#
  
      DB$PSH3(CAORD,FC,OLDREC); 
      DB$PSH2(NEWREC, SAVEOFF); 
      P<RSARBLK> = LOC(RSB) + DFRSBFIX + (CAORD - 1)*DFARECON;
      P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP [0];
      ND = CSADEPNO [0];
  
#----------------------------------------------------------------------#
#                                                                      #
#     AT LEAST ONE CONSTRAINT APPLIES TO THE AREA BEING UPDATED.  ALL  #
#     ENTRIES IN THE DEPENDENCY LIST MUST BE PROCESSED.  FOR EACH ENTRY#
#     THE APPROPRIATE SUB-PROCESSOR IS CALLED TO PROCESS IT.           #
#                                                                      #
#     CONSTRAINT PROCESSING IS DRIVEN BY THE TYPE FIELD IN THE LIST    #
#     ENTRY.  CURRENTLY, TWO SUB-PROCESSORS HAVE BEEN IMPLEMENTED.     #
#                                                                      #
#         TYPE      SUB-PROCESSOR       FUNCTION                       #
#         ----      -------------       --------                       #
#                                                                      #
#         DFCONTER   CSPTERC            VERIFY OWNER/MEMBER CONSTRAINT #
#                                       INVOLVING SEPARATE FILES       #
#                                       (INTER-RECORD)                 #
#                                                                      #
#         DFCONTRA   CSPTRAC            VERIFY OWNER/MEMBER CONSTRAINT #
#                                       INVOLVING SAME FILE            #
#                                       (INTRA-RECORD)                 #
#                                                                      #
#----------------------------------------------------------------------#
  
  
#     FOR EACH ENTRY IN DEPENDENCY LIST CALL APPLICABLE SUB-PROCESSOR  #
  
      P<CSADEPTB> = LOC(CSAREBLK) + CSADEPPT [0]; 
      FOR I=1 STEP 1
        UNTIL ND
      DO
        BEGIN  # START OF MAIN LOOP # 
        CONSTAT = DFCONOK;
        SUBTYP = CSADTYPE [0];
  
#       EXTRACT THE EXTENED AREA ORDINAL AND THE BASIC AND EXTENDED    #
#       KEY ORDINALS FROM THE CURRENT CONSTAINT DEPENDENCY LIST ENTRY. #
  
        AORDX = CSADAORD[0];
        KORDX = CSADEKEY[0];
        KORDB = CSADBKEY[0];
  
#       OBTAIN THE BEGINNING WORD POSITION AND THE BEGINNING CHARACTER #
#       POSITION OF THE BASIC KEY IN THIS CONSTRAINT.                  #
#       THESE WILL BE USED IN OBTAINING THE KEY VALUE WITH WHICH TO    #
#       ACCESS THE RECORD OF THE EXTENDED KEY.                         #
  
        GETKINFO(CAORD,KORDB,KBWP,KBCP,SINK,SINK);
  
#       SET DEFAULT VALUES FOR KEY ADDRESS AND ACCESS CONSTANT.        #
  
        KEYA = OLDREC + KBWP; 
        AC = DFRCONE; 
  
#       CALL THE APPROPRIATE SUBROUTINE - INTER OR INTRA.              #
  
        IF SUBTYP EQ DFCONTER 
        THEN
          BEGIN 
          CSPTERC;
          END 
        ELSE
          BEGIN 
          IF SUBTYP EQ DFCONTRA 
          THEN
            BEGIN 
            CSPTRAC;
            END 
          ELSE
            BEGIN 
            DB$PUNT("DB$CPRO 6"); 
            END 
          END 
  
  
 #       IF CONSTRAINT VIOLATION, I/O ERROR, OR AN AREA DOWN           #
 #       CALL ERROR PROCESSOR                                          #
  
        IF CONSTAT NQ DFCONOK 
        THEN
          BEGIN 
          RSFCCORD [0] = CSADCORD [0];
  
          CONTROL IFGR DFFLOP,0;
            ITEM VFLOP C(7) = "CPRO-V0";
            B<36,6>VFLOP = CONSTAT + O"33"; 
            DB$FLOP(VFLOP); 
          CONTROL ENDIF;
  
          IF CONSTAT EQ DFCONDW 
          THEN
            BEGIN 
            DB$ERR(10); 
            END 
          IF CONSTAT EQ DFCONFL 
          THEN
            BEGIN 
            DB$ERR(52);            # CONSTRAINT VIOLATION              #
            END 
          IF CONSTAT EQ DFCONER 
          THEN
            BEGIN 
            FPFTEX[0] = DFFTEX1;   # FLAG A NORMAL DB$FTEX EXECUTION   #
            DB$FTSM = TRUE;        # SUPPRESS MESSAGE                  #
            DB$FTEX;               # TEST IF SCHEMA SHOULD BE DOWNED   #
            DB$ERR(53); 
            END 
          IF CONSTAT EQ DFCONFT 
          THEN
            BEGIN 
            DB$ERR(63); 
            END 
          END 
  
        P<CSADEPTB> = P<CSADEPTB> + DFAREDEP; 
        END  # END OF MAIN LOOP # 
  
#     RELEASE I/O BUFFER FOR ACCESSING FILES INVOLVED IN CONSTRAINTS   #
  
      DB$MBF(IOBUF);
  
#      RESET POINTERS TO CURRENT AREA CONTROL AND WORK BLOCKS, OFT,    #
#      FKL, AND FPT.                                                   #
  
      DB$POP(SAVEOFF);
      P<RSARBLK> = LOC(RSB) + SAVEOFF;
      RCSTACKX[0] = RCSTACKX[0] +4;  # NO NEED TO POP THE NEXT 4 ITEMS #
                                     # ADJUST THE STACK INDEX          #
      DB$POP(DB$CPRO);
      RCMLOK[0] = FALSE;
      P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP [0];
      P<OFT> = RSAROFIT [0];
      RCOFTLOC [0] = RSAROFIT [0];
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
  
      END  #DB$CPRO#
      TERM
