*DECK DB$SFCL 
USETEXT CDCSCTX 
      PROC DB$SFCL((FC),(FP),(UCPA),(SCPA));
      BEGIN 
 #
* *   DB$SFCL -- SFCALL PROCESSOR                PAGE  1
* *   C O GIMBER                                 11/11/75 
* 
* DC  PURPOSE 
* 
*     GENERATE SFCALL REQUEST AND MAKE SFCALL.
* 
* DC  CALLING ROUTINES
* 
*     DB$ACM                 ISSUE ACCOUNTING MESSAGES
*     DB$ERR                 ERROR PROCESSOR
*     DB$IREC                INPUT RECEIVER 
*     DB$NRR                 SET NO RERUN BIT 
*     DB$SFRD                ISSUE SFCALL TO READ FROM UCP
*     DB$SWPO                SWAP OUT TASK TABLES FOR USER
*     DB$TERM                TERMINATE CDCS 
*     DB$TQTD                DELETE TQT ENTRY 
*     DB$TRU                 TERMINATE RUN UNIT 
*     DB$WRP                 COMMAND WRAP-UP PROCESSOR
* 
* DC  CALLED ROUTINES 
# 
      XREF ITEM DB$DSST S:SACSTAT;  # CDCS SYSTEM STATUS VARIABLE      #
      XREF PROC DB$ERR;      #ERROR PROCESSOR#
      XREF PROC DB$ERRE;     #ERROR MESSAGE EDITOR                     #
      XREF PROC DB$FLOP;     #IDENTIFY FLOW POINT                      #
      XREF PROC DB$POP;      #POP FROM STACK# 
      XREF PROC DB$PUNT;     #INTERNAL ABORT PROCESSOR# 
      XREF PROC DB$PUSH;     #PUSH INTO STACK#
      XREF PROC DB$SCHD;     #SCHEDULER#
      XREF PROC DB$SFCM;     #EXECUTE SF CALL MACRO#
      XREF PROC DB$TRU;      #TERMINATE USER WITH RUID# 
# 
* DC  ENTRY CONDITIONS
* 
*     PASSED PARAMETERS 
# 
      ITEM FC;               #SCP FUNCTION CODE#
      ITEM FP;               #FUNCTION PARAMETER# 
      ITEM UCPA;             #RELATIVE ADDRESS WITHIN THE UCP#
      ITEM SCPA;             #RELATIVE ADDRESS WITHIN THE SCP#
# 
*     TQT, RSB, AND RCB ALL EXIST.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT.  THE SFCALL HAS BEEN SUCCESSFULLY MADE.
* 
*     ABNORMAL EXIT .  JOB OR CDCS IS ABORTED.
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON.
 #
# 
*     LOCAL VARIABLES 
* 
# 
      ITEM COUNT46;          # COUNT DOWN WAITING FOR SWAP IN.         #
      ITEM ERCODE;           # ERROR CODE FOR DB$ERR OR DB$ERRE CALL   #
      ITEM LEN;              # MESSAGE LENGTH                          #
      ITEM MSGBUF  C(140);   # MESSAGE BUFFER                          #
# 
*     SFCALL IS AN ALTERNATE DESCRIPTION OF THE WORD TQSFBUF. 
# 
      BASED ARRAY SFCALL; 
        BEGIN 
        ITEM SFCLWD I(00,00,60);   # SFCALL FULL WORD                  #
        ITEM SFERR  B(00,00,01);   # SIGNIFICANT ERROR FLAG            #
        ITEM SFRC   U(00,00,06);   # RETURN CODE                       #
        ITEM SFFP   U(00,06,12);   # FUNCTION PARAMETER                #
        ITEM SFUCPA I(00,18,18);   # USER CONTROL POINT ADDRESS        #
        ITEM SFSCPA I(00,36,18);   # SYSTEM CONTROL POINT ADDRESS      #
        ITEM SFFC   U(00,54,06);   # FUNCTION CODE                     #
        ITEM SFCOMP B(00,59,01);   # COMPLETION BIT                    #
        END 
  
  
  
#     B E G I N   D B $ S F C L   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
*     SAVE ENTRY ADDRESS. 
 #
  
      CONTROL IFGR DFFLOP,0;
  
        ITEM FLONAME C(7) = "SFCL=  ";
  
        B<30,6>FLONAME = B<54,3>FC + O"33"; 
        B<36,6>FLONAME = B<57,3>FC + O"33"; 
        DB$FLOP(FLONAME); 
      CONTROL ENDIF;
  
      DB$PUSH(DB$SFCL); 
      COUNT46 = 40; 
 #
