*DECK DB$RCBQ 
USETEXT CDCSCTX 
      PROC DB$RCBQ; 
      BEGIN 
 #
* *   DB$RCBQ - ADD RCB TO EXECUTION QUEUE       PAGE  1
* *   R L MCALLESTER                             DATE  01/23/80 
* 
* DC  PURPOSE 
* 
*     PREPARE THE RCB FOR EXECUTION OF THE NEWLY RECEIVED REQUEST.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     THE INPUT AREA HAS JUST RECEIVED A NEW REQUEST. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE RCB HAS BEEN MADE READY TO BE SCHEDULED BY DB$SCHD. 
* 
* DC  CALLING ROUTINES
* 
*     DB$CRMR                CRM RECALL INTERFACE 
*     DB$IREC                INPUT RECEIVER 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$FLOP;   # GENERATE A FLOW POINT                     #
      XREF PROC DB$FLUI;   # GENERATE A USER IDENT                     #
      XREF PROC DB$LNKS;   # DELINK THE BLOCK AND SAVE IT              #
      XREF PROC DB$RCLM;   # ISSUE RECALL MACRO                        #
      XREF PROC DB$SFCM;   # ISSUE SFCALL MACRO                        #
# 
*     INTERNAL PROCS/FUNCS
* 
*     CONVERT                CONVERTS OLD REQUEST PACKET TO NEW FORMAT
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     RUN-UNIT COMMAND BLOCK - RCB
* 
*     CDCS COMMON.
# 
      XREF ARRAY DB$SSC;     #SSC COMMUNICATIONS WORD#
        BEGIN 
        ITEM IRFULLF B(00,00,01);      #TRUE IF DATA IN INPUT REGISTER# 
        ITEM IRPOINT I(00,42,18);      #POINTER TO CURRENT INPUT AREA  #
        END 
      XREF LABEL DB$IRCA;    #DB$IREC CONTINUATION ADDRESS             #
      XREF ITEM DB$RCBW B;   # TRUE IF A NEW REQUEST IS WAITING        #
 #
*     LOCAL VARIABLES.
# 
      ARRAY SFCALL [0:0] S(2);  # SFCALL REQUEST BUFFER FOR END TASK   #
        BEGIN 
        ITEM SFFC   I(00,00,60);       # FUNCTION CODE                 #
        ITEM SFUCPA I(00,18,18);       # UCP ADDRESS                   #
        ITEM SFCOMP B(00,59,01);       # COMPLETION BIT                #
        ITEM SFRUID I(01,00,60);       # RUN UNIT ID                   #
        END 
      ITEM INDEX;            #SCRATCH INDEX#
      ITEM RCOUNT I = 1;     # REQUEST COUNT                           #
      ITEM RUID;             # SAVE THE RUN UNIT ID                    #
      ITEM SAVERCB;          # SAVE LOCATION OF CURRENT RCB            #
      ITEM SAVETQT;          # SAVE LOCATION OF CURRENT TQT            #
  
  
  
#     S T A R T   O F   D B $ R C B Q   E X E C U T A B L E   C O D E  #
  
  
 #
