*DECK DB$TQTD 
USETEXT CDCSCTX 
USETEXT JLPCMTX 
      PROC DB$TQTD; 
      BEGIN 
 #
* *   DB$TQTD -- TQT DELETER                     PAGE  1
* *   C O GIMBER                                 12/19/75 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     DELETE TQT ENTRY AND RETURN ALL ITS RESOURCES.
* 
* DC  ENTRY CONDITIONS
* 
*     TQT BASED ARRAY POINTS TO AN TQT ENTRY TO BE DELETED. 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC DB$CDEB C(10);  # INTEGER TO DECIMAL WITH LEADING BLANK#
      XREF FUNC DB$CDEC C(10);  # INTEGER TO DECIMAL WITH LEADING ZEROS#
      XREF PROC DB$CLSA;     #CLOSE AREA AND LOG CLOSE# 
      XREF PROC DB$DUDF;     # UPDATE DYNAMIC DISPLAY FIELDS           #
      XREF PROC DB$FLOP;     # GENERATE FLOW POINT                     #
      XREF PROC DB$FLSH;     # FLUSH CRM OUTPUT BUFFERS                #
      XREF PROC DB$JLH;      # INITIALIZE JOURNAL LOG RECORD HEADER    #
      XREF PROC DB$JLO;      # OUTPUT A JOURNAL LOG RECORD             #
      XREF PROC DB$JRPT;     # JOURNAL LOG RECOVERY POINT / LOG SWITCH #
      XREF PROC DB$LNKD;     #DELINK LINKED BLOCK#
      XREF PROC DB$MBFA;     # FREE ALL TEMPORARY BUFFERS              #
      XREF PROC DB$MFF;      #CMM FREE FIXED BLOCK# 
      XREF PROC DB$MSG;      #ISSUE MESSAGE TO DAYFILE AND B DISPLAY# 
      XREF PROC DB$OFTR;     # OFT RELEASE PROCESSOR                   #
      XREF PROC DB$POP2;     # POP TWO VARIABLES FROM STACK            #
      XREF PROC DB$PSH2;     # PUSH TWO VARIABLES ONTO STACK           #
      XREF PROC DB$PST;      #PURGE UNUSED SCHEMA TABLES# 
      XREF PROC DB$PUNT;     # ABORT CDCS                              #
      XREF PROC DB$QRP;      #FLUSH QRF FILE# 
      XREF PROC DB$RCBF;     # PROCESS RCB END-CASE FLAGS              #
      XREF PROC DB$SCHD;     # CDCS TASK SCHEDULER                     #
      XREF PROC DB$SFCL;     #SFCALL PROCESSOR# 
      XREF PROC DB$SWPI;     # SWAP IN RSB/CST TABLES                  #
      XREF PROC DB$UNDU;     # BACK-OUT UNCOMMITTED TRANSACTION        #
      XREF PROC DB$WART;     # WRITE THE ART TO THE TRF                #
      XREF PROC DB$WSAR;     # RETURN WORKING STORAGE AREAS            #
# 
*     INTERNAL ROUTINES 
* 
*     PROC SETMSG5,                - INSERT SCHEMA NAME/ID IN MESSAGE 5-
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON 
* 
*     JOURNAL LOG COMMON
 #
 #                                                                     #
      XREF ITEM DB$DNAA I;         # NUMBER OF ACTIVE AREAS            #
      XREF ITEM DB$DNAS I;         # NUMBER OF ACTIVE SCHEMAS          #
      XREF ITEM DB$DNAU I;         # NUMBER OF ACTIVE USERS            #
      XREF ITEM DB$DSST S:SACSTAT; # CDCS SYSTEM STATUS                #
      XREF ITEM RJRSW B;           # RESTRICT JOURNAL RECORDS - SWITCH #
 #                                                                     #
