*DECK,QCM 
USETEXT IP$COM
USETEXT MISC$ 
USETEXT QAC$COM 
USETEXT TCH$COM 
USETEXT TSB$COM 
USETEXT ACN$COM 
USETEXT GLOBALI 
USETEXT QAB$COM 
USETEXT QCB$COM 
USETEXT RBF$COM 
USETEXT TCB$COM 
      PROC QCM; 
      BEGIN # QCM # 
*IF DEF,IMS 
 #
*1DC  QCM 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        QCM                 B. M. WEST          22 FEB 1977
*                            MODIFIED BY         JAN 1978 
*                            A. M. PRATT
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS MODULE COORDINATES ACTIVITIES BETWEEN RBF AND THE NOS 
*        QUEUE INFORMATION ROUTINE, "QAC".
* 
*     3. METHOD USED
*        THE "QAB", A PARAMETER-BLOCK IN A TSB BUFFER, IS THE PRIMARY 
*        MEANS FOR ENABLING THE TRANSFER OF INFORMATION BETWEEN RBF 
*        AND QAC ( A NOS PP ROUTINE).  THE QAB IS IN MANY WAYS ANALOGOUS
*        TO AN "FET" IN RBF/CIO INTERACTION.  ONLY THE CENTER SECTION 
*        OF THE QAB IS USED BY QAC: THE QAC-PARAMETER BLOCK - THE REST
*        OF THE QAB IS FOR RBF USE ONLY (SEE QAB$COM FOR FURTHER
*        DETAILS).
* 
*        QAC CAN PROCESS A LINKED CHAIN OF QAB-S IN A SINGLE CALL. QCM
*        FINDS IT CONVENIENT TO MAINTAIN FOUR SUCH CHAINS AS FOLLOWS: 
* 
*        TWO CHAINS CONTAIN "IMMEDIATE ACTION" ("IMD") QAB-S - THAT IS, 
*        QAB-S THAT ARE SENT ALMOST IMMEDIATELY AFTER THEIR GENERATION
*        TO QAC AND RELEASED WHEN RBF HAS PROCESSED THE QAC-REPLIES.
* 
*        THE OTHER TWO CHAINS CONTAIN "EXTENDED ACTION" ("EXT") QAB-S,
*        THAT IS, QAB-S THAT ARE NOT RELEASED AFTER RBF HAS PROCESSED 
*        QAC-REPLIES, BUT ARE SAVED AND RESENT PERIODICALLY TO QAC. 
*        (THESE CHAINS ARE NEEDED TO IMPLEMENT "EXTENDED DIVERT"
*        COMMANDS SUCH AS "DIVERT PR HOST EXT").
* 
*        THE REASON THERE ARE TWO "IMD" CHAINS (AND TWO "EXT" CHAINS) 
*        IS THAT WHILE QAC IS PROCESSING A CHAIN THAT HAS BEEN SUBMITTED
*        TO IT, OTHER QAB-S ARE BEING GENERATED THAT MUST BE HELD UNTIL 
*        QAC IS FINISHED WITH THE LAST BATCH.  SO TWO CHAINS CONTAIN
*        QAB-S ALREADY SUBMITTED TO QAC - CALLED "SUB" CHAINS, AND
*        TWO CHAINS ARE ACCUMULATING QAB-S WHICH ARE TO BE SENT LATER 
*        TO QAC CALLED "TBS" CHAINS.
* 
*        THE FOUR CHAINS ARE THEN (IN SUMMARY): 
*          1) THE IMD/SUB CHAIN 
*          2) THE IMD/TBS CHAIN 
*          3) THE EXT/SUB CHAIN 
*          4) THE EXT/TBS CHAIN 
* 
*        A CHAIN IS LINKED BY TSB ORDINALS IN THE FIRST-WORD OF THE 
*        QAB.  TSB ORDINALS OF THE FIRST AND LAST QAB-S FOR EACH CHAIN
*        (DENOTED BY "F" FOR FIRST, "L" FOR LAST) ARE MAINTAINED IN THE 
*        QCB (SEE QCB$COM).  A CHAIN IS EMPTY IF "FIRST" = "LAST" = 0.
*        QCM DECIDES THAT QAC IS FINISHED WITH A "SUB" CHAIN WHEN 
*        IT FINDS THAT QAC HAS SET THE "COMPLETE" BIT OF THE LAST 
*        QAB IN THE CHAIN.  WHILE QAB-S ARE ON A "TBS" CHAIN, THEY
*        ARE MOVEABLE BY THE MEMORY MANAGER.
* 
*        QCM IS CALLED WHEN IT IS DETERMINED THAT SOME ACTION IS
*        REQUIRED OF IT: WHEN THERE ARE "IMMEDIATE" QAB-S TO BE SENT
*        TO QAC, WHEN IT IS TIME TO RESEND "EXTENDED" QAB-S, OR WHEN
*        QAC HAS FINISHED PROCESSING EITHER CHAIN THAT HAS BEEN ALREADY 
*        SENT.  A PSEUDO-CONNECTION (QCBACN) IS USED AS A MECHANISM FOR 
*        IMPLEMENTING THIS.  QCBACN IS PLACED ON THE EVENT CHAIN ON 
*        EXIT FROM QCM WITH EVENT PROCESSOR "QTEST".  WHEN QTEST
*        DETERMINES THERE IS SOMETHING FOR QCM TO DO, QCBACN IS PLACED
*        ON QCM-S MODULE-CHAIN AND QCM IS SUBSEQUENTLY RELOADED AND 
*        PLACED IN EXECUTION. 
* 
*     4. ENTRY PARAMETER
*        THE QCB (SEE COMMENTS IN QCB$COM). 
* 
*     5. EXIT PARAMETER 
*        THE UPDATED QCB
* 
*     6. COMDECKS CALLED
*        RBF$COM
*        TCB$COM
*        QCB$COM
*        QAB$COM
*        TSBMDEFS 
*        TSBMBASE 
* 
*     7. ROUTINES CALLED
*        MOVEOK 
*        MESSAGE
*        DIFFER 
*        BUFINFO
*        RETTSB 
*        SYSCALL
*        LINK 
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
  
      XREF PROC MOVEOK;      # CHANGE BUFFER STATUS TO MOVEABLE        #