* 
* DC  DESCRIPTION 
* 
 #
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("RCBQ   ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
 #
*     ON EVERY EIGHTH REQUEST RECOMPUTE THE ACTIVE COUNT. 
 #
      RCOUNT = RCOUNT -1; 
      IF RCOUNT EQ 0
      THEN
        BEGIN 
        RCOUNT = -4;
        P<RCB> = LOC(RCBMTR); 
        P<RCB> = RCNEXT[0]; 
        FOR INDEX=INDEX WHILE LOC(RCB) NQ  LOC(RCBMTR)
        DO
          BEGIN 
          RCOUNT = RCOUNT +1;  # INCREMENT THE ACTIVE COUNT            #
          P<RCB> = RCNEXT[0]; 
          END 
                             # ADJUST THE EXISTING ACTIVE COUNT        #
        RCBAC = (RCOUNT + RCBAC) /2;
        RCOUNT = 8; 
        END 
  
 #
*     SET THE RCB POINTER TO THE RCB THAT JUST RECEIVED THE REQUEST.
 #
      P<RCB> = IRPOINT[0] - DFRCIR0;
  
      CONTROL IFGR DFFLOP,0;
        DB$FLUI(RCIRRUID[0]);          # USER IDENTIFICATION           #
      CONTROL ENDIF;
 #
* 
*     IF THE REQUEST PACKET IS AN ABORT NOTICE FROM THE OPERATING 
*     SYSTEM, ISSUE AN SF.ENDT IMMEDIATELY TO CLEAR ALL CONNECTIONS.
*     IF THIS IS LEFT TO BE DONE WHEN DB$TRU IS EXECUTED, THERE 
*     MAY BE MORE NOTIFICATIONS FROM THE OPERATING SYSTEM.
*     THEN ONE OF THESE SF.ENDT FUNCTIONS MAY BE ISSUED AFTER THE USER
*     JOB HAS ISSUED A NEW INVOKE REQUEST.
*     THAT WOULD BREAK THE CONNECTION FOR THE INVOKE. 
*     ALSO SET TQTERM FOR ANY TQT ALREADY EXISTING FOR THIS USER SO A 
*     RETURN CODE OF 63 WILL BE IGNORED BY DB$SFCL FOR ANY REQUEST
*     THAT IS ALREADY IN PROGRESS.
 #
      IF RCIRSTAT[0] NQ 0 
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("RCBQ-AN"); 
        CONTROL ENDIF;
  
        SAVERCB = P<RCB>; 
        SAVETQT = P<TQT>; 
        RUID = RCIRRUID[0]; 
        SFFC[0] = DFSFENDT; 
        SFUCPA[0] = -1; 
        SFRUID[0] = RUID; 
        DB$SFCM(LOC(SFCALL)); 
        FOR INDEX = INDEX WHILE NOT SFCOMP[0] 
        DO
          BEGIN              # WAIT FOR COMPLETION OF THE SFCALL       #
          DB$RCLM;
          END 
        RCCONTA[0] = 0; 
        P<TQT> = TQTCHAIN;
        FOR INDEX = INDEX WHILE LOC(TQT) NQ TQTMTR
        DO
          BEGIN 
          IF  TQRUID[0] EQ RUID 
          THEN
            BEGIN 
            TQTERM[0] = TRUE; 
            END 
          P<TQT> = TQNEXT[0]; 
          END 
                             # IF THERE IS A REQUEST WAITING THAT      #
                             # HAS NOT YET BEEN ASSIGNED TO A TQT,     #
                             # PURGE THAT REQUEST.                     #
        P<RCB> = LOC(RCBMTR); 
        FOR INDEX = INDEX WHILE RCNEXT[0] NQ LOC(RCBMTR)
        DO
          BEGIN 
          P<RCB> = RCNEXT[0]; 
          IF    RCIRRUID[0] EQ RUID 
            AND RCCONTA[0] EQ LOC(DB$IRCA)
            AND RCTQT[0] EQ TQTMTR
          THEN
            BEGIN 
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("RCBQ-PR"); 
            CONTROL ENDIF;
            DB$LNKS(P<RCB>, IDLERCBP);
            RCBIC = RCBIC +1; 
            END 
          END 
        P<RCB> = SAVERCB; 
        P<TQT> = SAVETQT; 
        END 
 #
* 
*     IF THE REQUEST PACKET IS NOT IN CURRENT (CDCS 2.3) FORMAT THEN
*     CONVERT IT. 
 #
      IF RCIRVER [0] NQ DFRQVERSN 
      THEN
        BEGIN 
        CONVERT;
        END 
  
 #
*     ASSIGN THE QUEUE POSITION TO NEWLY RECEIVED REQUESTS. 
*         UPDATE REQUESTS REQUIRE THE BLOCK THAT IS TO BE UPDATED 
*         IS IN MEMORY. 
*         THE USER JOB HAS ALREADY DONE A READ, SO THE BLOCK PROBABLY 
*         IS IN MEMORY. 
*         IF A LARGE NUMBER OF OTHER READS WERE PERMITTED BEFORE THE
*         UPDATE, THEY COULD FORCE THAT BLOCK OUT OF MEMORY.
*         TO AVOID THIS THE UPDATES ARE PLACED AHEAD OF OTHER REQUESTS. 
 #
      RCQPOS[0] = 2 * RCBAC;
      IF RCIRFUNC[0] EQ DFREW      # ACCELERATE UPDATE REQUESTS        #
        OR RCIRFUNC[0] EQ DFDEL 
        OR RCIRFUNC[0] EQ DFWR2 
        OR RCIRFUNC[0] EQ DFCMT 
      THEN
        BEGIN 
        RCQPOS[0] = 0;
        END 
 #
*     ADJUST THE UCPA FOR A TAF REQUEST.
 #
      IF RCIRBIAS [0] NQ 0
      THEN
        BEGIN 
        RCIRUCPA [0] = RCIRUCPA [0] - RCIRBIAS [0]; 
        END 
 #
*     SET THE CONTINUATION ADDRESS TO DB$IREC LABEL DB$IRCA.
*     SET THE CONSTRAINING ADDRESS TO STATCOMP.  THE RCB IS READY.
 #
      RCCONTA[0] = LOC(DB$IRCA);
      RCCONSTRA[0] = LOC(STATCOMP); 
 #
*     A FLAG TELLS DB$MTR THAT A NEW REQUEST IS WAITING 
 #
      DB$RCBW = TRUE; 
      RETURN;                # COMPLETION OF DB$RCBQ EXECUTION         #
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   C O N V E R T          #
#                                                                      #
#**********************************************************************#
  
      PROC CONVERT; 
      BEGIN 
 #
* *   DB$RCBQ                                    PAGE  1
* *   CONVERT - CONVERSION ROUTINE
* *   E. P. JOHNSON                              DATE  11/19/79 
* *   A W ALLEN - DATABASE VERSIONS              DATE  01/30/81 
* 
* DC  PURPOSE 
* 
*     CONVERT AN OLD REQUEST PACKET 
*     TO A NEW REQUEST PACKET.
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     RCB   POINTER SET 
* 
* DC  EXIT CONDITIONS 
* 
*     THE OLD FORMAT REQUEST PACKET HAS 
*     BEEN CONVERTED TO NEW FORMAT. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RCBQ                PLACE RCB IN EXECUTE QUEUE 
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     RUN-UNIT COMMAND BLOCK - RCB
* 
* DC  DESCRIPTION 
* 
*     IF THE REQUEST PACKET IS FOR CDCS 2.1 OR EARLIER DO THE 
*     FOLLOWING-- 
*     - NEW FORMAT REQUEST PACKET IS ONE WORD 
*       LONGER THAN OLD FORMAT: ALL ITEMS STARTING
*       WITH WORD FOUR ARE MOVED DOWN ONE WORD AND
*       WORD FOUR IS ZEROED OUT.
* 
*     - IF THE DML FUNCTION IS ONE THAT HAS A PRIMARY OR
*       ALTERNATE KEY, THEN EXTRACT THE OLD FORMAT RECORD 
*       ORDINAL (THE FIRST COMPONENT OF KEY ORDINAL - 
*       SECOND IS THE ITEM ORDINAL). INSERT THAT INTO THE 
*       NEW FORMAT RECORD ORDINAL. ZERO OUT THE FIRST 50
*       BITS OF THE WORD - THIS INCLUDES TWO NEW FLAGS
*       ALSO DEFINED IN THIS WORD. OLD FORMAT RECORD AND
*       ITEM ORDINALS ARE 10 BITS IN LENGTH AND NEW FORMAT
*       ARE 12 BITS IN LENGTH.
* 
*     IF THE REQUEST PACKET IS FOR CDCS 2.2 OR EARLIER DO THE 
*     FOLLOWING-- 
*     - IF THE DML FUNCTION IS INVOKE, THEN INSERT DEFAULT VERSION NAME 
*       OF "MASTER" INTO REQUEST PACKET.
* 
 #
  
  
  
# LOCAL ITEMS.                                                         #
  
      ITEM INDEX I;                    # INDUCTION VARIABLE.           #
      ITEM TEMP U;                     # SCRATCH TO HOLD               #
                                       # RECORD ORDINAL.               #
  
# EXTERNAL REFERENCES.                                                 #
  
      XREF ARRAY DB$SYMB;              # FUNCTION FLAGS ARRAY.         #
        BEGIN 
        ITEM FCSETUFT B(00,01,01);     # TRUE IF FUNCTION USES A       #
                                       # PRIMARY OR ALTERNATE KEY.     #
        END 
  
  
# S T A R T   O F   C O N V E R T   E X E C U T A B L E   C O D E      #
  
  
# CONVERT REQUEST PACKET IN RCB TO NEW FORMAT,                         #
# BY MOVING ALL ITEMS STARTING WITH WORD 4 DOWN                        #
# ONE WORD AND ZERO OUT WORD 4 ( NOT IN OLD FORMAT                     #
# REQUEST PACKET )                                                     #
  
      IF RCIRVER[0] NQ DF22VERSN   # IF CDCS 2.1 OR EARLIER...         #
      THEN
      BEGIN 
      INDEX = RCIRWC[0] + DFIRXTRA; 
      IF INDEX GR DFINRQBFHSUB + 2
      THEN
        INDEX = DFINRQBFHSUB + 2; 
      FOR INDEX = INDEX STEP -1 UNTIL DFRCIR5 - DFRCIR0 
      DO
        BEGIN 
        RCIR[INDEX] = RCIR[INDEX-1];
        END 
      RCIR[DFRCIR4-DFRCIR0] = 0;
  
# IF THE DML FUNCTION IS ONE THAT HAS A PRIMARY OR                     #
# ALTERNATE KEY, THEN EXTRACT THE OLD FORMAT RECORD                    #
# ORDINAL (THE FIRST COMPONENT OF KEY - SECOND IS ITEM                 #
# ORDINAL), AND INSERT IT INTO THE NEW FORMAT RECORD                   #
# ORDINAL. ZERO OUT THE FIRST 50 BITS OF THE WORD -                    #
# THIS INCLUDES TWO NEW FLAGS ALSO DEFINED IN THIS WORD.               #
# OLD FORMAT RECORD AND ITEM ORDINALS ARE 10 BITS IN                   #
# LENGTH AND NEW FORMAT ARE 12 BITS IN LENGTH.                         #
  
      IF FCSETUFT[RCIRFUNC[0]]
      THEN
         BEGIN
         TEMP = B<40,10>RCPPAKORD[0];  # EXTRACT OLD FORMAT            #
                                       # RECORD ORDINAL.               #
         B<0,50>RCPPAKORD[0] = 0;      # ZERO OUT FIRST 50 BITS OF     #
                                       # WORD - INCLUDING TWO FLAGS    #
                                       # ALSO DEFINED IN THIS WORD.    #
         RCPPAKRO[0] = TEMP;           # SET RECORD ORDINAL            #
                                       # IN NEW FORMAT.                #
         END
      END                          # END OF CDCS 2.1 CONVERSION.       #
      IF RCIRFUNC[0] EQ DFINV      # IF OLD INVOKE FORMAT...           #
      THEN
        BEGIN 
        RCPVENAM[0] = DFMASTER;    # SET VERSION NAME TO "MASTER".     #
        END 
      END                          # END OF CONVERT PROCEDURE          #
      END                          # END OF DB$RCBQ                    #
      TERM; 
