*DECK,EXTCMD
USETEXT IP$COM
USETEXT MISC$ 
USETEXT QAC$COM 
USETEXT TCH$COM 
USETEXT TSB$COM 
USETEXT ABH$COM 
USETEXT ACN$COM 
USETEXT CMD$COM 
USETEXT DCB$COM 
USETEXT GLOBALI 
USETEXT QAB$COM 
USETEXT QCB$COM 
USETEXT TCB$COM 
USETEXT UCB$COM 
      PROC EXTCMD;
      BEGIN # EXTCMD #
*IF DEF,IMS 
 #
*1DC  EXTCMD
* 
*     1. PROC NAME           AUTHOR              DATE 
*        EXTCMD              B. M. WEST          22 MARCH 1977
*                              AND
*                            A. M. PRATT
                             SEYUNG OH           JAN 15,1980
* 
*     2. FUNCTIONAL DESCRIPTION.
* 
*        EXTCMD EXECUTES COMMANDS SENT UPLINE FROM AN RBF CONSOLE.
*        IT ACCEPTS A COMMAND IN THE ENCODED FORM PROVIDED FOR IT IN
*        CIT$TABLE BY CRACKER.  ALL CONSOLE COMMANDS ARE PROCESSED BY 
*        THIS MODULE EXCEPT FOR "DISPLAY" AND "RESUME"
* 
*     3. METHOD USED. 
* 
* 
*     CONSOLE  STATE  TABLE 
* 
************************************************************************
** STATE* 1    * 2    * 3    *      *      *      *      *      *      *
*  ***  * IDLE *ACTIVE* GO   *      *      *      *      *      *      *
*INPUT **      *      *      *      *      *      *      *      *      *
**********************************M*************************************
* 1     * 1    * 2    * 3    *      *      *      *      *      *      *
* INPUT *      *      *      *      *      *      *      *      *      *
*       * A0   * A2   * A2   *      *      *      *      *      *      *
************************************************************************
* 2     * 1    * 2    * 3    *      *      *      *      *      *      *
* OUTPUT*      *      *      *      *      *      *      *      *      *
*       * A1   * A1   * A1   *      *      *      *      *      *      *
************************************************************************
* 3     *      * 2    *      *      *      *      *      *      *      *
* RESUME* ERR  *      * ERR  *      *      *      *      *      *      *
*       *      * A3   *      *      *      *      *      *      *      *
************************************************************************
* 4     * 2    * 2    *      *      *      *      *      *      *      *
* INTERT*      *      * ERR  *      *      *      *      *      *      *
*       * A4   * A4   *      *      *      *      *      *      *      *
************************************************************************
* 5     *      * 1    * 3    *      *      *      *      *      *      *
* BATCH * ERR  *      *      *      *      *      *      *      *      *
* CMD   *      * A6   * A0   *      *      *      *      *      *      *
************************************************************************
* 6     *      * 2    * 3    *      *      *      *      *      *      *
* REF-  * ERR  *      *      *      *      *      *      *      *      *
* RESH  *      * A5   * A5   *      *      *      *      *      *      *
************************************************************************
* 7     * 0    * 0    * 0    *      *      *      *      *      *      *
* TERM  *      *      *      *      *      *      *      *      *      *
* FAIL  * A7   * A7   * A7   *      *      *      *      *      *      *
************************************************************************
* 8     * 0    * 0    * 0    *      *      *      *      *      *      *
* CON   *      *      *      *      *      *      *      *      *      *
* BROKEN* A7   * A7   * A7   *      *      *      *      *      *      *
************************************************************************
* 9     * 1    * 2    * 3    *      *      *      *      *      *      *
* USER  *      *      *      *      *      *      *      *      *      *
* INTERT* A8   * A8   * A8   *      *      *      *      *      *      *
************************************************************************
* 10    * 1    *      *      *      *      *      *      *      *      *
* READY *      * ERR  * ERR  *      *      *      *      *      *      *
*       * A9   *      *      *      *      *      *      *      *      *
************************************************************************
* 
* 
*     C O N S O L E    S T A T E
* 
* 
*     IDLE    MODE 4A TERMINAL STATE WHEN PASSIVE DEVICE IS ACTIVE
* 
* 
*     ACTIVE  MODE 4A TERMINAL STATE WHEN PASSIVE DEVICE IS NOT ACTIVE
*             OR  INTERACTIVE COMMAND PROCESSING IS IN PROGRESS.
* 
* 
*     GO      NON-MODE 4A (HASP, 2780/3780, OR 714) CONSOLE STATE 
* 
* 
* 
*     C O N S O L E   A C T I O N 
* 
************************************************************************
* 
*     A0      DO NOTHING
* 
* 
*     A1      RESET RESUME TIMMER 
*             SEND CONSOLE MESSAGES 
* 
* 
*     A2      CLEAR REFRESH TIMMER
*             PROCESS RBF COMMAND 
* 
* 
*     A3      SET RESUME FLAGS FOR BATCH DEVICES
* 
* 
*     A4      READY FOR INTERACTIVE PROCESSING
* 
* 
*     A5      READY FOR REFRESHING DISPLAY
* 
* 
*     A6      BATCH COMMAND PROCESSED 
* 
* 
*     A7      PROCESS CONNECTION BROKEN 
* 
* 
*     A8      CLEAR ALL CONSOLE INPUT 
* 
* 
*     A9      OUTPUT READY MESSAGE TO MODE4A CONSOLE
* 
* 
* 
************************************************************************
* 
* 
*        EXTCMD SWITCHES TO THE COMMAND"S PROCESSOR - BASED ON THE
*        COMMAND TYPE PASSED TO IT IN CIT$TABLE.
* 
*     4. ENTRY PARAMETERS.
* 
*        TCB$CITBUF - CONTAINS THE ORDINAL OF A BUFFER WHICH CONTAINS 
*                     THE COMMAND CRACKER INTERFACE TABLE (CIT$TABLE) 
* 
*        CIT$TABLE  - RESULTS OF THE COMMAND CRACKER
* 
*     5. EXIT PARAMETERS. 
* 
*        NONE 
* 
*     6. COMDECKS USED. 
* 
*        RBF$COM
*        TSBMDEFS 
*        TSBMBASE 
*        CMD$COM
*        TCB$COM
*        QAB$COM
*        ABH$COM
*        DCB$COM
*        UCB$COM
*        QCB$COM
* 
*     7. ROUTINES USED. 
* 
*        QCMCALL,GETBUF,RETTSB,RDYMSG,CONSOLE,LINK,EVENT,BUFINFO
* 
*     8. DAYFILE MESSAGES.
* 
*        NONE.
* 
 #
*ENDIF
  
      XREF PROC ABORT;
      XREF FUNC INPTYPE U;
      XREF PROC QCMCALL;     # CHAINS QAC PARAMETER BLOCK ON QCB       #
      XREF FUNC GETBUF U;    # ACQUIRES BUFFER SPACE                   #
      XREF PROC RDYMSG;      # SEND READY MESSAGE TO CONSOLE           #
      XREF PROC RETTSB;      # RETURN BUFFER                           #
      XREF PROC ACKED;                           # WAIT FOR A WHILE    #
      XREF PROC FREEBUFFER; 
      XREF PROC NETPUT; 
      XREF PROC LINK;        # LINK PROCESSOR                          #
      XREF PROC EVENT;       # RETURNS CONTROL WHEN EVENT OCCURS       #
      XREF FUNC BUFINFO;     # FIXES BUFFER AND RETURNS ITS ADDRESS    #
      XREF PROC DONE;        # COMPLETE BIT EVENT PROCESSOR            #
      XREF PROC CONSOLE;     # CHAINS CONSOLE MESSAGES ON TCB          #
      XREF PROC SETUPACN; 
      XREF FUNC GETBSN U; 
