*DECK DB$WRP
USETEXT CDCSCTX 
      PROC DB$WRP;
      BEGIN 
 #
* *   DB$WRP -- COMMAND WRAP-UP                  PAGE  1
* *   C O GIMBER                                 12/19/75 
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE PERFORMS PROCESSING REQUIRED FOR COMMAND COMPLETION. 
* 
* DC  ENTRY CONDITIONS
* 
*     CDCS HAS PROCESSED A COMMAND AND AN RCB EXISTS
* 
* DC  EXIT CONDITIONS 
* 
*     SCP END TASK HAS BEEN ISSUED AND RCB SPACE RETURNED.
*     THIS ROUTINE EXITS BY A WAIT FOR INPUT CALL TO THE SCHEDULER. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ACCN;           # ACCOUNT CP/IO TIME                #
      XREF PROC DB$FLOP;           # GENERATE FLOW POINT               #
      XREF PROC DB$INV$;           # INVOKE SYMBIONT ENTRY POINT       #
      XREF PROC DB$IREC;           # INPUT RECEIVER                    #
      XREF PROC DB$LNKS;           # SAVE AN RCB AREA FOR LATER USE    #
      XREF PROC DB$MBFA;           # FREE ALL TEMPORARY BUFFERS        #
      XREF PROC DB$MFA;            # ALLOCATE A FIXED BLOCK            #
      XREF PROC DB$ODLC;           # DECREMENT OVCAP LOCK-COUNTS       #
      XREF PROC DB$OIUL;           # IMMEDIATELY UNLOAD AN OVCAP       #
      XREF PROC DB$RCBF;           # PROCESS RCB END-CASE FLAGS        #
      XREF PROC DB$SFCL;           # MAKE SCP SF CALL                  #
      XREF LABEL DB$SCHI;          # PREEMPTIVE SCHEDULING IN DB$SCHD  #
      XREF LABEL DB$SCHL;          # SCHEDULER LOOP                    #
      XREF PROC DB$WSAR;           # RETURN WORKING STORAGE AREAS      #
      XREF ARRAY DB$SYMB;          # FUNCTION FLAGS ARRAY              #
        BEGIN 
        ITEM FCFILPOS B(00,00,01);  # TRUE IF FUNCTION CHANGES FILE POS#
        END 
# 
* DC  CALLING ROUTINES
* 
*     ALL CDCS SYMBIONTS. 
*     DB$ERR     CDCS ERROR HANDLER 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON.
 #
*CALL DBSTDCLS
  
      XREF ITEM DB$MFPA;     #MEMORY OVERFLOW OPTION PROCEDURE ADDRESS #
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM PRIOR   I(00,24,18);  # POINTER TO PRIOR BLOCK            #
        ITEM NEXT    I(00,42,18);  # POINTER TO NEXT BLOCK             #
        ITEM NEXTIDL I(00,00,60);  # POINTER TO NEXT IDLE BLOCK        #
        END 
# 
*     LOCAL VARIABLES.
# 
      ITEM LENGTH;           # LENGTH OF RCB BLOCK                     #
      ITEM NEW;              # ADDRESS OF NEW BLOCK TO BE ADDED TO IDLE#
      BASED ARRAY NEWBLOCK; 
        BEGIN 
        ITEM NBWORD I(00,00,60);  # A WORD IN THE NEW BLOCK            #
        ITEM NBCHAR C(00,00,10);  # A WORD IN THE NEW BLOCK (CHARACTER)#
        END 
      ITEM XX;               # INDUCTION VARIABLE                      #
  
#**********************************************************************#
#                                                                      #
#     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 ("WRP-NOR");  # GENERATE A FLOW POINT                #
        CONTROL ENDIF;
  
        GOTO CMMEXIT;        # ABANDON THE MEMORY REQUEST              #
        END 
  
  
  
  
#     B E G I N   D B $ W R P   E X E C U T A B L E   C O D E          #
  
 #
