*DECK CDCSBTF 
USETEXT CDGDFTX 
      PRGM CDCSBTF; 
      BEGIN 
*CALL COPYRDCLS 
 #
* *   CDCSBTF - CDCS2 SCP BATCH TEST FACILITY    PAGE  1
* *   C O GIMBER
* *   BOB MCALLESTER                             DATE  08/30/82 
* 
* DC  PURPOSE 
* 
*     EXECUTE A PROGRAM OR PROGRAMS USING CDCS2 BY SIMULATING THE 
*     SYSTEM CONTROL POINT FACILITY.
* 
* DC  ENTRY CONDITIONS
* 
*     CONTROL CARD PARAMETERS 
*        LFN(S) OF USER PROGRAM(S) IN RELOCATABLE FORMAT
* 
* DC  EXIT CONDITIONS 
* 
*     THE USER PROGRAM(S) HAVE FINISHED EXECUTING.
* 
* DC  OVERVIEW
* 
*     SYSTEM CONTROL POINT (SCP) SIMULATION PROCEDURES ARE CONTAINED
*     IN CDCSBTF AND DB$$SIM. 
* 
*     THE SCP VERSION OF CDCS COMMUNICATES WITH THE OPERATING SYSTEM
*     THROUGH THE FOLLOWING INTERFACE PROCEDURES: 
* 
*     DB$SSIN - NOTIFIES THE OPERATING SYSTEM THAT CDCS IS READY TO 
*         BEGIN RECEIVING REQUESTS FROM USER CONTROL POINTS.
* 
*     DB$SFCM - ISSUES ONE OF THE PRIVILEGED SUBSYSTEM FUNCTION CALLS 
*         SUCH AS:  
*         SF.READ - READ DATA FROM THE UCP. 
*         SF.WRIT - WRITE DATA TO THE UCP.
*         SF.ENDT - NOTIFICATION THAT THE UCP REQUEST IS COMPLETE.
*         ETC ... 
* 
*     DB$RCLL - RELINQUISH THE CPU FOR OTHER CONTROL POINTS TO USE. 
* 
*     IN THE BTF VERSION OF CDCS, THE ABOVE PROCEDURES ARE REPLACED 
*     BY SIMULATION ROUTINES OF THE SAME NAME.
*     THIS SET OF SIMULATION ROUTINES IS CONTAINED IN DB$$SIM.
* 
*     IN THE SCP VERSION, THE USER PROGRAMS SEND THEIR REQUEST TO CDCS
*     VIA A CALLSS MACRO THAT IS CONTAINED IN THE PROCEDURE DB$SSCL.
*     IN THE BTF VERSION, DB$SSCL IS REPLACED BY A SIMULATION ROUTINE 
*     THAT IS CONTAINED IN CDCSBTF. 
* 
*     WITH THIS SIMULATION INTERFACE IN PLACE, CDCS AND ONE OR MORE 
*     USER PROGRAMS EXECUTE AS INDEPENDENT JOBS WITHIN A SINGLE 
*     CONTROL POINT.  THE LOGIC USED BY EACH OF THEM IS THE SAME AS IT
*     IS WHEN THEY EXECUTE AT SEPARATE CONTROL POINTS.
* 
*     THE DRIVER IS THAT PORTION OF CDCSBTF BEGINNING AT THE LABEL
*     LOOPI.
*     ITS PURPOSE IS TO SELECT ONE OF THE USER JOBS FOR EXECUTION.
* 
*     CDCS EXECUTES NORMALLY UNTIL IT CALLS DB$RCLL, DB$SFCM OR DB$SSIN.
* 
*     DB$SSIN IS ONLY CALLED DURING INITIALIZATION.  IN THE BTF VERSION,
*     DB$SSIN IS USED ONLY TO SET UP THE SCP COMMUNICATION WORD.
* 
*     A CALL TO DB$SFCM RESULTS IN THE SIMULATION OF THE SFCALL 
*     FUNCTION.  CONTROL IS ALWAYS RETURNED TO CDCS.
* 
*     THE ONLY TIME THAT CONTROL IS PASSED FROM CDCS TO THE DRIVER IS 
*     WHEN CDCS CALLS DB$RCLL.
* 
*     WHEN EVER CONTROL IS PASSED FROM CDCS TO THE DRIVER, THE CURRENT
*     CDCS EXECUTION ADDRESS IS SAVED IN THE VARIABLE NAMED XFCDCS. 
*     THIS RECORDS THE LOCATION AT WHICH CDCS PROCESSING MUST BE
*     RESUMED WHEN EVER CONTROL IS RETURNED.
* 
*     THE DRIVER HAS A SIMILAR VARIABLE NAMED XFDRIV THAT DETERMINES
*     WHERE ITS EXECUTION SHOULD BE RESUMED.
*     EACH USER JOB ALSO HAS A TRANSFER ADDRESS SIMILAR TO XFCDCS AND 
*     XFDRIV.  IT IS THE ITEM JOBCONTA IN THE BTF USER CONTROL TABLE. 
* 
*     THIS TECHNIQUE PERMITS CDCS AND THE DRIVER TO RUN INTERMITTANTLY
*     WITHOUT INTERFERING WITH EACH OTHER.
* 
*     EXECUTION OF THE SELECTED JOB IS INITIATED AT THE LOCATION SAVED
*     IN JOBCONTA.  THE JOB WILL THEN RUN INDEPENDENTLY OF CDCS OR
*     DRIVER UNTIL IT EITHER CALLS DB$SSCL OR TERMINATES. 
* 
*     WHEN DB$SSCL IS CALLED, THE CALLSS FUNCTION IS SIMULATED, 
*     JOBCONTA[JOBX] AND XFDRIVR ARE BOTH SET UP FOR FUTURE RESUMPTION
*     AND THEN CONTROL IS PASSED TO CDCS THROUGH XFCDCS.
* 
*     IF A USER JOB TERMINATES ABNORMALLY, THEN EXECUTION OF THE
*     ENTIRE CDCSBTF CONTROL POINT IS TERMINATED. 
* 
*     IF AN *END* IS ISSUED THROUGH THE SYSTEM ROUTINE SYS=, IT IS
*     INTERCEPTED BY A SYS= SUBSTITUTE THAT IS CONTAINED IN DB$$SYS.
*     THE JOB THAT TERMINATED IS FLAGGED SO THAT IT WILL NOT BE 
*     SELECTED FOR EXECUTION AGAIN. 
*     THE NORMAL EXECUTION OF CDCS AND ANY REMAINING USER JOB IS
*     CONTINUED.
* 
*     IF AN *END* IS PLACED IN RA+1 BY ANY MEANS OTHER THAN A SYS= CALL,
*     IT IS INTERCEPTED BY THE REPRIEVE ROUTINE DB$RCVD.
*     WHEN THAT USER JOB IS THE LAST TO END, THE NORMAL CDCS
*     TERMINATION PROCEDURES ARE USED.
*     IF THERE ARE ADDITIONAL USERS STILL EXECUTING, CDCSBTF
*     EXECUTION IS TERMINATED PREMATURELY.
* 
* 
* D   CDCSBTF INITIALIZATION
* 
*     THE FIRST TASK OF CDCSBTF IS TO LOAD EACH OF THE USER JOBS THAT 
*     IS TO BE EXECUTED.
* 
*     THE LGO FILES FOR THESE JOBS ARE SPECIFIED ON THE CDCSBTF 
*     CONTROL STATEMENT.
* 
*     THE FORMAT IS:  
* 
*     CDCSBTF(LGO1,LGO2,...LGON/P1,P2,...PN)
*         OR
*     CDCSBTF(LGO1,LGO2,...LGON)
* 
*     WHEN THERE ARE ANY CDCS PARAMETERS, OTHER THAN THE LGO FILE NAMES,
*     THEY ARE SEPARATED FROM THE LGO LIST BY A SLASH.
* 
*     AFTER CDCSBTF LOADS USER JOBS FROM EACH OF THE LGO FILES, IT
*     ADJUSTS THE PARAMETER LIST SO THAT CDCS WONT SEE THE LGO FILE 
*     PARAMETERS AND THEN CALLS CDCS. 
* 
* 
* DC  EXTERNAL REFERENCES 
# 
      XREF LABEL CDCS;       # CDCS ENTRY POINT                        #
      XREF PROC DB$ABRT;     # ABORT RUN BY A JUMP TO 400000           #
      XREF FUNC DB$CDEB C(10);  # INTEGER TO DECIMAL WITH BLANK FILL   #
      XREF FUNC DB$CDEC C(10);  # INTEGER TO DECIMAL WITH ZERO FILL    #
      XREF FUNC DB$COCB C(10);  # INTEGER TO OCTAL WITH BLANK FILL     #
      XREF PROC DB$FLOP;     # RECORD A FLOW POINT                     #
      XREF PROC DB$GOTO;
      XREF PROC DB$MSG;                #DAYFILE MESSAGE#
      XREF ARRAY DB$OFET;    # OUTPUT FILE FET                         #
        BEGIN 
        ITEM OFETLFN C(00,00,07);  # LOCAL FILE NAME OF OUTPUT FILE # 
        END 
      XREF ARRAY DB$RA0;
        ITEM RA;
      XREF PROC DB$$RAR;     # RESTORE CONTESTS OF A0 REGISTER         #
      XREF PROC DB$$SAR;     # SAVE CONTENTS OF A0 REGISTER            #
      XREF PROC DB$$CSM;               #CALL CALLSS MACRO#
      XREF ARRAY DB$$LDQ;              #LOADER REQUEST TABLE ARRAY# 
        BEGIN 
        ITEM LDRFWASC (0,12,18);  # FIRST WORD ADDR OF CM LOADABLE AREA#
        ITEM LDRLWASC (0,42,18);  # LAST WORD ADDR OF CM LOADABLE AREA #
        ITEM LDRFE   B(2,00,01);  # LOADER FATAL ERROR FLAG            #
        ITEM LDRSTAT U(2,06,18);  # LOADER FATAL ERROR NUMBER          #
        ITEM LDREPT2 U(2,24,18);  # LOADER SECONDARY TRANSFER ADDRESS  #
        ITEM LDREPT1 U(2,42,18);  # LOADER PRIMARY TRANSFER ADDRESS    #
                                  # START ADDRESS FOR USER PROGRAM     #
        END 
      XREF ARRAY DB$$LDF;           #LOADER LFN ENTRY#
        BEGIN 
        ITEM LDRLFN U(1,0,42);
        ITEM LDRLFNC C(1,0,7);    # LOAD FILE NAME - CHARACTER FORMAT  #
        ITEM LDRREWF U(1,58,02);  # TWO, ONE BIT FLAGS                 #
                                  # BIT 58 = 0, REWIND FLAG ABSENT     #
                                  #          1, REWIND FLAG PRESENT    #
                                  # BIT 59 = 0, NO REWIND              #
                                  #        = 1, REWIND                 #
        END 
      XREF PROC DB$$LDR;               #LOADER INTERFACE# 
      XREF PROC DB$$RCM;     # EXECUTE RECALL MACRO                    #
      XREF FUNC DB$$RTA;     # GET SUBROUTINE RETURN ADDRESS           #