#                                                                      #
      XREF LABEL CALLRTN; 
#     LOCAL PARAMETERS                                                 #
#                                                                      #
      DEF SET #3#;
      ARRAY CONSTATE [1:10] S(2);  # CONSOLE STATE TABLE #
        BEGIN 
        ITEM TCB$SIDLE       S:CONSOLESTATE (0,0,6) = 
                             [2(S"CON$IDLE"),S"CON$ERROR",
                              S"CON$ACTIVE",S"CON$ERROR",S"CON$ERROR",
                              S"CON$NULL",S"CON$NULL",2(S"CON$IDLE")],
             TCB$SACTIVE     S:CONSOLESTATE (0,6,6) = 
                             [4(S"CON$ACTIVE"),S"CON$IDLE", 
                              S"CON$ACTIVE",2(S"CON$NULL"), 
                              S"CON$ACTIVE",S"CON$ERROR"],
             TCB$GO          S:CONSOLESTATE (0,12,6) =
                             [2(S"CON$GO"),2(S"CON$ERROR"), 
                              2(S"CON$GO"),2(S"CON$NULL"),S"CON$GO",
                              S"CON$ERROR"];
        ITEM TCB$NEXTST      U(0,0,60); 
        ITEM TCB$AIDLE       S:CONSOLACTION (1,0,6) = 
                             [S"CON$A0",S"CON$A1",S"CON$AE",S"CON$A4",
                              2(S"CON$AE"),S"CON$A7",S"CON$A7", 
                              S"CON$A8",S"CON$A9"], 
             TCB$AACTIVE     S:CONSOLACTION (1,6,6) = 
                             [S"CON$A2",S"CON$A1",S"CON$A3",S"CON$A4",
                              S"CON$A6",S"CON$A5",S"CON$A7",S"CON$A7",
                              S"CON$A8",S"CON$AE"], 
             TCB$AGO         S:CONSOLACTION (1,12,6) =
                             [S"CON$A2",S"CON$A1",2(S"CON$AE"), 
                              S"CON$A0",S"CON$A5",S"CON$A7",
                              S"CON$A7",S"CON$A8",S"CON$AE"]; 
        ITEM TCB$ACTION      U(1,0,60); 
      END 
      ARRAY;
        ITEM INTERSECTION U(0,0,3); # EACH BIT OF INTERSECTION IS "ON" #
                             # IF THE CORRESPONDING TCB EXT DIV        #
                             # BIT MATCHES THE CORRESPONDING           #
                             # CANCEL REQUEST BIT                      #
      SWITCH CON$ACTION : CONSOLACTION
             CON$AZERO  : CON$A0, 
             CON$AONE   : CON$A1, 
             CON$ATWO   : CON$A2, 
             CON$ATHREE : CON$A3, 
             CON$AFOUR  : CON$A4, 
             CON$AFIVE  : CON$A5, 
             CON$ASIX   : CON$A6, 
             CON$ASEVEN : CON$A7, 
             CON$AEIGHT : CON$A8, 
             CON$ANINE  : CON$A9, 
             CON$AERROR : CON$AE; 
      ITEM I I; 
      ITEM NO$OF$HITS  I; 
      ITEM J I; 
      ITEM FLAG B;
      ITEM NEXT I;
      ITEM INPUT I; 
      ITEM ACTION I;
      ITEM NEXTSTATE I; 
      ITEM STATE I; 
      ITEM BSN I; 
      ITEM NODIVERTS C(40) = "0NO DIVERTS IN EFFECT FOR THIS QUEUE";
      ITEM DIVALREADY C(40) = "0EXTENDED DIVERT IN EFFECT, CMD IGNORED";
      ITEM NOFILEACTIVE C(25) = "0NO FILE ACTIVE AT DEVICE";
      ITEM INAPPMSG C(22) = "0INAPPROPRIATE COMMAND"; 
      ITEM BADDIVDEST C(27) = "0INVALID DIVERT DESTINATION";
      ITEM NOFILES C(15) = "0NO FILES FOUND"; 
      ITEM UNKDEV C (30) = "0ILLEGAL OR UNKNOWN DEVICE ***";
      ITEM DEVDT C (10) = "  CRLPCPPL"; 
      ITEM INCORR C (24) = "0INCORRECT SERVICE CLASS";
      ITEM SCFULL C (19) = "0SERVICE CLASS FULL"; 
      ITEM NOALTR C (34) = "0CANNOT ALTER CLASS OF ON-LINE JOB";
      ITEM UNDEF C (24) = "0UNDEFINED SERVICE CLASS"; 
      ITEM JOBWAIT C (37) = "0JOB ALREADY WAITING ON SERVICE CLASS";
      ITEM SCSUBSY C (41) = "0CANNOT CHANGE SERVICE CLASS OF SUBSYSTEM";
  
      ARRAY LISTOFDEVICE[1:28] S(1);
        ITEM TCBINDEX I(0,0,60);
  
      XREF                             # PURGE MSG FOR USER DAYFILE    #
      ARRAY ABORT$MESS S(4);
        BEGIN                          # MESSAGE FOR USER DAYFILE      #
        ITEM PUR$MESS C(0,0,38) ; 
        ITEM PUR$ZERO U(3,48,12) ;
        END 
      CONTROL EJECT;
      FUNC ACTIVE B;
      BEGIN # ACTIVE #
      ITEM I I; 
      ITEM FOUND B; 
      ITEM DEVACN I;
#                                                                      #
#     TEST FOR AN ACTIVE BATCH DEVICE                                  #
#                                                                      #
      FOUND = FALSE;
      FOR I = 1 STEP 1 WHILE I LQ TCB$NDEVICE AND NOT FOUND DO
        BEGIN # SEARCH FOR AN ACTIVE BATCH DEVICE # 
        DEVACN = TCB$DEVACN [I];
        IF ACN$DEVTYPE [DEVACN] EQ S"CARD$READER" 
        THEN
          BEGIN 
          IF ACN$MODE [DEVACN] EQ UCMSTATE"UCM$GO"
            OR ACN$MODE[DEVACN] EQ UCMSTATE"UCM$WTVEJ"
            OR ACN$MODE[DEVACN] EQ UCMSTATE"UCM$IDLE" 
            OR ACN$MODE[DEVACN] EQ UCMSTATE"UCM$ABTBY"
          THEN
            BEGIN 
            FOUND = TRUE; 
            END 
          END 
        ELSE
          BEGIN # OUTPUT DEVICE # 
          IF ACN$MODE [DEVACN] EQ DCMSTATE"DCM$GO"
          OR ACN$MODE [DEVACN] EQ DCMSTATE"DCM$GOBAN" 
          OR ACN$MODE [DEVACN] EQ DCMSTATE"DCM$GOEOF" 
          OR ACN$MODE [DEVACN] GQ DCMSTATE"DCM$SKIP"
          THEN
            BEGIN 
            FOUND = TRUE; 
            END 
          END   # OUTPUT DEVICE # 
        END   # SEARCH FOR AN ACTIVE BATCH DEVICE # 
      ACTIVE = FOUND; 
      RETURN; 
      END   # ACTIVE #
      CONTROL EJECT;
      PROC SENDMSG; 
      BEGIN # SENDMSG # 
      ITEM FINISHED B;
      ITEM ORDINAL I; 
