*DECK DB$LTSB 
USETEXT CDCSCTX 
      PROC DB$LTSB(SBNAM,LTIM,ERSTAT);
      BEGIN 
 #
* *   DB$LTSB -- SUBSCHEMA RETAIN/RETURN         PAGE  1
* *   RETAIN/RETURN PROCESSOR 
* *   W P CEAGLIO                                DATE  05/01/79 
* *   M. E. STERMER                              DATE  05/16/81 
* 
* DC  PURPOSE 
* 
*     SET OR CREATE THE RETENTION MODE FLAG FOR A SUBSCHEMA 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
# 
      ITEM SBNAM C(30);            # SUBSCHEMA NAME (BLANK FILL)       #
      ITEM LTIM      B;            # MODE (TRUE = SET FLAG)            #
      ITEM ERSTAT    I;            # STATUS OF CALL (OUTPUT)           #
# 
* 
*     ASSUMPTIONS 
* 
*     SALX    SET TO INDEX OF SAL ENTRY FOR APPLICALBE SCHEMA 
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL   -- THE ACTION SPECIFIED BY THE MODE PARAMETER IS DONE. 
*                 ERSTAT IS SET = 0.
* 
*     ABNORMAL - NO ACTION.  ERSTAT IS SET TO 1 OR 2 (UNKNOWN SUBSCHEMA 
*     OR RETENTION MODE RULE VIOLATION, RESPECTIVELY).
* 
* 
* DC  CALLING ROUTINES
* 
*     DB$DS30 (WITHIN DB$DSCS)    L-DISPLAY 
*     DB$DS31 (WITHIN DB$DSCS)    L-DISPLAY 
* 
* DC  CALLED ROUTINES 
* 
# 
      XREF PROC DB$ASLC;           # CREATE ASL ENTRY                  #
      XREF PROC DB$ASLF;           # SEARCH ASL FOR SUBSCHEMA NAME     #
      XREF PROC DB$FLOP;           # GENERATE A FLOW POINT             #
      XREF PROC DB$GOFT;           # SEARCH FOR AREA ID                #
      XREF FUNC DB$LNK;            # LINK CMM BLOCK INTO CHAIN         #
      XREF PROC DB$OFTC;           # CREATE AN OFT ENTRY               #
      XREF PROC DB$RLSA;           # RELEASE (RETURN) ASL              #
      XREF PROC DB$RLSF;           # RELEASE (RETURN) AREAS            #
      XREF PROC DB$RLSP;           # RELEASE (RETURN) DBP FILE         #
# 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON 
* 
* DC  DESCRIPTION 
* 
*     -  INITIALIZE RESULT OF REQUEST TO *SUCCESS*
* 
*     -  SEARCH THE ASL CHAIN FOR THE SAL ENTRY.
* 
*     -  IF THE MODE PARAMETER IS TRUE (SET FLAG)-- 
*           * IF THE SEARCH WAS UNSUCCESSFUL, CREATE AN ASL ENTRY (ERROR
*             IF UNKNOWN SUBSCHEMA).
*           * IF THERE IS A CST, SEARCH THE OFT CHAIN FOR EACH AREA IN
*             THE CST.  FOR EACH MATCHING OFT ENTRY WITH VERSION OF 
*             MASTER, INCREMENT THE RETAIN COUNT IN THE OFT.  IF NO 
*             MATCHING OFT IS FOUND, CREATE A DUMMY OF VERSION MASTER.
*           * RETURN
* 
*     -  OTHERWISE, MODE IS FOR CLEARING THE FLAG.  IF THE ASL SEARCH 
*        WAS UNSUCCESSFUL, SET ERROR(UNKOWN SUBSCHEMA) AND RETURN.
* 
*     -  IF *RETAIN* FLAG NOT SET IN ASL ENTRY, SET ERROR (NOT IN LONG- 
*        TERM MODE) AND RETURN. 
* 
*     -  IF ASL USER COUNT NOT ZERO, CLEAR FLAG IN ASL AND RETURN.
* 
*     -  IF THERE IS A CST, EXAMINE ALL OFT ENTRIES FOR AREAS IN THE
*        CST.  IF THERE IS A MATCH, DECREMENT THE OFT RETAIN COUNT--IF
*        IT NOT GREATER THAN ZERO, AND THE OFT USER COUNT IS ZERO, THEN 
*        RELEASE THE DATA AND INDEX FILES.
* 
*     -  RELEASE THE ASL
* 
*     -  IF THE ASL CHAIN IS EMPTY, RELEASE THE DATA BASE PROCEDURE 
*        FILE AND ANY LOADED PROCEDURES.
* 
 #
      CONTROL EJECT;
  
