*DECK DB$$SIM 
USETEXT CDCSCTX 
      PROC DB$$SIM; 
      BEGIN 
 #
* *   DB$$SIM - SIMULATE SYSTEM CONTROL POINT    PAGE  1
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     SIMULATE THE SYSTEM CONTROL POINT FUNCTIONS USED BY CDCS. 
* 
* DC  ENTRY CONDITIONS
* 
*     DB$$SIM IS NOT ENTERED DIRECTLY. THE FOLLOWING ENTRY POINTS ARE 
*     USED TO TRAP THE INDICATED CALLS: 
* 
*         DB$RCLL - RECALL REQUESTS MADE BY CDCS
* 
*         DB$SELF - CALL OWN SUBSYSTEM
* 
*         DB$SFCM - SUBSYSTEM FUNCTION CALLS MADE BY CDCS 
* 
*         DB$SSIN - SUBSYSTEM INITIALIZATION CALL MADE BY CDCS
* 
*         DB$$CSM - SUBSYSTEM FUNCTION CALLS PASSED BY CDCSBTF FROM 
*                   THE USER PROGRAM
* 
*         DB$$END - INTERCEPT AN *END* AND TERMINATE THE USER.
 #
*CALL DRIVRCOM
      XREF PROC DB$ABRT;
      XREF FUNC DB$CDEB C(10);  # INTEGER TO DECIMAL WITH BLANK FILL   #
      XREF FUNC DB$COCB C(10);  # INTEGER TO OCTAL WITH BLANK FILL     #
      XREF FUNC DB$COCT C(10);  # INTEGER TO OCTAL WITH ZERO FILL      #
      XREF PROC DB$FLOP;     # GENERATE FLOW POINT                     #
      XREF PROC DB$GOTO;
      XREF PROC DB$MSG; 
      XREF PROC DB$PUNT;
      XREF PROC DB$RCLR;     # RECALL ROUTINE FOR SYSTEM RECOVERY      #
      XREF ITEM DB$TRMF B;   # CDCS TERMINATION FLAG                   #
      XREF PROC DB$$RCM;
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM RA;
        END 
      XREF ARRAY DB$SSC;
        BEGIN 
        ITEM SSCBIT59 B(0,00,1);  # SET TO ONE BY OP SYS (IN SCP       #
                                  # VERSION) WHEN REQUEST BUFFER IS    #
                                  # FILLED, SET TO ZERO BY PROGRAM     #
                                  # WHEN REQUEST BUFFER IS EMPTIED     #
        ITEM SSCADDR   (0,42,18); # REQUEST BUFFER ADDRESS             #
        END 
      BASED ARRAY DUMMY;; 
      ITEM IX;
      ITEM RCBSAVED;         # SAVE RCB POINTER                        #
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ R C L L .        #
#                                                                      #
#**********************************************************************#
  
      XDEF PROC DB$RCLL;
      PROC DB$RCLL(PARM); 
      BEGIN 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$RCLL - TRAP RECALL REQUESTS
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     TRAP CDCS RECALL REQUESTS AND RETURN CONTROL TO CDCSBTF. RETURN 
*     CONTROL TO CDCS WHEN APPROPRIATE, BASED ON TYPE OF RECALL 
*     (PERIODIC OR AUTOMATIC).
 #
  
      ITEM PARM;
  
  
  
#     B E G I N   D B $ R C L L   E X E C U T A B L E   C O D E .      #
  
  
      IF SYSRECOVERY
      THEN
        BEGIN                # DURING SYSTEM RECOVERY                  #
        DB$RCLR(PARM);       # DO A RECALL                             #
        RETURN;              # AND RETURN                              #
  
        END 
      IF PARM EQ 0 THEN 
        XFCDCS = LOC(DB$RCLL);
      ELSE
        XFCDCS = LOC(RCLLCHECK);
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("RCLL-1 ");
      CONTROL ENDIF;
  
      DB$GOTO(XFDRIV);
  
