*DECK DB$ACHK 
USETEXT CDCSCTX 
      PROC DB$ACHK; 
      BEGIN 
 #
* *   DB$ACHK--CHECK AREA STATUS                 PAGE  1
* *   C O GIMBER                                 3/14/77
* 
* DC  PURPOSE 
* 
*     PERFORM CHECKS ON AREA BEFORE PROCESSING IT.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*     NONE
* 
*     ASSUMPTIONS 
* 
*     CSFIXED - POINTER SET.
*     RCB     - POINTER SET. CONTAINS REQUEST PACKET. 
*     RSB     - POINTER SET.
*     TQT     - POINTER SET.
* 
* DC  EXIT CONDITIONS 
* 
*     THE AREA HAS SUCCESSFULLY PASSED ALL CHECKS, AND, IF THE
*     RUN-UNIT HAS ESTABLISHED A DBST THAT IS LONG ENOUGH TO INCLUDE
*     THE AREA NAME, THEN THE AREA NAME HAS BEEN STORED IN THE DBST.
*     ELSE, IF THE AREA DID NOT SUCCESSFULLY PASS ALL OF THE CHECKS 
*     THEN THE REQUEST HAS BEEN ABORTED.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ERR;      #CDCS ERROR PROCESSOR# 
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT#
      XREF PROC DB$SFIT;     #SET UP FIT FOR IO OPERATION#
# 
* DC  NON-LOCAL VARIABLES 
* 
*     RSB - RSFCAORD (CURRENT AREA ORDINAL) SET 
 #
  
  
      CONTROL NOLIST;        #*CALL CSTARDCLS#
*CALL CSTARDCLS 
      CONTROL LIST; 
*CALL DBSTDCLS
#     THE FOLLOWING TWO BASED ARRAYS ARE USED WHEN COPYING THE         #
#     AREA NAME FROM THE CST AREA WORK BLOCK TO THE DBST.              #
  
      BASED ARRAY CSTAREANAME;     # TO BE BASED AT THE AREA NAME IN   #
                                   # THE CST AREA WORK BLOCK.          #
        BEGIN 
        ITEM CSTAREAWD  C(00,00,10);
        END 
  
      BASED ARRAY DBAREANAME;      # TO BE BASED AT THE AREA NAME IN   #
                                   # THE DBST                          #
        BEGIN 
        ITEM DBAREAWD   C(00,00,10);
        END 
  
  
      ITEM I;                      # FOR LOOPS                         #
  
  
  
  
#     B E G I N   D B $ A C H K   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
*     IF ILLEGAL AREA THEN ERROR. 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("ACHK   "); 
      CONTROL ENDIF;
  
      IF RCPARORD[0] LQ 0 
       OR RCPARORD[0] GR CSFARENO[0]
       THEN 
         BEGIN
         DB$ERR(6); 
         END
 #
*     SET RSFCAORD,P<RSARBLK>,P<OFT>,P<FPT>.
 #
      RSFCAORD[0] = RCPARORD[0];
      SETRSARBLK; 
      P<OFT> = RSAROFIT[0]; 
      RCOFTLOC[0] = LOC(OFT); 
      P<FKL> = RSFFKLLOC[0];
      IF RSARFPT[0] NQ 0
      THEN
        BEGIN 
        P<FPT> = LOC(FKL) + RSARFPT[0]; 
        END 
 #
*     IF A DBST EXISTS FOR THE RUN-UNIT AND THE DBST IS LONG ENOUGH TO
*     INCLUDE THE AREA NAME, THEN STORE THE AREA NAME IN THE DBST.
 #
      IF TQDBSTLW[0] GQ DFDBSTAREA
      THEN
        BEGIN 
        P<CSAREBLK> = LOC(CSFIXED) + RSARCSTP[0]; 
                                   # POINT THE CST AREA WORK BLOCK     #
        P<CSTAREANAME> = LOC(CSANAME[0]); 
                                   # POINT TO AREA NAME IN THE CST     #
        P<DBST> = TQDBSTSCP[0];    # POINT TO THE SCP-SIDE DBST        #
        P<DBAREANAME> =LOC(DBAREA[0]);  # POINT TO AREA NAME IN DBST   #
        FOR I=0 STEP 1             # STORE THE AREA NAME IN THE DBST,  #
                                   # LEFT-JUSTIFIED, BLANK-FILLED      #
          UNTIL 2 
        DO
          BEGIN 
          IF I LS CSANAMLW[0] 
          THEN
            BEGIN 
            DBAREAWD[I] = CSTAREAWD[I]; 
            END 
          ELSE
            BEGIN 
            DBAREAWD[I] = " ";
            END 
          END 
        END 
 #
*     IF THE AREA IS DOWN THEN GIVE ERROR.
 #
      IF OFSTATUS[0] NQ S"UP" AND 
                    OFSTATUS[0] NQ S"IDLING"
      THEN
        BEGIN 
        DB$ERR(10); 
        RETURN; 
        END 
  
#     CHECK FOR OUTSTANDING FATAL ERRORS                               #
  
      IF RSARFPT[0] NQ 0
      THEN
        BEGIN 
        IF FPFITFNF[0]
        THEN
          BEGIN 
          DB$ERR(63); 
          END 
        END 
 #
*     IF THE FUNCTION IS OPEN AND THE AREA IS ALREADY OPEN, 
*     THEN ISSUE ERROR NUMBER 11. 
 #
      IF RCFUNC[0] EQ DFOPN THEN
        BEGIN 
        IF RSARFPT[0] NQ 0 THEN 
          DB$ERR(11); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("ACHK-1 "); 
        CONTROL ENDIF;
  
        RETURN; 
        END 
 #
*     IF AREA NOT ALREADY OPEN THEN ERROR.
*     SET UP FIT FIELDS.
 #
      IF RSARFPT[0] EQ 0 THEN 
        DB$ERR(13); 
      DB$SFIT;
 #
*     IF MAJOR KEY LENGTH IS GREATER THAN KEY LENGTH, ISSUE ERROR.
 #
      IF FPFITMKL[0] GR FPFITKL[0]
      THEN
        BEGIN 
        FPFITES[0] = O"525";
        DB$ERR(12); 
        END 
      END  #DB$ACHK#
      TERM; 
