*DECK DIS 
USETEXT IP$COM
USETEXT MISC$ 
USETEXT QAC$COM 
USETEXT TCH$COM 
USETEXT TSB$COM 
USETEXT ABH$COM 
USETEXT ACN$COM 
USETEXT CYBRDEF 
USETEXT SMDEF 
USETEXT SMAPPFC 
USETEXT SMPFC 
USETEXT DCB$COM 
USETEXT GLOBALI 
USETEXT QAB$COM 
USETEXT QCB$COM 
USETEXT SM$COM
USETEXT TCB$COM 
USETEXT UCB$COM 
      PROC DIS;              # RBF DISPLAY DRIVER                      #
  
      BEGIN                  # DIS                                     #
  
*IF,DEF,IMS 
 #
*1DC  DIS 
* 
*     1. PROC NAME           AUTHOR            DATE 
*        DIS                 AL PRATT          77/02/01 
*        MODIFIED FOR F3180E BY SYLVIA PARR 79/08/13.  F3180E ADDS
*        THE BS PARAMETER TO THE DIS,DEV DISPLAY AND DELETES THE
*        FS PARAMETER FROM THIS SAME DISPLAY. 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        DIS CREATES RBF-S CONSOLE DISPLAYS: THE REMOTE BATCH DEVICE
*        STATUS DISPLAY, THE JOB-FILES DISPLAY, THE QUEUE DISPLAYS
*        (INPUT, PRINT, PUNCH, PLOT, AND EXECUTING-JOB DISPLAYS)
* 
*     3. METHOD USED
*        THE REMOTE BATCH DISPLAY IS CREATED BY PROCEDURE DEV$DIS,
*        WHICH USES INFORMATION IN RBF-S INTERNAL TABLES (TCB,ACNTABLE, 
*        DCB, AND UCB) AND CAN THEREFORE PERFORM ITS WORK AS A ONE-STEP 
*        PROCESS. 
* 
*        THE JOB-FILE DISPLAY IS CREATED BY FORMING FIVE LINKED QAC PARA
*        METER BLOCKS (ONE FOR EACH POSSIBLE FILE TYPE) WHICH 
*        ARE SBUBMITTED TO THE QUEUE INFORMATION ROUTINE, QAC.  ANY AND 
*        ALL FILES FOUND BY QAC FOR THE SPECIFIED JOB ARE FORMATTED 
*        BY THE QUEUE DISPLAY PROCEDURE, QUEUE$DIS. 
* 
*        THE QUEUE DISPLAYS ARE ALL CREATED SIMILARLY BY CALLING THE
*        QAC "PEEK" FUNCTION FOR A FIXED NUMBER OF FILES (USUALLY 
*        RELATED TO THE RBF CONSOLE-S PAGELENGTH).  WHEN REPLIES ARE
*        AVAILABLE THE REPLIES ARE FORMATTTED INTO DISPLAY LINES BY 
*        THE PROCEDURE "QUEUE$DIS". 
* 
*        IN ALL DISPLAY PROCESSORS, THE DISPLAYS ARE GENERATED LINE-BY- 
*        LINE AND HANDED OFF TO THE PROCEDURE "ADDLINE". IN MOST CASES
*        "ADDLINE" SIMPLY PASSES THE LINE ON TO "LINEOUT", BUT WILL 
*        INSERT TITLE LINES, AS APPROPRIATE. LINEOUT IS RESPONSIBLE FOR 
*        ACCUMULATING LINES IN A BLOCK, AND, AS APPROPRIATE, LINKING
*        THE CURRENT BLOCK TO A CHAIN BUILT OFF THE CONSOLE-S TCB.  THE 
*        MAIN-LOOP IS RESPONSIBLE FOR SENDING THE BLOCKS TO THE CONSOLE 
* 
*     4. ENTRY PARAMETERS 
*        TCB - THE CONSOLE-S TERMINAL CONTROL BLOCK 
*        DCB - THE DOWNLINE CONTROL BLOCK 
*        UCB - THE UPLINE CONTROL BLOCK 
*        ACN$TABLE - INFORMATION RELATED SPECIFICALLY TO CERTAIN CONNEC-
*        TIONS
* 
*     5. EXIT PARAMETERS
*        TCB - DISPLAY OUTPUT BLOCKS ARE CHAINED TO THE USER-S TCB
* 
*     6. COMDECKS CALLED. 
*        TSBMDEFS 
*        TSBMBASE 
*        RBF$COM
*        QCB$COM
*        ABH$COM
*        TCB$COM
*        QAB$COM
*        DCB$COM
*        UCB$COM
*        CTRL$COM 
* 
*     7. ROUTINES CALLED. 
*        DONE 
*        EVENT
*        GETBSN 
*        GETBUF 
*        LINK 
*        LINKBLOCK
*        MESSAGE                ISSUE ERROR MESSAGE 
*        QCMCALL
*        RETTSB 
*        SENDSM 
*        WAIT 
*        XCDD 
*        XCOD 
* 
*     8. DAYFILE MESSAGES.
*        * BAD QAC PEEK REPLY WORD *
 #