*     ON A TAF CALL, ADJUST FOR THE SUB-CONTROL POINT BIAS WITHIN 
*     THE TAF FIELD LENGTH. 
 #
      IF RCIRBIAS[0] NQ 0 
        AND UCPA GR 1 
      THEN
        BEGIN 
        UCPA = UCPA + RCIRBIAS[0];
        IF UCPA GQ (RCIRBIAS[0] + RCIRFL[0])
        THEN
          BEGIN 
          FLERR;                   # UCPA NOT IN FL                    #
          END 
        END 
  
 #
*     COMBINE THE DB$SFCL PARAMETERS INTO THE SFCALL PARAMETER WORD.
*     PLACE IT INTO THE TQT WORD FOR THE USE OF THE SFCALL MACRO. 
 #
      P<SFCALL> = LOC(TQSFBUF[0]);
  
      SFCLWD[0] = 
            B<48,12>FP   *2**42 
          + B<42,18>UCPA *2**24 
          + B<42,18>SCPA *2**06 
          + B<54,06>FC; 
 #
*     ISSUE SFCALL MACRO. 
 #
SFCALLLOOP: 
      DB$SFCM(P<SFCALL>); 
 #
*     IF SFCALL NOT COMPLETE THEN CALL SCHEDULER. 
 #
      IF NOT SFCOMP[0]
      THEN
        BEGIN 
        DB$SCHD(P<SFCALL>,DFWAITXE);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("SFCL-1");
        CONTROL ENDIF;
  
        P<SFCALL> = LOC(TQSFBUF[0]);
        END 
 #
*     IF SFCALL COMPLETED WITH NO ERROR 
*       OR THE SFCALL WAS TERMINATING A RUN UNIT. 
*         POP ENTRY ADDRESS 
*         RETURN. 
 #
      IF NOT SFERR[0] 
        OR TQTERM[0]
      THEN
        BEGIN 
        DB$POP(DB$SFCL);
        RETURN; 
  
        END 
 #
*     IF USER SWAPPED OUT 
*         SAVE SFCALL 
*         GENERATE SWAP IN SFCALL AND ISSUE CALL
*         CALL SCHEDULER FOR SFCALL COMPLETION
*         RESTORE ORIGINAL SFCALL 
*         JUMP BACK TO REISSUE ORIGINAL CALL. 
 #
      IF   SFRC[0] EQ O"44"        # JOB SWAPPED OUT                   #
        OR SFRC[0] EQ O"46"        # SWAP-IN TEMPORARILY PROHIBITED    #
      THEN
        BEGIN 
        SFRC[0] = 0;
        SFCOMP[0] = FALSE;   # CLEAR COMPLETION BIT                    #
 #
*     IF THE CDCS INITIATED SWAP OUT FLAG IS NOT SET, IT INDICATES
*     THAT THE USER JOB WAS SWAPPED OUT BY THE OPERATING SYSTEM. IN 
*     THIS CASE, THE UCP REQUEST IS PENDING AND CDCS SCHEDULER IS 
*     CALLED TO PROCESS THE OTHER UCP"S REQUESTS. 
 #
        IF NOT RCSFSWP[0]    #CDCS SWAP OUT FLAG NOT SET               #
        THEN
          BEGIN 
          RCOSSWP[0] = TRUE;
          DB$PUSH(10);       # DB$SCHD WILL POP AND USE THE DELAY COUNT#
          DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
          RCOSSWP[0] = FALSE; 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("SFCL-2");
          CONTROL ENDIF;
  
          P<SFCALL> = LOC(TQSFBUF);       #POINTED TO SUBSY CALL BUFFER#
          SCHDCOUNT = SCHDCOUNT - 1;      #DECREASE SCHEDULER COUNTER  #
          GOTO SFCALLLOOP;                #GOTO SUBSYSTEM CALL LOOP    #
  
          END 
        DB$PUSH(SFCALL);
        SFCLWD[0] = DFSFSWPI; 
        DB$SFCM(P<SFCALL>); 
        DB$SCHD(P<SFCALL>,DFWAITXE);
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("SFCL-3");
        CONTROL ENDIF;
  
        P<SFCALL> = LOC(TQSFBUF[0]);
        IF SFRC[0] EQ 0 
        THEN
          BEGIN 
          RCSFSWP[0] = FALSE;  # CLEAR THE CDCS SWAP OUT FLAG          #
          END 
 #