# 
*     LOCAL VARIABLES 
# 
      ITEM AREAOFFSET;
      ITEM MSG5 C(58) = 
          "THE SCHEMA ID/NAME IS NNNN/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX:"; 
      ITEM RECOVSW B;              # SWITCH TO TRIGGER A RECOVERY POINT#
      ITEM SAVEDRUID;              # RUID FROM TQT ENTRY               #
      ITEM TEXT C(30) = " USER TERMINATION "; 
# 
*     LOCAL DEFS
# 
      DEF DFCPMSG5ID # 22 #;       # BCP OF ID PORTION OF MSG5         #
      DEF DFCPMSG5NM # 27 #;       # BCP OF NAME PORTION OF MSG5       #
  
      CONTROL NOLIST;              # QRTABDCLS                         #
*CALL QRTABDCLS 
      CONTROL LIST; 
  
  
  
  
#     E X E C U T A B L E   C O D E   F O R   D B $ T Q T D            #
  
  
 #
* 
* DC  DESCRIPTION 
* 
*     CLEAR EXISTING END CONDITIONS.
* 
*     IF LTC FLAG THEN
*       ISSUE TERMINATION MESSAGE TO UCP. 
*       CLEAR LONG-TERM CONNECT FLAG IN TQT 
*       CLEAR LONG-TERM CONNECT IF ONLY TQT ENTRY WITH RUID.
*       ISSUE SFCALL ENDT 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("TQTD   ");
      CONTROL ENDIF;
  
      IF RCFLAGS[0] 
      THEN                             # SOME END CONDITIONS ARE TRUE  #
        BEGIN 
        DB$RCBF;                       # CLEAR END CONDITION FLAGS     #
        END 
  
      IF TQLTCF[0] THEN 
        BEGIN 
        TQLTCF[0] = FALSE;
        SAVEDRUID = TQRUID[0];
        P<TQT> = LOC(TQTCHAIN); 
        FOR SAVEDRUID=SAVEDRUID WHILE TQNEXT[0] NQ 0 DO 
          BEGIN 
          P<TQT> = TQNEXT[0]; 
          IF TQRUID[0] EQ SAVEDRUID 
          AND TQLTCF[0] 
          THEN
            BEGIN 
            P<TQT> = RCTQT[0];
            GOTO CLEARLTCEND; 
            END 
          END 
        P<TQT> = RCTQT[0];
        DB$SFCL(DFSFCLTC,0,0,0);
CLEARLTCEND:  
        DB$SFCL(DFSFENDT,0,RCIRUCPA[0],0);
        END 
      ELSE
        BEGIN 
        IF TQTERM[0]
        THEN
          BEGIN                    # TERMINATE TASK                    #
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("TQTD-TT"); 
          CONTROL ENDIF;
          DB$SFCL(DFSFENDT,0,-1,0); 
          END 
        END 
 #
*     RETURN ALL TEMPORARY BUFFERS THAT ARE CURRENTLY HELD. 
*       THIS WILL AVOID ASSIGNMENT OF MULTIPLE BUFFERS ON A SINGLE
*       BASED ARRAY POINTER.
*       FOR INSTANCE, DB$UNDU AND DB$JLH EACH ASSIGN A BASED ARRAY
*       USING JLREC.
*       IF A JLREC BASED ARRAY IS ALREADY DEFINED, A JOURNAL LOG
*       ERROR MAY RESULT. 
 #
      DB$MBFA;
 #
*     IF RSB IS SWAPPED OUT, SWAP IT IN.
 #
      IF TQRSB[0] LS 0
      THEN
        BEGIN 
        DB$SWPI;
        END 
 #
*     IF AN UNCOMMITTED TRANSACTION EXISTS, BACK IT OUT.
 #
      IF TQARTX[0] NQ 0 
        AND SALX LQ SALL
        AND SASCHST[SALX] NQ S"ERRDOWN" 
      THEN
        BEGIN 
        DB$UNDU;
        END 
 #