*IF,DEF,DEBUG 
      XREF PROC MESSAGE;
      XREF PROC ABORT;
*ENDIF
      XREF FUNC DIFFER U;    # CALCULATES TIME INTERVAL                #
      XREF FUNC BUFINFO U;   # OBTAINS ADDRESS OF BUFFER AND FIXES     #
                             # LOCATION AS UNMOVEABLE                  #
      XREF PROC RETTSB;      # RETURN ALLOCATED BUFFER                 #
      XREF PROC SYSCALL;     # CALL SYSTEM ROUTINE                     #
      XREF PROC LINK;        # LINK ACN TO MODULE                      #
      XREF PROC QTEST;       # QCM EVENT PROCESSOR                     #
# 
      LOCAL PARAMETERS
# 
      ITEM POINTER U; 
      ITEM ADDR I;           # ADDRESS TEMPORARY                       #
      ITEM LACTQABADDR I;    # ADDRESS OF LAST QAB TO REMAIN ACTIVE    #
      ITEM QACFINISHED B;    # TRUE IF QAC IS DONE WITH Q OR Q IS NULL #
      ITEM I U; 
      ITEM NEXT U;
      ITEM LAST U;
  
*IF,DEF,DEBUG 
  
      ARRAY QAC$ERRORMSG; 
        BEGIN 
        ITEM MSG C(0,0,8) = ["QAC$ERR"];
        ITEM EOMSG U(0,48,12) = [0];
        END 
*ENDIF
      CONTROL EJECT;
      PROC QCMCANCELEXT;
      BEGIN # QCMCANCELEXT #
# 
      REMOVE EXTENDED QUEUE ACTION REQUESTS WHICH HAVE BEEN CANCELLED 
      AND FREE BUFFER SPACE 
