*DECK DB$SCHD 
USETEXT CDCSCTX 
      PROC DB$SCHD((COMPFLAG),(WAITSTATUS));
      BEGIN 
 #
* *   DB$SCHD--CDCS SCHEDULER                    PAGE  1
* *   C O GIMBER                                 10/20/75 
* 
* DC  PURPOSE 
* 
*     CAUSE TASKS TO EXECUTE.  IT WILL NOT CAUSE TASKS WHICH ARE
*     WAITING FOR AN EVENT TO COMPLETE TO EXECUTE.
* 
* DC  CALLING ROUTINES
* 
*     ANY TASK THAT CAN BE INTERRUPTED. 
*       EXAMPLE.  IF TASK MUST WAIT FOR FET TO GO COMPLETE. 
*       1.  SAVE ALL TASK RELATED INFORMATION.
*       2.  CALL DB$SCHD PASSING FET (COMPLETION BIT WORD)
*       3.  AFTER FET HAS GONE COMPLETE, NEXT INSTRUCTION WILL
*           BE EXECUTED.
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC CLOCK;       # GET THE CURRENT TIME FROM THE SYSTEM    #
      XREF FUNC DB$COCT C(10);  # CONVERT BINARY TO DISPLAY OCTAL      #
      XREF PROC DB$CRMR;     # EXECUTE RECALL MACRO WITHOUT A CMM CALL #
      XREF PROC DB$FLOP;     #IDENTIFY FLOW POINT                      #
      XREF PROC DB$FLUI;     #IDENTIFY USER FOR FLOW POINT REPORT      #
      XREF PROC DB$GOTO;     #JUMP TO ADDRESS PASSED AS PARAMETER#
      XREF PROC DB$IREC;     #INPUT RECEIVER# 
      XREF PROC DB$MBS;      #SET TEMPORARY BASED ARRAY POINTERS# 
      XREF PROC DB$MFO8;     #CALL DB$ERR TO ABORT THE USER#
      XREF PROC DB$POP;      #RESTORE AN ITEM FROM THE PUSH-DOWN STACK# 
      XREF PROC DB$PUSH;     #SAVE AN ITEM IN THE RCB PUSH-DOWN STACK#
# 
* DC  ENTRY CONDITIONS
* 
*     CALLED FROM EXECUTING SYMBIONT. 
*     RCB BASED ARRAY SET.
* 
*     SCHDFLAG, WAITSTATUS
*     SCHDFLAG - . NORMALLY ZERO. IF NON-ZERO, ITS ABSOLUTE VALUE 
*                  INDICATES THE ADDRESS OF AN RCB. THE ONLY TIME A 
*                  NEGATIVE VALUE IS SET IS WITHIN DB$SCHD, AND THIS
*                  OCCURS WHEN $SCHD IS CALLED AND SCHDFLAG IS
*                  POSITIVE.
*                . IF SCHDFLAG IS POSITIVE UPON ENTRY TO $SCHD, $SCHD 
*                  SHOULD SWAP FROM THE CURRENT RCB TO THE ONE
*                  INDICATED BY SCHDFLAG (SCHDFLAG IS THEN SET TO THE 
*                  NEGATIVE OF OLD CURRENT RCB BEFORE CRANKING UP 
*                  NEW RCB).
*                . IF SCHDFLAG IS NEGATIVE, THIS IS THE FIRST $SCHD 
*                  CALL AFTER THE "POSITIVE SCHDFLAG" TASK, AND THE 
*                  PRIOR RCB SHOULD BE RESTARTED AND SCHDFLAG IS
*                  ZEROED (DB$WRP TAKES A SHORT CUT AND, IF SCHDFLAG
*                  IS NEGATIVE, POSITIONS TO THAT RCB, CLEARS 
*                  SCHDFLAG, AND HAS DB$SCHL CONTINUE THAT RCB. 
*                  IF SCHDFLAG WAS NON-NEGATIVE, ITS VALUE WAS
*                  IGNORED AND THE *NEXT* RCB WAS USED FOR DB$SCHL).
* 
*     WAITSTATUS   ONLY USED IF $SCHD ENTERED WITH SCHDFLAG POSITIVE. 
*                  IF IT IS EQUAL TO DFWAITTASK, THE NEW RCB IS 
*                  FOLLOWED TO COMPLETION. ANY INTERRUPTION IN ITS
*                  EXECUTION MUST BE ACCOMPLISHED BY A $SCHD CALL.
* 
*     A TASK SETS SCHDFLAG = RCB ADDRESS OF A TASK WHICH IT 
*     WANTS TO EXECUTE AND CALLS THE SCHEDULER.  THE
*     SCHEDULER SET SCHDFLAG = -RCB ADDRESS OF THE
*     CALLING TASK AND STARTS EXECUTION OF THE CALLED 
*     TASK.  THE CALLED TASK EXECUTES AND CALLS THE 
*     SCHEDULER.  IF THE CALLING TASK SPECIFIED A 
*     WAITSTATUS = DFWAITTASK THEN THE SCHEDULER
*     RECALLS CDCS UNTIL COMPLETION AND RETURNS TO THE CALLED TASK
*     UNTIL THE TASK COMPLETES OR UNTIL THE CALLED TASK 
*     CALLS SCHEDULER WITH WAITSTATUS = 0.  SCHEDULER 
*     WILL SET SCHDFLAG = 0 AND CONTINUE EXECUTING THE
*     CALLING TASK. 
*     PARAMETER 
# 
      ITEM COMPFLAG;         #ADDRESS WHICH CONTAINS COMPLETION BIT#
      ITEM WAITSTATUS;       #CONSTRAINT FOR JOB# 