#     COMDECK CALLED - CSTARDCLS                                       #
  
      CONTROL NOLIST; 
*CALL CSTARDCLS 
      CONTROL LIST; 
  
#     LOCAL VARIABLES                                                  #
  
      ITEM ARID    I;              # USED FOR SCAN OF CST AREA BLCOKS  #
      ITEM DISPL   I;              # USED FOR SCAN OF CST AREA BLCOKS  #
      ITEM ERCODE  I;              # USED FOR CREATION OF ASL ENTRY    #
      ITEM FOUND   B;              # USED IN SEARCH OF OFT CHAIN       #
      ITEM I       I;              # SCRATCH -- FOR LOOPS              #
      ITEM J       I;              # SCRATCH -- FOR LOOPS              #
      ITEM K       I;              # SCRATCH -- FOR LOOPS              #
      ITEM MASTERVN C(7);          # USED TO HOLD VERSION NAME *MASTER*#
      ITEM RESULT  I;              # USED FOR SEARCH OF ASL            #
  
      CONTROL EJECT;
  
  
#     S T A R T  O F  D B $ L T S B  E X E C U T A B L E  C O D E      #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LTSB   ");        # GENERATE FLOW POINT - ENTRY       #
      CONTROL ENDIF;
  
#     INITIALIZE RESULT OF REQUEST TO *SUCCESS*                        #
  
      ERSTAT = 0; 
  
#     SEARCH THE ASL CHAIN FOR THE SAL ENTRY                           #
  
      DB$ASLF(SBNAM,RESULT);
  
#     IF THE MODE PARAMETER IS TRUE (SET FLAG) AND THE RESULT OF THE   #
#     SEARCH WAS UNSUCCESSFUL, CREATE AN ASL ENTRY (IF VALID SUBSCHEMA #
#     NAME).  IN ANY CASE, SET THE LONG-TERM FLAG IN THE ASL ENTRY.    #
#     FOR EACH AREA IN THE CST, EITHER INCREMENT AN EXISTING OFT ENTRY #
#     (IF IT MATCHES THE AREA), OR CONSTRUCT A DUMMY OFT ENTRY.        #
  
      IF LTIM 
      THEN
        BEGIN 
        IF RESULT NQ 0
        THEN
          BEGIN 
          DB$ASLC(SBNAM,ERCODE);
          IF ERCODE NQ 0
          THEN
            BEGIN 
            ERSTAT = 1;            # UNKNOWN SUB-SCHEMA                #
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LTSB-R1");  # GENERATE FLOW POINT - RETURN 1    #
            CONTROL ENDIF;
  
            RETURN; 
            END 
          ASINCF [0] = TRUE;       # SET THE ASL INCOMPLETE FLAG TO    #
                                   # INDICATE THAT THE SUBSCHEMA TABLES#
                                   # ARE NOT READY FOR GENERAL USE.    #
  
          END 
        ELSE
          BEGIN 
          IF ASLTIF [0] 
          THEN
            BEGIN 
            ERSTAT = 2;            # SUB-SCHEMA ALREADY IN LT MODE     #
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LTSB-R2");  # GENERATE FLOW POINT - RETURN 2    #
            CONTROL ENDIF;
  
            RETURN; 
            END 
  
          END 
        ASLTIF [0] = TRUE;
        IF ASCSTLOC [0] GR 0
        THEN
          BEGIN                    # EXAMINE OFT CHAIN                 #
          P<CSFIXED> = ASCSTLOC [0];
          DISPL = DFCSTFIX; 
          FOR I=1 STEP 1
            UNTIL CSFARENO [0]
          DO
            BEGIN 
            P<CSAREBLK> = LOC(CSFIXED) + DISPL; 
            ARID = CSAIDENT [0];
            MASTERVN = DFMASTER;
            DB$GOFT(ARID,MASTERVN,FOUND); 
            IF FOUND
            THEN
              BEGIN                # MATCH--BUMP *RETAIN* COUNT        #
              OFRETCT [0] = OFRETCT [0] + 1;
              END 
            ELSE
              BEGIN                # NO MATCH--CREATE DUMMY OFT ENTRY  #
              DB$OFTC;             # CREATE AN OFT                     #
              OFVENAME[0] = MASTERVN; 
              OFARID [0] = ARID;
              OFRETCT [0] = 1;
              END 
            DISPL = DISPL + CSALENTH [0]; 
            END 
          END 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LTSB-R3");      # GENERATE FLOW POINT - RETURN 3    #
        CONTROL ENDIF;
  
        RETURN; 
        END 
  
  