# 
      NEXT = QCB$EXTTBSF;    # NEXT INITIALIZED TO ORD OF FRST QAB OR 0#
      LACTQABADDR = LOC(QCB$EXTTBSF);  # QUEUE HEAD ACTS AS DUMMY QAB  #
  
      QCB$EXTTBSF = 0;       # IF NO QAB-S REMAIN IN THE QUEUE, THE    #
      QCB$EXTTBSL = 0;       # POINTERS ARE LEFT ZERO                  #
  
      FOR I = I WHILE NEXT NQ 0 DO     # THREAD THROUGH QAB-QUEUE      #
        BEGIN                # PROCESS ONE QAB CURRENTLY IN QUEUE      #
        P<QAB> = ADDRESS[NEXT]; 
        NEXT = QAB$NEXT;
  
        IF QAB$CANCEL 
        THEN
          BEGIN              # CANCEL FLAG SET - QAB INACTIVE          #
          RETTSB(QAB$ORD);         # RELEASE QAB-S STORAGE             #
          P<QAB> = LACTQABADDR; 
          P<QCB> = ADDRESS [ACN$CB[QCBACN]];
          QAB$NEXT = NEXT;         # MAKE LAST-ACTIVE-QAB POINT TO NEXT#
          END                # CANCEL FLAG SET ...                     #
  
        ELSE
  
          BEGIN              # NO CANCEL - QAB TO REMAIN ACTIVE        #
          LACTQABADDR = P<QAB>; 
  
          IF QCB$EXTTBSF EQ 0 
          THEN
            QCB$EXTTBSF = QAB$ORD;
  
          QCB$EXTTBSL = QAB$ORD;
          END                # NO CANCEL ...                           #
  
        END                  # PROCESS ONE QAB CURRENTLY IN QUEUE      #
      RETURN; 
      END # QCMCANCELEXT #
      CONTROL EJECT;
      PROC QCMEXTDONE;
      BEGIN # QCMEXTDONE #
  
# QAC ACTION COMPLETED WITH QAB-S OF "EXT/SUB" QUEUE - TAKE THEM OFF   #
# "EXT/SUB" AND PLACE THEM BACK ON "EXT/TBS"                           #
  
      NEXT = QCB$EXTSUBF; 
  
      FOR I = I WHILE NEXT NQ 0 DO
        BEGIN                # MAKE QAB MOVEABLE AND CLEAR COMPLETE BIT#
        P<QAB> = ADDRESS[NEXT]; 
        IF QAB$ACN NQ 0                          # CONSOLE STILL EXISTS#
          AND ACN$CB[QAB$ACN] NQ 0               # DEVICE STILL EXISTS #
        THEN
          BEGIN 
          P<TCB> = ADDRESS[ACN$CB[QAB$ACN]];   # SET TCB ARRAY   #
          IF TCB$EXTDIVC1 
          THEN
            BEGIN           # FIRST TIME THIS EXT QAB WAS SENT   #
            P<CCBHDR> = ADDRESS[ACN$CB[QAB$ACN]]; 
            CCB$COMPLETE = TRUE;
            TCB$EXTDIVC1 = FALSE; 
            SYSACT = TRUE;
            END             # GO THROUGH MAIN LOOP ONE MORE TIME #
          END 
        QAC$DONE = FALSE; 
        MOVEOK(QAB$ORD);
        NEXT = QAB$NEXT;
        END                  # MAKE QAB MOVEABLE ...                   #
  
