*DECK DB$IREC 
USETEXT CDCSCTX 
      PROC DB$IREC; 
      BEGIN 
 #
* *   DB$IREC -- INPUT RECEIVER                  PAGE  1
* *   C O GIMBER                                 DATE  10/30/75 
* *   R L MCALLESTER                             DATE  01/23/80 
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE RECOGNIZES TASK INPUT REQUESTS AND PROCESSES THEM. 
* 
* DC  CALLING ROUTINES
* 
*     DB$RCLL -- PUT CONTROL POINT IN RECALL
*     DB$SCHD -- CDCS SCHEDULER 
*     DB$WRP  -- COMMAND WRAP UP
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$CALL;     #CALL PROC GIVEN ENTRY ADDRESS#
      XREF PROC DB$ERR;      #ERROR PROCESSOR#
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT                      #
      XREF PROC DB$FLUI;     #GENERATE FLOW POINT TRACE ENTRY          #
      XREF PROC DB$GOTO;     #CONTINUE EXECUTION AT GIVEN ADDRESS#
      XREF PROC DB$LNKD;     #DELINK AND RELEASE A MEMORY BLOCK        #
      XREF PROC DB$PUSH;     #PUSH A VARIABLE TO THE PUSH/POP STACK    #
      XREF PROC DB$RCBC;     #RCB ENTRY CREATOR#
      XREF PROC DB$RCBQ;     #PLACE RCB IN EXECUTE QUEUE               #
      XREF PROC DB$SCHD;     #SCHEDULER#
      XREF PROC DB$SFCL;     #ISSUE SCP FUNCTION# 
      XREF PROC DB$SCHT;     # DB$SCHD ENTRY TO SET CDCSCOMMN POINTERS #
      XREF PROC DB$SWPI;     # SWAP IN RSB AND CST TABLES              #
      XREF PROC DB$TQTC;     #TQT ENTRY CREATOR#
      XREF PROC DB$TRU;      #TERMINATE USER# 
# 
*     SYMBIONTS TO BE EXECUTED. 
* 
* DC  EXIT CONDITIONS 
* 
*     RETURN IF NO INPUT REQUEST. 
*     FOR INVOKE AND ILLEGAL REQUESTS 
*         TQT ENTRY HAS BEEN CREATED. 
*     IF THE USER HAS ESTABLISHED A DBST THAT CONTAINS THE AREA NAME, 
*     THEN THE AREA NAME IN THE DBST HAS BEEN BLANK-FILLED. 
*     BASE POINTERS HAVE BEEN SET.
*     SYMBIONT FUNCTION CODE HAS BEEN PUT IN TQT ENTRY. 
*     SYMBIONT HAS BEEN CALLED. 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON.
# 
      XREF ITEM DB$MFPA;     #MEMORY OVERFLOW OPTION PROCEDURE ADDRESS #
  
      XREF ARRAY DB$SYMB;    #ARRAY OF SYMBIONT ENTRY ADDRESSES#
        BEGIN 
        ITEM SYMBCF     B(00,02,01);   # TRUE IF REQUEST NOT ALLOWED   #
                                       # WITHIN BEGIN/COMMIT SEQUENCE  #
        ITEM SYMVER     B(00,03,01);   # TRUE IF REQUEST ALLOWED AFTER #
                                       # VERSION CHANGE ERROR          #
        ITEM SYMBIONT   U(00,42,18);   # ADDRESS OF SYMBIONT ENTRY PT  #
        END 
      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 ITEM TQTTCOMP;    # COMPLETE FLAG USED BY DB$TQTT           #
  
*CALL DB$FUNC 
  
# 
* DC  EXTERNALLY DEFINED SYMBOLS
# 
      XDEF LABEL DB$IRCA;    # INPUT RECEIVER CONTINUATION ADDRESS     #
      XDEF ITEM DB$IRQR B = TRUE;  # TRUE IF AN RCB IS AVAILABLE FOR   #
                             # QUEUING.                                #
 #
