*DECK DB$RLCK 
USETEXT RQPARTX 
      PROC DB$RLCK (FITLIST); 
      BEGIN 
 #
* *   DB$RLCK                                    PAGE  1
* *   W P CEAGLIO                                9/15/76
* * 
* 
* DC  PURPOSE 
* 
*     PERFORM CHECKS OF THE "ES" FIELD IN THE LIST OF FITS PASSED IN
*     THE READ RELATION REQUEST.  SPECIFICALLY, CHECKS ARE MADE FOR CRM 
*     ERROR OR A NULL RECORD OCCURRENCE RETURNED BY MFP.
*     UPDATE THE SECTION OF RELATION STATUS INFORMATION IN THE DBST.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*     THE ARRAY *FITLIST*, PASSED AS A FORMAL PARAMETER, IS A 
*     ZERO-TERMINATED LIST OF ONE-WORD ENTRIES, WITH ONE ENTRY
*     FOR EACH FIT INVOLVED IN THE RELATION.
*     FIELD FITES IN THE FITLIST CONTAINS ES FIELD FOR EACH FIT.
*     FIELD FITLRL IN THE FITLIST CONTAINS THE RECORD LENGTH FOR EACH 
*     RECORD. 
* 
*     ASSUMPTIONS 
* 
*     FIELD RQPKHDFC IN THE PARAMETER PACKET HEADER OF THE REQUEST
*     PACKET CONTAINS THE FUNCTION CODE OF THE RELATION OPERATION.
*     IF A DBST EXISTS FOR THIS USER, THEN ARRAY *DB$DBS*, DEFINED IN 
*     DB$RQST, CONTAINS THE LOCATION AND LENGTH OF THE DBST.  IF AN 
*     ERROR WAS DETECTED DURING SCP PROCESSING OF THE RELATION
*     OPERATION, THEN THE DBST CONTAINS ERROR STATUS INFORMATION
*     STORED BY THE SCP.
* 
* DC  EXIT CONDITIONS 
* 
*     FOR CRM ERROR, THE ROUTINE SPECIFIED IN THE "EX" FIELD OF THE 
*     FIT IS EXECUTED IF SPECIFIED.  OTHERWISE, CONTROL IS RETURNED TO
*     THE CALLER. 
* 
*     FOR NULL RECORD OCCURRENCE, A RECORD CONSISTING OF THE NULL VALUE 
*     "]" IS GENERATED IN THE WSA OF THE FITIN WHICH THE CONDITION IS 
*     DETECTED, AND IS PROPOGATED IN ALL WSAS IN FITS BELOW 
* 
*     CONTROL BREAK IS SET IN FIT ES FIELD IF APPROPRIATE.
* 
*     IF THE USER HAS ESTABLISHED A DBST THAT CONTAINS THE SECTION OF 
*     RELATION STATUS INFORMATION, THEN THE DBST RELATION STATUS
*     SECTION HAS BEEN UPDATED TO REFLECT THE RESULTS OF THE
*     RELATION PROCESSING.
* 
* DC  CALLING ROUTINES
* 
*     DB$REL     READ RELATION RANDOM OBJECT-TIME ROUTINE 
*     DB$RELS    READ RELATION SEQUENTIAL OBJECT-TIME ROUTINE 
* 
* DC  CALLED ROUTINES 
* 
*     DB$CALL    EXECUTE ERROR ROUTINE
*     DB$WEF     WRITE MESSAGE TO ERROR FILE
* 
* DC  DESCRIPTION 
* 
*     LOOP THROUGH THE ARRAY *FITLIST*, CHECKING THE "ES" FIELD FOR 
*     EACH ENTRY OF THE FITLIST, AND, IF THE USER HAS ESTABLISHED 
*     A DBST THAT INCLUDES THE RELATION STATUS SECTION, THEN THE
*     RELATION STATUS INFORMATION IS UPDATED IN THE DBST AS 
*     INFORMATION BECOMES AVAILABLE WHILE LOOPING THROUGH THE FITLIST 
*     ENTRIES.  INFORMATION STORED IN THE RELATION STATUS SECTION IS: 
*     RANK OF FILE ON WHICH A CRM/CDCS ERROR WAS DETECTED, LOWEST 
*     RANK ON WHICH A CONTROL BREAK OCCURRED, AND LOWEST RANK ON WHICH
*     A NULL RECORD OCCURRED.  IF AN ERROR CONDITION WAS DETECTED,
*     THEN ALL ERROR STATUS INFORMATION (ERROR CODE, FUNCTION NAME, 
*     AUXILIARY STATUS, AREA NAME) HAS BEEN STORED IN THE DBST
*     BY THE SCP.  IF A SPECIAL RELATION CONDITION (CONTROL BREAK 
*     OR NULL RECORD) WAS ENCOUNTERED, BUT NO ERROR OCCURRED, 
*     THEN THE FUNCTION NAME (AS DESCRIBED IN DB$FUNC) MUST BE
*     STORED, IN ADDITION TO THE INFORMATION IN THE RELATION
*     STATUS SECTION. 
  