# 
* 
* DC    NON-LOCAL VARIABLES 
# 
      XREF ITEM CRMRC I;     # CRM RECALL COUNT                        #
      XREF ARRAY DB$RA0;     #BASED AT RA+0#
        BEGIN 
        ITEM COMPLETE B(0,59,1);
        ITEM INDIRECT I (00,42,18);  # INDIRECT POINTER TO CONSTRAINT  #
        END 
      XREF ITEM DB$MFPA;     #ADDR. OF PROC TO HANDLE MEMORY OVERFLOW#
      XREF ITEM REQSCHD;     # COUNT OF REQUESTS SCHEDULED SINCE RCL #
 #
# 
# 
*     LOCAL VARIABLES 
# 
      ITEM ADDRESS;          # ADDRESS OF CONSTRAINING BIT             #
      ITEM INDEX;            #SCRATCH ITEM# 
      ITEM SAVERCB I;        # SCRATCH--FOR SAVING RCB ENTRY           #
      ITEM SELPOS  I;        # QUEUE POSITION OF A SELECTED RCB        #
      ITEM SELRCB  I;        # LOCATION OF A SELECTED RCB              #
      BASED ARRAY DBSCHD; 
        BEGIN 
        ITEM CONTINUE (00,12,18);  # CONTINUATION ADDRESS FOR CALLER   #
        END 
      ITEM TASKFLAG;         #MEANINGFUL ONLY IF SCHDFLAG NON ZERO# 
                             #  0  IF CURRENT RCB TO BE EXECUTED# 
                             #     TO COMPLETION# 
  
  
  
  
  
#     B E G I N   D B $ S C H D   E X E C U T A B L E   C O D E .      #
  
  
 #
* DC  DESCRIPTION 
* 
*     PUT CONTINUATION ADDRESS IN RCB ENTRY.
*     PUT COMPLETION ADDRESS IN RCB ENTRY.
*     SET CONSTRAINT TYPE FIELD IN TQT ENTRY. 
 #
  
      CONTROL IFGR DFFLOP,1;
        DB$FLOP("SCHD");
      CONTROL ENDIF;
  
      P<DBSCHD> = LOC(DB$SCHD); 
      $BEGIN                       #DEBUG TRACE#
      XREF PROC DB$TRCX;
      XREF PROC DB$TRCO;
      IF WAITSTATUS NQ 0 THEN 
        BEGIN 
        DB$TRCX(WAITSTATUS);
        DB$TRCO("CONTA=:",CONTINUE[0],6); 
        END 
      $END
      RCCONTA[0] = CONTINUE[0]; 
      RCCONSTRA[0] = COMPFLAG;
      RCCT[0] = WAITSTATUS; 
 #