* 
* DC  DESCRIPTION 
* 
*     PROCESS AND CLEAR ANY END-CASE CONDITIONS THAT ARE LEFT TRUE. 
*     REMOVE ANY RCB LOCKS ON OVCAPS HELD BY THIS RCB.
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("WRP    ");
      CONTROL ENDIF;
  
      IF RCFLAGWORD[0]
      THEN                             # RCFLAGS OR RCOVCAPS IS TRUE   #
        BEGIN 
        IF RCFLAGS[0] 
        THEN                           # SOME END CONDITIONS ARE TRUE  #
          BEGIN 
          DB$RCBF;                     # CLEAR END CONDITION FLAGS     #
          END 
        IF RCOVCAPS[0]
        THEN                           # SOME OVCAPS ARE LOCKED BY RCB #
          BEGIN 
          IF RCFUNC[0] EQ DFINV 
          THEN
            BEGIN 
            DB$OIUL(DB$INV$);      # UNLOAD INVOKE OVCAP               #
            END 
          DB$ODLC;                     # DECREMENT OVCAP LOCK-COUNTS   #
          END 
        END 
  
 #
*     IF THE USER HAS A DBST THAT CONTAINS THE AUX STATUS SECTION, AND
*     IF AN I/O SYMBIONT WHICH CHANGES THE FILE POSITION WAS JUST 
*     PROCESSED, AND IF THE CALLING ROUTINE IS NOT DB$ERR, STORE THE
*     FILE POSITION IN THE SCP-SIDE DBST AND WRITE THE AUX. STATUS
*     INFORMATION TO THE DBST RESERVED IN THE USER"S FIELD LENGTH.
*     ( THE RELATION SYMBIONTS WHICH CHANGE FILE POSITION WILL HAVE 
*       ALREADY STORED THE FILE POSITION IN THE DBST. ) 
 #
      IF TQDBSTLW[0] GQ DFDBSTAUX 
        AND FCFILPOS[RCFUNC[0]] 
        AND RCFUNC[0] NQ DFCLS
        AND (RCIRRC[0] EQ 0 
          OR RCIRRC[0] EQ DFERREOD) 
      THEN                             # AN OPEN FILE EXISTS FOR USER  #
        BEGIN 
        P<DBST> = TQDBSTSCP[0]; 
        IF DBFILPOS[0] NQ 0            # IF THE FP HAS BEEN SET        #
        THEN
          BEGIN 
          DB$SFCL(DFSFWRIT,            # WRITE DBST BACK TO UCP        #
                    DFDBSTAUX,         # LENGTH OF THE TRANSFER        #
                    TQDBSTUCP[0],      # UCP ADDRESS OF DBST           #
                    TQDBSTSCP[0]);     # SCP ADDRESS OF DBST           #
          DBFILPOS[0] = 0;             # REINITIALIZE AUX. STATUS WORD #
          END 
        ELSE
          BEGIN 
          IF FPFITFP[0] NQ 0
          THEN
            BEGIN 
            DBFILPOS[0] = FPFITFP[0]; 
            DB$SFCL(DFSFWRIT,          # WRITE DBST BACK TO UCP        #
                      DFDBSTAUX,       # LENGTH OF THE TRANSFER        #
                      TQDBSTUCP[0],    # UCP ADDRESS OF DBST           #
                      TQDBSTSCP[0]);   # SCP ADDRESS OF DBST           #
            DBFILPOS[0] = 0;           # REINITIALIZE AUX. STATUS WORD #
            END 
          END 
        END 
 #
*     IF AN RSB EXISTS, THEN SET THE CURRENT AREA ORDINAL TO ZERO.
 #
  
      IF TQRSB[0] NQ 0
      THEN
        BEGIN 
        RSFCAORD[0] = 0;
        RSFAGE[0] = 0;
        END 
 #
*     IF PROCESSING REQUEST FROM A UCP (NOT AN INTERNAL TASK) 
*       ISSUE END TASK SCP CALL.
 #
      IF TQLTCF[0] THEN 
        BEGIN 
 #