# 
 #
# 
*     LOCAL VARIABLES.
# 
      ITEM DEADCOUNT=200;    #COUNT GOES TO ZERO WHEN#
                             #DEADLOCK SITUATION OCCURS#
      ITEM ENDMSG C(30) = "  END PROGM XXX.:";
      ITEM INDEX; 
      ITEM JOBMAX        I;  # NUMBER OF JOBS LOADED                   #
      ITEM JOBPROC B; 
      ITEM LDRMSG C(70) = 
"  CDCSBTF TERMINATED, LOADER ERRORXXXXXX  ON USER LOAD FILE FFFFFFF.:";
      ITEM LDRMSG2 C(70) =
"  CDCSBTF ABORTED, 2 TRANSFER ADDRESSES   ON USER LOAD FILE FFFFFFF.:";
      ITEM STATBUSY = 0;
      ITEM STATCOMP = 1;
                             # REPRIEVE PARAMETERS (TEMPORARY STORAGE) #
      ITEM TEMPEXP U;        # ADDRESS OF EXCHANGE PACKAGE             #
      ITEM TEMPTFLG I;       # JOB TERMINATION FLAG                    #
      ITEM TEMPRA1 I;        # CONTENTS OF RA+1                        #
# 
*     CDCSBTF COMMON. 
# 
*CALL DRIVRCOM
  
  
  
  
#     B E G I N   C D C S B T F   E X E C U T A B L E   C O D E .      #
  
 #