*ENDIF
  
      CONTROL EJECT;
  
      ITEM WORDS$BUF I;      # NR OF CM WORDS TO ALLOCATE FOR DIS BUF  #
      ITEM PAGELEN I;        # NUMBER OF LINES PER CONSOLE "PAGE"      #
      ITEM BYTES$MAX I;      # NUMBER OF BYTES ALLOWED IN OUTPUT BLK   #
                                   # WHOLE LINE                        #
      ITEM NEXT I;           # ORDINAL OF NEXT QAB ON CHAIN            #
      ITEM REPLIES I;        # NUMBER OF ACTUAL QAC REPLIES            #
      ITEM Q$TYPE I;         # CONTAINS QTYPE STATUS VALUE             #
      ITEM BSN I;            # BLOCK SEQUENCE NUMBER                   #
      ITEM QABORD I;         # ORDINAL OF QAB                          #
      ITEM ZSUPFLAG B;       # TRUE IF BINBCO IN ZERO-SUPPRESS MODE    #
      ITEM PAGEWAITOFF U = X"50473D4E000"; # STRING FOR PAGE-WAIT      #
      ITEM PAGEWAITON U = X"50473D59000";  # PG=Y STRING               #
      ITEM PAGEWAIT U;       # HOLD PAGE-WAIT "ON"/"OFF" INSTRUCTION   #
      ITEM REPLYWD;          # INDEX INTO QAC PEEK CALL REPLY BUFFER   #
      ITEM Y I;              # TEMPORARY                               #
      ITEM XCONVERT C(10);   # TEMPORARY CONVERSION VARIABLE           #
      ITEM CHAIN I;          # CONTROL VARIABLE (EXTDIV$DIS            #
      ITEM FOUND B; 
      ITEM I1 I;             # CONTROL VARIABLE IN QUEUE$DIS           #
      ITEM J1 I;             # CONTROL VARIABLE IN QUEUE$DIS           #
      ITEM K I;              # CONTROL VARIABLE (MAIN-LOOP)            #
      ITEM K3 I;             # K (ADDLINE)                             #
      ITEM K4 I;             # K (EXTDIV$DIS)                          #
      ITEM K5 I;             # CONTROL VARIABLE (DEV$DIS)              #
      ITEM K6 I;             # CONTROL VARIABLE (SUPZERO)              #
      ITEM KK I;             # TEMPORARY (DEV$DIS)                     #
      ITEM ACN1 I;           # SEARCH TEMPORARY (EXTDIV$DIS)           #
      ITEM ACN2 I;           # TEMPORARY (DEV$DIS)                     #
      ITEM DTYPE I;          # CONTROL VARIABLE - DEVICE TYPE          #
      ITEM JJ I;             # CONTROL VARIABLE (DEV$DIS)              #
      ITEM T I;              # TEMPORARY                               #
  
      DEF DISSPACE #200#;    # SPACE NEEDED FOR "DIS" TO BEGIN WORK    #
      DEF BYTES$LINE #51#;   # NR OF ASCII BYTES AFTER CONVERSION      #
      DEF QACREQSDEF #20#;   # DEFAULT NUMBER OR REPLIES TO ASK OF QAC #
      DEF PAGELENINF #2000#; # "LENGTH" OF ENDLESS-FORM TERMINAL       #
      DEF DISPLAY$ZERO #O"33"#;    # VALUE OF A DISPLAY CODE ZERO      #
      DEF WORDS$LINE #5#;    # WORDS PER DISPLAY LINE                  #
      DEF EXECUTING #2#;     # QAC STATUS VALUE OF EXECUTING JOB       #
      DEF MAXDEVERRS #7#;    # CHECK 1ST 7 BITS IN TCB$ERRORS, THE LAST#
                             # BIT (TCB$PM) IS USED FOR PM MESSAGES.   #
  
      XREF PROC QCMCALL;     # ROUTINE TO CHAIN QAB TO QAB-CHAIN       #
      XREF FUNC GETBSN;      # GET BLOCK SEQUENCE NUMBER               #
      XREF FUNC GETBUF;      # ROUTINE TO GET BUFFER FROM MEMORY MGR   #
      XREF PROC LINK;        # ROUTINE TO CALL ANOTHER OVERLAY         #
      XREF PROC LINKBLOCK;   # LINK OUTPUT BLOCKS                      #
      XREF PROC MESSAGE;     # ISSUE ERROR MESSAGE                     #
      XREF PROC ABORT;       # ABORT RBF                               #
      XREF PROC EVENT;       # ROUTINE TO GIVE-UP CPU UNTIL EVENT CMPLT#
      XREF PROC DONE;        # EVENT PROCESSOR (WAITS FOR COMPLETE BIT)#
      XREF PROC SETUPACN;   # SET UP CONTROL BLOCKS                 # 
      XREF PROC RETTSB;      # ROUTINE TO RETURN BUFFER TO MEMORY MGR  #
      XREF PROC MOVEBLK;     # NOS BLOCK-MOVE ROUTINE                  #
      XREF FUNC BUFINFO;     # FUNCTION TO FIX BUF AND RETURN ORDINAL  #
      XREF PROC CHGSIZE;     # ROUTINE TO CHANGE THE SIZE OF A TSB BUF #
      XREF PROC WAIT;        # WAIT FOR A TIME EVENT.                  #
      XREF FUNC XSFW C(10);  # SPACE FILE RIGHT JUSTIFIED ZEROS        #
      XREF FUNC XCDD C(10);  # CONVERTS TO DECIMAL DISPLAY, RIGHT JUST #
      XREF FUNC XCOD C(10);  # CONVERTS TO OCTAL DISPLAY, RIGHT JUST.  #
  
      XREF ARRAY RBPS; ;
      XREF LABEL CALLRTN; 
      CONTROL EJECT;
  
      ARRAY TITLE1$AREA S(5); 
        BEGIN                # FIRST LINE OF TITLE                     #
        ITEM TITLE1    C(0,0,50); 
        ITEM T$DEV     C(0,6,14); 
        ITEM T$JOBFILE C(0,6,8);
        ITEM T$JOBSOF  C(0,6,7);
        ITEM T$JOBNAME C(1,0,7);
     ITEM  T$JSN   C (1,0,4) ;
     ITEM  T$BLK   C (1,24,3) ; 
        ITEM T$USRFAM9 C(0,54,20);
        ITEM T$USRFAM18      C(1,48,20);
        ITEM T$USRFAM16      C(1,36,20);
        ITEM T$INQUEUE C(3,0,18); 
        END                  # FIRST LINE OF TITLE                     #
  
      ARRAY TITLE2$AREA S(5); 
        BEGIN                # SECOND LINE OF TITLE                    #
        ITEM TITLE2    C(0,0,50); 
        END                  # SECOND LINE OF TITLE                    #
  
      ARRAY DATA$AREA S(5); 
        BEGIN                # DATA LINE TO BE DISPLAYED               #
        ITEM LINE      C(00,0,50); # DATA LINE                         #
        ITEM LINE$FE   C(00,0,1);        # FORMAT EFFECTOR             #
        ITEM LINE$OFF  C(00,6,49);       # DATA LINE (OFFSET ONE CHAR) #
        ITEM LINE$EOL  U(04,48,12);# END OF LINE INDICATOR             #
  
                                   # FIELDS OF -LINE- FOR QUEUE DISPLAY#
        ITEM Q$NAME    C(00,6,7);      # QUEUE OR JOB NAME             #
        ITEM Q$PRI     C(01,6,7);      # PRIORITY (OCTAL)              #
        ITEM Q$FL      C(02,0,7);      # FIELD LENGTH (OCTAL)          #
        ITEM Q$FS      C(02,0,7);      # FILE SIZE (DECIMAL PRU-S)     #
        ITEM Q$DLID    U(02,30,18);    # DESTINATION LOGICAL ID        #
        ITEM Q$SRU     C(03,0,7);      # SYSTEM RESOURCE UNITS         #
        ITEM Q$FMS     U(03,6,12);     # FORMS CODE                    #
        ITEM Q$EC      C(03,24,2);     # EXTERNAL CHARACTERISTICS      #
        ITEM Q$REP     C(04,0,3);      # REPEAT COUNT (DECIMAL)        #
        ITEM Q$STATUS  C(04,0,4);      # JOB STATUS - EX/WAIT          #
        ITEM Q$SLASH   C(03,18,1);     # SLASH                         #
  
                                   # FIELDS OF -LINE-,  DEVICE DISPLAY #
        ITEM D$EQ      C(00,6,2);      # CR, LP, ETC                   #
        ITEM D$ORD     C(00,18,1);     # EQUIPMENT ORDINAL - 1...7     #
        ITEM D$STATUS   C(00,30,5);    # DEVICE STATE                  #
        ITEM D$NAME     C(01,06,7);    # FILE NAME                     #
        ITEM D$FS       C(01,48,6);    # FILE SIZE                    # 
        ITEM D$REP      C(02,30,2);    # REPEAT COUNTER                #
        ITEM D$FMS     U(02,48,12);    # FORMS CODE                    #
        ITEM D$TR      C(03,6,2);      # TRAIN TYPE                    #
        ITEM D$OPT     C(03,24,3);     # ACK, BAN, FMT, OR B/F         #
        ITEM D$WID     C(03,48,3);     # PRINTER LINE WIDTH            #
        ITEM D$SIZ     C(04,12,4);     # TRANSMISSION BLOCK SIZE       #
        ITEM D$SLASH   C(03,0,1);      # SLASH                         #
  
                                   # FIELDS OF -LINE- FOR EXT DIVS     #
        ITEM X$MESS    C(00,6,18);       # EXT DIV IN EFFECT TO HOST   #
        ITEM X$DEST    C(02,0,4);        # "HOST" OR "USER"            #
        ITEM X$USR     C(02,30,7);       # USER NAME                   #
        ITEM X$SLASH   C(03,12,1);       # SLASH                       #
        ITEM X$FAM     C(03,18,7);       # FAMILY NUMBER               #
        END                  # DATA LINE TO BE DISPLAYED               #
  
      ARRAY BLANK$AREA S(5);
        ITEM BLANK$ITEM C(0,0,50) = [" "];
  
      ARRAY SAVE$AREA S(5); ; 
  
      ARRAY A$QABORDS[0:4] S(1);
        ITEM A$QABORD I(0,0,60);   # ORDINALS OF CHAINED QAB BUFS      #
      CONTROL EJECT;
      ARRAY REPLY S(PEEKREL); 
      BEGIN                                # ONE QAC "PEEK" REPLY      #
        ITEM R$NAME          C (0,0,04);   # JOB SEQUENCE NUMBER       #
        ITEM R$ORD           I(00,24,12);  #QUEUE ORDINAL OF THIS ENTRY#
        ITEM R$FMS           U (1,12,12);  # FORMS CODE                #
        ITEM R$DISP          U (1,24,12);  # DISPOSITION CODE          #
        ITEM R$EC            U (1,36,3);   # E.C.                      #
        ITEM R$IC            U (1,39,3);   # I.C.                      #
        ITEM R$PRI           U (2,0,12);   # PRIORITY                  #
        ITEM R$FL            U (2,24,12);  # FIELD LENGTH              #
        ITEM R$LFN           C (3,0,06);   # USER JOB NAME             #
        ITEM R$REP           U (4,18,6);   # REPEAT COUNT              #
        ITEM R$FS            U (5,0,24);   # FILE SIZE                 #
        ITEM R$STATUS        U (6,0,12);   # CODE FOR WAIT/EX          #
        ITEM R$SRU           U (7,0,42);   # SRUS ACCUMULATED          #
        ITEM R$DLID          U(8,6,18);    # DESTINATION LOGICAL ID    #
        ITEM R$0             I (0,0,60);   # FIRST OF REPLY            #
        ITEM R$1             I (1,0,60);   # SECOND WORD OF REPLY      #
        ITEM R$2             I (2,0,60);   # THIRD WORD OF REPLY       #
        ITEM R$3             I (3,0,60);   # FOURTH WORD OF REPLY      #
        ITEM R$4             I (4,0,60);   # FIFTH WORD OF REPLY       #
        ITEM R$5             I (5,0,60);   # SIXTH WORD OF REPLY       #
        ITEM R$6             I (6,0,60);   # SEVENTH WORD OF REPLY     #
        ITEM R$7             I (7,0,60);   # EIGTH WORD OF REPLY       #
        ITEM R$8             I (8,0,60);   # NINTH WORD OF REPLY       #
      END 
  
  
      ARRAY USRFAMNAMES S(2); 
        BEGIN                # TERMINAL IDENTIFICATION                 #
        ITEM U$F       C(0,0,20); 
        ITEM $USR$     C(0,0,5) = ["USER "];
        ITEM USER      C(0,30,7); 
        ITEM $SL$      C(1,12,1) = ["/"]; 
        ITEM FAM       C(1,18,7); 
        END                  # TERMINAL IDENTIFICATION                 #
  
  
      ARRAY IN$QUEUE[0:4] S(2);    # *IN* QUEUE-NAME *QUEUE*           #
        BEGIN 
        ITEM IN$Q      C(0,0,18) = ["IN EXECUTION QUEUE", 
                                    "IN PLOT QUEUE     ", 
                                    "IN PUNCH QUEUE    ", 
                                    "IN PRINT QUEUE    ", 
                                    "IN INPUT QUEUE    "];
        END 
  
      ARRAY MISCELLANY[0:4] S(1); 
        BEGIN                # PARAMETERS OF QUEUE TYPE                #
        ITEM QNAME C(0,0,7) =            # NAMES OF QUEUES (QAC ORDER) #
          ["EXECUTE","PLOT","PUNCH","PRINT","INPUT"]; 
        ITEM QFLAGS U(0,42,18) = [1,2,4,8,16];
        END                  # PARAMETERS OF QUEUE TYPE                #
  
      ARRAY FLAGS$QTYPE S(2); 
        BEGIN                # QUEUE FLAGS TO QUEUE-TYPE ORDINAL       #
      ITEM WORD1 U(0,0,60) = [O"00040000030000000200"]; 
      ITEM WORD2 U(1,0,60) = [O"00000000000001000000"] ;
        ITEM FLAG$QTYPE C(0,0,20);
        END                  # QUEUE FLAGS TO QUEUE-TYPE ORDINAL       #
  
      ARRAY ECTYPEX [0:7] S(1); 
        BEGIN 
        ITEM ECPLOT     C (0,0,2) = ["  ","T6","T8","  ","  ","  ","  ",
                                     "  "], 
             ECPUNCH    C (0,12,2)= ["  ","SB","80","  ","26","29","AS",
                                     "  "], 
             ECPRINT    C (0,24,2)= ["  ","  ","  ","  ","B6","A6","A9",
                                     "  "]; 
        END 
      ARRAY TRAIN$ S(1);
        BEGIN 
        ITEM TR$TYPE C (0,0,10) = ["A6B6A9T6T8"]; 
        END 
  
      ARRAY DISSTATE  [0:17] S (1); 
        BEGIN 
        ITEM STATE$DCM  C (0,0,5) = ["     ","GO","GO","GO","GO","STOP",
                                     "STOP","STOP","STOP","STOP","SKIP",
                                     "SKIP","ABORT","ABORT","ABORT",
                                     "RETN","RETN","RETN"], 
             STATE$UCM  C (0,30,5) = ["  ","GO","GO","GO","STOP","STOP",
                                     "STOP","ABORT","ABORT"]; 
        END 
  
  
  
      ARRAY COUNTS[0:4] S(1); 
        ITEM COUNT I(0,0,60); 
  
      ARRAY DEVERRS[1:MAXDEVERRS] S(2); 
        ITEM DEVERR C(0,0,20) = 
          [ "NOT READY",
            "CARD ERROR", 
            "INPUT QUEUE FULL", 
            "DISK ERROR", 
            "DISK FULL",
            "JOB CARD ERROR", 
            "USER CARD ERROR",
          ];
  
      ARRAY BADQACREPLY S(3); 
        BEGIN 
        ITEM BADQACMSG    C(00,00,24) = [" BAD QAC PEEK REPLY WORD"]; 
        ITEM BADQACMEND   U(02,24,36) = [0];
        END 
  
      BASED ARRAY DATATMP [1:1];
        ITEM DATAW I;              # BE TRANSFERRED TO OUTPUT          #
  
      BASED ARRAY BUFFER;    # TEMPLATE OVER DISPLAY OUTPUT BUFFER     #
        ITEM BUF$ITEM I;
  
      BASED ARRAY QREPLY;    # TEMPLATE OVER QAC "PEEK" REPLY BUFFER   #
        BEGIN 
        ITEM QREPLYW I; 
        ITEM QREPLYCODE  U(0,54,6);      # REPLY CODE                  #
        END 
      BASED ARRAY PM$TXT S(8);
        ITEM PM$MSG C (0,0,80); 
      PROC SENDSM (SMFUNC,LENGTH,CHARTYPE,BSN,STRING);
      BEGIN # SENDSM #