* 
* D   -- INTERNAL TASK SCHEDULER -- 
* 
*     IF SCHEDULER FLAG NON-ZERO THEN 
*       IF FLAG NEGATIVE THEN 
*         IF TASK NOT TO BE EXECUTED UNTIL COMPLETION THEN
*           EXECUTE ORIGINAL TASK.
*         RECALL CDCS UNTIL WAIT STATUS COMPLETED.
*         CONTINUE EXECUTING CALLING RCB. 
*       SET CDCS TO EXECUTE RCB AT SCHEDULER FLAG ADDRESS.
*       SET SCHEDULER FLAG TO -RCB ADDRESS OF CALLING RCB.
*       EXECUTE RCB.
* 
*     NOTE -- IT IS ASSUMED THAT INTERNAL TASKS DO NOT USE ANY
*     INDIRECT CONSTRAINING ADDRESSES.
* 
 #
      IF SCHDFLAG NQ 0 THEN 
        BEGIN 
        IF SCHDFLAG LS 0 THEN 
          BEGIN 
          IF TASKFLAG NQ 0
            OR WAITSTATUS EQ DFWAITRTN
          THEN
            BEGIN 
            P<RCB> = -SCHDFLAG; 
            SCHDFLAG = 0; 
            GOTO DB$SCHI; 
            END 
  
          FOR INDEX = INDEX WHILE  NOT COMPLETE[RCCONSTRA[0]] 
          DO
            BEGIN 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("SCHD-1");
            CONTROL ENDIF;
  
            CRMRC = 0;
            DB$CRMR;
            END 
          RETURN; 
          END 
        TASKFLAG = WAITSTATUS-DFWAITTASK; 
        INDEX = P<RCB>; 
        P<RCB> = SCHDFLAG;
        SCHDFLAG = -INDEX;
                             # WAIT FOR THE CONSTRAINING EVENT.        #
                             # DO NOT MAKE ANY CMM REQUEST FOR A NEW   #
                             # RCB WHILE WAITING.                      #
  
        FOR INDEX = INDEX WHILE NOT COMPLETE[RCCONSTRA[0]]
        DO
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("SCHD-2");
          CONTROL   ENDIF;
  
          CRMRC = CRMRC -1; 
          DB$CRMR;
          END 
        GOTO DB$SCHI;        # PROCESS THE SELECTED INTERNAL TASK      #
        END 
  
TRYNEXT:  
  
 #
*     ASSIGN THE NEW RCB QUEUE POSITION TO THIS RCB.
*     GIVE A LONGER WAIT TO RCB'S THAT ARE IN SOME WAIT STATE.
 #
      IF LOC(RCB) EQ LOC(RCBMTR)
        OR RCCT[0] EQ DFWAITCOUNT 
      THEN                         # WAITING JOBS                      #
        BEGIN 
        RCQPOS[0] = 5;
        END 
      ELSE
        BEGIN 
        RCQPOS[0] = 0;
        END 
 #
* 
*     PROCESS INPUT REQUESTS BY CALLING INPUT RECEIVER. 
 #
      DB$IREC;
 #
*     LOOP THRU RCB ENTRIES.
 #
      P<RCB> = RCNEXT[0]; 
      XDEF LABEL DB$SCHL; 
DB$SCHL:  
 #