*     IF RSB EXISTS FOR TQT THEN
*       FLUSH CRM BLOCKS AND JOURNAL LOG FILE.
 #
      IF TQRSB [0] NQ 0 
        AND SALX LQ SALL
        AND SASCHST[SALX] NQ S"ERRDOWN" 
      THEN
        BEGIN 
 #
*       CHECK WHETHER ART MUST BE WRITTEN TO TRF BEFORE RELEASING LOCKS 
*       HELD BY THIS RUNUNIT. 
 #
        IF RCWART[0]               # IF ART MUST BE WRITTEN TO TRF     #
        THEN
          BEGIN 
          DB$WART;                 # WRITE ART TO TRF                  #
          END 
 #
*       CLEAR RCMLOK OR DB$LOKD MAY NOT CLEAR ALL OF THE LOCKS. 
 #
        RCMLOK[0] = FALSE;
 #
*       LOOP THRU ALL AREA FOR USER 
 #
        RCCT[0] = 0;               # CONSTRAINT MUST NOT BE DFWAITTERM #
        FOR AREAOFFSET = DFRSBFIX + DFARECON * (CSFARENO[0]-1) STEP 
          -DFARECON UNTIL DFRSBFIX DO 
          BEGIN 
          P<RSARBLK> = P<RSB> + AREAOFFSET; 
          P<OFT> = RSAROFIT[0]; 
          RCOFTLOC[0] = LOC(OFT); 
          P<FKL> = RSFFKLLOC[0];
 #
*         CLOSE AREA IF OPEN. 
 #
          IF RSARFPT[0] NQ 0
          THEN
            BEGIN 
            P<FPT> = LOC(FKL) + RSARFPT[0]; 
            FPFTEX[0] = DFFTEX0;   # DO NOT EXECUTE DB PROCS ON ERROR  #
            DB$PSH2(AREAOFFSET,P<OFT>); 
            DB$CLSA;
            DB$POP2(P<OFT>,AREAOFFSET); 
            P<RSARBLK> = P<RSB> + AREAOFFSET; 
            P<FPT> = DFNPTR;
            END 
 #
*         IF LAST USER OF OFT THEN DO OFT RELEASE PROCESSING--
*           RELEASE INTERNAL FILE TABLE (IFT) 
*           CHECK FOR CHANGE IN OFT STATUS
*           RETURN FILE IF NOT RETAINED.
 #
          IF P<OFT> NQ 0 THEN 
            BEGIN 
            OFUSERS[0] = OFUSERS[0] - 1;
            IF OFOPENS[0] GR OFUSERS[0] 
            THEN
              BEGIN 
              DB$PUNT("DB$TQTD"); 
              END 
            RSAROFIT[0] = 0;   # CLEAR THE OFT POINTER JUST IN CASE    #
                               # ANOTHER USER ABORT NOTIFICATION IS    #
                               # RECEIVED FROM THE OS BEFORE DB$TQTD   #
                               # COMPLETES.                            #
                               # THAT WOULD CAUSE DB$TQTD TO BE        #
                               # REPEATED, REDUCING OFUSERS AGAIN.     #
            IF OFUSERS [0] EQ 0 THEN
              BEGIN 
              DB$OFTR;             # OFT RELEASE PROCESSOR.            #
              END 
            END 
          END 
 #
*       SET A SWITCH THAT WILL REDUCE THE FREQUENCY OF RECOVERY POINTS. 
*       TAKE A RECOVERY POINT WHEN THE LAST USER OF THE SCHEMA
*       TERMINATES OR IF THE QRF IS OVER ONE THIRD FULL.
 #
        RECOVSW = TRUE; 
        P<QFT> = SAQRFPTR[SALX];
        IF SASCUSERS[SALX] GR 1 
          AND LOC(QFT) NQ 0 
          AND (QFSIZE[0] - QFFREE[0]) *3 LS QFSIZE[0] 
        THEN
          BEGIN 
          RECOVSW = FALSE;
          END 
 #