*IF DEF,IMS 
 #
*1DC  SENDSM
* 
*     1. PROC NAME           AUTHOR              DATE 
*        SENDSM              B. M. WEST          7 MARCH 1977 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        SENDS A SUPERVISORY MESSAGE TO NAM.
* 
*     3. METHED USED. 
         SENDSM BUILDS SUPERVISORY MESSAGE IN SMBUFFER, CALLS NETPUT
*        AND RETURNS. 
* 
*     4. ENTRY PARAMETERS.
* 
*         SMFUNC - PFC/SFC OF SUPERVISORY MESSAGE 
*         LENGTH - LENGTH OF SUPERVISORY MESSAGE
*         ACT    - APPLICATION CHARACTER TYPE 
*         BSN    - BLOCK SEQUENCE NUMBER
*         STRING - USED IN CTRL/DEF SUPERVISORY MESSAGES TO CHANGE THE
*                  TERMINAL DEFINITION. IF NOT A CTRL/DEF SUPERVISORY 
*                  MESSAGE STRING SHOULD BE BLANK. FOR MAT OF 
*                  STRING IS THE FIRST (UPPER) U, BITS = 0, THE LOWER 
*                  42 BIT CONTAIN THE ASCII STRING TO SENT
* 
*         ACN    - APPLICATION CONNECTION NUMBER, GLOBAL ITEM 
* 
*     5. EXIT PARAMETERS. NONE. 
* 
*     6. COMDECKS USED. 
*        RBF$COM
*        SM$COM 
*        ABH$COM
*        CTRLDEF
* 
*     7. ROUTINES CALLED. 
*        NETPUT 
* 
*     8. DAYFILE MESSAGES. NONE.
* 
 #
*ENDIF
  
      XREF PROC NETPUT;      # NETPUT, SEND DATA, SM"S TO NAM          #
# 
      LOCAL PARAMETERS
# 
      DEF LSMSG # 3 #;       # LENGTH OF SM + 1 FOR APPLICATION BLOCK  #
                             # HEADER                                  #
      ITEM SMFUNC U;         # PFC/SFC OF SM                           #
      ITEM LENGTH U;         # LENGTH OF SM                            #
      ITEM CHARTYPE I;
      ITEM BSN U;            # BSN OF SM (FPR CTRL SM"S ONLY)          #
      ITEM I I;              # INDEX VARIABLE                          #
      ITEM STRING U;         # STRING TO BE PASSED                     #
# 
      SUPERVISORY MESSAGE BUFFER AREA 
# 
      ARRAY SMBUFFER  [0:LSMSG] S(1); 
        ITEM SM U (0,0,60);  # FIRST WORD OF SUPERVISORY MESSAGE       #
# 
      INITIALIZE SUPERVISORY MESSAGE AREA 
# 
      FOR I = 0 STEP 1 UNTIL LSMSG DO SM [I] = 0; 
# 
      BUILD APPLICATION BLOCK HEADER
# 
      P<ABH> = LOC(SM [0]); 
      ABH$ABT = BLOCKTYPE"SM";
      ABH$ADR = ACN;
      ABH$ABN = BSN;
      ABH$TLC = LENGTH; 
      ABH$ACT = CHARTYPE; 
      P<SM$> = LOC (SM[1]); 
      SPMSG0 = STRING;       # STORE STRING IN SM$                     #
      PFCSFC = SMFUNC;