*       IF SFCALL ERROR 46 (SWAP-IN TEMPORARILY PROHIBITED) 
*           DELAY AND THEN TRY AGAIN. 
 #
        IF SFRC[0] EQ O"46" 
        THEN
          BEGIN 
          DB$POP(SFCALL); 
 #
*         IF COUNT DOWN IS COMPLETE AND CDCS OR THE SCHEMA IS 
*           BEING TAKEN DOWN, 
*             POP ENTRY ADDRESS 
*             RETURN. 
 #
          COUNT46 = COUNT46 -1; 
          IF COUNT46 LQ 0 
            AND (DB$DSST EQ S"DOWNING"
              OR DB$DSST EQ S"DOWN" 
              OR SASCHST[SALX] EQ S"DOWNING"
              OR SASCHST[SALX] EQ S"DOWN")
          THEN
            BEGIN 
            DB$POP(DB$SFCL);
            RETURN; 
  
            END 
          DB$PUSH(COUNT46); 
          DB$PUSH(10);
          DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("SFCL-4");
          CONTROL ENDIF;
  
          DB$POP(COUNT46);
          P<SFCALL> = LOC(TQSFBUF); 
          GOTO SFCALLLOOP;
  
          END 
        DB$POP(SFCALL); 
        GOTO SFCALLLOOP;
        END 
  
      CONTROL IFGR DFFLOP,0;
        ITEM FLORET C(7) = "SFCL.  "; 
        B<30,6>FLORET = B<0,3>SFRC[0] + O"33";
        B<36,6>FLORET = B<3,3>SFRC[0] + O"33";
        DB$FLOP(FLORET);
      CONTROL ENDIF;
 #
*     IF SFCALL ERROR 41 OR 45 (RUN UNIT ID UNKNOWN)
*         OR 63 (HAS NO SHORT TERM CONNECTION)
*         ISSUE DIAGNOSTIC, AND TERMINATE THE RUN UNIT. 
 #
      IF (SFRC[0] EQ O"41"         # IF (JOB ID WAS INVALID            #
           OR SFRC[0] EQ O"63"     # OR USER JOB HAS NO NOS CONNECTION #
           OR SFRC[0] EQ O"45")    # OR USER JOB WAS NOT IN SYSTEM)    #
      THEN
        BEGIN 
        TQLTCF[0] = FALSE;         # NO LONGER ATTACHED TO CDCS        #
        DB$ERRE(47,MSGBUF,LEN);    # JOB UNKNOWN TO SYSTEM             #
        IF TQTERM[0]
        THEN
          BEGIN 
          DB$POP(DB$SFCL);
          RETURN;                  # RETURN IF DB$TRU IS ALEADY CALLED #
  
          END 
        DB$TRU;                    # TERMINATE RUN UNIT                #
        END 
 #
*     IF SFCALL ERROR 57 (ALREADY HAS A LONG TERM CONNECTION) 
*         ISSUE DIAGNOSTIC, AND TERMINATE THE RUN UNIT. 
* 
*         THIS HAPPENS AFTER CDCS HAS BEEN DROPPED AND THEN RESTARTED 
*         SO THE PRIOR USERS STILL HAVE LONG TERM CONNECTIONS.
 #
      IF SFRC[0] EQ O"57"          # IF ALREADY HAS LONG TERM CONNECT  #
      THEN
        BEGIN 
        TQLTCF[0] = TRUE;          # ALREADY CONNECTED                 #
        DB$ERR(29);                # ILLEGAL REQUEST - NOT INVOKED     #
        DB$TRU;                    # TERMINATE RUN UNIT                #
        END 
 #
*     IF SFCALL ERROR 43 (UCPA ILLEGAL) 
*         ISSUE DIAGNOSTIC, AND TERMINATE THE RUN UNIT. 
 #
      IF SFRC[0] EQ O"43"          # IF UCPA ILLEGAL                   #
      THEN
        BEGIN 
        FLERR;                     # UCPA NOT IN FL                    #
        END 
 #