*     IF LOGGING IS SPECIFIED 
*       LOG A SIGN-OFF RECORD AND A JOURNAL LOG RECOVERY POINT. 
*     ELSE
*       IF QRF LOGGING IS ACTIVE, TAKE A QRF RECOVERY POINT.
 #
        IF SAJLFPTR[SALX] NQ 0
          AND NOT SANOJLF[SALX] 
          AND NOT RCJLRS[0]        # NOT DROPPED DURING JOURNAL LOGGING#
          AND NOT RCJLWTR[0]       # NOT DROPPED DURING DB$RWTR        #
          AND SASCHST[SALX] NQ S"ERRDOWN" 
        THEN
          BEGIN 
          IF NOT RJRSW             # NOT RESTRICTED BY RJR PARAMETER   #
          THEN
            BEGIN 
            PARLEN = DFJLSZTM;     # SIZE OF TERMINATE LOG RECORD      #
            DB$JLH;                # INITIALIZE JOURNAL LOG REC HEADER #
  
            JLHDWDA[0] = DFJLWDATM; 
            JLTMSCNM[0] = SASCNAME[SALX];  # SCHEMA NAME               #
            JLTMSBNM[0] = ASSBNAME[0];     # SUBSCHEMA NAME            #
            JLTMNRDS[0] = DB$CDEC(RSFNRDS[0],10);  # NUMBER OF READS   #
            JLTMNWRS[0] = DB$CDEC(RSFNWRS[0],10);  # NUMBER OF WRITES  #
            JLTMNRWS[0] = DB$CDEC(RSFNRWS[0],10);  # NUMBER OF REWRITES#
            JLTMNDLS[0] = DB$CDEC(RSFNDLS[0],10);  # NUMBER OF DELETES #
            JLTMRCPT[0] = "0000000000";  # NO RECOVERY POINT NUMBER    #
            TRLRLEN = 0;
  
            DB$JLO;                   # OUTPUT A JOURNAL LOG RECORD    #
            END 
          IF NOT RCJLRS[0]         # COULD BE SET DURING DB$JLO        #
            AND NOT RCJLWTR[0]     # IF SO, DONT ATTEMPT RECOVERY POINT#
            AND RECOVSW 
          THEN
            BEGIN 
            IF SAJLUPD[SALX]       # TRUE IF ANY UPDATES SINCE LAST    #
                                   # RECOVERY POINT                    #
            THEN
              BEGIN 
              DB$JRPT(LOC(TEXT));  # JOURNAL LOG RECOVERY POINT        #
              END 
            ELSE
              BEGIN 
              IF SAQRFPTR[SALX] NQ 0
              THEN
                BEGIN 
                DB$FLSH;
                RPNUM = RPNUM +1; 
                DB$QRP(RPNUM);     # RESET THE QRF                     #
                END 
              END 
            END 
          END 
        ELSE
          BEGIN 
          IF SAQRFPTR[SALX] NQ 0
            AND RECOVSW 
          THEN
            BEGIN 
            DB$FLSH;
            RPNUM = RPNUM +1; 
            DB$QRP(RPNUM);   # RESET THE QRF                           #
            END 
          END 
 #
*       RELEASE RSB IF THERE WAS ONE. 
 #
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP ("TQTD-1 ");
        CONTROL ENDIF;
  
        P<RSB> = TQRSB[0];
        P<FKL> = RSFFKLLOC[0];
        IF LOC(FKL) NQ LOC(RSB) + RSFRLEN[0]
        THEN                 # THE FKL IS NOT ATTACHED TO THE RSB      #
          BEGIN 
          DB$MFF(P<FKL>);    # RETURN THE FKL                          #
          END 
        DB$MFF(P<RSB>);      # RETURN THE RSB                          #
        TQRSB [0] = 0;
        END 
 #