# 
      CALL NETPUT TO SEND THE SUPERVISORY MESSAGE TO NAM
# 
      NETPUT (ABH,SM$); 
      RETURN; 
      END # END OF SENDSM # 
      CONTROL EJECT;
      PROC BUILDQAB(QABORD$K,REPLYMAX); 
  
# THIS ROUTINE BUILDS A QAC PARAMETER BLOCK (IMBEDDED IN A -QAB-) AND  #
# SUBMITS THE QAB TO QCMCALL FOR INCLUSION ON A "TO-BE-SUBMITTED" CHAIN#
  
      BEGIN                  # BUILDQAB                                #
  
      ITEM REPLYMAX I;       # NUMBER OF REPLIES (IF A "PEAK") - PARAM #
      ITEM QABORD I;         # TSB ORDINAL OF QAB                      #
      ITEM QABORD$K I;       # INDEX INTO ARRAY OF QAB BUFFER ORDS     #
  
  
  
      QABORD = A$QABORD[QABORD$K];
      P<QAB> = ADDRESS[QABORD]; 
      QAB$ORD = QABORD;            # TSB ORDINAL OF QAB                #
      QAC$FUNCTION = QAC$PEEK;
      QAC$CFLAGS = TCB$QFLAGS ; 
      QAB$ACN = TCB$ACN;           # CONSOLE-S ACN                     #
      QAC$FILENAME = TCB$JOBNAME;  # SELECT ON JOB NAME IF SET         #
      QAC$JSN = TCB$JSN ; 
      QAC$ORIGIN = RBFORIGIN;      # QAC-S ORIGIN CODE FOR RBF         #
      QAC$FAMNAME = TCB$FAMNAME ; 
      QAC$USRNUM  = TCB$USERNUM ; 
      QAC$UI = TCB$USERORD; 
      QAC$LENQAC = BLOCK$PEEK - 5;         # QAC LENGTH -5             #
      QAC$DONE = FALSE; 
      QAC$REPLY = P<QAB> + BLOCK$PEEK + 1 ; 
      QAC$IN = QAC$REPLY ;
      QAC$OUT = QAC$REPLY ; 
      QAC$LIMITADD = QAC$REPLY + NR$PEEK + 1 ;
      IF LASTORD EQ 0 THEN
        QAC$ORDINAL = 0;                #START QAC AT ORDINAL 0#
      ELSE
        BEGIN 
        QAC$ORDINAL = LASTORD +1;       #START QAC AT LASTORD+1#
        QAC$QUEUE = QAC$CQUEUE;         #INTERRUPTED PEEK QUEUE BITS# 
        END 
      IF TCB$JOBFLAG
      THEN  QAC$LIMITADD = QAC$REPLY+60+1;
      QAC$INFOWORD = 0 ;
      QAC$INFOJSN = TRUE ;
      QAC$INFOJOB = TRUE ;
      QAC$INFOFL = TRUE ; 
      QAC$INFOSTS = TRUE ;
      QAC$INFOSRU = TRUE ;
      QAC$INFOFMS = TRUE ;
      QAC$INFOPRI = TRUE ;
      QAC$INFOREP  = TRUE ; 
      QAC$INFOLID[0] = TRUE;  # RECEIVE LOGICAL ID INFORMATION         #
      QAC$JOBCNT = REPLYMAX;
      QAC$INPCNT = REPLYMAX;
      QAC$PRTCNT = REPLYMAX;
      QAC$PCHCNT = REPLYMAX;
      QAC$SPCCNT = REPLYMAX;
        QAC$SELECTA = 0 ; 
      QAC$SINDUPL = TRUE ;
      QAC$SDEST[0] = TRUE;
  
      QAC$SZEROPRI = TRUE ; 
      IF QAC$JSN NQ 0 THEN QAC$SJSN = TRUE ;
  
      QCMCALL(QABORD);       # SUBMIT QAB FOR INCLUSION ON "IMMEDIATE",#
      RETURN;                      # "TO-BE-SUBMITTED" QAB CHAIN       #
      END                    # BUILDQAB                                #
CONTROL EJECT;
      PROC INITIALIZE;
  
# THIS ROUTINE PERFORMS INITIALIZATION FOR DISPLAY, INCLUDING          #
# THE SETTING UP OF TITLES, PAGE-LENGTH, ETC                           #
  
      BEGIN                  # INITIALIZE                              #
  
      ARRAY LINES2[0:4] S(10);
        ITEM LINE2 C(0,0,50) = [
          " NAME     PRIORITY    FL       SRU     STATUS     ",   # EX #
          " NAME     PRIORITY       FS    FC/EC     RP       ",   # PT #
          " NAME     PRIORITY       FS    FC/EC     RP       ",   # PU #
          " NAME     PRIORITY       FS    FC/EC     RP       ",   # PR #
          " NAME     PRIORITY       LID                      "];  # IN #
  
  
  
      P<TCB$ANNEX> = ADDRESS[TCB$ANNEXORD]; 
  
      IF TCB$PL GQ 2
      THEN
        BEGIN                # TERMINALS WHICH USE "PAGING             #
        PAGELEN = TCB$PL - 1; 
        NRQACREQS = TCB$PL - 4;    # TITLE PLUS DATA TO FILL ONE PAGE  #
        END                  # TERMINALS WHICH USE "PAGING             #
      ELSE
        BEGIN                # TERMINALS WHICH USE "ENDLESS FORM"      #
        PAGELEN = PAGELENINF; 
        NRQACREQS = QACREQSDEF;    # USE ENDLESSS PAGE DEFAULT         #
        END                  # TERMINALS WHICH USE "ENDLESS FORM"      #
  
      IF NRQACREQS LS 5 
      THEN
        NRQACREQS = 5;
  
      MOVEBLK(WORDS$LINE,BLANK$AREA,DATA$AREA); 
      MOVEBLK(WORDS$LINE,BLANK$AREA,TITLE1$AREA); 
      MOVEBLK(WORDS$LINE,BLANK$AREA,TITLE2$AREA); 
      BYTES$MAX = TCB$BLKSIZE;
  
  
      IF BYTES$MAX LS BYTES$LINE
      THEN
        BYTES$MAX = BYTES$LINE;    # MUST BE ROOM FOR AT LEAST ONE LINE#
  
      FLUSHBUF = FALSE; 
  
      USER = XSFW (TCB$USERNUM);
      FAM = XSFW(TCB$FAMNAME);
  
      IF TCB$JOBFLAG
      THEN
        BEGIN                # JOB-FILE DISPLAY                        #
        T$JOBFILE = "JOB/FILE";    # FIRST LINE OF TITLE               #
      T$JSN = TCB$JSN ; 
      T$BLK = "   " ; 
        T$USRFAM18 = U$F; 
  
        TITLE2 = " QUEUE    PRIORITY    FL/FS     FC/SRU  STAT/RP"; 
        END                  # JOB-FILE DISPLAY                        #
  
      IF TCB$DEVFLAG
      THEN
        BEGIN                # DEVICE DISPLAY                          #
        T$DEV = "RBF DEVICES OF"; 
        T$USRFAM16 = U$F; 
  
        TITLE2 = " EQ  STAT    NAME     FS RP FC/TR OPT WID   BS "; 
        END                  # DEVICE DISPLAY                          #
  
      IF TCB$QFLAGS NQ 0 AND (NOT TCB$JOBFLAG)
      THEN
        BEGIN                # INPUT, OUTPUT, EXECUTE DISPLAYS         #
        Q$TYPE = C<TCB$QFLAGS>FLAG$QTYPE; 
        T$JOBSOF = "JOBS OF";            # TITLE1                      #
        T$USRFAM9 = U$F;
        T$INQUEUE = IN$Q[Q$TYPE]; 
  
        TITLE2 = LINE2[Q$TYPE]; 
        END                  # INPUT, OUTPUT, ...                      #
  
      WORDS$BUF = BYTES$MAX/10 + 2; 
      RETURN; 
      END                    # INITIALIZE                              #
      CONTROL EJECT;
      PROC ADDLINE; 
  