RCLLCHECK:  
      IF B<59,1>RA[PARM] EQ 0 THEN
        BEGIN 
        IF SSCBIT59[0] THEN 
          DB$$RCM;
        ELSE
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP ("RCLL-2 ");
          CONTROL ENDIF;
  
          DB$GOTO(XFDRIV);
          END 
        END 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("RCLL-3 ");
      CONTROL ENDIF;
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ S E L F .        #
#                                                                      #
#**********************************************************************#
  
      XDEF FUNC DB$SELF;
      FUNC DB$SELF B; 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$SELF - TRAP CALLS TO OWN SUBSYSTEM 
* *   R L MCALLESTER                             DATE  01/23/80 
* 
* DC  PURPOSE 
* 
*     ALWAYS RETURN TRUE  -  CALLSS SUCCESSFUL
 #
      BEGIN 
      DB$SELF = TRUE; 
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ S F C M .        #
#                                                                      #
#**********************************************************************#
  
      XDEF PROC DB$SFCM;
      PROC DB$SFCM(PARMLOC);
      BEGIN 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$SFCM - TRAP SCP FUNCTION CALLS 
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     TRAP CDCS SYSTEM CONTROL POINT FUNCTION CALLS AND SIMULATE THEM.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETER = ADDRESS OF REQUEST PACKET 
* 
* DC  EXIT CONDITIONS 
* 
*     REQUEST HAS BEEN PROCESSED. 
*     RETURN TO THE CALLING ROUTINE IN CDCS.
 #
  
      ITEM PARMLOC; 
      BASED ARRAY PARM; 
        BEGIN 
        ITEM RC U(0,0,6); 
        ITEM FP U(0,6,12);
        ITEM UCPA (0,18,18);
        ITEM SCPA (0,36,18);
        ITEM FC (0,54,6); 
        ITEM JNAME U(1,0,42); 
        ITEM JO (1,42,18);
        END 
  
      ITEM MSG2 C(20) = "    ERROR FLAG     :"; 
      ITEM MSG1 C(24) = " MESSAGE FOR USER XXXX =:";
  
  
  
  
  
#     B E G I N   D B $ S F C M   E X E C U T A B L E   C O D E .      #
  
  
  
 #
*     PUNT IF FC FIELD IS COMPLETE. 
 #
      P<PARM> = PARMLOC;
      IF FC[0] LAN 1 NQ 0 THEN
        DB$PUNT("FC COMPLTE");
 #
*     PROCESS SF.READ.
 #
      IF FC[0] EQ DFSFREAD THEN 
        BEGIN 
        FOR IX=FP-1 STEP -1 UNTIL 0 DO
          RA[SCPA[0]+IX] = RA[UCPA[0]+IX];
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.WRIT.
 #
      IF FC[0] EQ DFSFWRIT THEN 
        BEGIN 
        FOR IX=FP-1 STEP -1 UNTIL 0 DO
          RA[UCPA[0]+IX] = RA[SCPA[0]+IX];
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.ENDT.
 #
      IF FC[0] EQ DFSFENDT THEN 
        BEGIN 
        IF UCPA[0] GR 0 
        THEN
          BEGIN 
          B<59,1>RA[UCPA[0]] = 1; 
          END 
        ELSE
          BEGIN 
          IF UCPA[0] EQ -1
          THEN
            BEGIN 
            JOBCONNF[JO[0]] = FALSE;
            END 
          END 
        IF SCPA[0] NQ 0 THEN
          BEGIN 
          P<ATBL> = SCPA[0];
          CPA[JO[0]] = CPA[JO[0]]+ACPA[0];
          CPB[JO[0]] = CPB[JO[0]]+ACPB[0];
          IO[JO[0]] = IO[JO[0]]+AIO[0]; 
          CM[JO[0]] = CM[JO[0]]+ACM[0]; 
          ECS[JO[0]] = ECS[JO[0]]+AECS[0];
          PP[JO[0]] = PP[JO[0]]+APP[0]; 
          END 
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.SLTC.
 #
      IF FC[0] EQ DFSFSLTC THEN 
        BEGIN 
        IF JOBCONNF[JO[0]] THEN 
          DB$PUNT("SLTC ERROR");
        JOBCONNF[JO[0]] = TRUE; 
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.CLTC.
 #
      IF FC[0] EQ DFSFCLTC THEN 
        BEGIN 
        IF NOT JOBCONNF[JO[0]] THEN 
          DB$PUNT("CLTC ERROR");
        OUTACC("CPA",CPA[JO[0]]); 
        OUTACC("CPB",CPB[JO[0]]); 
        OUTACC("IO",IO[JO[0]]); 
        OUTACC("CM",CM[JO[0]]); 
        OUTACC("ECS",ECS[JO[0]]); 
        OUTACC("PP",PP[JO[0]]); 
        JOBCONNF[JO[0]] = FALSE;
        GOTO SFCALLX; 
        END 
  
  
      PROC OUTACC(INSERT,NUM);
      BEGIN 
      ITEM INSERT C(10);
      ITEM NUM; 
      ITEM ACCMSG C(30) = "   XXX = 00000111112222233333:"; 
  
      IF NUM EQ 0 THEN
        RETURN; 
      C<3,3>ACCMSG = INSERT;
      C<09,10>ACCMSG = DB$COCB(B<00,30>NUM,10); 
      C<19,10>ACCMSG = DB$COCT(B<30,30>NUM,10); 
      DB$MSG(ACCMSG); 
      END 
  
  
 #