# 
      NETPUT MESSAGES UNTIL ALL ARE SENT OR APPLICATION BLOCK LIMIT 
      EXCEEDED
# 
      FINISHED = FALSE; 
      FOR I = I WHILE NOT FINISHED DO 
        BEGIN # TRY TO SEND DATA #
        IF TCB$OUTPUT NQ 0
        THEN
          BEGIN # OUTPUT TO SEND #
          BSN = GETBSN; 
          IF BSN NQ 0 
          THEN
            BEGIN # BSN AVAILABLE, SEND MESSAGE # 
            P<ABH> = ADDRESS [TCB$OUTPUT];
            P<TXT> = ADDRESS[TCB$OUTPUT] +1;
            ORDINAL = TCB$OUTPUT; 
            TCB$OUTPUT = ABH$NEXT;
            IF TCB$OUTPUT EQ 0
            THEN
              BEGIN # LAST MESSAGE #
              TCB$OLAST = ZERO; 
              FINISHED = TRUE;
              END   # LAST MESSAGE #
            ABH$ADR = ACN;
            ABH$ABN = BSN;
            IF ABH$ABT EQ 0 
            THEN
              BEGIN                              # NOT SUPV MSG        #
            ABH$ACT = ACT"DISPLAYCODE"; 
            ABH$ABT = S"MSG"; 
              END                                # NOT SUPV MSG        #
            NETPUT (ABH,TXT); 
            RETTSB (ORDINAL); 
            SETUPACN (ACN); 
            END   # BSN AVAILABLE, SENT MESSAGE # 
          ELSE    # NO BSN AVAILABLE #
            BEGIN 
            TCB$WAITACK = TRUE;                  # WAIT FOR ACK        #
            FINISHED = TRUE;
            END 
          END   # DATA TO SEND #
        ELSE # NO DATA TO SEND #
          FINISHED = TRUE;
        END   # TRY TO SEND DATA #
      RETURN; 
      END   # SENDMSG # 
      CONTROL EJECT;
      PROC SEARCHDEVICE;
      BEGIN 
*IF DEF,IMS 
 #
*1DC  SEARCHDEVICE
* 
*     1. PROC NAME           AUTHOR              DATE 
*        SEARCHDEVICE        B. M. WEST          28 JANUARY 1977
* 
*     2. FUNCTIONAL DESCRIPTION.
*        SEARCH TCB$DEVICE ENTRIES FOR ENTRIES WHOSE DEVICE 
*        DESIGNATION MATCHES THAT IN CIT$BUF. 
* 
*     3. METHOD USED. 
*        EACH TCB$DEVICE ENTRY IS EXAMINE TO SEE IF IT FALLS
*        WITHIN THE RANGE OF DEVICES GIVEN IN LOWER TO UPPER
*        DEVICE TYPE AND LOWER TO UPPER DEVICE ORDINAL. IF
*        SO, ITS OFFSET IN THE TCB IS ADDED TO THE LIST OF
*        DEVICES IN TCBINDEX. THE NUMBER OF DEVICES FOUND IS
*        ACCUMULATED IN NO$OF$HITS. 
* 
*     4. ENTRY PARAMETERS.
*        TCB                 TERMINAL CONTROL BLOCK 
*        CIT$BUF             COMMAND DESCRIPTION TABLE (CRACKED CMD)
* 
*     5. EXIT PARAMETERS. 
*        NO$OF$HITS          NUMBER OF DEVICES FOUND
*        TCBINDEX            LIST OF OFFSETS OF FOUND DEVICES.
* 
*     6. COMDECKS CALLED. 
*        SAME AS EXTCMD 
* 
*     7. ROUTINES USED. 
*        NONE.
* 
*     8. DAYFILE MESSAGES.
*        NONE.
* 
*     9. CONSOLE MESSAGES.
*        UNKNOWN OR ILLEGAL DEVICE. 
* 
 #
*ENDIF
      ITEM LOWERDEVICET I,
           UPPERDEVICET I,
           LOWERDEVICEO I,
           UPPERDEVICEO I,
           STATE        I,
           IX           I,
           JX           I;
  
#       DETERMINE DEVICE TYPE AND ORDINAL RANGES                       #
  
        IF CIT$DEVT EQ 0
        THEN
          BEGIN 
          LOWERDEVICET = 1; 
          UPPERDEVICET = 4; 
          END 
        ELSE
          IF CIT$DEVT EQ  5 
          THEN
            BEGIN 
            LOWERDEVICET = 2; 
            UPPERDEVICET = 4; 
            END 
          ELSE
            BEGIN 
            LOWERDEVICET = CIT$DEVT;
            UPPERDEVICET = CIT$DEVT;
            END 
        IF CIT$ORD EQ 0 
        THEN
          BEGIN 
          LOWERDEVICEO = 1; 
          UPPERDEVICEO = 7; 
          END 
        ELSE
          BEGIN 
          LOWERDEVICEO = CIT$ORD; 
          UPPERDEVICEO = CIT$ORD; 
          END 
  
#       SEARCH TCB FOR BATCH DEVICE ENTRIES WHICH FALL WITHIN THE 
        TYPE AND ORDINAL RANGES AND ARE IN OPERATIONAL STATES          #
        NO$OF$HITS = 0; 
        FOR IX = 1 STEP 1 UNTIL TCB$NDEVICE DO
          BEGIN 
          JX = TCB$DEVACN [IX]; 
          STATE = ACN$STATE [JX]; 
          IF ACN$DEVTYPE [JX] GQ LOWERDEVICET AND ACN$DEVTYPE [JX] LQ 
             UPPERDEVICET AND TCB$ORD [IX] GQ LOWERDEVICEO AND
             TCB$ORD [IX] LQ UPPERDEVICEO AND 
             STATE EQ CONNECTSTATE"ACTIVE"
          THEN
            BEGIN 
            IF TCB$CMDTY [IX] NQ 0  # IF THERE IS ALREADY A COMMAND  #
            THEN                      # THEN SET BUSY AND RETURN.      #
              BEGIN 
              LINK (CHAINS"EXT$CMD", LOC (ACKED));
              GOTO CALLRTN; 
              END 
            NO$OF$HITS = NO$OF$HITS + 1;
            TCBINDEX [NO$OF$HITS] = IX; 
            END 
          END 
        IF NO$OF$HITS EQ 0
        THEN
          BEGIN 
          C<27,2>UNKDEV = C<CIT$DEVT * 2,2>DEVDT; 
          C<29,1>UNKDEV = CIT$ORD + O"33";
          CONSOLE (UNKDEV,NON$CRITICAL,26); 
          END 
        RETURN; 
  
      END 