# THIS ROUTINE ACCEPTS DATA LINES / ONE-BY-ONE AND SENDS THEM, ALONG   #
# WITH ANY TITLE LINES, TO THE OUTPUT BUFFER (VIA LINEOUT)             #
  
      BEGIN                  # ADDLINE                                 #
  
      IF NOT FLUSHBUF 
      THEN
        FULLPAGE = LINENR GR PAGELEN - 1; 
  
      IF FULLPAGE AND (NOT TITLESENT OR PAGELEN GQ 4) 
      THEN
        BEGIN                # OUTPUT THE TITLE                        #
        LINENR = 0;          # RESET LINE COUNTER FOR NEXT PAGE        #
        MOVEBLK(WORDS$LINE,DATA$AREA,SAVE$AREA);
        MOVEBLK(WORDS$LINE,TITLE1$AREA,DATA$AREA);
        LINE$FE = "1";       # RESET CURSER TO TOP OF PAGE             #
        LINEOUT;
        FULLPAGE = FALSE; 
        MOVEBLK(WORDS$LINE,TITLE2$AREA,DATA$AREA);
        LINEOUT;
        MOVEBLK(WORDS$LINE,BLANK$AREA,DATA$AREA); 
        LINEOUT;
        MOVEBLK(WORDS$LINE,SAVE$AREA,DATA$AREA);
        TITLESENT = TRUE; 
        END                  # OUTPUT THE TITLE                        #
  
      LINEOUT;
  
      RETURN; 
  
      END                    # ADDLINE                                 #
      CONTROL EJECT;
      PROC LINEOUT; 
  
#     THIS ROUTINE TAKES ONE LINE TO BE DISPLAYED (EITHER A TITLE LINE #
#     OR A LINE OF TEXT) FROM DATA$AREA, AND PLACES IT IN AN OUTPUT    #
#     BUFFER.  BUFFERS ARE ALLOCATED (AS NEEDED), FILLED, AND WHEN     #
#     FULL (OR TRUNCATED IF THERE IS NO MORE DATA), THEY ARE PLACED ON #
#     A CHAIN LINKED TO THE TCB                                        #
  
      BEGIN                  # LINEOUT                                 #
      FULLBUF = (BYTES$USED + BYTES$LINE) GR BYTES$MAX; 
  
      IF FULLPAGE OR NOCURBUF OR FLUSHBUF OR FULLBUF
      THEN
        BEGIN                # CHANGE OUTPUT BUFFERS                   #
        IF NOT NOCURBUF 
        THEN
          BEGIN              # FINISHED WITH THIS BUFFER - CHAIN TO TCB#
          P<ABH> = ADDRESS[CURBUFORD];
          ABH$TLC = 10*WORDS$USED;
          ABH$ABT = 0;                           # INDICATE DATA MSG   #
          LINKBLOCK (LOC (TCB$OUTPUT),CURBUFORD); 
          CHGSIZE(CURBUFORD,WORDS$USED + 1,0); # TRUNCATE # 
          CURBUFORD = 0;
          END                # FINISHED WITH THIS BUFFER - CHAIN TO TCB#
  
        IF NOT FLUSHBUF 
        THEN
          BEGIN              # ALLOCATE ANOTHER BUFFER                 #
          IF  CURBUFORD EQ 0
          THEN
            BEGIN 
            CURBUFORD = GETBUF(WORDS$BUF,MOVEABLE); 
            IF CURBUFORD EQ 0 
            THEN
              DIS$EXIT; 
            END;
          BYTES$USED = 0; 
          WORDS$USED = 0; 
          NOCURBUF = FALSE; 
          END                # ALLOCATE ANOTHER BUFFER                 #
  
        END                  # CHANGE OUTPUT BUFFERS                   #
  
      IF NOT FLUSHBUF 
      THEN
        BEGIN                # TRANSFER ONE LINE TO BUFFER             #
        P<BUFFER> = ADDRESS[CURBUFORD] + WORDS$USED + 1;
        LINE$EOL = 0;        # INSERT 12 BITS OF ZERO AS LINE TERMINATE#
        LINENR = LINENR + 1;
        MOVEBLK(WORDS$LINE,DATA$AREA,BUFFER); 
        MOVEBLK(WORDS$LINE,BLANK$AREA,DATA$AREA); 
        WORDS$USED = WORDS$USED + WORDS$LINE; 
        BYTES$USED = BYTES$USED + BYTES$LINE; 
        END                  # TRANSFER ONE LINE TO BUFFER             #
  
      RETURN; 
  
      END                    # LINEOUT                                 #
      CONTROL EJECT;
      PROC  DIS$EXIT; 
#                                                                    #
#   EFFORT IS MADE TO MOVE ALL PROC CALL -GETBUF- TO MAINLP IF IT    #
#   IS POSSIBLE. FOR THE CASE IT CANNOT BE DONE, -DIS- PROCESS       #
#   WILL BE TERMINATED WITHOUT RETRY IF BUFFER NOT AVAILABLE.        #
#                                                                    #
      BEGIN 
      MOVEBLK(WORDS$LINE,BLANK$AREA,DATA$AREA); 
      LINE$EOL = 0; 
      LINE$OFF ="DISPLAY TERMINATED DUE TO INSUFFICIENT BUFFERS"; 
      P<BUFFER> = ADDRESS[WMSGORD] + 1; 
      MOVEBLK(WORDS$LINE,DATA$AREA,BUFFER); 
      P<ABH> = ADDRESS[WMSGORD];
      ABH$TLC = 50; 
      ABH$ABT = 0;                               # INDICATE DATA MSG   #
      LINKBLOCK(LOC(TCB$OUTPUT),WMSGORD); 
      IF  TCB$JOBFLAG  OR  (TCB$QFLAGS NQ 0)
      THEN
        IF  QABBUF NQ 0 
        THEN
          BEGIN 
          RETTSB(QABBUF); 
          SETUPACN (ACN); 
          END 
      GOTO DIS$TERM;
      RETURN; 
      END 
        CONTROL EJECT;
      PROC EXTDIV$DIS;
  
# A CONSOLE HAS ASKED FOR A DISPLAY OF AN OUTPUT QUEUE THAT HAS BEEN   #
# DIVERTED TO ANOTHER TERMINAL OR TO THE HOST COMPUTER. THIS ROUTINE   #
# FINDS THE EXTENDED QAB THAT HAS BEEN DIVERTING THE QUEUE SO AS TO BE #
# ABLE TO INFORM THE USER OF THE DIVERT DESTINATION                    #
  
      BEGIN                  # EXTDIV$DIS                              #
  
      DEF K #K4#;            # CONTROL VARIABLE                        #
      DEF ACN #ACN1#;        # ACN TO SEARCH QAB CHAIN FOR             #
  
  
      ACN = TCB$ACN;
      FOUND = FALSE;
      X$MESS = "EXTENDED DIVERT TO";
  
      FOR CHAIN = 0 STEP 1 UNTIL 1 DO 
        BEGIN                # SEARCH ONE CHAIN                        #
  
        IF CHAIN EQ 0 
        THEN
          NEXT = QCB$EXTSUBF;# INITIALIZE FOR SUBMITTED-TO-QAC CHAIN   #
        ELSE
          NEXT = QCB$EXTTBSF;# INITIALIZE FOR TO-BE-SUBMITTED CHAIN    #
  
        FOR K = 0 WHILE NEXT NQ 0 DO     # SEARCH ONE CHAIN            #
          BEGIN              # LOOK AT ONE QAB                         #
          P<QAB> = ADDRESS[NEXT]; 
  
          IF QAB$ACN EQ ACN AND QAC$COQFLAGS LAN TCB$OQFLAGS NQ 0 
          AND NOT QAB$CANCEL
          THEN
            BEGIN            # CORRECT QAB                             #
            IF QAC$DVRTHOST 
            THEN
              X$DEST = "HOST";     # DIVERTED TO CENTRAL SITE HOST     #
            ELSE
              BEGIN                # DIVERTED TO OTHER TERMINAL        #
              X$DEST = "USER";
              X$USR = XSFW(QAB$NEWUSR); 
              X$SLASH = "/";
              X$FAM = XSFW(QAB$NEWFAM); 
              END                  # DIVERTED TO OTHER TERMINAL        #
  
            ADDLINE;         # SEND DIVERT-MESSAGE TO OUTPUT           #
            RETURN; 
            END              # CORRECT QAB                             #
  
          NEXT = QAB$NEXT;
          END                # LOOK AT ONE QAB                         #
  
        END                  # SEARCH ONE CHAIN                        #
  
      RETURN; 
      END                    # EXTDIV$DIS                              #
      CONTROL EJECT;
      PROC DEV$DIS; 
  