*     OTHER RETURN CODES SHOULD NOT OCCUR.
*     IF THEY DO, ABORT CDCS. 
 #
      DB$PUNT("DB$SFCL"); 
  
  
  
  
  
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   F L E R R .            #
#                                                                      #
#**********************************************************************#
  
      PROC FLERR; 
      BEGIN 
 #
* *   DB$SFCL                                    PAGE  1
* *   FLERR - UCPA NOT IN FIELD LENGTH
* *   BOB MCALLESTER                             DATE  09/20/84 
* 
* DC  PURPOSE 
* 
*     DETERMINE WHICH FIELD IS NOT IN THE FIELD LENGTH AND ISSUE
*     A SPECIFIC MESSAGE. 
*     TAKE STEPS TO PREVENT INFINITE LOOPS WITH DB$ERR. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     IF DB$SFCL WAS CALLED FROM DB$ERR, RCIRRC CONTAINS ERROR LEVEL. 
* 
* DC  EXIT CONDITIONS 
* 
*     IF A FATAL ERROR IS NOT ALREADY IN PROGRESS, ONE IS INITIATED.
* 
*     IF A FATAL ERROR IS IN PROGRESS, AN INFORMATIONAL ERROR IS  SENT
*     AND PROCESSING OF THE FATAL ERROR IS RESUMED. 
* 
* DC  DESCRIPTION 
* 
*     THE DEFAULT MESSAGE IS "CDCS REQUEST NOT IN FL".
*     IF UCPA IS FOUND TO BE THE DBST, WSA OR KA, 
*     THEN A MORE DESCRIPTIVE MESSAGE IS USED.
* 
*     IF DB$SFCL HAS BEEN CALLED WHILE DB$ERR IS PROCESSING A FATAL 
*     ERROR, THE RCB RETURN CODE HAS A FATAL ERROR FLAG.
*     A CALL TO DB$ERR UNDER THESE CONDITIONS COULD CAUSE AN ENDLESS
*     LOOP TO OCCUR.
*     INSTEAD OF CALLING DB$ERR, BD$ERRE IS CALLED TO SELECT THE
*     MESSAGE AND WRITE IT TO THE OUTPUT FILE.
*     THEN AN SF.REGR FUNCTION IS SUBSTITUTED FOR FOR THE FUNCTION
*     THAT WAS REQUESTED. 
*     THIS IS DONE TO SEND THE MESSAGE TO THE UCP DAYFILE.
* 
*     OTHERWISE, DB$ERR IS CALLED.
 #
  
  
  
  
#     B E G I N   F L E R R   E X E C U T A B L E   C O D E .          #
  
  
      ERCODE = 32;                 # CDCS REQUEST NOT IN FL            #
  
      IF UCPA EQ TQDBSTUCP[0]      # IF IT IS THE DBSTATUS ADDRESS     #
      THEN
        BEGIN                      # CANCEL THE DBSTATUS               #
        TQDBSTLW[0] = 0;
        TQDBSTUCP[0] = 0; 
        TQDBSTSCP[0] = 0; 
        ERCODE = 14;
        END 
      IF UCPA EQ RCPFITWS[0]       # IF IT IS THE WORKING STORAGE ADDR #
      THEN
        BEGIN 
        ERCODE = 37;
        END 
      IF UCPA EQ RCPFITKA[0]       # IF IT IS THE KEY ADDRESS          #
      THEN
        BEGIN 
        ERCODE = 42;
        END 
                                   # IF A FATAL ERROR IS ALEADY BEING  #
      IF RCIRRC[0] EQ DFERRFAT     # PROCESSED                         #
      THEN
        BEGIN                      # PUT MESSAGE ON OUTPUT FILE.       #
        DB$ERRE(ERCODE,MSGBUF,LEN); 
                                   # ALTER THE FUNCTION TO AN SF.REGR  #
        P<SFCALL> = LOC(TQSFBUF); 
        SFCLWD[0] = (LOC(MSGBUF) +2) *64 + DFSFREGR;
        GOTO SFCALLLOOP;
  
        END 
      ELSE
        BEGIN 
        DB$ERR(ERCODE);            # FATAL ERROR, NO RETURN - UNLESS   #
                                   # THERE IS NO LONG TERM CONNECTION. #
        DB$POP(FLERR);             # POP DB$SFCL ENTRY TO FLERR        #
        RETURN;                    # THEN RETURN FROM DB$SFCL          #
  
        END 
      END 
      END 
      TERM; 