* 
* DC  DESCRIPTION 
* 
*     ABORT IF NO JOBS TO EXECUTE.
 #
      JOBMAX = B<42,18>RA[O"64"]; 
      IF JOBMAX EQ 0
      THEN
        BEGIN 
        DB$MSG("  CDCSBTF TERMINATED, NO PROGRAMS:"); 
        STOP; 
        END 
 #
*     LOAD ALL PROGRAMS TO BE EXECUTED. 
 #
      JOBCOUNT = 0; 
      FOR JOBX=1 STEP 1 UNTIL JOBMAX DO 
        BEGIN 
        JOBCOUNT = JOBCOUNT+1;
        LDRFWASC[0] = 0;
        LDRLWASC[0] = 0;
        LDRLFN[0] = B<0,42>RA[1+JOBX];
        LDRREWF[0] = 3;      # PRESUME FILE SHOULD BE REWOUND          #
        LDREPT1[0] = 0; 
        LDREPT2[0] = 0; 
        LDRFE[0] = FALSE; 
        LDRSTAT[0] = 0; 
#     IF SAME FILE AS ANOTHER LGO, DO NOT REWIND THE FILE.             #
        FOR INDEX=JOBX-1 STEP -1 UNTIL 1 DO 
          BEGIN 
          IF B<0,42>RA[1+INDEX] EQ B<0,42>RA[1+JOBX] THEN 
            LDRREWF[0] = 2; 
          END 
        DB$$LDR;