* 
* D   -- PRIORITY REQUEST SCHEDULER --
* 
*     SAVE THE CURRENT RCB LOCATION.
*     SET THE SELECTED RCB QUEUE POSITION TO THE MAXIMUM VALUE. 
*     THEN LOOP THROUGH ALL OF THE RCB'S TESTING FOR THOSE THAT ARE 
*     READY FOR EXECUTION.
*       ADVANCE EACH OF THESE TO THE NEXT QUEUE POSITION UNTIL ZERO.
*       SELECT THE FIRST ONE OF THE SET OF RCB'S THAT HAVE THE LOWEST 
*       QUEUE POSITION. 
*     SINCE RCBMTR IS ALWAYS IN THE RCB RING AND ALWAYS READY, IT IS
*     GUARANTEED THAT ONE RCB WILL BE SELECTED. 
 #
      SELPOS = 2**8-1;       # MAXIMUM VALUE FOR RCQPOS                #
      SAVERCB = LOC(RCB); 
  
      CONTROL FASTLOOP;      # ONCE THROUGH THE LOOP IS GUARANTEED     #
  
                             # WHEN FAST LOOP IS SPECIFIED, THE WHILE  #
                             # CONDITION IS CHECKED ONLY AT THE END OF #
                             # THE LOOP.                               #
                             # THE FIRST ITERATION IS PERFORMED EVEN   #
                             # THOUGH LOC(RCB) IS EQUAL TO SAVERCB.    #
  
      FOR INDEX=INDEX WHILE LOC(RCB) NQ SAVERCB 
      DO
        BEGIN 
        ADDRESS = RCCONSTRA[0]; 
        IF ADDRESS LS 0 
        THEN
          BEGIN              # USE THE INDIRECT ADDRESS                #
          ADDRESS = INDIRECT [-ADDRESS];
          END 
        IF COMPLETE [ADDRESS] 
        THEN
          BEGIN 
          RCQPOS[0] = RCQPOS[0] -1; 
                             # MINIMUM EFFECTIVE QUEUE POSITION IS ZERO#
                             # FOR VALUES OF ZERO OR LESS THE          #
                             # SCHEDULING IS ROUND ROBIN.              #
          IF RCQPOS[0] LS 0 
          THEN
            BEGIN            # SELECT THIS ONE AND EXIT                #
            SELRCB = LOC(RCB);
            P<RCB> = SAVERCB; 
            TEST INDEX; 
  
            END 
          IF RCQPOS[0] LS SELPOS
          THEN
            BEGIN            # RECORD BEST SELECTION SO FAR            #
            SELRCB = LOC(RCB);
            SELPOS = RCQPOS[0]; 
            END 
          END 
        P<RCB> = RCNEXT[0]; 
        END 
      CONTROL SLOWLOOP;      # RETURN TO NORMAL LOOP CONTROL           #
  
      P<RCB> = SELRCB;
  
  
      XDEF LABEL DB$SCHI;          # PREEMPTIVE SCHEDULING             #
                                   # TAKES PRECEDENCE OVER PRIORITY    #
                                   # SCHEDULING                        #
DB$SCHI:  
 #
* 
* D   -- PROCESS THE SELECTED REQUEST --
* 
*     IF THE REQUEST HAS A DELAY COUNT, 
*       POP THE REMAINING COUNT FROM THE STACK AND REDUCE IT BY ONE.
*       IF THE REDUCED COUNT IS ZERO, PROCESS THE REQUEST.
*       ELSE RESTORE THE COUNT TO THE STACK AND SELECT ANOTHER REQUEST. 
 #
      IF RCCT[0] EQ DFWAITCOUNT 
      THEN
        BEGIN 
        DB$POP(INDEX);       # GET THE COUNT                           #
        INDEX = INDEX -1; 
        IF INDEX GR 0 
        THEN
          BEGIN 
          DB$PUSH(INDEX); 
          GOTO TRYNEXT; 
  
          END 
        END 
 #
*     INCREMENT THE SCHEDULED REQUEST COUNT.
 #
      SCHDCOUNT = SCHDCOUNT+1;
      REQSCHD = REQSCHD+1;
      CRMRC = 0;
  
      CONTROL IFGR DFFLOP,0;
        ITEM CTIME I;        # CURRENT TIME                            #
        CLOCK(INDEX); 
        IF INDEX NQ CTIME 
        THEN
          BEGIN 
          CTIME = INDEX;
          DB$FLUI("       "); 
          DB$FLUI(" TIME ="); 
          DB$FLUI(C<2,7>CTIME); 
          END 
      CONTROL ENDIF;
  
 #
*     SET COMMON CELLS BASED ON RCB.
*       P<TQT>
*       MBA BASED ARRAYS. 
 #
      P<TQT> = RCTQT[0];
      DB$MBS; 
 #