*     PROCESS SF.REGR.
 #
      IF FC[0] EQ DFSFREGR THEN 
        BEGIN 
        IF SCPA[0] NQ 0 THEN
          BEGIN 
          C<18,4>MSG1 = DB$CDEB(JO[0],4); 
          DB$MSG(MSG1); 
          P<DUMMY> = SCPA[0]; 
          DB$MSG(DUMMY);
          END 
 #
*         ERROR FLAG. 
 #
        IF UCPA[0] NQ 0 THEN
          BEGIN 
          C<15,4>MSG2 = DB$CDEB(JO[0],4); 
          DB$MSG(MSG2); 
          JOBCOMPA[JO[0]] = LOC(STATBUSY);
          JOBDONEF[JO[0]] = TRUE;  # ABORT THE USER JOB                #
          JOBCOUNT = JOBCOUNT -1; 
          IF JOBCOUNT EQ 0
          THEN
            BEGIN 
            DB$TRMF = TRUE; 
            END 
          END 
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.EXIT.
 #
      IF FC[0] EQ DFSFEXIT THEN 
        BEGIN 
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.SWPI 
 #
      IF FC[0] EQ DFSFSWPI THEN 
        BEGIN 
        JOBSWAPF[JO[0]] = FALSE;
        GOTO SFCALLX; 
        END 
 #
*     PROCESS SF.SWPO.
 #
      IF FC[0] EQ DFSFSWPO THEN 
        BEGIN 
        JOBSWAPF[JO[0]] = TRUE; 
        GOTO SFCALLX; 
        END 
 #
*     PROCESS REQUEST IF SWAPPED OUT. 
 #
      IF JOBSWAPF[JO[0]] THEN 
        BEGIN 
        RC[0] = O"44";
        FC[0] = FC[0]+1;
        RETURN; 
        END 
 #
*     IGNORE NO-RERUN AND STATUS REQUESTS.
 #
      IF FC[0] EQ DFSFRERN
        OR FC[0] EQ DFSFSTAT
      THEN
        BEGIN 
        GOTO SFCALLX; 
        END 
 #
*     ERROR IF FUNCTION CODE IS UNKNOWN.
 #
      DB$MSG("  CDCS FUNCTION CODE UNKNOWN:");
      DB$PUNT("DB$$SIM 1"); 
 #
*     COMMON CODE FOR SFCALL EXIT.
 #
SFCALLX:  
      RC[0] = 0;
      FC[0] = FC[0]+1;
      RETURN; 
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ S S I N .        #
#                                                                      #
#**********************************************************************#
  
      XDEF PROC DB$SSIN;
      PROC DB$SSIN(IRBUF);
      BEGIN 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$SSIN - TRAP SUBSYSTEM INIT CALL
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     TRAP THE CDCS SUBSYSTEM INITIALIZATION CALL.
* 
* DC  EXIT CONDITIONS 
* 
*     RA.SSC IS READY TO RECEIVE INPUT. 
* 
* DC  CALLING ROUTINES
* 
*     DB$INIT                CDCS INITIALIZATION
* 
* DC  CALLED ROUTINES 
* 
*     NONE
 #
      ITEM IRBUF I;          # INPUT RECEIVER BUFFER ADDRESS           #
      XREF ITEM DB$BTF B;    # CDCSBTF FLAG                            #
  
  
  
  