#     TERMINATE IF FATAL LOADER ERROR.                                 #
        IF LDRFE[0] THEN
          BEGIN 
          C<34,6>LDRMSG = DB$COCB(LDRSTAT[0],6);
          C<60,7>LDRMSG = LDRLFNC[0]; 
          DB$MSG(LDRMSG); 
          STOP; 
          END 
#     PRINT DAYFILE MESSAGE AND ABORT IF THERE IS MORE THAN ONE        #
#     TRANSFER ADDRESS.                                                #
        IF LDREPT2[0] NQ 0 THEN 
          BEGIN 
          C<60,7>LDRMSG2 = LDRLFNC[0];
          DB$MSG(LDRMSG2);
          STOP; 
  
          END 
        JOBWORD[JOBX] = 0;   # INITIALIZE ALL SWITCHES = FALSE         #
        JOBCONTA[JOBX] = LDREPT1[0];
        JOBCOMPA[JOBX] = LOC(STATCOMP); 
        JOBNAME[JOBX] = DB$CDEC(JOBX,7);
        C<0> JOBNAME[JOBX] = "C"; 
        CPA[JOBX] = 0;
        CPB[JOBX] = 0;
        IO[JOBX] = 0; 
        CM[JOBX] = 0; 
        ECS[JOBX] = 0;
        PP[JOBX] = 0; 
        IF B<54,6>RA[1+JOBX] EQ 3 THEN
          BEGIN 
          FOR JOBX=1 STEP 1 UNTIL 20 DO 
            RA[1+JOBX] = RA[1+JOBX+JOBCOUNT]; 
          RA[O"64"] = RA[O"64"]-JOBCOUNT; 
          JOBMAX = JOBCOUNT;
          GOTO ENDLOAD; 
          END 
        END 
      B<42,18>RA[O"64"] = 0;
  