#     END OF PROCEDURE SEARCHDEVICE                                    #
      CONTROL EJECT;
      PROC CANCEL;
      BEGIN # CANCEL #
      ITEM QUEUE I;          # QUEUE CONTROL-VARIABLE                  #
  
      ARRAY;
        ITEM T U(0,0,3);     # MASKING TEMPORARY                       #
  
      ITEM K I; 
#                                                                      #
#     CANCEL EXTENDED DIVERT                                           #
#                                                                      #
      # SEARCH THE "EXTENDED/SUBMITTED" AND "EXTENDED/TO-BESUBMITTED"  #
      # QAB-QUEUES FOR QAB-S BELONGING TO THE CONNECTION THAT SENT UP  #
      # THE "CANCEL" COMMAND                                           #
  
      P<QCB> = ADDRESS[ACN$CB[QCBACN]]; 
  
      FOR QUEUE = 0 STEP 1 UNTIL 1 DO 
        BEGIN                # SEARCH ONE QUEUE                        #
  
        IF QUEUE EQ 0 
        THEN
          NEXT = QCB$EXTSUBF;      # INITIALIZE FOR "EXT/SUB" QUEUE    #
        ELSE
          NEXT = QCB$EXTTBSF;      # INITIALIZE FOR "EXT/TBS" QUEUE    #
  
        FOR I = I WHILE NEXT NQ 0 DO
          BEGIN              # LOOK AT ONE QAB                         #
          P<QAB> = ADDRESS[NEXT]; 
  
          IF QAB$ACN EQ ACN 
          THEN
            BEGIN            # CORRECT ACN - SEE IF CORRECT QUEUES     #
     T = CIT$OQFLAGS LAN QAC$COQFLAGS ; 
            TCB$EXTDIVS = TCB$EXTDIVS LXR T;     # IN QAB AND TCB      #
     T = QAC$COQFLAGS LXR T ; 
  
            IF T NQ 0 
            THEN
              QAC$COQFLAGS = T; 
            QAB$CANCEL = T EQ 0;   # CANCEL QAB IF NO QUEUES DIVERTED  #
            END              # CORRECT ACN ...                         #
  
          NEXT = QAB$NEXT;
          END                # LOOK AT ONE QAB                         #
  
        END                  # SEARCH ONE QUEUE                        #
      RETURN; 
      END   # CANCEL #
      CONTROL EJECT;
#                                                                      #
#     SET UP CIT$TABLE AND GO TO MODULE TO PROCESS COMMAND             #
#                                                                      #
RESTART:  
      INPUT = INPTYPE;
      IF INPUT EQ ZERO
      THEN
        BEGIN                                    # NOTHING TO DO,      #
        LINK (CHAINS"EXT$CMD", LOC (ACKED));     # LINK ACN TO EVENT   #
        GOTO CALLRTN;                            # CHAIN               #
        END 
      ELSE
        BEGIN 
        STATE = ACN$MODE [ACN];                  # GET CURRENT STATE   #
        NEXTSTATE = B<STATE*6-6,6>TCB$NEXTST [INPUT]; 
        ACTION = B<STATE*6-6,6>TCB$ACTION [INPUT];
        ACN$MODE [ACN] = NEXTSTATE;              # SAVE NEXT STATE     #
        TCB$INPTYPE = ZERO; 
        TCB$CURINPUT = INPUT;                    # SAVE CURRENT INPUT  #
        TCB$CURSTATE = STATE;                    # SAVE CURRENT STATE  #
        TCB$CURACTN = ACTION;                    # SAVE CURRENT ACTION #
        TCB$TIME = CLOCK;                        # SAVE CURRENT TIME   #
        GOTO CON$ACTION [ACTION]; 
CON$AERROR:                                      # PROCESS ERROR       #
*IF DEF,DEBUG 
        ABORT;
*ENDIF
        RDYMSG (FALSE); 
CON$AZERO:  
        IF TCB$CITBUF NQ ZERO 
         THEN GOTO EXTCOMMAND;
        GOTO RESTART;                            # DO NOTHING          #
CON$AONE: 
        TCB$READY = FALSE;
        SENDMSG;                                 # OUTPUT CONSOLE MSG  #
        GOTO RESTART; 
CON$ATWO: 
        TCB$REFRESH = FALSE;                     # CLEAR REFRESH FLAG  #
        IF TCB$CITBUF EQ ZERO 
        THEN
          BEGIN                                  # CRACK CONSOLE CMD   #
          LINK (CHAINS"CMD$", NOEVENT); 
          GOTO CALLRTN;                          # RETURN TO PROCESS   #
          END 
        GOTO EXTCOMMAND;
CON$ATHREE: 
        TCB$RESUME = TRUE;                       # RESUME TIME EXPIRED #
        GOTO EXTCMD$RSM;                         # RESUME BATCH DEVICES#
CON$AFOUR:  
        TCB$INTERRPT = ZERO;                     # CLEAR INTERRUPT FLAG#
        TCB$BATCH = FALSE;
        IF NOT TCB$RESUME 
        THEN
          BEGIN                                  # SEND READY MSG      #
          RDYMSG (TCB$READY); 
          TCB$READY = FALSE;
          END 
        TCB$RESUME = FALSE; 
        GOTO RESTART; 
CON$AFIVE:  
        TCB$REF = CLOCK;                         # SET REFRESH TIMMER  #
        LINK (CHAINS"DIS$", NOEVENT);            # LINK TO DISPLAY     #
        GOTO CALLRTN;                            # RETURN TO PROCESS   #
CON$ASIX: 
        GOTO RESTART;                            # BATCH CMD PROCESSED #
CON$ASEVEN: 
        LINK (CHAINS"CON$END", NOEVENT);         # TERMINAL FAILURE    #
        ACN$STATE [ACN] = CONNECTSTATE"END$CONNECT"; #LINK TO CON$END # 
        GOTO CALLRTN;                            # RETURN TO PROCESS   #
CON$AEIGHT:                                      # USER INTERRUPT      #
        FOR I=1 STEP 1 UNTIL TCB$NDEVICE DO 
          BEGIN                                  # CLEAR BATCH COMMAND #
          TCB$CMDTY [I] = ZERO; 
          END 
        FREEBUFFER (LOC (TCB$INPUT));            # CLEAR ALL INPUTS    #
        IF TCB$CITBUF NQ ZERO 
        THEN
          BEGIN                                  # CLEAR THE COMMAND   #
          RETTSB (TCB$CITBUF);                   # ALREADY PROCESSED   #
          SETUPACN (ACN); 
          TCB$CITBUF = ZERO;
          END 
        RDYMSG (FALSE); 
        GOTO RESTART; 
CON$ANINE:  
        IF NOT ACTIVE 
        THEN
          BEGIN # BATCH DEVICE NOT ACTIVE # 
          IF TCB$BATCH
          THEN
            BEGIN # BATCH DEVICE WAS ACTIVE # 
            RDYMSG (TRUE);
            END   # BATCH DEVICE WAS ACTIVE # 
          ELSE
            BEGIN # RBF DID NOT START BATCH DEVICES # 
            TCB$INTERRPT = SET; 
            END   # GO TO INTERACTIVE STATE WITHOUT EXTERNAL INTERRUPT #
          TCB$READY = FALSE;
          END   # BATCH DEVICE NOT ACTIVE # 
        ELSE
          TCB$READY = FALSE;
        GOTO RESTART; 
        END 