#     B E G I N   D B $ S S I N   E X E C U T A B L E   C O D E .      #
  
  
      SSCADDR[0] = IRBUF; 
      SSCBIT59[0] = FALSE;
      DB$BTF = TRUE;
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ $ C S M .        #
#                                                                      #
#**********************************************************************#
  
      XDEF PROC DB$$CSM;
      PROC DB$$CSM(RAY);
      BEGIN 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$$CSM - TRAP UCP FUNCTION CALLS 
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     TRAP USER CONTROL POINT SUBSYSTEM FUNCTION CALLS AND SIMULATE 
*     THEM. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETER = REQUEST PACKET
 #
      ARRAY RAY;
        ITEM RAYWORD; 
 #
* DC  EXIT CONDITIONS 
* 
*     REQUEST HAS BEEN PROCESSED. CONTROL IS PASSED TO CDCS.
* 
* DC  CALLING ROUTINES
* 
*     CDCSBTF PROCEDURE DB$SSCL.
* 
* DC  DESCRIPTION 
* 
*     SET DRIVER TRANSFER ADDRESS.
 #
  
  
  
#     B E G I N   D B $ $ C S M   E X E C U T A B L E   C O D E .      #
  
  
      XFDRIV = LOC(XFCSM);
XFCSM:  
      IF SSCBIT59[0] THEN 
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("$CSM-1");
        CONTROL ENDIF;
  
        DB$GOTO(XFCDCS);
        END 
      XFDRIV = LOC(DB$$CSM);
 #
*     STORE WORD 0 OF IR BUFFER.
 #
      RCBSAVED = P<RCB>;
      P<RCB> = SSCADDR[0] - DFRCIR0;
      RCIRSTAT[0] =0; 
      RCIRUCPA[0] = LOC(RAY); 
 #
*     STORE WORD 1 OF IR BUFFER.
 #
      C<0,7>RCIRRUID[0] = JOBNAME[JOBX];
      B<42,18>RCIRRUID[0] = JOBX; 
 #
*     COPY OVER REST OF REQUEST.
 #
      FOR IX=B<36,6>RAYWORD STEP -1 UNTIL 0 DO
        RCIR[IX+2] = RAYWORD[IX]; 
      P<RCB> = RCBSAVED;
 #
*     SET RA.SSC BIT TO SHOW MESSAGE. 
 #
      SSCBIT59 = TRUE;
 #
*     CONTINUE EXECUTING CDCS.
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("$CSM-2");
      CONTROL ENDIF;
  
      DB$GOTO(XFCDCS);
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ $ E N D .        #
#                                                                      #
#**********************************************************************#
  
      XDEF PROC DB$$END;
      PROC DB$$END; 
      BEGIN 
 #
* *   DB$$SIM                                    PAGE  1
* *   DB$$END - INTERCEPT USER PROGRAM ENDRUNS. 
* *   BOB MCALLESTER                             DATE  08/30/82 
* 
* DC  PURPOSE 
* 
*     INTERCEPT RA+1 END REQUESTS AND NOTIFY CDCS/CDCSBTF OF THE
*     USER TERMINATION. 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     IF DB$TRMF (CDCS TERMINATION FLAG) IS TRUE, IT IS CDCS THAT IS
*     TERMINATING INSTEAD OF A USER PROGRAM.
* 
* DC  EXIT CONDITION
* 
*     IF CDCS IS TERMINATING, RETURN WITH NO ACTION.
*     IF A USER IS TERMINATING, FLAG THE TERMINATION AND TRANSFER 
*     CONTROL TO THE DRIVER.
* 
* DC  CALLING ROUTINES
* 
*     DB$$SYS                SYS= SUBSTITUTE ROUTINE ENCOUNTERS AN END. 
*     RECOVR                 IF SYS= MISSES THE END, A REPRIEVE OCCURS. 
* 
* DC  CALLED ROUTINES 
* 
*     DB$MSG                 ISSUE A MESSAGE
* 
* DC  DESCRIPTION 
* 
*     IF CDCS IS TERMINATING, RETURN TO PERMIT IT.
* 
*     SET THE JOB-DONE-FLAG FOR THE USER SO THAT DRIVER WILL NOT
*     SCHEDULE THE USER AGAIN.
*     REDUCE THE JOB COUNT. 
* 
*     IF CALLED FROM DB$RCVD AND THERE ARE STILL OTHER USERS, 
*     DONT RISK ANOTHER *END* NOT COMING THROUGH SYS=.
*     CDCSBTF WOULD NOT BE ABLE TO REGAIN CONTROL THROUGH RECOVR AGAIN. 
*     TERMINATE THE CDCSBTF RUN PREMATURELY.
* 
*     IF THE USER DOES NOT HAVE A LONG TERM CONNECTION GO DIRECTLY
*     TO DRIVER TO SCHEDULE ANOTHER USER. 
* 
*     WHEN THE USER IS CONNECTED, SIMULATE AN OPERATING SYSTEM
*     NOTIFICATION THAT A CONNECTED UCP HAS TERMINATED. 
*     GO TO CDCS TO PROCESS THE NOTIFICATION. 
 #