*     SO, WHILE LOOPING THROUGH THE FITLIST, PROCESSING IS PERFORMED
*     AS FOLLOWS: 
*     SET THE "ES" AND "RL" FIELDS OF THE FIT FROM THE VALUES STORED
*     IN THE FITLIST ENTRY. 
*     IF A VALUE OF CONTROL BREAK (DFCTLBRK) IS FOUND FOR THE "ES"
*     AND THE USER HAS A DBST THAT CONTAINS THE RELATION STATUS SECTION,
*     THEN STORE THE LOWEST RANK ON WHICH A CONTROL BREAK OCCURRED. 
*     IF A VALUE OF NULL RECORD (DFNULLST) IS FOUND FOR "ES" AND THE
*     USER HAS A DBST THAT CONTAINS THE RELATION STATUS SECTION,
*     THEN STORE THE LOWEST RANK ON WHICH A NULL RECORD WAS FOUND,
*     AND STORE THE FUNCTION NAME.  A NULL RECORD, WHICH
*     IS DEFINED AS A RECORD FILLED WITH THE SPECIAL CHARACTER "]", IS
*     GENERATED IN THE WSA SPECIFIED IN THE FIT.  THIS SAME SPECIAL 
*     RECORD IS CREATED FOR ALL SUBSEQUENT FIT ENTRIES TO THE END OF
*     THE LIST.  CONTROL IS RETURNED TO THE CALLER. 
*     IF INSTEAD, AN ERROR IS DETECTED IN A PARTICULAR FIT, 
*     AND THE USER HAS A DBST WITH THE RELATION STATUS SECTION, 
*     THEN STORE THE RANK OF THE FILE WITH THE CRM/CDCS ERROR.  IF
*     A FATAL ERROR OCCURRED, THEN THE ERROR IS DAYFILED IN 
*     THE UCP"S DAYFILE.  IF A CRM ERROR OCCURRED, AND AN 
*     ERROR ROUTINE IS SPECIFIED IN THE FIT, IT IS EXECUTED.  IF THE
*     ERROR WAS FATAL, THEN THE RUN-UNIT IS ABORTED.  IF NONFATAL, THEN 
*     CONTROL IS RETURNED TO THE USER.
* 
*     WHEN LOOPING THROUGH THE FITLIST IS COMPLETE (AND CONTROL 
*     HAS NOT BEEN RETURNED TO THE USER BY PROCESSING OF A CRM/CDCS 
*     ERROR OR A NULL RECORD), IF THE USER HAS A DBST 
*     WITH RELATION STATUS INFORMATION, AND A CONTROL BREAK 
*     OCCURRED, THEN STORE THE FUNCTION DESCRIPTION IN THE DBST.
* 
 #
      CONTROL EJECT;
      CONTROL NOLIST;         #CDGDFDCLS# 
  
# LOCAL ITEMS AND ARRAYS                                               #
  
      BASED ARRAY FIT;                  # USER FIT                     #
*CALL FITDCLS 
      CONTROL LIST; 
      ARRAY FITLIST;