# THIS ROUTINE CREATES THE REMOTE BATCH DEVICE STATUS DISPLAY FROM A   #
# USER-S TCB AND THE DCB/UCB AND ACN$TABLE ENTRY ASSOCIATED WITH A     #
# PARTICULAR RBF DEVICE                                                #
  
      BEGIN                  # DEV$DIS                                 #
  
      ITEM TEMP U;
      ITEM TT I;             # TEMPORARY CELL TO HOLD POCKET           #
      DEF ACN #ACN2#;        # ACN OF CURRENT RBF DEVICE LINE          #
      DEF K #K5#;            # CONTROL VARIABLE                        #
  
      ARRAY POCKETS[1:4] S(1);     # ARRAY FOR SORTING ON DEV TYPE/ORD #
        BEGIN 
        ITEM POCKET    I(0,0,60); 
        ITEM CPOCKET   C(0,0,10); 
        END 
  
      ARRAY MISC[1:14] S(1); # MISCELLANEOUS NAMES                     #
        BEGIN 
        ITEM DEVICE$NAME C(0,42,3) =   ["CR","LP","CP","PL"]; 
        ITEM OPT$NAME    C(0,42,3) =   [,,,," ","BAN","FMT","B/F","ACK",
                                       "A/B","A/F","ALL"];
        END                  # MISCELLANEOUS NAMES                     #
  
  
# SORT BATCH DEVICE ENTRIES OF TCB BY DEVICE-TYPE (MAJOR) AND DEVICE   #
# ORDINAL (MINOR)                                                      #
  
      FOR K = 1 STEP 1 UNTIL 4 DO 
        POCKET[K] = 0;
  
      FOR K = 1 STEP 1 UNTIL TCB$NDEVICE DO 
        C<TCB$ORD[K] - 1>CPOCKET[TCB$DEVDT[K]] = K; 
  
  
# PICK-UP THE ORDERED DEVICE ENTRY INDICES, ONE-BY-ONE, AND EXPAND     #
# THE ASSOCIATED DEVICE ENTRY INTO ONE DISPLAY LINE                    #
  
      FOR DTYPE = 1 STEP 1 UNTIL 4 DO 
        BEGIN                # DEAL WITH DEVICE TYPES ONE-BY-ONE       #
        TT = POCKET[DTYPE]; 
  
        IF TT EQ 0
        THEN
          TEST DTYPE;        # NO DEVICES OF THIS TYPE                 #
  
        FOR K = 0 STEP 1 UNTIL 6 DO 
          BEGIN              # DEAL WITH ORDINALS OF DEVICE-TYPE DTYPE #
          KK = C<K>TT;
  
          IF KK EQ 0
          THEN
            TEST K;          # NO DEVICE WITH THIS ORDINAL             #
  
          D$EQ = DEVICE$NAME[DTYPE];     # DEVICE (CR,LP, ...)         #
          D$ORD = DISPLAY$ZERO + K + 1;  # AND ITS ORDINAL (1-7)       #
          ACN = TCB$DEVACN[KK]; 
  
          IF DTYPE EQ DEVICETYPE"CARD$READER" 
          THEN
            BEGIN            # HANDLE CR(K+1)                          #
            P<UCB> = ADDRESS[ACN$CB[ACN]];   # UPLINE CONTROL BLOCK    #
            D$STATUS = STATE$UCM [ACN$MODE [ACN]];
            IF UCB$BUFSIZE GR 3 
            THEN
              D$NAME = XSFW(UCB$JOBNAME);    # ACTIVE FILE - FILE NAME #
  
            IF TCB$ACKFLAG[KK]
            THEN
              D$OPT = "ACK";
            END              # HANDLE CR(K+1)                          #
  
          ELSE
  
            BEGIN            # HANDLE LP(K+1), CP(K+1), OR PL(K+1)     #
            P<DCB> = ADDRESS[ACN$CB[ACN]]; # DOWNLINE CONTROL BLOCK    #
            D$STATUS = STATE$DCM [ACN$MODE [ACN]];
            IF DCB$FILEACT
            THEN
              BEGIN 
              D$NAME = XSFW(DCB$FETLFN);
              XCONVERT = XCDD (DCB$EOIPRU);         # INSERT FILE SIZE #
              D$FS     = C<4,6>XCONVERT;
              IF TCB$REPEAT[KK] GQ 0
              THEN                               # POSITIVE REPEAT     #
                BEGIN 
                XCONVERT = XCDD ( TCB$REPEAT [KK]); 
                D$REP    = C< 8,2 >XCONVERT;     # INSERT REPEAT COUNT #
                END 
              ELSE                               # REPEAT LESS THAN 0  #
                BEGIN 
                D$REP  = " 0";                   # DISPLAY AS ZERO.    #
                END 
              END            # OUTPUT FILE ACTIVE                      #
  
            IF TCB$FORMS[KK] NQ 0  # LP(K+1) ... (CONTINUED)           #
            THEN
              D$FMS = TCB$FORMS[KK];
  
            D$OPT = OPT$NAME[TCB$OPT[KK]+5];
  
            IF DTYPE EQ DEVICETYPE"LINE$PRINTER"
            THEN
              BEGIN 
              D$SLASH = "/";
              XCONVERT = XCDD(TCB$CURWIDTH[KK]+50); 
              D$WID = C<7,3>XCONVERT; 
              D$TR = C<TCB$TRAIN [KK]* 2, 2>TR$TYPE;
              END 
            IF DTYPE EQ DEVICETYPE"PLOTTER" 
            THEN
              BEGIN 
              D$TR = C<(TCB$TRAIN [KK] + 3)*2, 2>TR$TYPE; 
              D$SLASH = "/";
              END 
  
            XCONVERT = XCDD (TCB$DEVBSZ [KK]);
            D$SIZ = C<6,4>XCONVERT; 
                                                 # INSERT BLOCK SIZE   #
            END              # HANDLE LP(K+1) ...                      #
          ADDLINE;           # SEND GENERATED LINE TO OUTPUT           #
          CONTROL EJECT;
          IF TCB$PM [ KK ]   # IS THERE A PM MESSAGE (LP-S ONLY)...    #
          THEN
            BEGIN                # THIS TEST SHOULD ALWAYS PASS WHEN-  #
            IF DCB$PMTXT NQ ZERO # EVER TCB$PM IS SET.                 #
            AND DTYPE EQ DEVICETYPE"LINE$PRINTER" 
            THEN
              BEGIN          # DISPLAY PM MESSAGE TEXT                 #
              P<PM$TXT> = ADDRESS[DCB$PMTXT]; 
              IF ( DCB$PMSIZE - 6 ) GQ 48 
              THEN           # ONLY THE FIRST 47 CHARACTERS OF THE PM  #
                BEGIN        # CAN BE DISPLAYED (DIS LIMITATION).      #
                LINE$OFF = C<6,47>PM$MSG; 
                END 
              ELSE           # THE ENTIRE PM MESSAGE CAN BE DISPLAYED. #
                BEGIN 
                LINE$OFF = C<6,( DCB$PMSIZE - 6 )>PM$MSG; 
                END 
              ADDLINE;
              END            # DISPLAY PM MESSAGE TEXT                 #
            END 
          ELSE               # NO PM MESSAGE, CHECK OTHER BITS IN      #
            BEGIN            # TCB$ERRORS, DISPLAY APPROPRIATE MESSAGE #
            FOR JJ = 1 STEP 1 UNTIL MAXDEVERRS
            DO
              BEGIN          # DEVICE ERRORS...                        #
              IF B<JJ-1>TCB$ERRORS [KK] EQ 1
              THEN           # IF A BIT IS SET THEN DISPLAY MESSAGE,   #
                BEGIN        # (ONLY 1 BIT SHOULD BE SET AT A TIME).   #
                LINE$OFF = DEVERR[JJ];
                ADDLINE;     # INSERT ERROR-MESSAGE IN LINE            #
                END 
              END            # DEVICES ERRORS...                       #
            END 
  
          END                # DEAL WITH ORDINALS OF DEVICE-TYPE DTYPE #
  
        END                  # DEAL WITH DEVICE TYPES ONE-BY-ONE       #
  
      IF NOCURBUF 
      THEN
        BEGIN                # NO BATCH DEVICES                        #
        LINE$OFF = "NO DEVICES";
        ADDLINE;
        END                  # NO BATCH DEVICES                        #
  
  
      IF TCB$DIVFLAGS NQ 0
      THEN
        BEGIN                # GLOBAL LINE - EXTENDED DIVERT           #
        ADDLINE;                   # SPACE                             #
        LINE$OFF = "EXTENDED DIVERT IN EFFECT"; 
        ADDLINE;
        END                  # GLOBAL LINE ...                         #
  
      IF IDLESHUTDOWN 
      THEN
        BEGIN                # GLOBAL LINE - SHUT DOWN                 #
        ADDLINE;                   # SPACE                             #
        LINE$OFF = "RBF SHUTTING DOWN"; 
        ADDLINE;
        END                  # GLOBAL LINE ...                         #
  
      RETURN;                # EXIT DEV$DIS                            #
      END                    # DEV$DIS                                 #
      CONTROL EJECT;
      PROC QUEUE$DIS(QABORD$K); 
  