* 
*     IF A SYSTEM FILE INITIALIZATION IS IN PROGRESS, WAIT UNTIL THE
*     THE INITIALIZATION IS COMPLETE, UNLESS THIS IS THE RCB THAT 
*     THE INITIALIZATION WAS BEING DONE FOR.
*      (THAT HAPPENS IF A REQUEST IS DROPPED DURING THE INITIALIZATION) 
 #
      IF NOT SASFINCOMP[SALX] 
        AND SALX LQ SALL
        AND NOT RCINVI[0] 
      THEN
        BEGIN 
        DB$SCHD(LOC(SASFINCOMP[SALX]),DFWAITINV); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("TQTD-S1");      # GENERATE FLOW POINT - SCHED 1     #
        CONTROL ENDIF;
  
        END 
  
      IF SALX LQ SALL 
      THEN
        BEGIN 
        RCINVI[0] =TRUE;
        SASFINCOMP[SALX] = FALSE;  # DELAY ANY DB$SFIN EXECUTION       #
                                   # WHILE DB$PST IS EXECUTING.        #
  
        DB$PST;                    # PURGE SCHEMA TABLES               #
  
        RCINVI[0] =FALSE; 
        SASFINCOMP[SALX] = TRUE;
        END 
 #
* 
*     IF THE TQT HAS BEEN COUNTED AMONG THE ACTIVE USERS THEN 
*     DECREMENT THE ACTIVE USER COUNT.
*     DECREMENT SCHEMA USAGE COUNT. 
*     IF RESULTANT COUNT IS ZERO, 
*       DECREMENT ACTIVE SCHEMA COUNT,
*       SET COMPLETION OF AN IDLE/DOWN IF NEEDED. 
 #
      IF TQCOUNTED[0] 
      THEN
        BEGIN 
        DB$DNAU = DB$DNAU -1;      # DECREMENT ACTIVE USER COUNT       #
        TQCOUNTED[0] = FALSE; 
      SASCUSERS[SALX] = SASCUSERS[SALX] - 1;  # DECREMENT USER COUNT   #
      IF SASCUSERS[SALX] EQ 0      # IF NO MORE ACTIVE USERS           #
      THEN
        BEGIN 
        DB$DNAS = DB$DNAS - 1;     # NUMBER OF ACTIVE SCHEMAS          #
        IF SASCHST[SALX] EQ S"IDLING"  # IF IN THE PROCESS OF AN IDLE  #
        THEN
          BEGIN 
          SASCHST[SALX] = S"IDLE"; # SCHEMA IDLE IS NOW COMPLETE       #
          SETMSG5;                 # PREPARE SCHEMA IDENTIFICATION MSG #
          DB$MSG(MSG5);            # ISSUE SCHEMA IDENTIFICATION MSG   #
          DB$MSG("  IDLE COMPLETE:"); 
          END 
  
        IF SASCHST[SALX] EQ S"DOWNING"  # IF IN THE PROCESS OF A DOWN  #
        THEN
          BEGIN 
          SASCHST[SALX] = S"DOWN"; # SCHEMA DOWN IS NOW COMPLETE       #
          SETMSG5;                 # PREPARE SCHEMA IDENTIFICATION MSG #
          DB$MSG(MSG5);            # ISSUE SCHEMA IDENTIFICATION MSG   #
          DB$MSG("  DOWN COMPLETE:"); 
          END 
  
        IF SASCHST[SALX] EQ S"ERRDOWN"  # IF JUST COMPLETED AN INTERNAL#
                                        # DOWN OF THIS SCHEMA.         #
        THEN
          BEGIN 
          SETMSG5;                 # PREPARE SCHEMA IDENTIFICATION MSG #
          DB$MSG(MSG5);            # ISSUE SCHEMA IDENTIFICATION MSG   #
          DB$MSG("  INTERNAL DOWN COMPLETE:");  # ISSUE COMPLETION MSG #
          END 
        END 
  
        END 
 #