*       ACCOUNT CP AND IO TIME FOR CDCS REQUEST.
 #
        IF ACCNFLAG THEN
          BEGIN 
          DB$ACCN;
#                            THE DB$SFCL CALL IS IN DB$ACCN            #
          END 
        ELSE
          BEGIN 
          DB$SFCL(DFSFENDT,0,RCIRUCPA[0],0);
          END 
        END 
 #
*     RETURN ALL TEMPORARY BUFFERS. 
 #
      DB$MBFA;
 #
*     ZERO RCB POINTER IN TQT.
*     RETURN THE RCB. 
 #
      TQRCB[0] = 0; 
  
      IF RCFUNC[0] NQ DFQRF 
      THEN
        BEGIN 
        DB$LNKS(P<RCB>,IDLERCBP); 
        RCBIC = RCBIC +1;          # INCREMENT IDLE COUNT              #
        END 
      ELSE
        BEGIN 
                             # DELINK THE QRF TASK FROM THE RCB CHAIN  #
        NEXT[RCPRIOR[0]] = RCNEXT[0]; 
        PRIOR[RCNEXT[0]] = RCPRIOR[0];
        P<RCB> = RCNEXT[0]; 
        END 
  
      IF TQLTCF[0]
        AND RCFUNC[0] NQ DFQRF
      THEN
        BEGIN 
 #
*       IF THERE ARE LESS THAN THREE IDLE RCB'S, GENERATE A NEW ONE.
 #
        IF RCBIC LS 3 
        THEN
          BEGIN 
          LENGTH = DFINRQBFSIZE + DFRCIR2;
          DB$MFPA = LOC(NORCB); 
          DB$MFA(LENGTH,NEW);      # REQUEST THE NEW BLOCK             #
          P<NEWBLOCK> = NEW;
          FOR XX = LENGTH-1 STEP -1 UNTIL 1 
          DO
            BEGIN                  # CLEAR THE NEW BLOCK               #
            NBWORD[XX] = 0; 
            END 
          NBCHAR[4] = "UNUSED RCB"; 
          RCBIC = RCBIC +1; 
                                   # POSITION IT IN THE IDLE CHAIN     #
          FOR XX = LOC(IDLERCBP)
            WHILE NEW GR NEXTIDL[XX]
            AND NEXTIDL[XX] NQ 0
          DO
            BEGIN 
            XX = NEXTIDL[XX]; 
            END 
  
#         INSERT THE BLOCK INTO THE CHAIN OF IDLE BLOCKS.              #
  
          NEXTIDL[NEW] = NEXTIDL[XX]; 
          NEXTIDL[XX] = NEW;
          END 
CMMEXIT:                           # JUMP HERE IF REQUEST REJECTED     #
 #
*       CHECK FOR NEW REQUESTS. 
 #
        DB$IREC;
        END 
 #
*     IF MAXIMUM SCHEMA WORKING STORAGE AREA LENGTH IS NEGATIVE,
*       IT INDICATES THAT THE WSA BUFFERS ARE BEING ALLOCATED FOR EACH
*       REQUEST.  RETURN THE WORKING STORAGE AREAS. 
*     IF SCHDFLAG SET THEN
*       CAUSE RCB AT -SCHDFLAG ADDRESS TO BE CONTINUED. 
*       CLEAR SHCDFLAG. 
*       USE THE PREEMPTIVE ENTRY POINT TO THE SCHEDULER LOOP. 
* 
*     GO TO SCHEDULER LOOP. 
 #
      IF TQSCWSAL[0] LS 0 
      THEN
        BEGIN 
        DB$WSAR;                   # RETURN WORKING STORAGE AREAS      #
        END 
  
      IF SCHDFLAG NQ 0 THEN 
        BEGIN 
        P<RCB> = -SCHDFLAG; 
        SCHDFLAG = 0; 
        GOTO DB$SCHI;              # PREEMPTIVE SCHEDULING IS IN USE   #
  
        END 
  
      GOTO DB$SCHL; 
  
      END 
      TERM; 