# COPY "EXT/SUB" QAB-S TO "EXT/TBS" QUEUE                              #
  
      IF QCB$EXTTBSF EQ 0 
      THEN
        BEGIN                # "TO-BE-SUBMITTED" QUEUE IS EMPTY        #
        QCB$EXTTBSF = QCB$EXTSUBF;
        QCB$EXTTBSL = QCB$EXTSUBL;
        END                  # "TO-BE-SUBMITTED" QUEUE IS EMPTY        #
  
      ELSE
  
        BEGIN                # "TO-BE-SUBMITTED" QUEUE NON-EMPTY       #
        P<QAB> = ADDRESS[QCB$EXTTBSL]; # ADD QAB-S TO END              #
        QAB$NEXT = QCB$EXTSUBF; 
        QCB$EXTTBSL = QCB$EXTSUBL;
        END                  # "TO-BE-SUBMITTED" QUEUE NON-EMPTY       #
  
      QCB$EXTSUBF = 0;       # EMPTY "EXT/SUB" QUEUE                   #
      QCB$EXTSUBL = 0;
  
      RETURN; 
      END  # END OF QCMEXTDONE #
      CONTROL EJECT;
      PROC QCMIMDDONE;
      BEGIN 
      ITEM FINISHED B;
# 
      REMOVES IMMEDIATE ACTION REQUESTS WHICH HAVE BEEN PROCESSED BY
      QAC AND NOTIFIES THE CONNECTION WHICH MADE THE REQUEST THAT IT
      HAS BEEN COMPLETED
# 
      NEXT = QCB$IMDSUBF; 
  
      FOR I = I WHILE NEXT NQ 0 DO
        BEGIN                # PROCESS ONE QAB                         #
        P<QAB> = ADDRESS[NEXT]; 
*IF,DEF,DEBUG 
        IF QAC$ERROR NQ S"NOFILE" AND QAC$ERROR NQ S"NULL"
        AND QAC$ERROR NQ S"BADUSRFAM" AND NOT(QAC$ERROR GQ S"INCORSC" 
        AND QAC$ERROR LQ S"SUBSYST")
        THEN
          BEGIN 
          MESSAGE(QAC$ERRORMSG,DFLOPT); 
*IF,DEF,DEBUG 
          ABORT;
          END 
*ENDIF
        MOVEOK(QAB$ORD);           # UNFREEZE THIS BUFFER              #
  
        P<CCBHDR> = ADDRESS[ACN$CB[QAB$ACN]]; # SET REQUESTING CONNEC- #
        CCB$COMPLETE = TRUE;       # TIONS CONTROL BLOCK "COMPLETE"    #
  
        NEXT = QAB$NEXT;           # FOLLOW LINK TO NEXT QAB           #
        END                  # PROCESS ONE QAB                         #
  
      QCB$IMDSUBF = 0;       # EMPTY OUT "IMD/SUB" QAB-QUEUE           #
      QCB$IMDSUBL = 0;
      SYSACT=TRUE;                     # DO NOT ROLLOUT                #
      RETURN; 
  
      END  # END OF QCMIMDDONE #
      CONTROL EJECT;
  
      PROC QCMSETUPCALL(FIRSTQABORD); 
  
# CHAIN THROUGH THE "IMD/SUB" OR "EXT/SUB" QAB-QUEUE, FIXING THE QAB-S #
# LOCATION, RECALCULATING ADDRESSES WHICH DEPEND ON QAB-LOCATION,      #
# SETTING THE QAC ADDRESS-LINK FIELD, AND SUBMITTING THE LINKED QUEUE  #
# TO QAC                                                               #
  
  
      BEGIN                  # QCMSETUPCALL                            #
  
      ITEM T I;              # TEMPORARY                               #
      ITEM FIRSTQABORD I;    # ORDINAL OF FIRST QAB IN QUEUE (PARAM)   #
  
  
      NEXT = FIRSTQABORD;          # INITIALIZE FOR START-OF-QUEUE     #
  
  
      FOR I = I WHILE NEXT NQ 0 DO
        BEGIN                # PROCESS ONE QAB                         #
        P<QAB> = BUFINFO(NEXT);    # FIX LOCATION OF QAB               #
        QAC$ERROR = 0;
        QAC$DONE = FALSE; 
  
        IF QAB$EXTFLAG
        THEN
          BEGIN              # EXTENDED-ACTION QAB - RECALCULATE ADDRS #
  
  
          END                # EXTENDED-ACTION QAB ...                 #
  
  
        NEXT = QAB$NEXT;
  
        IF NEXT NQ 0
        THEN
          QAC$LINK = ADDRESS[NEXT] + 1;    # INTERMEDIATE LINK         #
        ELSE
          QAC$LINK = 0;                    # LAST LINK                 #
        END                  # PROCESS ONE QAB                         #
  
  
  
      P<QAB> = ADDRESS[FIRSTQABORD];   # REINITIALIZE FOR QUEUE-START  #
      SYSCALL("QAC",LOC(QAC$BUFFER));  # MAKE "SYSTEM" CALL TO QAC     #
      SYSACT = TRUE;         # THERE IS SYSTEM ACTIVITY                #
  
      RETURN; 
      END                    # QCMSETUPCALL                            #
      CONTROL EJECT;