*     CALL FLOW POINT PROCEDURES TO IDENTIFY THE TASK BEING SCHEDULED.
 #
      CONTROL IFGR DFFLOP,0;
        IF LOC(RCB) EQ LOC(RCBMTR)
        THEN
          BEGIN 
          DB$FLOP("* MTR *");  # RECORD USER BUT DONT FLOOD DB$FLUI    #
          END 
        ELSE
          BEGIN 
          DB$FLUI("       "); 
          DB$FLUI(" JOB = "); 
          DB$FLUI(RCIRRUID[0]);  # IDENTIFY THE NEWLY SCHEDULED USER   #
          IF RCIRTASK[0] GR 1 
          THEN
            BEGIN            # RECORD TASK NUMBER, OMIT BITS 3 THRU 5. #
            DB$FLUI (DB$COCT (B<0,3>RCIRTASK[0] * 2**18 
                             + B<6,18>RCIRTASK[0], 7)); 
            END 
          END 
      CONTROL ENDIF;
 #
*     IF CDCS TASK THEN 
*       CONTINUE EXECUTING IT.
 #
      IF LOC(TQT) EQ TQTMTR 
      THEN                   # AN INTERNAL TASK                        #
        BEGIN 
        SALX = RCITSALX[0]; 
        DB$GOTO(RCCONTA[0]);
  
        END 
 #
*     SET COMMON CELLS BASED ON TQT.
*       P<RSB>
*       SALX
*       P<ASL>
*       P<CSFIXED>
 #
SETTQTCELLS:  
      P<RSB> = TQRSB[0];
      SALX = TQSALX[0]; 
      P<ASL> = TQASL[0];
      P<CSFIXED> = ASCSTLOC[0]; 
 #
*     SET THE DEFAULT MEMORY OVERFLOW OPTION
 #
      DB$MFPA = LOC(DB$MFO8); 
 #
*     SET COMMON CELLS BASED ON RSB.
*       P<RSARBLK>
*       P<FKL>
*       P<FPT>
*       P<OFT>
*       P<UFT>
*     ANY OF THESE POINTERS THAT CAN NOT BE SET, ARE LEFT WITH A NULL 
*     POINTER VALUE.  THE NULL POINTER VALUE IS A INVALID ADDRESS 
*     AND WILL CAUSE AN ADDRESS OUT OF RANGE IF IT IS USED. 
 #
      P<ACL> = DFNPTR;
      P<APL> = DFNPTR;
      P<FKL> = DFNPTR;
      P<FPT> = DFNPTR;
      P<OFT> = DFNPTR;
      P<RSARBLK> = DFNPTR;
      P<UFT> = DFNPTR;
 #
*     IF AN RSB EXISTS, THEN IF THERE IS AN AREA INVOLVED IN THE
*     REQUEST, THEN SET THE POINTER OF THE RSB AREA WORK BLOCK AND
*     THE POINTER OF THE UFT. 
 #
      IF P<RSB> GR 0
      THEN
        BEGIN 
        P<FKL> = RSFFKLLOC[0];
        IF RSFCAORD[0] NQ 0 
        THEN
          BEGIN 
          SETRSARBLK; 
          P<OFT> = RSAROFIT[0]; 
          IF RSARFPT[0] NQ 0
          THEN
            BEGIN 
            P<FPT> = LOC(FKL) + RSARFPT[0]; 
            END 
          END 
        END 
 #
*     CONTINUE EXECUTING TASK.
 #
      $BEGIN                       #DEBUG TRACE#
      IF RCCT[0] NQ 0 THEN
        DB$TRCO("CONT AT :",RCCONTA[0],6);
      $END
      DB$GOTO(RCCONTA[0]);
 #
* 
* DC  ALTERNATE ENTRY POINTS
* 
*     DB$SCHT--SET COMMON CELLS BASED ON TQT. 
 #
      XDEF PROC DB$SCHT;
      PROC DB$SCHT; 
      BEGIN 
  
      CONTROL IFGR DFFLOP,1;
        DB$FLOP("SCHT");
      CONTROL ENDIF;
  
      RCCONTA[0] = LOC(DB$SCHT);
      GOTO SETTQTCELLS; 
      END  #DB$SCHT#
  
      END  #DB$SCHD#
      TERM; 