# THIS ROUTINE TRANSFORMS QAC "PEEK" REPLIES (CONTAINING INFORMATION   #
# ABOUT AN RBF JOB/FILE QUEUE) INTO LINES THAT WILL BE PLACED IN       #
# A DISPLAY BUFFER                                                     #
  
      BEGIN                  # QUEUE$DIS                               #
  
      ITEM REPLIES I;        # NR OF "PEEKS" IN QAC REPLY BUFFER       #
      ITEM QABORD$K I;       # INDEX (0-4) INTO ARRAY OF TSB ORDINALS  #
                             # OF QAB BUFFERS - INDEX IS TO CURRENT QAB#
      ITEM J I;              # CONTROL VARIABLE                        #
# 
      SWITCH USED FOR PROCESSING QAC PEEK FUNCTION REPLY CODE WORDS 
# 
      SWITCH REPLYSWITCH  NORESP,RC1,RC2,RC3,BADRC,BADRC,BADRC,BADRC, 
                          BADRC,RC9,RC10,BADRC,RC12,RC13,BADRC,BADRC, 
                          BADRC,RC17,BADRC,BADRC,RC20,BADRC;
CONTROL EJECT;
  
  
      P<QAB> = BUFINFO(A$QABORD[QABORD$K]); 
      P<QREPLY> =   QAC$REPLY  ;           # FWA OF REPLY BUFFER       #
  
# UNPACK QAB COUNT-FIELDS INTO AN ARRAY                                #
  
      COUNT[QTYPE"EXECUTE"] = QAC$JOBCNT; 
      COUNT[QTYPE"INPUT"  ] = QAC$INPCNT; 
      COUNT[QTYPE"PRINT"  ] = QAC$PRTCNT; 
      COUNT[QTYPE"PUNCH"  ] = QAC$PCHCNT; 
      COUNT[QTYPE"PLOT"   ] = QAC$SPCCNT; 
  
      Q$TYPE = C<QAC$CFLAGS>FLAG$QTYPE ;
  
      REPLIES = COUNT[Q$TYPE];
  
      IF QAC$ERROR EQ S"NOFILE" 
      THEN
        REPLIES = 0;
      ELSE
        EMPTYDISPLAY = FALSE;# AT LEAST ONE JOB/FILE FOUND             #
  
  
      IF TCB$REFRESH AND NOT TCB$JOBFLAG AND REPLIES GR 2 
      AND REPLIES EQ NRQACREQS
      THEN
        BEGIN                # WARN USER - MORE IN QUEUE               #
        REPLIES = REPLIES - 2;
        TCB$MOREINQ = TRUE; 
        END                  # WARN USER ...                           #
  
      FOR J = 1 STEP 1 UNTIL REPLIES DO 
          BEGIN              # PROCESS ONE QAC "PEEK" REPLY ENTRY      #
  
# 
        PICK UP ALL REPLY WORDS 