# 
*     NON-LOCAL VARIABLES REFERENCED
# 
      XREF ITEM DB$RCVD;     # ENTRY POINT IS ZERO IF NOT CALLED       #
  
  
  
  
  
#     B E G I N   D B $ $ E N D   E X E C U T A B L E   C O D E .      #
  
  
      IF DB$TRMF
      THEN
        BEGIN 
        IF DB$RCVD EQ 0      # ISSUE END MESSAGE ON DB$$SYS CALL ONLY  #
        THEN
          BEGIN 
          DB$MSG("  END CDCSBTF RUN:"); 
          END 
        RETURN;              # PROCEED TO COMPLETE CDCS TERMINATION    #
  
        END 
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("$END");
      CONTROL ENDIF;
  
      JOBCOMPA[JOBX] = LOC(STATBUSY); 
      JOBDONEF[JOBX] = TRUE;
      JOBCOUNT = JOBCOUNT -1; 
  
      IF JOBCOUNT EQ 0
      THEN
        BEGIN 
        DB$TRMF = TRUE; 
        END 
  
      IF JOBCOUNT NQ 0
        AND DB$RCVD NQ 0
      THEN
        BEGIN 
        TERMFLAG = TRUE;     # FLAG A PREMATURE TERMINATION            #
        DB$MSG("  CDCSBTF TERMINATED BEFORE ALL USERS COMPLETED:"); 
        RETURN; 
  
        END 
      IF NOT JOBCONNF[JOBX]  # IF NO LONG TERM CONNECTION              #
      THEN
        BEGIN 
        DB$GOTO(XFLOOPX);    # GO TO DRIVER AT LOOPX                   #
  
        END 
  
XFEND:  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("$END-1");
      CONTROL ENDIF;
  
      IF SSCBIT59[0]
      THEN                   # IF RA.SSC WORD BIT 59 IS SET, DELAY CALL#
        BEGIN 
        XFDRIV = LOC(XFEND);
        DB$GOTO(XFCDCS);     # GO TO CDCS TO CLEAR BIT 59.             #
  
        END 
# 
*     SET THE NOTIFICATION IN THE RECEIVING RCB.  SPECIFIED BY RA.SSC.
# 
      RCBSAVED = P<RCB>;
      P<RCB> = SSCADDR[0] - DFRCIR0;
      RCIRSTAT[0] = 1;       # STATUS CODE FOR A NORMAL TERMINATION    #
      RCIRUCPA[0] = 0;
      C<0,7>RCIRRUID[0] = JOBNAME[JOBX];  # SET THE RUN-UNIT ID        #
      B<42,18>RCIRRUID[0] = JOBX; 
      P<RCB> = RCBSAVED;
      SSCBIT59 = TRUE;       # SET RA.SSC INTERLOCK BIT                #
  
      XFDRIV = XFLOOPX;      # AFTER CDCS EXECUTION, GO TO LOOPX.      #
      DB$GOTO(XFCDCS);       # GO TO CDCS PROCESSING                   #
  
      END 
      END  #DB$$SIM#
      TERM; 