*     LOCAL VARIABLES.
# 
*CALL DBSTDCLS
      BASED ARRAY DBAREANAME;      # USED TO BLANK-FILL DBST AREA NAME #
        BEGIN 
        ITEM DBAREAWD  C(00,00,10); 
        END 
  
      ITEM CONTA;            #CONTINUATION ADDRESS                     #
      ITEM INDEX;            #SCRATCH INDEX#
      ITEM MFPASAVE I;       #SAVE MEMORY OVERFLOW OPTION PROCEDURE    #
      ITEM NEEDLTC B;        #FLAG FOR SET LONG TERM CONNECT# 
      ITEM RCBSAVED I;       #SAVE RCB ADDRESS                         #
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   N O R C B .            #
#                                                                      #
#**********************************************************************#
  
  
#     MEMORY OVERFLOW PROCEDURE FOR RCB MEMORY REQUEST                 #
  
      PROC NORCB; 
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP ("IREC-2"); # GENERATE A FLOW POINT                  #
        CONTROL ENDIF;
  
        DB$IRQR = FALSE;     # INDICATE THAT THERE IS NO NEW RCB       #
        GOTO IRECX;          # EXIT FROM DB$IREC                       #
        END 
  
  
  
#     B E G I N   D B $ I R E C   E X E C U T A B L E   C O D E .      #
  
  
#     GENERATE A FLOW POINT.                                           #
  
      CONTROL IFGR DFFLOP,1;
        DB$FLOP ("IREC"); 
      CONTROL ENDIF;
  
 #
* 
* DC  DESCRIPTION 
* 
*     RETURN IF THE INPUT REQUEST BUFFER IS EMPTY 
*         OR IF THE CURRENT RCB IS FOR A QRF TASK.
 #
      IF NOT IRFULLF[0] 
        OR RCFUNC[0] EQ DFQRF 
      THEN
        RETURN; 
  
#     GENERATE A FLOW POINT.                                           #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("IREC-1"); 
      CONTROL ENDIF;
  
 #
*     SET SCHDCOUNT TO KEEP MONITOR FROM PAUSING. 
 #
      SCHDCOUNT = 2;
      RCBSAVED = P<RCB>;
 #
*     IF THE NEW REQUEST HAS NOT BEEN PREVIOUSLY PROCESSED BY DB$CRMR 
*     CALL DB$RCBQ TO PLACE IT INTO THE EXECUTE QUEUE.
 #
      IF DB$IRQR
      THEN
        BEGIN 
        DB$RCBQ;
        END 
 #
*     CREATE ANOTHER RCB THAT CAN RECEIVE THE NEXT INPUT. 
*     IF THE MEMORY FOR THE RCB IS NOT AVAILABLE,  CMM WILL RETURN TO 
*     DB$IREC VIA THE INTERNAL PROCEDURE NORCB. 
*     DB$RCBC SETS THE CONSTRAINING ADDRESS TO STATBUSY.
*     THIS LEAVES THE RCB IN A BUSY STATUS SO THAT IT IS IGNORED BY 
*     DB$SCHD.  WHEN INPUT IS RECEIVED, DB$RCBQ CHANGES THE CONSTRAINING
*     ADDRESS TO STATCOMP.
*     SET THE INPUT REGISTER POINTER TO THE NEW RCB.
*     CLEAR THE INPUT REQUEST FULL FLAG.
 #
      MFPASAVE = DB$MFPA;    # SAVE CURRENT MEMORY OVERFLOW PROCEDURE  #
      DB$MFPA = LOC(NORCB); 
  
#     A MEMORY OVERFLOW DURING DB$RCBC PROCESSING WILL CAUSE CONTROL   #
#     TO BE RETURNED TO IRECX VIA THE INTERNAL PROCEDURE NORCB.        #
  
      P<RCB> = RCPRIOR[0];
      DB$RCBC;
      IRPOINT[0] = LOC(RCIR[0]);
      DB$IRQR = TRUE; 
      IRFULLF[0] = FALSE;    # READY TO ACCEPT ANOTHER REQUEST         #
  
IRECX:                       # FROM INTERNAL PROCEDURE NORCB.          #
      DB$MFPA = MFPASAVE; 
      P<RCB> = RCBSAVED;
      RETURN; 
  
  
  
#       C O N T I N U A T I O N   A D D R E S S .                      #
  
 #