# 
      ARE THERE ANY CALLS TO QAC FOR IMMEDIATE ACTION SUBMITTED 
# 
      P<QCB> = ADDRESS [ACN$CB[QCBACN]];
  
      IF QCB$IMDSUBF NQ 0    # PROCESS IMMEDIATE/SUBMITTED QAB QUEUE   #
      THEN
        BEGIN                # NON-EMPTY QUEUE (IMD/SUBMITTED-TO-QAC)  #
        P<QAB> = ADDRESS[QCB$IMDSUBL];
  
        IF QAC$DONE                # ALL QAB-S ARE ASSUMED "DONE" IF   #
        THEN                       # THE LAST ONE IS DONE              #
          QCMIMDDONE;              # DONE, GO PROCESS COMPETED QAB-S   #
        END                  # NON-EMPTY QUEUE ...                     #
  
      IF QCB$IMDTBSF NQ 0    # PROCESS IMMEDIATE/TO-BE-SUB QAB-QUEUE   #
        AND QCB$IMDSUBF EQ 0
      THEN
        BEGIN                # NON-EMPTY QUEUE (IMD/TBS)   AND         #
                                   # "IMD/SUB" IS FREE TO TAKE QAB-S   #
        QCB$IMDSUBF = QCB$IMDTBSF;
        QCB$IMDSUBL = QCB$IMDTBSL; # DUMP "IMD/TO-BE-SUBMITTED" INTO   #
        QCB$IMDTBSF = 0;           # "IMD/SUBMITTED" QUEUE             #
        QCB$IMDTBSL = 0;
        QCMSETUPCALL(QCB$IMDSUBF);
        END                  # NON-EMPTY QUEUE ...                     #
  
      QACFINISHED = TRUE; 
  
      IF QCB$EXTSUBF NQ 0    # PROCESS EXTENDED/SUBMITTED QUEUE        #
      THEN
        BEGIN                # NON-EMPTY QUEUE (EXT/SUB)               #
        P<QAB> = ADDRESS[QCB$EXTSUBL];
  
        IF QAC$DONE 
        THEN
          QCMEXTDONE;        # FINISHED - PLACE QAB-S ON "TO-BE-SUB"   #
        ELSE
          QACFINISHED = FALSE;
        END                  # NON-EMPTY QUEUE (EXT/SENT)              #
  
  
      IF QCB$EXTIME AND QACFINISHED 
      THEN
        BEGIN                # TIME TO SUBMIT "TO-BE-SUBMITTED" QUEUE  #
        QCMCANCELEXT;        # TO QAC - CULL CANCELLED QAB-S FROM QUEUE#
        QCB$EXTSUBF = QCB$EXTTBSF;
        QCB$EXTSUBL = QCB$EXTTBSL;
        QCB$EXTTBSF = 0;
        QCB$EXTTBSL = 0;
  
        IF QCB$EXTSUBF NQ 0  # MAYBE ALL HAVE BEEN CANCELLED           #
        THEN
          QCMSETUPCALL(QCB$EXTSUBF);   # PREPARE QUEUE FOR CALL TO QAC #
  
        QCB$TIME = CLOCK; 
        QCB$EXTIME = FALSE;            # EXTENDED DIVERT PROCESSED     #
        END 
# 
      FINISHED FOR THIS TIME AROUND 
# 
      LINK (CHAINS"QCM$",LOC(QTEST)); 
      RETURN; 
      END # QCM # 
      TERM; 