#     OTHERWISE, THE MODE IS FOR CLEARING THE FLAG.  IF THE ASL SEARCH #
#     WAS NOT SUCCESSFUL, SET ERROR (UNKNOWN SUBSCHEMA) AND RETURN.    #
#     IF THE ASL IS NOT IN LONG-TERM MODE, SET ERROR AND RETURN        #
#     EXAMINE THE OFT CHAIN FOR AREAS IN THE CST ASSOCIATED WITH       #
#     THE ASL ENTRY--FOR EACH MATCH, DECREMENT THE OFT *RETAIN* COUNT, #
#     AND IF IT IS NOT GREATER THAN ZERO AND THE OFT USER COUNT IS ZERO#
#     , RELEASE THE DATA AND INDEX FILES.                              #
#     IF THE ASL USER COUNT IS NOT ZERO, CLEAR *RETAIN* FLAG AND RETURN#
  
      IF RESULT NQ 0
      THEN
        BEGIN 
        ERSTAT = 1;                # UNKNOWN SUB-SCHEMA                #
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LTSB-R4");          # GENERATE FLOW POINT - RETURN 4#
        CONTROL ENDIF;
  
        RETURN; 
        END 
  
      IF NOT ASLTIF [0] 
      THEN
        BEGIN 
        ERSTAT = 2;                # NOT IN LONG-TERM MODE             #
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LTSB-R5");          # GENERATE FLOW POINT - RETURN 5#
        CONTROL ENDIF;
  
        RETURN; 
        END 
  
      IF ASCSTLOC [0] GR 0
      THEN
        BEGIN                      # MATCH OFT WITH CST AREAS          #
        P<CSFIXED> = ASCSTLOC [0];
        DISPL = DFCSTFIX; 
        FOR I=1 STEP 1
          UNTIL CSFARENO [0]
        DO
          BEGIN 
          P<CSAREBLK> = LOC(CSFIXED) + DISPL; 
          ARID = CSAIDENT [0];
          MASTERVN = DFMASTER;
          DB$GOFT(ARID,MASTERVN,FOUND); 
          IF FOUND
          THEN
            BEGIN                  # MATCH--DECREMENT *RETAIN* COUNT   #
            OFRETCT [0] = OFRETCT [0] - 1;
            IF OFUSERS [0] EQ 0 
              AND OFRETCT [0] EQ 0
            THEN
              BEGIN 
              DB$RLSF;             # RELEASE FILES                     #
              END 
            END 
          DISPL = DISPL + CSALENTH [0]; 
          END 
        END 
  
  
      IF ASNUSERS [0] NQ 0
      THEN
        BEGIN 
        ASLTIF [0] = FALSE; 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LTSB-R6");          # GENERATE FLOW POINT - RETURN 6#
        CONTROL ENDIF;
  
        RETURN; 
        END 
  
#     RELEASE ASL                                                      #
  
      DB$RLSA;
  
#     IF THE ASL CHAIN IS EMPTY, RELEASE THE DATA BASE PROCEDURE FILE  #
#     AND ANY LOADED PROCEDURES.                                       #
  
        IF SAASLPTR [SALX] EQ 0 
          AND SADBPPTR [SALX] NQ 0
        THEN
          BEGIN 
          DB$RLSP;
          END 
  
      END 
      TERM