# 
        FOR REPLYWD = 0 STEP 1 UNTIL QAC$ENTLGTH[0] - 1 
        DO
          BEGIN 
          IF QREPLYCODE[REPLYWD] GR MAXRCP1 
          THEN                # UNEXPECTED REPLY CODE WORD RETURNED    #
            BEGIN 
            QREPLYCODE[REPLYWD] = MAXRCP1;
            END 
  
          GOTO REPLYSWITCH[QREPLYCODE[REPLYWD]];
  
 BADRC:                        # UNEXPECTED REPLY CODE WORD RETURNED   #
          MESSAGE(BADQACREPLY,DFLOPT);
          $BEGIN
          ABORT;
          $END
          GOTO ENDRC; 
  
 NORESP:                     # NO INFORMATION AVAILABLE FOR THIS CODE  #
          GOTO ENDRC; 
  
 RC1:                         # JSN REPLY WORD                         #
          R$0[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC2:                         # FC,DC,EC,IC REPLY WORD                 #
          R$1[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC3:                         # PRIORITY REPLY WORD                    #
          R$2[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC9:                         # USER JOB NAME REPLY WORD               #
          R$3[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC10:                        # REPEAT COUNT REPLY WORD                #
          R$4[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC12:                        # FILE SIZE REPLY WORD                   #
          R$5[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC13:                        # EJT STATUS REPLY WORD                  #
          R$6[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC17:                        # SRU ACCUMULATED                        #
          R$7[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 RC20:                        # DESTINATION LOGICAL ID REPLY WORD      #
          R$8[0] = QREPLYW[REPLYWD];
          GOTO ENDRC; 
  
 ENDRC: 
          END 
        P<QREPLY> = P<QREPLY> + QAC$ENTLGTH[0]; 
  
          LASTORD = R$ORD;         #SAVE CURRENT ORD AT LAST# 
  
          IF TCB$JOBFLAG
          THEN
            Q$NAME = QNAME[Q$TYPE];# JOB/FILE DISPLAY - QUEUE NAME     #
          ELSE
            BEGIN 
            Q$NAME = R$NAME;       # INPUT/EXECUTE/OUTPUT QUEUE DISPLAY#
            END 
  
          XCONVERT = XCOD(R$PRI);  # INSERT JOB/FILE PRIORITY          #
          Q$PRI = C<3,7>XCONVERT; 
  
        IF QAC$COQFLAGS NQ 0
          THEN
            BEGIN            # "PEEK" REPLY FROM ONE OF OUTPUT FILES   #
  
  
            XCONVERT = XCDD(R$FS); # INSERT FILE-SIZE                  #
            Q$FS = C<3,7>XCONVERT;
  
            IF R$FMS NQ 0 
            THEN
              Q$FMS = R$FMS;       # INSERT FORMS CODE                 #
  
        IF QAC$CFLAGS EQ QAC$SPQUEUE
            THEN                                 # PLOT FILE EC        #
              BEGIN 
              Q$EC = ECPLOT [R$EC]; 
              END 
        IF QAC$CFLAGS EQ QAC$PUQUEUE
            THEN
              BEGIN                              # PUNCH FILE EC       #
              Q$EC = ECPUNCH [R$EC];
              END 
        IF QAC$CFLAGS EQ QAC$PRQUEUE
            THEN                                 # PRINT FILE EC       #
              BEGIN 
              Q$EC = ECPRINT [R$EC];
              END 
            Q$SLASH = "/";
            IF R$REP GQ 0 
            THEN                                 # POSITIVE REPEAT     #
              BEGIN 
              XCONVERT = XCDD (R$REP);           # INSERT REPEAT COUNT #
              Q$REP = C<7,3>XCONVERT; 
              END 
            ELSE                                 # REPEAT LESS THAN 0  #
              BEGIN 
              Q$REP = "  0";                     # DISPLAY AS ZERO     #
              END 
            END              # "PEEK" REPLY FROM ONE OF OUTPUT FILES   #
        IF QAC$CINFLAG[0] 
        THEN               # SELECTED INPUT QUEUE SCAN                 #
          IF R$DLID[0] EQ 0 
              THEN
                Q$DLID[0] = O"555555";
              ELSE
                Q$DLID[0] = R$DLID[0];      # DISPLAY DESTINATION LID  #
  
        IF QAC$CEXFLAG
          THEN
            BEGIN            # "PEEK" REPLY FROM EXECUTING-JOB QUEUE   #
            XCONVERT = XCOD(O"100" * R$FL); # INSERT FIELD-LENGTH      #
            Q$FL = C<3,7>XCONVERT;
            XCONVERT = XCOD(R$SRU);      # INSERT SYS. RES. UNITS      #
            Q$SRU = C<3,7>XCONVERT; 
            Q$STATUS = "WAIT";           # INSERT CURRENT STATUS -     #
                                         #  EXECUTING/WAITING          #
  
            IF R$STATUS EQ EXECUTING
            THEN
              Q$STATUS = "EX";
  
            END              # "PEEK" REPLY FROM EXECUTING JOB QUEUE   #
  
          ADDLINE;           # SEND DISPLAY LINE TO OUTPUT BLOCK       #
          END                # PROCESS ONE QAC "PEEK" REPLY ENTRY      #
  
      LASTQACCALL = REPLIES EQ 0 OR TCB$REFRESH;
  
EXIT: 
      RETURN; 
      END                    # QUEUE$DIS                               #
      CONTROL EJECT;
# BEGIN MAIN LOOP CODE                                                 #
  
  
      IF TCB$PL GQ 7
      THEN
        BEGIN                # TERMINAL THAT CAN BE "PAGED"            #
  
        IF TCB$REFRESH AND TCB$PAGEWAIT OR NOT TCB$REFRESH AND NOT
          TCB$PAGEWAIT
        THEN
          BEGIN              # NEED TO TURN PAGEWAIT "ON" OR "OFF"     #
DISGETBSN:  
          BSN = GETBSN; 
  
          IF BSN EQ 0 
          THEN
            BEGIN            # NEED TO WAIT FOR BSN                    #
            EVENT (CHAINS"BACKGROUND");          # LINK TO BACK GROUND #
            GOTO DISGETBSN;                      # CHAIN               #
            END              # NEED TO WAIT FOR BSN                    #
  
          IF TCB$REFRESH
          THEN
            BEGIN            # SET-UP PAGEWAIT "OFF"                   #
            TCB$PAGEWAIT = FALSE; 
            PAGEWAIT = PAGEWAITOFF; 
            END              # SET-UP PAGEWAIT "OFF"                   #
  
          ELSE
  
            BEGIN            # SET-UP PAGEWAIT "ON"                    #
            TCB$PAGEWAIT = TRUE;
            PAGEWAIT = PAGEWAITON;
            END              # SET-UP PAGEWAIT "ON"                    #
  
          SENDSM(CTRDEF,6,ACCTRL,BSN,PAGEWAIT); 
  
          END                # NEED TO TURN PAGEWAIT "ON"/"OFF"        #
  
        END                  # TERMINAL THAT CAN BE "PAGED"            #
  
  
  
# CREATE THE DISPLAY INDICATED BY TCB FLAGS                            #
  
  
      TCB$ANNEXORD = GETBUF(3,NOT$MOVEABLE);
      FOR Y=Y WHILE TCB$ANNEXORD EQ 0 DO
        BEGIN 
        EVENT(CHAINS"BACKGROUND");
        TCB$ANNEXORD = GETBUF(3,NOT$MOVEABLE);
        END 
      P<TCB$ANNEX> = ADDRESS[TCB$ANNEXORD]; 
      WMSGORD = GETBUF(6,MOVEABLE); 
      FOR Y = Y WHILE WMSGORD EQ 0 DO 
        BEGIN 
        EVENT(CHAINS"BACKGROUND");
        P<TCB$ANNEX> = ADDRESS[TCB$ANNEXORD]; 
        WMSGORD = GETBUF(6,MOVEABLE); 
        END 
      NOCURBUF = TRUE;
      BYTES$USED = 0; 
      WORDS$USED = 0; 
      TITLESENT = FALSE;
      LASTQACCALL = FALSE;
      LASTORD = 0;                     #START QAC AT ORDINAL 0# 
      TCB$MOREINQ = FALSE;
      INITIALIZE; 
      CURBUFORD = GETBUF(WORDS$BUF,MOVEABLE); 
      FOR Y = Y WHILE CURBUFORD EQ  0 DO
        BEGIN 
        EVENT(CHAINS"BACKGROUND");
        INITIALIZE; 
        CURBUFORD = GETBUF(WORDS$BUF,MOVEABLE); 
        END 
      EMPTYDISPLAY = TRUE;
      LINENR = PAGELEN + 1;  # FORCE PAGE BOUNDARY                     #
  
      IF TCB$DEVFLAG
      THEN
        BEGIN 
        DEV$DIS;                       # CREAT DEVICE DISPLAY          #
        END 
  
      IF TCB$JOBFLAG
      THEN
        BEGIN                # CREATE JOB-FILE DISPLAY                 #
        QABBUF = GETBUF(60+BLOCK$PEEK+2,NOT$MOVEABLE);
        FOR Y = Y WHILE QABBUF EQ 0 DO
          BEGIN 
          EVENT(CHAINS"BACKGROUND");
          P<TCB$ANNEX> = ADDRESS[TCB$ANNEXORD]; 
          QABBUF = GETBUF(60+BLOCK$PEEK+2,NOT$MOVEABLE);
          END 
        FOR K = 0 STEP 1 UNTIL 4 DO 
          BEGIN              # CREATE ONE QAC PARAMETER BLOCK ("PEEK") #
          TCB$QFLAGS = QFLAGS[K];  # SET QUEUE FLAGS ONE BY ONE        #
          A$QABORD[K] = QABBUF; 
          LASTORD = 0;       # START FROM BEGINNING FOR EACH QUEUE     #
          BUILDQAB(K,1);           # NEED ONLY ONE FILE OF EACH TYPE   #
          QINDEX  = K;
          EVENT(LOC(DONE)); 
          INITIALIZE; 
          K = QINDEX; 
          A$QABORD[K] = QABBUF; 
          QUEUE$DIS(K); 
          END 
        TCB$QFLAGS = 0; 
        RETTSB(QABBUF); 
        SETUPACN (ACN); 
  
  
        IF EMPTYDISPLAY 
        THEN
          BEGIN              # NO FILES                                #
  
          LINE$OFF = "NO FILES FOUND";
          ADDLINE;
          END                # NO FILES                                #
  
        END                  # CREATE JOB-FILE DISPLAY                 #
  
  
  
      IF TCB$QFLAGS NQ 0 AND TCB$OQFLAGS LAN TCB$EXTDIVS EQ 0 
      THEN
        BEGIN                # PROCESS REQUESTS FOR ONE QUEUE DISPLAY  #
  
        QABBUF = GETBUF(NR$PEEK+BLOCK$PEEK+2,NOT$MOVEABLE); 
        FOR Y = Y WHILE QABBUF EQ 0 DO
          BEGIN 
          EVENT(CHAINS"BACKGROUND");
          P<TCB$ANNEX> = ADDRESS[TCB$ANNEXORD]; 
          QABBUF = GETBUF(NR$PEEK+BLOCK$PEEK+2,NOT$MOVEABLE); 
          END 
NEWQACCALL: 
        A$QABORD[0] = QABBUF; 
  
        BUILDQAB(0,NRQACREQS);           # MAKE PP ROUTINE SCAN "FNT-  #
  
        EVENT(LOC(DONE));    # CONTROL RETURNS WHEN REPLIES ARE AVAIABL#
  
        INITIALIZE; 
        A$QABORD[0] = QABBUF; 
        QUEUE$DIS(0); 
  
        IF NOT LASTQACCALL
        THEN
          GOTO NEWQACCALL;
  
        IF EMPTYDISPLAY 
        THEN
          BEGIN              # NO FILES FROM QAC                       #
          LINE$OFF = "QUEUE EMPTY"; 
          ADDLINE;
          END                # NO FILES ...                            #
        RETTSB(QABBUF); 
        SETUPACN (ACN); 
  
        END                  # PROCESS REQUEST FOR ONE QUEUE DISPLAY   #
  
  
      IF TCB$OQFLAGS LAN TCB$EXTDIVS NQ 0 
      THEN
        EXTDIV$DIS;          # DISPLAY OF QUEUE ON EXTENDED DIVERT     #
  
      IF TCB$MOREINQ
      THEN
        BEGIN                # DIS RFR UNABLE TO DISPLAY COMPLETE Q    #
        LINE$OFF = "MORE JOBS/FILES IN QUEUE";
        ADDLINE;
        TCB$MOREINQ = FALSE;
        END                  # DIS RFR UNABLE TO DISPLAY COMPLETE Q    #
  
      LINE$OFF = "*** END DISPLAY ***"; 
      ADDLINE;               # TERMINATE DISPLAY WITH END-MESSAGE      #
      FLUSHBUF = TRUE;
      ADDLINE;               # SEND OUT LAST BUFFER                    #
      RETTSB(WMSGORD);
      SETUPACN (ACN); 
  
DIS$TERM: 
      IF NOT TCB$REFRESH
      THEN
        TCB$DIS = 0;         # CLEAR DISPLAY BITS IN NON-RFR TCB       #
  
      RETTSB(TCB$ANNEXORD);  # RELEASE TCB ANNEX                       #
      SETUPACN (ACN); 
      TCB$ANNEXORD = 0;      # CLEAR POINTER                           #
      LINK (CHAINS"EXT$CMD", NOEVENT);           # RETURN TO EXT$CMD   #
      GOTO CALLRTN; 
  
      END                    # DIS                                     #
TERM; 