*CALL FTLSTDCLS 
  
*CALL DBSTDCLS
      CONTROL PRESET; 
*CALL DB$FUNC 
  
      ITEM INDEX;                       # FOR LOOPS                    #
      ITEM INDEX2;                      # FOR LOOPS                    #
      ITEM J;                           # FOR LOOPS                    #
  
      BASED ARRAY NULLREC;              # FOR GENERATING NULL RECORD   #
        ITEM NULLITEM  C(0,0,10); 
  
      ITEM NULLVAL C(10) = "]]]]]]]]]]";
      ITEM RECLEN;                      # RECORD LENGTH                #
  
      ITEM ABTMSG C(40) = "     FATAL CDCS ERROR--RUN-UNIT ABORTED:"; 
  
      BASED ARRAY ERRBUF;;
  
  
# EXTERNAL REFERENCES                                                  #
  
      XREF PROC DB$ABRT;           # ABORT THE RUN-UNIT                #
      XREF PROC DB$CALL;                # EXECUTE FIT ERROR ROUTINE    #
      XREF PROC DB$MSG;            # ISSUE A DAYFILE MESSAGE           #
      XREF PROC DB$WEF;                 # WRITE MESSAGE TO ERROR FILE  #
  
# XREF VARIABLES                                                       #
  
      XREF ARRAY DB$DBS;
        BEGIN 
        ITEM DBSTLW  U(00,36,06);  # DBST LENGTH IN WORDS              #
        ITEM DBSTADR U(00,42,18);  # DBST ADDRESS AT THE UCP           #
        END 
  
      CONTROL NOLIST;              # RQPARDCLS - XREF ARRAY DB$RQBF    #
  
      XREF
  
        BEGIN 
  
  
        END 
  
      CONTROL LIST; 
      CONTROL EJECT;
  
# START OF D B $ R L C K  E X E C U T A B L E  C O D E                 #
  
  
      IF DBSTADR[0] NQ 0           # IF A DBST EXISTS FOR THIS USER    #
      THEN
        BEGIN 
        P<DBST> = DBSTADR[0];      # SET DBST POINTER                  #
        END 
  
#     LOOP THROUGH THE FITLIST, CHECKING THE "ES" FIELD.  UPDATE THE   #
#     FIT AND PROCESS THE INDICATED ERROR OR RELATION CONDITION.       #
#     IF A DBST EXISTS FOR THE USER, UPDATE THE RELATION STATUS        #
#     INFORMATION WHEN NECESSARY AND POSSIBLE.                         #
  
      FOR INDEX=0 STEP 1 WHILE FITADR[INDEX] NQ 0  DO 
        BEGIN 
  
        IF FITLES[INDEX] EQ DFNOREAD THEN 
          TEST INDEX;              #NO ACTIVITY ON FILE#
        P<FIT> = FITADR [INDEX];        # POINT TO ENTRY IN FIT LIST   #
        FITES[0] = FITLES[INDEX]; 
        FITRL[0] = FITLRL[INDEX]; 
  
#       PROCESS A CONTROL BREAK                                        #
  
        IF FITES[0] EQ DFCTLBRK    # TEST FOR CONTROL BREAK            #
        THEN
          BEGIN 
          IF DBSTLW[0] GQ DFDBSTREL  # IF THE USER HAS A DBST THAT     #
                                     # CONTAINS THE REL STATUS SECTION #
          THEN
            BEGIN 
            IF DBCTLBRK[0] EQ 0    # IF FIRST CONTROL BREAK ENCOUNTERED#
            THEN
              BEGIN 
              DBCTLBRK[0] = INDEX + 1;    # LOWEST RANK WITH CTL BRK   #
              END 
            END 
          TEST INDEX; 
          END                      # OF TEST FOR CONTROL BREAK         #
  