EXTCOMMAND: 
      P<CIT$TABLE> = BUFINFO(TCB$CITBUF); 
  
  
      SWITCH EXTCMD$PROC  :  IACOMMAND
             EXTCMD$ABT   :  ABORT, 
             EXTCMD$CAN   :  CANCEL,
             EXTCMD$QUEUE :  CHANGE,
             EXTCMD$QUEUE :  DIVERT,
             EXTCMD$END   :  END, 
             EXTCMD$GO    :  GO,
             EXTCMD$END   :  IAF, 
             EXTCMD$END   :  LOGIN, 
             EXTCMD$END   :  LOGOUT,
             EXTCMD$QUEUE :  PURGE, 
             EXTCMD$RES   :  RESTORE, 
             EXTCMD$RSM   :  RESUME,
             EXTCMD$RET   :  RETURN,
             EXTCMD$REW   :  REWIND,
             EXTCMD$SET   :  SET, 
             EXTCMD$SKIP  :  SKIP,
             EXTCMD$STOP  :  STOP,
             EXTCMD$SUP   :  SUPPRESS;
  
      GOTO EXTCMD$PROC [CIT$CMDTYPE]; 
  
  
        BEGIN # EXTENDED COMMAND PROCESSOR MODULES #
  
      CONTROL EJECT;
# 
      PROCESS ABORT COMMAND 
                                                                       #
EXTCMD$ABT: 
  
#       SEARCH TCB FOR DEVICES AFFECTED BY THIS ABORT COMMAND          #
  
        SEARCHDEVICE; 
  
  
#       ABORT EACH DEVICE                                              #
  
      FOR I = 1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS ABORT CMD   #
        IF TCB$DEVDT [TCBINDEX [I]] EQ DEVICETYPE"CARD$READER"
        THEN
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = UCMINPUT"ABORTUCM";
          END 
        ELSE
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"ABORTDCM";
          END 
        END                                      # PROCESS ABORT CMD   #
      GOTO EXTCMDXRSM;
# 
      END OF ABORT COMMAND PROCESSING 
                                                                       #
      CONTROL EJECT;
#     PROCESS CANCEL COMMAND                                           #
#                                                                      #
EXTCMD$CAN: 
      IF CIT$OUTQFLAG 
      THEN
        CIT$OQFLAGS = 7;     # SET INDIVIDUAL FLAGS ON IF "ALL" ON     #
  
      INTERSECTION = CIT$OQFLAGS LAN TCB$EXTDIVS; 
  
      IF INTERSECTION EQ 0
      THEN
        BEGIN                # MESSAGE COMES IF NO OUTSTANDING EXT DIVS#
                             # WILL BE CANCELLED BY THIS COMMAND       #
       CONSOLE(NODIVERTS,NON$CRITICAL,37);
        GOTO EXTCMDRDYMSG;
        END                  # MESSAGE COMES ...                       #
  
      CANCEL;                # FIND APPROPRIATE QAB-S AND SET FLAGS    #
      GOTO EXTCMDRDYMSG;
#                                                                      #
#     END OF CANCEL COMMAND                                            #
#                                                                      #
      CONTROL EJECT;
# 
      PROCESS GO COMMAND
# 
EXTCMD$GO:  
# 
      SEARCH TCB FOR DEVICE AFFECTED BY THIS COMMAND
# 
      SEARCHDEVICE; 
      FOR I = 1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS GO CMD      #
        IF TCB$DEVDT [TCBINDEX [I]] EQ DEVICETYPE"CARD$READER"
        THEN
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = UCMINPUT"GOUCM"; 
          END 
        ELSE
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"GODCM"; 
          END 
        END                                      # PROCESS GO CMD      #
      GOTO EXTCMDXRSM;
      CONTROL EJECT;
#                                                                      #
#     PROCESS END, LOGIN, LOGON, LOGOUT, LOGOFF AND IAF COMMANDS       #
#                                                                      #
EXTCMD$END: 
#                                                                      #
#     SET TCB$JOBNAME TO THE APPLICATION NAME INDICATED BY THE COMMAND #
#                                                                      #
      TCB$JOBZERO = 0;
      IF CIT$CMDTYPE EQ S"LOGIN" OR CIT$CMDTYPE EQ S"IAF" OR
         CIT$CMDTYPE EQ S"LOGOUT" 
      THEN
        TCB$JOBNAME = " ";          # BLANK FILL NAME FIELD # 
      IF CIT$CMDTYPE EQ S"LOGIN"
      THEN
        C<0,5>TCB$JOBNAME = "LOGIN";
      ELSE
        IF CIT$CMDTYPE EQ S"LOGOUT" 
        THEN
          C<0,6>TCB$JOBNAME = "LOGOUT"; 
        ELSE
          IF CIT$CMDTYPE EQ S"IAF"
          THEN
            BEGIN # IAF COMMAND # 
            C<0,3>TCB$JOBNAME = "IAF";
            TCB$IAFFLAG = TRUE; 
            END   # IAF COMMAND # 
#                                                                      #
#     SET END CONSOLE CONNECT FLAG                                     #
#                                                                      #
      TCB$ENDFLAG = TRUE; 
#                                                                      #
#     SET FLAGS TO STOP ALL MODE 4 BATCH DEVICES                       #
#                                                                      #
      IF ((TCB$DEVTC EQ TERMINALCLAS"$200UT") OR      # 200UT TERMINAL #
          (TCB$DEVTC EQ TERMINALCLAS"$734$1")) AND    # 734/1 TERMINAL #
         (NOT TCB$CDCNT)                              # NOT CDCNET CON #
         OR 
         TCB$DEVTC EQ TERMINALCLAS"$2780" 
         OR 
         TCB$DEVTC EQ TERMINALCLAS"$3780" 
      THEN
        BEGIN                                    # MODE 4 TERMINALS    #
        FOR I=1 STEP 1 UNTIL TCB$NDEVICE DO 
          BEGIN 
          TCB$ENDCON [I] = TRUE;
          TCB$PRIORITY[I] = O"100";  # DEFAULT PRIORITY FOR OUTPUT FILE#
          END 
        END 
      TCB$INPTYPE = CONINPUT"CONBROKENX"; 
      GOTO LINKTOCMD; 
#                                                                      #
#     END OF END, LOGOUT, AND LOGIN COMMAND PROCESSING                 #
      CONTROL EJECT;
# THIS SECTION BUILDS QAB/QAC PARAMETER BLOCKS WHICH ARE USED TO       #
# REQUEST QAC "ALTER"S OF CERTAIN FILES IN A SPECIFIED QUEUE, IN ALL   #
# SYSTEM OUTPUT QUEUES, OR IN ALL SYSTEM QUEUES.  THE "ALTER"S COME AS #
# A RESPONSE TO USER "CHANGE", "DIVERT", OR "PURGE" COMMANDS           #
  
EXTCMD$QUEUE: 
  
# GET BUFFER SPACE FOR QAB/QAC BLOCK                                   #
  
      TCB$QABBUF = GETBUF(QAB$SIZE,FALSE);
  
      FOR ACN = ACN WHILE TCB$QABBUF EQ 0 DO
        BEGIN                # WAIT-FOR-SPACE LOOP                     #
        EVENT (CHAINS"BACKGROUND"); 
        TCB$QABBUF = GETBUF(QAB$SIZE,FALSE);
        END                  # WAIT-FOR-SPACE LOOP                     #
  