ENDLOAD:  
  
      XFDRIV = LOC(LOOPI);   # DRIVER TRANSFER ADDRESS                 #
      XFLOOPX = LOC(LOOPX);  # CONSTANT, LOOPX LOCATION                #
      OFETLFN[0] = "CDCSOUT";  # CDCSBTF OUTPUT FILE                   #
      GOTO CDCS;             # TRANSFER CONTFOL TO CDCS FOR INIT       #
  
  
  
 #
* 
* DC  DRIVER
* 
*     S T A R T   O F   D R I V E R   E X E C U T A B L E   C O D E . 
* 
*     BEGIN SCHEDULING LOOP FOR EXECUTION OF USER PROGRAMS. 
 #
LOOPI:  
      JOBX = 1; 
       JOBPROC = FALSE; 
  
LOOP: 
      IF B<59,1>RA[JOBCOMPA[JOBX]] EQ 0 
      OR JOBWAITF[JOBX] 
      THEN
        GOTO LOOPX; 
  
      CONTROL IFGR DFFLOP,0;
        ITEM USERID C(07) = "$USER00";
        C<5,2>USERID = C<5,2>JOBNAME[JOBX]; 
        DB$FLOP(USERID);
      CONTROL ENDIF;
  
      JOBPROC = TRUE; 
      JOBCOMPA[JOBX] = LOC(STATBUSY); 
      DB$$RAR(LOC(JOBA0[JOBX]));   # RESTORE CONTENTS OF REGISTER A0   #
      DB$GOTO(JOBCONTA[JOBX]);
  
LOOPX:  
      JOBX = JOBX+1;
      IF JOBX LQ JOBMAX THEN
        GOTO LOOP;
      IF NOT JOBPROC THEN 
        BEGIN 
        DEADCOUNT = DEADCOUNT-1;
        IF DEADCOUNT EQ 0 THEN
          BEGIN 
          DB$MSG("  CDCSBTF DEADLOCK, JOB ABORTED:"); 
          DB$ABRT;
          END 
        DB$$RCM;
        IF B<59,1>DEADCOUNT EQ 0
        THEN
          BEGIN 
          WAITTEST;          # EVERY OTHER PASS, CHECK WAIT STATUS     #
          END 
        XFDRIV = LOC(LOOPI);
        DB$GOTO(XFCDCS);
        END 
      DEADCOUNT = 20000;
      GOTO LOOPI; 
      CONTROL EJECT;
      XDEF PROC DB$SSCL;
      PROC DB$SSCL(PARM); 
      BEGIN 
 #