*     THE REMAINING PORTION OF DB$IREC IS NOT EXECUTED ON A CALL TO 
*     DB$IREC.
*     DB$RCBQ PLACES THE LOCATION OF THE LABEL DB$IRCA INTO THE 
*     CONTINUATION ADDRESS FIELD OF THE RCB.
*     THE FIRST TIME THE RCB IS SCHEDULED BY DB$SCHD EXECUTION BEGINS 
*     AT DB$IRCA. 
 #
  
DB$IRCA:  
  
 #
*     IF AN ERROR OCCURS DURING PROCESSING, WE MUST 
*     ENSURE THAT THE UFT POINTER CONTAINS A NULL POINTER 
*     VALUE BECAUSE A CHECK IS MADE AGAINST THE UFT 
*     POINTER IN DB$ERR. IF NO ERROR OCCURS, THEN THE 
*     UFT POINTER WILL BE RESET IN THE SYMBIONT.
 #
  
      RCIRDTCT[0] = 0;
      RCOFTLOC[0] = 0;
      P<UFT> = DFNPTR;
  
 #
*     IF JOB ABORTED OR ENDED BY SYSTEM THEN
*       CREATE TQT ENTRY
*       ISSUE MESSAGE TO OUTPUT FILE
*       ABORT ALL TQT ENTRIES WITH RUID 
 #
      IF RCIRSTAT[0] NQ 0 THEN
        BEGIN 
        RCIR [4] = 0; 
        DB$TQTC;
        DB$ERR(28); 
        DB$TRU; 
        END 
      RCFUNC[0] = RCIRFUNC[0];
 #
* 
* D   PROCESS CREATED RCB ENTRY.
* 
 #
PROCESSRCB: 
 #
* 
*     TRY TO FIND RUN UNIT ID IN TQT. 
*       TQT ENTRY MUST BE ASSOCIATED WITH A RUNNING JOB.
 #
      CONTA = 0;
      NEEDLTC = TRUE; 
      P<TQT> = LOC(TQTCHAIN); 
      FOR INDEX=INDEX WHILE TQNEXT[0] NQ 0 DO 
        BEGIN 
        P<TQT> = TQNEXT[0]; 
        IF RCIRRUID[0] EQ TQRUID[0] 
        THEN
          BEGIN 
          IF RCIRTASK[0] EQ TQTASK[0] 
          THEN
            BEGIN 
 #
*                            IF ANOTHER REQUEST IS STILL FINISHING, 
*                            WAIT FOR IT TO COMPLETE. 
 #
            IF TQRCB[0] GR 0
            THEN
              BEGIN 
              RCBSAVED = LOC(RCB);
              P<RCB> = TQRCB[0];
                             # WHEN THERE IS AN RCB THAT HAS BEEN      #
                             # CREATED BY DB$TQTT, FOR TERMINATING A   #
                             # USER JOB, GET ITS CONTINUATION ADDRESS  #
                             # AND THEN DELETE IT.                     #
              IF RCCONSTRA[0] EQ LOC(TQTTCOMP)
              THEN
                BEGIN 
                TQRCB[0] = 0; 
                CONTA = RCCONTA[0]; 
                DB$LNKD(P<RCB>);
  
                CONTROL IFGR DFFLOP,0;
                  DB$FLOP ("IREC-AB");
                CONTROL ENDIF;
  
                P<RCB> = RCBSAVED;
                GOTO ENDFINDUSER; 
  
                END 
              P<RCB> = RCBSAVED;
              DB$PUSH(2); 
              DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
              CONTROL IFGR DFFLOP,0;
                DB$FLOP ("IREC-W");  # GENERATE A FLOW POINT.          #
              CONTROL ENDIF;
  
              P<UFT> = 0; 
              GOTO PROCESSRCB;
  
              END 
            GOTO ENDFINDUSER; 
  
            END 
          IF TQLTCF[0]
          THEN
            BEGIN 
            NEEDLTC = FALSE;
            END 
          END 
        END 
 #