# START BUILDING QAB/QAC BLOCK                                         #
  
      P<QAB> = ADDRESS[TCB$QABBUF]; 
      QAB$ACN = TCB$ACN;           # ACN                               #
      QAB$ORD = TCB$QABBUF;        # ORDINAL OF THIS QAB               #
      QAB$EXTFLAG = CIT$EXTFLAG;   # TRUE IF THIS IS EXTENDED DIVERT   #
      QAC$JSN = CIT$JSN ; 
      QAC$FIELD1 = CIT$JSN ;
      QAC$FIELD2 = 0 ;
      QAC$SELECTA = 0 ; 
  
      IF CIT$OUTQFLAG 
      THEN
     CIT$QFLAGS = O"34" ; 
  
      IF CIT$ALLQFLAG 
      THEN
        CIT$QFLAGS = O"37";  # ALL QUEUES SELECTED                     #
      IF CIT$SCFLAG 
      THEN
        CIT$QFLAGS = O"03";        # INPUT AND EXECUTION SELECTED      #
  
    QAC$CFLAGS = CIT$QFLAGS ; 
      QAC$FUNCTION = QAC$ALTER;    # QAC "ALTER" FUNCTION              #
      QAC$ORIGIN = RBFORIGIN;      # RBF-S ORIGIN CODE                 #
      QAC$FAMNAME = TCB$FAMNAME ; 
      QAC$USRNUM = TCB$USERNUM ;
      QAC$UI = TCB$USERORD; 
      QAC$LENQAC = BLOCK$ALTER - 5;        # QAC LENGTH - 5            #
  
# HANDLE PURGE COMMAND                                                 #
  
      QAC$PURGE = CIT$CMDTYPE EQ S"PURGE";
  
      IF QAC$PURGE
      THEN
          BEGIN 
            QAC$REPLY = LOC(ABORT$MESS);    # NEED FOR PURGE OF EX JOB #
            QAC$IN = QAC$REPLY+4;       # LWA +1                    # 
            QAC$OUT = QAC$REPLY ; 
            QAC$LIMITADD = QAC$REPLY+4+1; 
            QAC$AMESS = TRUE ;
          END 
  
  
# HANDLE CHANGE COMMAND                                                #
  
      IF CIT$CMDTYPE EQ S"CHANGE"      #CHANGE COMMAND# 
         AND NOT CIT$PRIFLAG            #PRI NOT SPECIFIED# 
         AND NOT CIT$SCFLAG             #SC NOT SPECIFIED#
         AND NOT CIT$REPFLAG            #REP NOT SPECIFIED# 
       THEN 
         BEGIN
         RETTSB(TCB$QABBUF);
         SETUPACN(ACN); 
         TCB$QABBUF = 0;
         GOTO EXTCMDRDYMSG; 
         END
      QAC$CHGPRI = CIT$PRIFLAG;    # PRIORITY                          #
      QAC$CHGSC = CIT$SCFLAG;      # SERVICE CLASS FLAG                #
      IF CIT$SCFLAG                # SERVICE CLASS FLAG SET            #
      THEN
        QAC$SC = CIT$SCVALUE;      # SERVICE CLASS VALUE               #
      ELSE
        QAC$PRI = CIT$PRIVALUE;    # PRIORITY VALUE                    #
      QAC$CHGREP = CIT$REPFLAG;    # REPEAT COUNT                      #
      QAC$NRPTCNT = CIT$REP ;     # NEW REPEAT COUNT                  # 
  
# HANDLE DIVERT COMMAND                                                #
  
      IF CIT$CMDTYPE EQ S"DIVERT" 
      THEN
        BEGIN                # DIVERT ...                              #
        IF CIT$HSTFLAG
        THEN
          BEGIN 
            QAC$DVRTHOST = TRUE ; 
            QAC$NBATCHID = 0 ;
          END 
        ELSE
          BEGIN                    # TO OTHER TERMINAL                 #
          QAC$DVRTID = TRUE;
          QAB$NEWFAM = CIT$FAMNAME; # SAVE NEW FAM/USR IN QAB          #
          QAB$I = 0;                   # ZERO FILL FOR QAC             #
  
          IF QAB$NEWFAMI EQ 0 
          THEN
            QAB$NEWFAM = TCB$FAMNAME;  # SUPPLY DEFAULT FROM LOGIN FAM #
  
          QAB$NEWUSR = CIT$USERNUM; 
          QAB$K = 0;                   # ZERO FILL FOR QAC             #
          END                      # TO OTHER TERMINAL                 #
        END                  # DIVERT ...                              #
      QAC$SDEST = TRUE; 
      QAC$SINDUPL = TRUE ;
      QAC$SZEROPRI = TRUE ; 
      IF  QAC$JSNNUM  NQ  0 
      THEN
        QAC$SJSN = TRUE;
  
      IF CIT$EXTFLAG
      THEN
        BEGIN                # EXTENDED DIVERT                         #
        CANCEL;                    # CANCEL OLD EXT DIVS ON SAME ACN/Q #
        QCMCALL(TCB$QABBUF);       # PLACE QAB ON EXT DIV CHAIN        #
        QCB$EXTIME = TRUE;         #  ENSURE QAC CALLED ASAP #
        TCB$EXTDIVC1 = TRUE; # IN SENDING THE SAME QAC PARAMETER BLOCK #
                             # TO QAC REPEATEDLY IN AN EXTENDED DIVERT,#
                             # CONTROL RETURNS TO EXTCMD ONLY THE FIRST#
                             # TIME - IN ORDER TO CHECK THE DIV DEST   #
        SYSACT = TRUE;                 # GO THROUGH MAIN LOOP ONCE MORE#
        EVENT(LOC(DONE)); 
  
        P<QAB> = ADDRESS[TCB$QABBUF]; 
          TCB$EXTDIVS = TCB$EXTDIVS LOR CIT$OQFLAGS; # MARK Q-S AS EXT #
  
        IF QAC$ERROR EQ S"BADUSRFAM"
        THEN
          BEGIN              # INVALID USER/FAMILY NAME                #
          TCB$EXTDIVS = TCB$EXTDIVS LXR CIT$OQFLAGS; # CLEAR CMD BITS  #
          QAB$CANCEL = TRUE;
          CONSOLE(BADDIVDEST,FALSE,27); 
          END                # INVALID USER/FAMILY NAME                #
  
        END                  # EXTENDED DIVERT                         #
      ELSE
        BEGIN                # NON-EXTENDED COMMAND                    #
  
        IF CIT$OQFLAGS LAN TCB$EXTDIVS EQ 0 
        THEN
          BEGIN              # OK TO DIVERT                            #
          QCMCALL(TCB$QABBUF);     # PLACE ON "IMMEDIATE" CHAIN        #
          SYSACT = TRUE;               # GO THROUGH MAIN LOOP ONCE MORE#
          EVENT(LOC(DONE)); 
  
          P<QAB> = ADDRESS[TCB$QABBUF]; 
  
          IF QAC$ERROR EQ S"INCORSC" # INCORRECT SERVICE CLASS         #
          THEN
            CONSOLE(INCORR,CRITICAL,24); # SEND MSG TO CONSOLE         #
  
          IF QAC$ERROR EQ S"SCFULL" # SERVICE CLASS FULL               #
          THEN
            CONSOLE(SCFULL,CRITICAL,19);  # SEND MSG TO CONSOLE        #
  
          IF QAC$ERROR EQ S"ONLINE" # CANNOT ALTER ON-LINE JOB         #
          THEN
            CONSOLE(NOALTR,CRITICAL,34);  # SEND MSG TO CONSOLE        #
  
          IF QAC$ERROR EQ S"UNDEFSC" # UNDEFINED SERVICE CLASS         #
          THEN
            CONSOLE(UNDEF,CRITICAL,24);  # SEND MSG TO CONSOLE         #
  
          IF QAC$ERROR EQ S"JOBWAIT" # JOB ALREADY WAITING ON SC       #
          THEN
            CONSOLE(JOBWAIT,CRITICAL,37);  # SEND MSG TO CONSOLE       #
  
          IF QAC$ERROR EQ S"SUBSYST" # CANNOT CHANGE SC OF SUBSYSTEM   #
          THEN
            CONSOLE(SCSUBSY,CRITICAL,41);  # SEND MSG TO CONSOLE       #
  
          IF QAC$ERROR EQ S"BADUSRFAM" # CHECK USER/FAMILY NAME        #
          THEN
            CONSOLE(BADDIVDEST,FALSE,27);  # BAD DIVERT DESTINATION    #
  
          IF QAC$ERROR EQ S"NOFILE" 
          THEN
            CONSOLE(NOFILES,FALSE,15);   # NO FILES FOUND IN DIV OR PRG#
                                         # OR CHANGE                   #
  
          END                # OK TO DIVERT                            #
  
        ELSE
  
          CONSOLE(DIVALREADY,NON$CRITICAL,39);   # ON EXT DIVERT       #
  
        RETTSB(TCB$QABBUF);        # RELEASE BUFFER                    #
        SETUPACN (ACN); 
        END                  # NON-EXTENDED COMMAND                    #
  
      TCB$QABBUF = 0; 
      GOTO EXTCMDRDYMSG;     # GO ISSUE "READY" MESSAGE                #
      CONTROL EJECT;