* *   DB$SSCL - TRAP USER SUBSYSTEM CALLS        PAGE  1
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     TRAP USER PROGRAM CALLS TO THE SSCALL MACRO.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETER = ADDRESS OF SUBSYSTEM REQUEST PACKET 
* 
* DC  EXIT CONDITIONS 
* 
*     THE CONTENTS OF REGISTER A0 HAS BEEN SAVED IN THE 
*     CDCSBTF SCHEDULING TABLES.
*     THE REQUEST HAS BEEN PASSED ON TO DB$$CSM. THE COMPLETION BIT 
*     ADDRESS HAS BEEN SAVED IN THE CDCSBTF SCHEDULING TABLES. RETURN IS
*     DIRECTLY TO THE CDCSBTF SCHEDULING LOOP, WHICH WILL RESTART 
*     THE USER PROGRAM WHEN THE REQUEST IS COMPLETE.
* 
* DC  CALLING ROUTINES
* 
*     DB$RQST - SUBSYSTEM REQUEST PROCESSOR (LOADED IN USER JOB)
* 
* DC  CALLED ROUTINES 
* 
*     DB$$CSM - PERFORMS SUBSYSTEM REQUEST PROCESSING.
*     DB$$SAR - SAVE CONTENTS OF REGISTER A0
* 
 #
      ARRAY PARM; 
        BEGIN 
        ITEM PARTASK U(1,46,8); 
        END 
  
  
      DB$$SAR(LOC(JOBA0[JOBX]));   # SAVE CONTENTS OF REGISTER A0      #
      PARTASK[0] = JOBX;
      JOBCOMPA[JOBX] = LOC(PARM); 
      JOBCONTA[JOBX] = DB$$RTA(DB$SSCL);
      DB$$CSM(PARM);
      JOBPROC = TRUE; 
      XFDRIV = LOC(LOOPX);
      DB$GOTO(XFCDCS);
      END 
      CONTROL EJECT;
      XDEF PROC DB$WAIT;
      PROC DB$WAIT; 
      BEGIN 
 #
* *   DB$WAIT - CONCURRENCY TEST COORDINATOR     PAGE  1
* *   C O GIMBER
* 
* DC  PURPOSE 
* 
*     PROVIDE A COORDINATION MECHANISM FOR MULTIPLE USER JOBS TO ALLOW
*     TESTING OF SPECIFIC CONCURRENCY PROBLEMS. THE CALLING USER JOB
*     IS SUSPENDED UNTIL ALL EXECUTING USER JOBS HAVE BEEN SUSPENDED. 
*     ALL USER JOBS ARE THEN ALLOWED TO CONTINUE. 
* 
* DC  ENTRY CONDITIONS
* 
*     NO PARAMETERS 
* 
* DC  EXIT CONDITIONS 
* 
*     USER JOB HAS BEEN SUSPENDED.
*     RETURN IS MADE DIRECTLY TO THE CDCSBTF SCHEDULING LOOP, WHICH 
*     WILL RESTART THE USER PROGRAM WHEN THE WAIT CONDITION IS
*     SATISFIED.
* 
* DC  CALLING ROUTINES
* 
*     CALLED DIRECTLY FROM THE USER PROGRAM AS A SUBROUTINE.
* 
* DC  CALLED ROUTINES 
* 
*     WAITTEST - CHECK FOR ALL USERS IN WAIT STATE
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("$WAIT"); 
      CONTROL ENDIF;
  
      JOBWAITF[JOBX] = TRUE;
      JOBCOMPA[JOBX] = LOC(STATBUSY); 
      JOBCONTA[JOBX] = DB$$RTA(DB$WAIT);
  
      WAITTEST; 
      GOTO LOOPX; 
      END 
      CONTROL EJECT;
      PROC WAITTEST;
      BEGIN 
 #
*     WAITTEST - INTERNAL PROCEDURE TO TEST STATUS OF ALL USER JOBS.
*                IF ALL JOBS ARE IN WAIT STATUS, THEY ARE ALL ALLOWED 
*                TO CONTINUE. 
 #
      FOR INDEX = 1 STEP 1 UNTIL JOBMAX DO
        BEGIN 
        IF NOT JOBDONEF[INDEX] AND NOT JOBWAITF[INDEX] THEN 
          RETURN; 
        END 
  
      FOR JOBX=1 STEP 1 UNTIL JOBMAX DO 
        BEGIN 
        IF JOBDONEF[JOBX] THEN
          TEST JOBX;
        JOBWAITF[JOBX] = FALSE; 
        JOBCOMPA[JOBX] = LOC(STATCOMP); 
        END 
      GOTO LOOPI; 
      END 
      END  #CDCSBTF#
      TERM; 