*     IF NO TQT ENTRY FOR REQUEST THEN
*       CREATE TQT ENTRY
*       ERROR IF NOT INVOKE 
*       EXECUTE SYMBIONT. 
 #
        BEGIN 
        DB$TQTC;
        TQLTCF[0] = TRUE; 
        IF NEEDLTC THEN 
          DB$SFCL(DFSFSLTC,0,0,0);
        IF RCIRFUNC[0] NQ DFINV THEN
          DB$ERR(29); 
        DB$SCHT;                   # SET POINTERS IN CDCSCOMMN         #
        GOTO EXECUTESYMB; 
        END 
  
  
ENDFINDUSER:  
 #
*     IF THIS RUN-UNIT HAS ESTABLISHED A DBST THAT INCLUDES 
*     THE AREA NAME, THEN BLANK FILL THE AREA NAME IN THE DBST. 
 #
      IF TQDBSTLW[0] GQ DFDBSTAREA
      THEN
        BEGIN 
        P<DBST> = TQDBSTSCP[0];    # POINT DBST BASED ARRAY            #
        P<DBAREANAME> = LOC(DBAREA[0]); 
                                   # POINT TO AREA NAME IN THE DBST    #
        FOR INDEX = 0 STEP 1       # BLANK-FILL AREA NAME              #
          UNTIL 2 
        DO
          BEGIN 
          DBAREAWD[INDEX] = " ";
          END 
        END 
      TQRCB[0] = LOC(RCB);
      RCTQT[0] = LOC(TQT);
      IF TQRSB[0] LS 0             # IF THE RSB IS SWAPPED OUT         #
      THEN                         # SWAP IT IN.                       #
        BEGIN 
        DB$SWPI;
        END 
      DB$SCHT;                     # SET POINTERS IN CDCSCOMMN         #
      IF CONTA NQ 0 
      THEN
        BEGIN 
        DB$GOTO(CONTA); 
        END 
 #
*     ERROR IF INVOKE CALL BY NON-REAL TIME TASK (TAF, QU)
 #
      IF RCIRFUNC[0] EQ DFINV AND RCIRTASK[0] EQ 0 THEN 
        DB$ERR(30); 
 #
*     ISSUE ERROR IF COMMAND NOT ALLOWED WITHIN BEGIN/COMMIT SEQUENCE.
 #
      IF TQARTX[0] NQ 0            # IF WITHIN TRANSACTION SEQUENCE    #
        AND SYMBCF[RCIRFUNC[0]]    # IF COMMAND NOT ALLOWED            #
      THEN
        BEGIN 
        DB$ERR(71);                # NO RETURN                         #
  
        END 
 #
*     IF REQUESTED VERSION NAME IN RSB IS BLANKS AND FUNCTION IS NOT A
*     VERSION CHANGE NOR A TERMINATE, THEN ERROR. 
*     (THIS CAN ONLY HAPPEN IF THE PREVIOUS REQUEST FOR THIS RUN-UNIT 
*     WAS A VERSION CHANGE THAT RESULTED IN A NON-FATAL ERROR.  IN THIS 
*     CASE, THE RUN-UNIT IS INVOKED BUT NO FILES ARE ATTACHED.) 
 #
      IF TQRSB[0] NQ 0
      THEN
        BEGIN 
        P<RSB> = TQRSB[0];
        IF RSFVENAME[0] EQ DFCLRVENM   # IF NO ACTIVE VERSION          #
          AND NOT SYMVER[RCIRFUNC[0]]  # AND IF FUNCTION NOT ALLOWED   #
                                       # AFTER VERSION CHANGE ERROR    #
        THEN
          DB$ERR(65);              # FATAL ERROR.  NO VERSION ACTIVE.  #
  
        END 
 #
*     ERROR IF ILLEGAL FUNCTION.
 #
      IF RCIRFUNC[0] GR DFFUNCMAX THEN
        DB$ERR(34); 
 #
*     EXECUTE SYMBIONT. 
 #
EXECUTESYMB:  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLUI (" FUNC =");       # RECORD THE FUNCTION               #
        DB$FLUI (FUNCODE[RCFUNC[0]]); 
      CONTROL ENDIF;
  
      DB$CALL(SYMBIONT[RCIRFUNC[0]]); 
      END 
      TERM; 