# 
      PROCESS RETURN COMMAND
# 
EXTCMD$RET: 
  
#                                                                      #
#     SEARCH FOR ALL AFFECTED DEVICES                                  #
#                                                                      #
      SEARCHDEVICE; 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS RETURN CMD  #
        TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"RETURNDCM"; 
        IF CIT$PRIFLAG
        THEN
          BEGIN 
          TCB$PRIORITY [TCBINDEX [I]] = CIT$PRIVALUE; 
          END 
        ELSE
          BEGIN  #  APPLY DEFAULT VALUE # 
          TCB$PRIORITY [TCBINDEX [I]] = O"100"; 
          END 
        END                                      # PROCESS RETURN CMD  #
      GOTO EXTCMDXRSM;
      CONTROL EJECT;
# 
      PROCESS RESTORE AND SUPPRESS COMMANDS 
# 
EXTCMD$RES: 
EXTCMD$SUP: 
      IF CIT$CMDTYPE EQ S"RESTORE"
      THEN # RESTORE COMMAND #
        FLAG = TRUE;
      ELSE  # SUPPRESS COMMAND #
        FLAG = FALSE; 
# 
      SEARCH TCB FOR DEVICES AFFECTED BY THIS COMMAND 
# 
      SEARCHDEVICE; 
# 
      SET FLAGS OF AFFECTED DEVICES 
# 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN 
        J = TCB$DEVACN[I];   # ACN OF BATCH DEVICE #
        IF ACN$DEVTYPE[J] EQ DEVICETYPE"CARD$READER"
        THEN                 # INPUT DEVICE # 
          BEGIN 
          IF ACN$MODE[J] LQ UCMSTATE"UCM$GO"
            OR ACN$MODE[J] EQ UCMSTATE"UCM$ABTBY" 
          THEN               # NEED TO RESTART INPUT DEVICE # 
            BEGIN 
            TCB$CMDTY[I] = UCMINPUT"RESUMEUCM"; 
            END 
          END 
        ELSE                 # OUTPUT DEVICE #
          BEGIN 
          TCB$CMDTY[I] = DCMINPUT"RESUMEDCM"; 
          END 
        IF CIT$BANFLAG
        THEN
          BEGIN                                  # BANNER CMD          #
          TCB$BANFLAG [TCBINDEX [I]] = FLAG;
          END 
        IF CIT$ACKFLAG
        THEN
          BEGIN                                  #ACKNOLEDGE INPUT NAME#
          TCB$ACKFLAG [TCBINDEX [I]] = FLAG;
          END 
        IF CIT$FMTFLAG
        THEN
          BEGIN                                  # FORMAT EFFECTOR CMD #
          TCB$FMTFLAG [TCBINDEX [I]] = FLAG;
          TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"DEVFLDCM";
          END 
        END 
#     INFORM BATCH DEVICE                                              #
#                                                                      #
      GOTO EXTCMDXRSM;
# 
      END OF RESTORE AND SUPPRESS COMMAND PROCESSING. 
# 
      CONTROL EJECT;
#     PROCESS RESUME COMMAND                                           #
EXTCMD$RSM: 
      IF ACN$MODE [ACN] EQ CONSOLESTATE"CON$ACTIVE" 
      THEN
        BEGIN                                    # PROCESS RESUME      #
        FOR I = 1 STEP 1 UNTIL TCB$NDEVICE DO 
          BEGIN 
          J = TCB$DEVACN [I]; 
          IF ACN$DEVTYPE [J] EQ S"CARD$READER"
          THEN
            BEGIN 
            IF ACN$MODE [J] LQ UCMSTATE"UCM$GO" 
               OR 
               ACN$MODE [J] EQ UCMSTATE"UCM$ABTBY"
            THEN
              BEGIN 
              TCB$CMDTY [I] = UCMINPUT"RESUMEUCM";
              END 
            END 
          ELSE
            BEGIN 
            IF ACN$MODE [J] LQ DCMSTATE"DCM$GOEOF"
            THEN
              BEGIN 
              TCB$CMDTY [I] = DCMINPUT"RESUMEDCM";
              END 
            END                                  # PROCESS RESUME      #
          END 
        END 