#       PROCESS A NULL RECORD OCCURRENCE                               #
  
        IF FITES[0] EQ DFNULLST THEN   #TEST FOR NULL RECORD# 
          BEGIN 
          IF DBSTLW[0] GQ DFDBSTREL  # IF THE USER HAS A DBST THAT     #
                                     # CONTAINS THE REL STATUS SECTION #
          THEN
            BEGIN 
            DBFUNCTION[0] = FUNCODE[RQPKHDFC[0]]; 
                                   # STORE FUNCTION DESCRIPTION        #
            DBNULLREC[0] = INDEX + 1;   # LOWEST RANK WITH NULL RECORD #
            END 
          FOR INDEX2=INDEX STEP 1 WHILE FITADR [INDEX2] NQ 0  DO
            BEGIN 
            P<FIT> = FITADR [INDEX2];   # NULL--CREATE SPECIAL RECORD  #
            P<NULLREC> = FITWSA;        # USING "WSA", "MRL" FIT FIELDS#
            RECLEN = FITMRL [0];
            FITRL[0] = FITMRL[0]; 
            FOR J=0 STEP 1 WHILE RECLEN GQ 10  DO 
              BEGIN 
              NULLITEM [J] = NULLVAL; 
              RECLEN = RECLEN - 10; 
              END 
            IF RECLEN NQ 0  THEN
              C<0,RECLEN>NULLITEM[J] = NULLVAL; 
            END 
          RETURN; 
          END                      # OF TEST FOR NULL RECORD           #
  
  
#       PROCESS A CRM/CDCS ERROR                                       #
  
        IF FITES[0] NQ 0           # TEST FOR CRM/CDCS ERROR           #
        THEN
          BEGIN 
  
          IF DBSTLW[0] GQ DFDBSTREL  # IF THE USER HAS A DBST THAT     #
                                     # CONTAINS THE REL STATUS SECTION #
          THEN
            BEGIN 
            DBRKRELERR[0] = INDEX + 1;  # RANK WITH CRM/CDCS ERROR     #
            END 
  
          IF RQHDRERF[0] EQ DFERRNON  # IF NONFATAL ERROR OCCURRED     #
            AND RQPKTASK [0] EQ 0 
          THEN
            BEGIN 
            DB$WEF(FIT);           # WRITE MESSAGE TO ERROR FILE       #
            END 
  
          IF RQHDRERF[0] EQ DFERRFAT  # IF FATAL ERROR OCCURRED        #
            AND RQPKTASK [0] EQ 0 
          THEN
            BEGIN 
            P<ERRBUF> = RQPKEBUF[0];
            DB$MSG(ERRBUF);        # DAYFILE ERROR MESSAGE             #
            DB$MSG(ABTMSG); 
            END 
  
          IF RQPKERR[0] NQ 0      # IF AN ERROR OCCURRED               #
            AND FITEX[0] NQ 0      # AND A FIT ERROR ROUTINE EXISTS    #
          THEN
            BEGIN 
            DB$CALL (FITEX[0]); 
            END 
  
          IF RQHDRERF[0] EQ DFERRFAT  # IF A FATAL ERROR OCCURRED      #
            AND RQPKTASK [0] EQ 0 
          THEN
            BEGIN 
            DB$ABRT;               # ABORT THE RUN-UNIT                #
            END 
  
          RETURN; 
          END                      # OF TEST FOR CRM/CDCS ERROR        #
  
        END                        # OF LOOP THROUGH FITLIST           #
  
#     ALL ENTRIES IN THE FITLIST HAVE BEEN PROCESSED.  IF THE USER     #
#     HAS ESTABLISHED A DBST, SUPPLY ALL RELEVANT STATUS INFORMATION   #
#     THAT HAS NOT YET BEEN UPDATED.                                   #
  
      IF DBSTLW[0] GQ DFDBSTREL    # IF THE USER HAS A DBST WITH       #
                                   # RELATION STATUS INFORMATION       #
      THEN
        BEGIN 
        IF DBCTLBRK[0] NQ 0        # IF A CONTROL BREAK OCCURRED       #
        THEN
          BEGIN 
          DBFUNCTION[0] = FUNCODE[RQPKHDFC[0]]; 
                                   # SUPPLY THE FUNCTION DESCRIPTION   #
          END 
        END 
  
  
      END 
      TERM