*     IF A DBST HAS BEEN ESTABLISHED FOR THIS RUN-UNIT, THEN FREE 
*     THE CMM BUFFER THAT IS ASSIGNED FOR THE DBST. 
 #
      IF TQDBSTSCP[0] NQ 0
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP ("TQTD-2 ");
        CONTROL ENDIF;
  
        DB$MFF(TQDBSTSCP[0]); 
        END 
 #
*     FREE WORKING STORAGE AREAS THAT HAVE BEEN ALLOCATED 
 #
      DB$WSAR;
 #
*     RETURN TQT ENTRY. 
*     SET TQT BASE POINTER. 
 #
      IF TQRCB[0] GR 0             # IF AN RCB EXISTS FOR THIS TQT     #
      THEN
        RCTQT[TQRCB[0]-LOC(RCB)] = TQTMTR;
      DB$LNKD(P<TQT>);
      IF DB$DNAU EQ 0              # IF ACTIVE USER COUNT REACHED ZERO #
      THEN
        BEGIN 
        IF DB$DSST EQ S"IDLING"    # IF IN THE PROCESS OF AN IDLE      #
        THEN
          BEGIN 
          DB$DSST = S"IDLE";       # THE IDLE IS NOW COMPLETE          #
          DB$MSG(" CDCS IDLE COMPLETE:"); 
          END 
  
        IF DB$DSST EQ S"DOWNING"   # IF IN THE PROCESS OF A DOWN       #
        THEN
          BEGIN 
          DB$DSST = S"DOWN";       # THE DOWN IS NOW COMPLETE          #
          DB$MSG(" CDCS DOWN COMPLETE:"); 
          END 
        END 
  
      DB$DUDF;                     # UPDATE DYNAMIC DISPLAY FIELDS     #
      P<TQT> = TQTMTR;
      RETURN; 
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   S E T M S G 5 .        #
  
  
      PROC SETMSG5; 
      BEGIN 
 #
* *   DB$TQTD                                    PAGE  1
* *   SETMSG5 - INSERT NAME AND ID IN MESSAGE 5 
* *   C F RICHARDS                               DATE  11/30/78 
* 
* DC  PURPOSE 
* 
*     INSERT THE SCHEMA NAME AND SCHEMA ID INTO A MESSAGE ITEM WHICH IS 
*     GLOBAL TO THE DOWN, UP, AND IDLE PROCESSORS. THIS MESSAGE IS
*     USED ON THE CONSOLE DISPLAY AND CAN BE ISSUED TO THE DAYFILE. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     SALX - INDICATES THE SCHEMA ENTRY FROM WHICH WE GET THE SCHEMA ID 
*            AND SCHEMA NAME. 
* 
* DC  EXIT CONDITIONS 
* 
*     MSG5 - CONTAINS THE SCHEMA-ID (PIC ZZZ9) AND SCHEMA-NAME
*            (PIC X(30)) INSERTED AT CHARACTER POSITIONS
*            DFCPMSG5ID  AND  DFCPMSG5NM. 
* 
* DC  CALLING ROUTINES
* 
*     DB$TQTD - TQT DELETER 
* 
* DC  CALLED ROUTINES 
* 
*     DB$CDEB                      INTEGER TO DECIMAL / LEADING BLANKS
*     DB$FLOP                      GENERATE FLOW POINT
* 
* DC  DESCRIPTION 
* 
*     MOVE THE NAME AND ID INTO THE MESSAGE.
 #
  
  
  
#     E X E C U T A B L E   C O D E   F O R   S E T M S G 5            #
  
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("TQTD-6 ");
      CONTROL ENDIF;
  
      C<DFCPMSG5ID, 4>MSG5 = DB$CDEB(SASCHID[SALX],4);
      C<DFCPMSG5NM,30>MSG5 = SASCNAME[SALX];
      RETURN; 
  
      END 
      END 
      TERM; 