EXTCMDXRSM: 
      IF TCB$CURSTATE EQ CONSOLESTATE"CON$ACTIVE" 
      THEN
        BEGIN 
        TCB$INTERRPT = SET; 
        FOR I=1 STEP 1 UNTIL TCB$NDEVICE DO 
          BEGIN                                  # SEARCH ALL DEVICES  #
          J = TCB$DEVACN [I];                    # PASSIVE DEVICE ACN  #
          IF ACN$DEVTYPE [J] EQ S"CARD$READER"
          THEN
            BEGIN                                # CARD READER CONNECTN#
            IF TCB$CMDTY [I] EQ ZERO
            THEN
              BEGIN 
              IF ACN$MODE [J] LQ UCMSTATE"UCM$GO" 
                 OR 
                 ACN$MODE [J] EQ UCMSTATE"UCM$ABTBY"
              THEN
                BEGIN                            # OK TO RESUME INPUT  #
                TCB$CMDTY [I] = UCMINPUT"RESUMEUCM";
                TCB$CRINTR = FALSE;  # ALLOW UPLINE BATCH TRAFFIC # 
                END 
              END 
            ELSE
              BEGIN 
              TCB$CRINTR = FALSE; 
              END 
            END 
          ELSE
            BEGIN                                # OUTPUT DEVICE ACN   #
            IF TCB$CMDTY [I] EQ ZERO
            THEN
              BEGIN 
              IF ACN$MODE [J] LQ DCMSTATE"DCM$GOEOF"
              THEN
                BEGIN                            # OK TO RESUME OUTPUT #
                TCB$CMDTY [I] = DCMINPUT"RESUMEDCM";
                IF ACN$MODE[J] NQ DCMSTATE"DCM$IDLE"
                THEN         # ALLOW DOWNLINE BATCH TRAFFIC            #
                  BEGIN 
                  TCB$LPINTR = FALSE; 
                  END 
                END 
              END 
            ELSE
              BEGIN 
              IF TCB$CMDTY[I] NQ DCMINPUT"RESUMEDCM"
                AND ACN$MODE[J] NQ DCMSTATE"DCM$IDLE" 
              THEN           # ALLOW DOWNLINE BATCH TRAFFIC            #
                BEGIN 
                TCB$LPINTR = FALSE; 
                END 
              END 
            END 
          END 
          IF TCB$INTERRPT NQ SET
          THEN
            BEGIN                                # CHANGE CONSOLE STATE#
            TCB$INPTYPE = CONINPUT"BATCHCMDX";
            END 
          END 
        ELSE
          BEGIN                                  # CONCURRENT BATCH    #
          GOTO EXTCMDRDYMSG;                     # TERMINAL, SEND READY#
          END                                    # MESSAGE             #
      GOTO LINKTOCMD; 
      CONTROL EJECT;
# 
      PROCESS REWIND AND SKIP COMMANDS
# 
EXTCMD$REW: 
# 
# 
      SEARCHDEVICE; 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS REWIND CMD  #
        TCB$CMDTY [TCBINDEX [I]]= DCMINPUT"REWINDDCM";
        TCB$SKPVAL [TCBINDEX [I]] = -4095;
        END                                      # PROCESS REWIND CMD  #
      GOTO EXTCMDXRSM;
      CONTROL EJECT;
EXTCMD$SKIP:  
# 
      SEARCH FOR ALL DEVICES AFFECTED BY THIS COMMAND 
# 
      SEARCHDEVICE; 
# 
      SET SKIP FLAG OR VALUE FOR EACH DEVICE
# 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS SKIP CMD    #
        IF CIT$ENDFLAG
        THEN
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"SKPENDDCM"; 
          END 
        ELSE
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"SKPDCM";
          TCB$SKPDFL [TCBINDEX [I]] = CIT$DFLFLAG;
          TCB$SKPVAL [TCBINDEX [I]] = CIT$SKPVALUE; 
          END 
        END                                      # PROCESS SKIP CMD    #
      GOTO EXTCMDXRSM;
      CONTROL EJECT;
# 
      PROCESS SET COMMAND 
# 
EXTCMD$SET: 
CMD$SET:  
# 
      SEARCH FOR ALL DEVICES AFFECTED BY THIS COMMAND 
# 
      SEARCHDEVICE; 
# 
      SET VALUES OF AFFECTED DEVICES
# 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN 
        J = TCBINDEX [I]; 
        TCB$CMDTY [J] = DCMINPUT"RESUMEDCM";
        IF CIT$REPFLAG
        THEN
          BEGIN                                  # SET REPEAT COUNTER  #
          P<DCB> = ADDRESS [ACN$CB [TCB$DEVACN [J]]]; 
          IF DCB$FILEACT
          THEN
            BEGIN 
            TCB$REPEAT [J] = CIT$REP; 
            END 
          ELSE
            BEGIN 
            CONSOLE (NOFILEACTIVE, FALSE, 25);
            TCB$CMDTY [J] = ZERO; 
            GOTO EXTCMDRDYMSG;
            END 
          END                                    # SET REPEAT COUNTER  #
        IF CIT$FMSFLAG
        THEN
          BEGIN                                  # SET FORMS CODE      #
          TCB$FORMS [J] = CIT$FORMS;
          END                                    # SET FORMS CODE      #
        IF CIT$WIDFLAG
        THEN
          BEGIN                                  # SET PAGE WIDTH      #
          IF CIT$WIDTH EQ WID$DEFAULT 
          THEN
            TCB$CURWIDTH [J] = TCB$ORGWIDTH [J];
          ELSE
            TCB$CURWIDTH [J] = CIT$WIDTH - WID$GLB; 
          END                                    # SET PAGE WIDTH      #
        IF CIT$BLKSIZ 
        THEN
          BEGIN                                  #SET XMISSION BLK SIZE#
          TCB$DEVBSZ [J] = CIT$BLKVAL;
          END                                    #SET XMISSION BLK SIZE#
        IF CIT$TRFLAG 
        THEN
          BEGIN                                  # SET TRAIN TYPE      #
          TCB$TRAIN [J] = CIT$TRAIN;
          END                                    # SET TRAIN TYPE      #
        END 
      GOTO EXTCMDXRSM;
# 
      END OF SET COMMAND PROCESSING 
# 
      CONTROL EJECT;
# 
      PROCESS STOP COMMAND
# 
EXTCMD$STOP:  
CMD$STOP: 
# 
      SEARCH TCB FOR DEVICES AFFECTED BY THIS STOP COMMAND
# 
      SEARCHDEVICE; 
# 
      STOP EACH DEVICE
# 
      FOR I=1 STEP 1 UNTIL NO$OF$HITS DO
        BEGIN                                    # PROCESS STOP CMD    #
        IF TCB$DEVDT [TCBINDEX [I]] EQ DEVICETYPE"CARD$READER"
        THEN
          BEGIN 
          TCB$CMDTY [TCBINDEX [I]] = UCMINPUT"STOPENDUCM";
          END 
        ELSE
          BEGIN 
          IF CIT$ENDFLAG
          THEN
            BEGIN 
            TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"STOPENDDCM";
            END 
          ELSE
            BEGIN 
            TCB$CMDTY [TCBINDEX [I]] = DCMINPUT"STOPDCM"; 
            END 
          END 
        END                                      # PROCESS STOP CMD    #
      IF TCB$MD4A THEN GOTO LINKTOCMD;
         ELSE GOTO CMDRDYMSG; 
      CONTROL EJECT;
EXTCMDRDYMSG: 
CMDRDYMSG:  
#                                                                      #
#     ISSUE READY MESSAGE                                              #
#                                                                      #
           RDYMSG(FALSE); 
LINKTOCMD:  
#                                                                      #
#                                                                      #
#     FREE CIT$TABLE BUFFER                                            #
#                                                                      #
      RETTSB (TCB$CITBUF);
      SETUPACN (ACN); 
      TCB$CITBUF = 0; 
  
ENDOFEXTPROC: 
        GOTO RESTART; 
        END   # EXTENDED COMMAND PROCESSOR MODULES #
      END # EXTCMD #
      TERM; 
