*
*  FOR MINICOC, USE THE FOLLOWING TWO UPDATE LINES (WITHOUT THE *'S).
*+0
*MINICOC SET      1
*
         PCC      0
         DEF      COC:
COC:     EQU      %
         TITLE    'C O M M E N T A R Y   S Y M B O L S'
********************************************************************************
*
*  COMMENTARY PREFIXES:
*
*  SYMBOL         MEANING
*
*  L/             'LOAD'
*  S/             'STORE'
*  X/             'EXCHANGE'
*  XVALUE         'MULTIPLY BY (VALUE)'
*  &              'AND' (LOGICAL OPERATION)
*  G/             'GET'
*  C/             'COMPARE'
*  W/             'WITH'
*  B/             'BRANCH IF' OR 'BRANCH AND'
*  0/             'ZERO (CLEAR)' OR 'IF ZERO, THEN'
*  NZ/            'IF NON-ZERO, THEN'
*  +              'ADD' OR 'IF POSITIVE, THEN'
*  -              'SUBTRACT' OR 'IF NEGATIVE, THEN'
*  M/             'MULTIPLY BY' OR 'MOVE'
*  /              'DIVIDE' OR 'DIVIDE BY'
*  LJ/            'LEFT JUSTIFY'
*  RJ/            'RIGHT JUSTIFY'
*  MNEMONIC       LITERAL
*  VALUE/         'IF (VALUE), THEN'
*
********************************************************************************
         TITLE    'A S S E M B L Y   F L A G S'
*  ASSEMBLY PARAMETERS
*
         DO1      TCOR(S:FR,MINICOC)
MINICOC  SET      0                 IF MINICOC IS UNDEFINED, SET TO 0
*
C:140    SET      140               MAX MESSAGE SIZE FOR RD & WR REQUESTS
RCVRCHK  SET      0                 1/CHECK RECEIVERS DURING COC INIT
COCPCP   SET      MINICOC=0         1/PROVIDE PAGE HEADING CODE
2741CODE SET      MINICOC=0         1/PROVIDE 2741 CAPABILITY
PMONOFF  SET      MINICOC=0         1/PROVIDE PERFORMANCE MONITORING
*
*  THE FOLLOWING TWO ASSEMBLY FLAGS CONTROL THE GENERATION OF THE
*  INTEGRITY CHECKING OF THE ENTIRE FREE COC BUFFER POOL ON EACH
*  GET/RELEASE OPERATION.
*
COCGBUG  SET      1-MINICOC         1/GEN CODE FOR GET BUF CHECKING
COCPBUG  SET      1-MINICOC         1/GEN CODE FOR PUT BUF CHECKING
*
*  THE FOLLOWING TWO ASSEMBLY FLAGS CONTROL THE EXECUTION OF THE
*  INTEGRITY CHECKING OF THE COC BUFFER POOL.
*  *  INTEGRITY CHECKING WILL BE DONE IF ALL OF THE FOLLOWING ARE TRUE:
*     1  COCGBUG IS SET TO 1 (FOR GET BUF OPERATIONS) OR COCPBUG
*        IS SET TO 1 (FOR RELEASE OPERATIONS).
*     2  COCGBUGE IS SET TO 1 AND SENSE SWITCH 4 IS UP (FOR GET BUF
*        OPERATIONS) OR COCPBUGE IS SET TO 1 AND SENSE SWITCH 4 IS UP
*        (FOR RELEASE OPERATIONS).
*  *  THE DEFAULT ASSEMBLY YIELDS GENERATION OF THE CODE, BUT WITH
*     THE CODE BYPASSED WITH A BRANCH AT THE POINT WHERE THE SENSE
*     SWITCH WOULD BE CHECKED.  THE CODE CAN BE TURNED ON BY REPLACING
*     (THRU PATCHING) THE BRANCHES AT GETBR AND PUTBR WITH 'RD,0 0'
*     INSTRUCTIONS.
*
COCGBUGE SET      0                 1/EXECUTE GET BUF CHECKING
COCPBUGE SET      0                 1/EXECUTE PUT BUF CHECKING
SECTB    SET      0                 SET TO 1 FOR SECTIONING ECHO GO TO'S
2741ARUB SET      0                 SET TO 1 FOR UC BS RUB CODE
CNM      SET      1                 SET TO 1 FOR LONDON HOSP SYST.
         DO       CNM
COC:SPECHAR EQU   X'88'
DCB:ECB  EQU      9
BATAB    EQU      4*15
BARNDV   EQU      4*5+2
RD:ERRCODE EQU    X'E'
WT:ERRCODE EQU    X'F'
         FIN
*
         DEF      COCASMFL          COC ASSEMBLY FLAGS
COCASMFL EQU      (;
                  CNM**11+;
                  COCGBUGE**10+;
                  COCPBUGE**9+;
                  MINICOC**8+;
                  RCVRCHK**7+;
                  COCPCP**6+;
                  2741CODE**5+;
                  PMONOFF**4+;
                  COCGBUG**3+;
                  COCPBUG**2+;
                  SECTB**1+;
                  2741ARUB;
                  )**16+END-COC
         TITLE    'C O M M A N D   D E F I N I T I O N S'
         SYSTEM   UTS
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
*
:WD      CNAME
         PROC
FC       SET      SCOR(AF(1),DISARM,ARM%ENABLE,ARM%DISABLE,ENABLE,;
                  DISABLE,ENABLE%DISABLE,TRIGGER)
         ERROR,3,FC=0[AF(2)>X'F'[AFA(2)    'ILLEGAL AF'
LF       WD,CF(2) 1**12+FC**8+AF(2)
         PEND
*
         OPEN     PUSH,PULL
PUSH     CNAME    X'B',9
PULL     CNAME    X'A',8
         PROC
T        SET      S:S((NUM(CF)=2)*8+(NUM(AF)>1)*4+(NUM(AF)>0)*2+;
   (NUM(AF(1))>1),(0,16),,(AF(1),1),(AF(1,1),AF(1,2)-AF(1,1)+1),,,;
   (AF(2),AF(1)),,(CF(2),1),,(CF(2),AF(1)))
         ERROR,3,(T(1)=0)&(T(2)=0)    'ILLEGAL FORMAT'
T(2)     SET      S:S(T(2)<0,S:S(T(2)=16,T(2)),T(2)+16)
LF       DO1      T(2)~=1
         LCI      T(2)
         GEN,8,4,20    NAME((T(2)=1)+1),T(1),TSTACK
         PEND
*
INHIBIT  COM,32   X'6D000037'       INHIBIT
RINHIBIT COM,32   X'6D000027'       RESET INHIBITS
*
C:REG    CNAME                      PERFORM REG (REPORT EVENT, GIVE UP
         PROC                       .. CONTROL)
         DO       NUM(AF)=0
         BAL,R12  C:REG
         ELSE
         LI,R12   AF(1)
         B        C:REG
         FIN
         PEND
*
C:EN%DSABL    CNAME
         PROC
         BAL,R12  C:ENABLE%DISABLE  ENABLE COC INTS, CLEAR T:COCHC
         PEND                       .. LOCK-OUT, DISABLE COC INTS, SET
*                                   .. T:COCHC LOCK-OUT FLAG
         TITLE    'D E F S ,   S T A T I C   D A T A'
         DEF      COCCODE
         DEF      COC
         DEF      COCFLAG
*
*
*        CHARACTER ORIENTED COMMUNICATIONS (7611) HANDLER
COC,COCCODE   EQU    %
COCCODE  EQU      %
COCFLAG  EQU      1
         PCC      0
SCHPSD   :PSD     (IA,COCENABL),(WK,1)
DM8      DATA     0,X'FF'
DWB1B5   DATA     X'B1',X'B5'
LOWLET   DATA     X'81',X'A9'       LIMITS OF EBCDIC LOWER CASE LETTERS
HILET    DATA     'A','Z'           LIMITS FOR LOWER CASE SIMULATION
*
X38      DATA     X'38'
         TITLE    'D E F S   A N D   S T A T I C   D A T A'
*
         REF      COCBUF
         REF      COCHPB
         REF      COCIPC            INPUT PARITY ERROR COUNT
         REF      COCIPL            INPUT PARITY LINE NUMBER
         REF      COCOEC            OUTPUT EXTRANEOUS INTERRUPT COUNT
         REF      COCOEL            OUTPUT EXTRANEOUS INTERRUPT LINE
         REF      COCBLC
         REF      COCBLN
         REF      COCE
         REF      MODE
         REF      MODE2
         REF      COCOC
         REF      COCII,COCIR
         REF      COCOI,COCOR
         REF      COCTERM
         REF      CPOS,CPI
         REF      LB:UN
         REF      ARSZ
         REF      RSZ
         REF      BUFCNT
         REF      TL
         REF      EOMTIME
         REF      TIME
         REF      DATE
         REF      J:ACCN
         REF      J:INTER           COUNT # OF CONSOLE INTERACTIONS
         REF      RCVPSD
         REF      MASKS
         REF      HRBA              HIGHEST RELATIVE BUFFER ADDRESS
         REF      COCMESS           ADMINISTRATIVE MESSAGE
         DO1      CNM
         REF      ECBFRCHN          HEAD POINTER TO CHAIN OF ECBS
*                                   .. THAT WERE RELEASED AT THE
*                                   .. INTERRUPT LEVEL WHILE COC WAS
*                                   .. PROCESSING (LH OF CO:INTFL NOT 0)
         REF      MODE3
         DO       CNM
         REF      SW,E:WU
         REF      MODE5,COC:ECB
         REF      ECBGBLK,ECBFBLK
         REF      ECBPOST,YFFFF,J:BASE,S:CUN
         DEF      KILLIN
         REF      ECBPOST1
M12      EQU      MASKS+12
         FIN
         DEF      MODE4INIT
MODE4INIT EQU     COCBUF+4
         DO       2741CODE=1
         SREF      ESTD,ESTDLC,ESTDUC
         SREF      EAPL,EAPLLC,EAPLUC
         SREF      SSTD,SSTDLC,SSTDUC
         SREF      SAPL,SAPLLC,SAPLUC
         FIN
         REF      COH:DN            COC DEVICE ADR
         REF      CO:STAT           'SENSE RECEIVER L STATUS' WD
         REF      LCOC              INDEX TO LAST COC (# OF COCS - 1)
         REF      CO:IIL            INPUT INTERRUPT LEVEL SELECT BITS
         REF      CO:OIL            OUTPUT INTERRUPT LEVEL SELECT BITS
         REF      CO:INTFL,MODE4
         REF      CO:OUTRS,CO:RCVON,CO:XDATA,CO:XSTOP,CO:RINGE
         REF      COD:LPC,COH:RBS,CO:LST,CO:IN0,CO:OUT,COH:II
         REF      CO:CMND
         REF      COA:IG            COC EXTERNAL INTERRUPT GROUP #
         REF      CO:HIIL           HIGHEST PRIORITY INPUT INTERRUPT
*                                   .. LEVEL SELECT BIT
         REF      CO:AIL            ALL COC INTERRUPT LEVEL SELECT BITS
         REF      CO:XPSDI          XPSD INSTRUCTION FOR OTHER THAN THE
*                                   .. HIGHEST PRIORITY INPUT INT
         REF      COB:SIOS          SIO CC'S INDEXED BY COC#
         REF      COCM1
         DO1      RCVRCHK
         REF      COCM2
         REF      MSGOUT
         REF      IOQ14
         REF,1    Y00FE
         PAGE
         REF      STOB,STOBO
         REF      CO:RCVDOFF,COD:HWL
         DEF      COCIP
         DEF      COCOP
*                                                                          00350
* COC ROUTINE ENTRY POINTS                                                 00360
*                                                                          00370
         DEF      COCIO             ENTRY FOR DCB READS AND WRITES
         DEF      COCDSABL          DISABLE COC INTERRUPTS
         DEF      COCENABL          ENABLE COC INTERRUPTS
         DEF      COCSENDX          SEND 1 CHARACTER TO TERMINAL
         DEF      ECHOCR2           FOR BUMPING LINE COUNT IN LINE TABLE
         DEF      T:COCHC
         DEF      COCOFF
         DEF      COCINIT           INITIALIZATION ENTRY FOR COC; CALLED
*                                   ... FROM GHOST1D,PFSR, & CSECOM
         DEF      MODENO
         DEF      TTYIN             ASCII -> EBCDIC TRANSLATION TABLE
         DEF      TTYOUT            EBCDIC -> ASCII TRANSLATION TABLE
         DEF      COCITV            INPUT TRANSLATE TABLE POINTER
         DEF      COCOTV            OUTPUT TRANSLATION TABLE POINTER
*                                                                          00400
         REF      M:UC
         REF      UB:ACP            ASSOCIATED COMMAND PROCESSOR
         REF      P:NAME
         REF      TCLOGON           TEXTC 'LOGON'
*                                                                          00540
         DEF      X38
*                 ADD  TO  MONITOR  CONSTANT POOL
         REF      X1000001,X500000D,XFFF0
         REF      Y000A,Y6,Y7F
         REF      YBE
         REF      M3,M6,XFC,XFE,YFFFE,XF,XFFEF
         REF      Y01,Y02,Y03,Y8
EF       EQU      XFFEF
F7       EQU      WA(BA(TTYIN)+X'37')
C3C4     EQU      3                 CC'S 3 AND 4
BIT4T6   EQU      YBE
         REF      M2,M7,M16,M17
         REF      HEX               TEXT '0123456789ABCDEF'
*
SPACE    EQU      BA(TTYIN)+X'20'
SLASH    EQU      BA(TTYIN)+X'2F'
COLON    EQU      BA(TTYIN)+X'3A'
         REF      SL:TB             NUMBER OF CHARACTER AT WHICH TO BLOC
         REF      SL:UB             UNBLOCK LIMIT                          00680
         REF      SL:ONCB           MAX NO OF COC BUFFERS GIVEN A USER
         REF      SL:OITO,SL:OLTO
         REF      E:CEC             CONTROL E RECEIVED
         REF      E:CIC             INPUT COMPLETE
         REF      E:CBL             BLOCK
         REF      E:CRD             READ IN PROGRESS
         REF      E:CUB             RECORD UNBLOCK                         00730
         REF      E:CFB             CANT FIND BUFFER
         REF      E:CBK             BREAK RECEIVED
         REF      E:OFF             TERMINAL OFF EVENT
* JIT INFORMATION
         REF      J:JIT
         REF,1    JB:LC
         REF,1    JB:PCW
         REF,2    JH:PC
         REF,1    JB:LPP
         REF,1    JB:PROMPT
         REF      COCLN
* MONITOR SUBROUTINES                                                      00740
         REF      T:SSE             SCHEDULER                              00750
         REF      T:REG             REPORT EVENT                           00760
         REF      T:RCE             REPORT COC EVENT                       00770
         REF      UH:DL
         REF      E:CBA
         REF      T:RUE             REPORT USER EVENT
         REF      RMB
         REF      GMB
         REF      SETTYC
* MONITOR TABLES                                                           00810
         REF      UH:FLG            USER ASSOC. TABLE (FLAGS)
         REF      UH:FLG2
         REF      KICKOFF
         REF      UB:US
         DO       PMONOFF=1
* PERFORMANCE MEASUREMENT ITEMS & ROUTINES
         REF      C:CO
         REF      C:CI
         REF      C:CTW             COUNT OF TERMINAL WRITES
         REF      WTMSGSIZ
         REF      RDMSGSIZ
         REF      READREQ
         REF      CURNTIM
         FIN
         DO 2741CODE=1
STAR     DATA,2   X'FFFF'           ASTERISK CODES FOR KEYBOARD SELECT
         DATA,1   X'04'             EBCD - STANDARD
         DATA,1   X'79'             EBCD - APL
         DATA,1   X'38'             SELECTRIC - STANDARD
         DATA,1   X'0B'             SELECTRIC - APL
NOSTARS  EQU      BA(%)-BA(STAR)-1
         BOUND    4
         FIN
*
*                 INPUT AND OUTPUT  TRANSLATE TABLE VECTORS
COCITV   EQU      %
         DATA,2   TTYIN             M33
         DATA,2   TTYIN             M35
         DATA,2   TTYIN             M37
         DATA,2   TTYIN             XDS MODEL 7015
         DO 2741CODE=1
         DATA,2   ESTDLC            EBCD STANDARD LOWER CASE
         DATA,2   ESTDUC            EBCD STANDARD UPPER CASE
         DATA,2   EAPLLC            EBCD APL LOWER CASE
         DATA,2   EAPLUC            EBCD APL UPPER CASE
         DATA,2   SSTDLC            SELECTRIC STANDARD LOWER CASE
         DATA,2   SSTDUC            SELECTRIC STANDARD UPPER CASE
         DATA,2   SAPLLC            SELECTRIC APL LOWER CASE
         DATA,2   SAPLUC            SELECTRIC APL UPPER CASE
         FIN
         BOUND    4
*
*                 OUTPUT TABLES
*
COCOTV   EQU      %
         DATA,2   TTYOUT            M33
         DATA,2   TTYOUT            M35
         DATA,2   TTYOUT            M37
         DATA,2   TTYOUT            XDS MODEL 7015
         DO 2741CODE=1
         DATA,2   ESTD              EBCD STANDARD
         DATA,2   ESTD              EBCD STANDARD
         DATA,2   EAPL              EBCD APL
         DATA,2   EAPL              EBCD APL
         DATA,2   SSTD              SELECTRIC STANDARD
         DATA,2   SSTD              SELECTRIC STANDARD
         DATA,2   SAPL              SELECTRIC APL
         DATA,2   SAPL              SELECTRIC APL
         FIN
COCHTT   EQU      HA(%)-HA(COCOTV)-1     LARGEST VALID TERMINAL TYPE
         DEF      COCHTT
         BOUND    4                                                        02090
  TITLE    'S Y M B O L I C   C O N S T A N T   D E F I N I T I O N S'
R0       EQU      0                                                        02630
R1       EQU      1
R2       EQU      2                                                        02650
R3       EQU      3                                                        02660
R4       EQU      4                                                        02670
R5       EQU      5                                                        02680
R6       EQU      6                                                        02690
R7       EQU      7                                                        02700
R8,SR1   EQU      8
R9,SR2   EQU      9
R10,SR3  EQU      10
R11,SR4  EQU      11
R12,D1   EQU      12
R13,D2   EQU      13
R14,D3   EQU      14
R15,D4   EQU      15
         SPACE    3
BELL     EQU      X'07'             BELL CHAR; BUFFER EXHAUSTION WARNING
BS       EQU      X'08'             BACKSPACE CHARACTER
BSBS     EQU      X'46'             BACKSPACE THAT IMMEDIATELY FOLLOWS
*                                   .. ANOTHER BACKSPACE IN THE INPUT
*                                   .. BUFFERS
XON      EQU      X'11'             XON CHAR; START PAPER TAPE READER
XOFF     EQU      X'13'             XOFF CHAR; STOP PAPER TAPE READER
SYN      EQU      X'16'             SYN CHAR; IDLE, FOR 2741 TIMING
RUBOUT   EQU      X'FF'             RUBOUT CHAR; NON-2741 TIMING CHAR
         TITLE    'I N P U T   I N T E R R U P T   R O U T I N E'
* ROUTINE TO PROCESS INPUT CHARACTERS FROM COMMON INPUT RING BUFFER        04600
* AND MOVE EACH CHARACTER INTO PROPER LINE BUFFER                          04610
*
*  ENTER WITH INHIBITS OFF, REGISTER BLOCK 1.
*
COCIP    EQU      %                                                        04620
         MTB,-1   CO:INTFL          SET T:COCHC LOCK-OUT FLAG
         LI,R3    LCOC              SET COC 7611 NUMBER TO LAST COC
         DO       CNM
         LI,R1    0                 L/0; NEW HEAD POINTER
         XW,R1    ECBFRCHN          X/0 W/ECB FREED CHAIN HEAD POINTER
         BEZ      COCIP01           BEZ; NO ECBS TO TRANSFER TO COC
*                                   .. BUF POOL
         XW,R1    COCHPB            X/ECB ADR W/COC BUF HEAD POINTER
         LW,R2    COCHPB            L/ADR OF ECB CURRENTLY BEING
*                                   .. TRANSFERRED INTO COC BUF POOL
         XW,R1    COCBUF,R2         X/ADR OF OLD COC HEAD BUFFER W/WD 0
*                                   .. OF BUF BEING TRANSFERRED
         BNEZ     %-3               BNEZ; FLINK WASN'T 0, SO TRANSFER
*                                   .. NEXT BUFFER (ECB)
         FIN
*                                                                          04680
*                                                                          04690
COCIP01  EQU      %
         LW,R6    CO:LST,R3        RING POINTER (RELATIVE POSITION OF
*                                   CHARACTER IN RING BUFFER)
         LW,R4    CO:RINGE,R3       END OF RING BUFFER
         LH,D4    COH:DN,R3         COC DEVICE ADDR
         TIO,D4   *D4               TEST DEV.
         BCS,8    COCIP04
         BCR,4    COCIP04           B/SIO POSSIBLE; COC IS THERE, BUT
*                                   .. NOT RUNNING
         AND,D4   M16               MASK REMAIN BYTE CNT
         AW,D4    R6
         BNEZ     COCIP5
COCIP04  EQU      %
         AI,R3    -1                DECREMENT 7611 NUMBER
         BGEZ     COCIP01           PROCESS INPUT FROM NEXT 7611
         XW,R3    COCE              TURN OFF EVENT FLAG
         BGEZ     SCHDEXIT          BGEZ; EVENT WAS REPORTED; CHANGE REG
*                                   .. PNTR, SAVE ENVIRONMENT, ENABLE
*                                   .. COC INTERRUPTS, GO TO T:SSE
         MTB,1    CO:INTFL          RESET T:COCHC LOCK-OUT FLAG
         LPSD,11  CO:IN0            RETURN - ARM (CLEAR) INTERRUPT LEVEL
         PAGE
*                                                                          05030
*                                                                          05040
COCIP5   EQU      %
         LI,R7    COCIP512
         LB,R5    *R4,R6            L/CHARACTER FROM RING BUF
         AI,R6    1                 +1 TO RING BUFFER POINTER
         LB,R2    *R4,R6            L/LINE NUMBER FROM RING BUFFER
         BIR,R6   %+2               +1 TO RING BUF POINTER; B/NOT AT END
         LCH,R6   COH:RBS,R3        L/-(RING BUFFER SIZE); WRAP AROUND
         STW,R6   CO:LST,R3        UPDATE RING POINTER
*
*                 TEST FOR VALID LINE NUMBER
*
         LD,D3    COD:LPC,R3        1ST & LAST LOGICAL LINES FOR COC
         AW,R2    D3                R2 IS LOGICAL LINE OF TERMINAL
COCIP7   EQU      %
         LB,R4    COCTERM,R2
         LH,SR3   COCOTV,R4
         CW,R2    D4
         BLE      0,R7              BRCH IF VALID LOGICAL LINE
         AI,R2    -X'80'            REMOVE BREAK BIT
         LI,R7    COCIPBRK          SET R7 TO GO TO BREAK LOGIC
         CLM,R2   D3
         BCR,9    COCIP7            BRANCH IF BREAK FOR VALID LINE
*
*                 COUNT  INVALID  LINE INTERRUPTS
*
         MTW,1    COCBLC            COUNT INTERUPTS FROM INVALID LINES
         STW,R2   COCBLN            SAVE BAD LINE
         STB,R3   COCBLN            S/COC #
         B        COCIP01
*
         PAGE
*
*                 NORMAL CHAR PROCESSING - 2=LINE, 5= CHAR
*
COCIP512 EQU      %
         DO       PMONOFF=1
         MTW,1    C:CI              BUMP COUNT OF CHARACTERS INPUT
         FIN
         DO       CNM
         LC       MODE5,R2          SEE IF SLAVE & NOT ACTIVE
         BCR,8    %+2               NOT SLAVE
         BCR,2    COCIP01           BR IF NO DCB OPEN TO LINE
         FIN
         LC       MODE2,R2
         DO1      2741CODE
         BCS,1    COCIP6            2741
         BCS,8    COCIP01           IGNORE INPUT FROM DISCONNECTED LINE
         LC       MODE,R2
         BCS,2    COCIP55
         LB,R7    MODE2,R2
         CI,R7    4
         BAZ      COCIP51           DONT CHECK PARITY
         SCS,R5   32
         BEV      COCIP51           PARITY OK
COCIP54  EQU      %
         LI,R5    X'1A'             SUB(PARITY ERR)
         MTW,1    COCIPC            COUNT PARITY ERRORS
         STW,R2   COCIPL            SAVE LINE NUMBER
         STB,R3   COCIPL            S/COC #
COCIP55  EQU      %                 EBCDIC CHAR IN 5.
         LB,D1    MODE,R2
         AND,D1   XFC
         STB,D1   MODE,R2
COCIP9   EQU      %
         LI,D1    COCIP98
         LB,SR4   MODE3,R2          MODE3 FLAGS INTO SR4
         CI,SR4   X'8'
         LH,R4    COCII,R2          INSERTION POINT IN R4
         BANZ     COCIP99           BRANCH IF IN THE LOST DATA MODE
         BNEZ     COCIP91           ALREADY SOME INPUT
         LB,R6    LB:UN,R2          L/USER NUMBER; SEE IF ANY ASSOCIATED
         BEZ      COCIP01           BEZ; NO USER, DON'T BUFFER CHARS
         BAL,R6   COCGETB           GET A BUFFER
         B        COCIP96           BRANCH IF NONE AVAILABLE
         STH,R4   COCIR,R2          SET UP NEW BUF
         B        COCIP92
*
*
COCIP91  EQU      %
         AI,R4    1                 BUMP BUFFER POSITION
         CI,R4    X'F'
         BANZ     COCIP92           BRANCH IF ROOM IN BUFFER
*                 OBTAIN A BUFFER AND LINK TO THIS USER'S CHAIN
         LW,R7    R4                PUT LINK INTO R7
         BAL,R6   COCGETB           GET A BUFFER
         B        COCIP96-1         BRANCH IF NONE AVAILABLE
         SLS,R7   -1
         STH,R4   COCBUF-4,R7       LINK BUFFER TO CHAIN
*                 MOVE TRANSLATED INPUT CHARACTER INTO BUFFER
COCIP92  EQU      %
         STH,R4   COCII,R2          UPDATE INSERTION POINT
COCIP93  EQU      %
         STB,R5   COCBUF,R4         PUT CHARACTER IN BUFFER
*                 ECHO INPUT CHARACTER IF A READ IS PENDING
         LC       MODE,R2
         BCR,1    COCIP95
IP930    EQU      %
         LH,R0    COCIR,R2          HEAD OF INPUT FOR ECHO
         BAL,SR4  COCECHO
         B        COCIP95           NORMAL RETURN
*                 ACTIVATION RETURN, SET READ AHEAD.
         DO       CNM
COCIP93A LC       MODE5,R2
         BCR,8    COCIP94A          BR IF NOT SLAVE LINE
         BAL,11   GETECBRD          GET READ WAIT BLOCK
         BEZ      COCIP94A          NONE, USER IS REGED
         LW,10    2,7               GET WA(ECB)
         LB,8     LB:UN,R2          GET USER #
         LI,9     1
         LW,0     10                SET TYC IN READ WAIT BLOCK
         STB,9    0
         STW,0    2,7
         LB,R5    MODE5,R2
         OR,R5    X8                SET READ COMPLETE FLAG
         STB,R5   MODE5,R2
         SCS,9    -8
         BAL,11   ECBPOST           POST THE ECB
         LI,11    COCIP01
         LI,10    4
         STH,10   *7                PROPER CODE TO DOLIST BLOCK
         LW,10    7                 SET WA(4 WORD BLOCK)
PUTDOLIST2 LB,7   LB:UN,R2          GET USER NUMBER
         DEF      PUTDOLIST3
PUTDOLIST3 ANLZ,7 XXX               GET HA(CHAIN HEAD)
         B        WLDLCHN           CHAIN BLOCK TO UH:DL
XXX      LH,0     UH:DL,R7          USED IN ANLZ INSTR.
COCIP94A EQU      %
         FIN
         LI,R6    E:CIC             SET TO REPORT INPUT COMPLETE
COCIP94  EQU      %
         LW,R7    R2                LINE NUMBER INTO R7
         LW,SR2   R3                SAVE R3
         DO       CNM
         AI,6     0                 DON'T REPORT ZERO EVENTS
         BE       %+2
         FIN
         BAL,SR4  T:RCE             REPORT EVENT
         LW,R3    SR2               RESTORE R3
         STW,R6   COCE               SET EVENT FLAG
         B        COCIP01
*
COCIP95  EQU      %
         LB,D4    BUFCNT,R2         GET USER COC BUFFER COUNT
         CW,D4    SL:ONCB
         BL       COCIP01           BRANCH IF BUFFER LIMIT NOT REACHED
         LI,D1    COCIP01
         LI,R5    X'F'
         CS,R4    XF
         BNE      COCIP97           BRANCH IF BUFFER LIMIT NOT EXCEEDED
         LH,R4    COCII,R2
*                 USER BUFFER LIMIT EXCEEDED OR BUFFERS ARE UNAVAILABLE
COCIP96  EQU      %
         LB,SR4   MODE3,R2
         OR,SR4   X8                SET MODE BIT REFLECTING LOST DATA
         STB,SR4  MODE3,R2
*                 SEND 'BE'S TO ALARM THE TERMINAL USER
COCIP97  EQU      %
         BAL,R15  SENDXOFF          BAL/STOP PAPER TAPE READER
         LI,R1    BELL              L/BELL CHAR
         BAL,D4   CHKPTAP1          SEND BELL TO FRONT OF OUTPUT BUFFERS
         B        *D1
*                 OPERATING IN THE LOST DATA MODE
COCIP98  EQU      %
         LI,D1    COCIP01
         LC       MODE,R2
         BCR,1    IP980             BRANCH IF IN READ AHEAD MODE
         BAL,D4   SETACT1           SET ACTIVATION
         DO       CNM
         LI,D1    COCIP93A
         ELSE
         LI,D1    COCIP94-1
         FIN
IP980    EQU      %
         AI,R4    0
         BEZ      COCIP97           BRANCH IF NO INPUT BUFFERS EXIST
         LI,R5    X'BE'
         STB,R5   COCBUF,R4         GIVE BUFFER EXHAUSTION CHAR TO USER
         B        COCIP97
*                 INPUT RECEIVED WHILE LOST DATA MODE IS SET
COCIP99  EQU      %
         BEZ      COCIP97           DATA HAS BEEN LOST IF NO BUFFERS
         LB,D4    COCBUF,R4
         AI,D4    -X'BE'
         BEZ      COCIP01           BRANCH IF LOST DATA CHAR IN BUFFER
         LB,D4    BUFCNT,R2
         CW,D4    SL:ONCB
         BGE      COCIP97           BRANCH IF BUFFER LIMIT REACHED
         LI,SR2   COCIP91           NO LOST DATA, SET RETURN FOR CLEARLD
         B        CLEARLD           RESET LOST DATA AND CONTINUE
COCIP51  EQU      %
         AND,R5   M7                SCRUB PARITY
         CI,R5    X'7D'
         BL       COCIP56           BR IF NOT ALTMODE OR DEL CHAR
         CI,R5    X'7F'             C/CHAR W/.7F (RUBOUT)
         BE       COCIP53           BE; SET UP RUBOUT SEQUENCE
         CI,R4    2
         BE       COCIP56           NOT ALTMODE IF MODEL 37 TTY
COCIP53  EQU      %
         LB,R5    ALTMODES-X'1F',R5 ASCII ESCAPE IF ALTMODE CODE
COCIP56  EQU      %
         LH,R7    COCITV,R4
         LC       MODE,R2
         BCR,4    COCIP5F           BRANCH IF NO ESCAPE PENDING
         LB,D1    MODE,R2
         AI,D1    -X'40'            RESET ESC
         STB,D1   MODE,R2
         LB,R6    *R7,R5            TRANSLATE TO EBCDIC
COCIP59  EQU      %
         CLM,R6   LOWLET
         BCS,9    %+2
         AI,R6    X'40'             ADJUST LC
         LI,SR4   TTESCS
         LI,R4    NTTESCS           SET UP
         DO 2741CODE=1
         LC       MODE2,R2              TO CHECK
         BCR,1    %+3                        ESCAPE
         LI,SR4   27ESCS                          TABLE
         LI,R4    N27ESCS
         FIN
         CB,R6    *SR4,R4
         BE       COCIP5B           FOUND AN ESCAPE
         BDR,R4   %-2
         DO 2741CODE=1
         LC       MODE2,R2
         BCS,1    IP681             IGNORE 2741 EOT IF NOT AN ATTN SEQ
         FIN
COCIP5F  EQU      %
         LB,R5    *R7,R5            TRANSLATE
         BEZ      COCIP01           NULL = NOP
         LC       *SR3,R5
         BCR,8    COCIP55           NO SPEC FLAG
         LI,R7    -#IMCHR           L/# OF IMMEDIATE CHARACTERS
         CB,R5    IMCHR,R7
         BE       %+3
         BIR,R7   %-2
         B        COCIP55
         LB,R7    IMOFF,R7
         B        IMOFF,R7          GO TO IMMED PROC.
         SPACE    3
         DATA,3                     DUMMY ENTRIES
IMCHR1   EQU      %
         DATA,1   BS                BACKSPACE CHARACTER
         DATA     X'19303231'
#IMCHR   EQU      BA(%)-BA(IMCHR1)  # OF 'IMMEDIATE' CHARACTERS
         SPACE
IMCHR    EQU      %
         DATA,3                     DUMMY ENTRIES
         DATA,1   COCIBS-IMOFF      BACKSPACE CHARACTER
         DATA,1   COCIYC-IMOFF,COCIESC-IMOFF
         DATA,1   COCIXC-IMOFF,COCIRUB-IMOFF
IMOFF    EQU      %
         BOUND    4
         SPACE    3
COCIBS   LH,R7    COCII,R2          L/INPUT INSERTION POINTER
         BEZ      COCIP55           BEZ; NO INPUT BUFFERED
         LB,R7    COCBUF,R7         L/LAST CHARACTER BUFFERED
         CI,R7    BS                C/CHAR W/BACKSPACE CHAR
         BNE      COCIP55           BNE; THIS ISN'T CONTIGUOUS BS
         DO       2741CODE
         LC       MODE2,R2
         BCS,1    COCIP55           B/2741
         FIN
         LI,R5    BSBS              L/CONTIGUOUS BACKSPACE 'CHARACTER'
         B        COCIP55           B; BUFFER IT
         SPACE    3
COCIYC   EQU      %
         DO       CNM
         LC       MODE5,R2          IF SLAVE LINE, JUST PUT CHAR
         BCS,8    COCIP55           IN BUFFER.
         FIN
         LI,R7    1                 CONTROL Y EVENT
         STB,R7   CPI,R2            RESET INITIAL CARRIAGE POSITION
         LI,R7    E:CEC
BRKYC    EQU      %
         LB,R5    LB:UN,R2
         BNEZ     %+2               B/USER # NOT 0; LINE INITIALIZED
         BAL,R4   COCMINT           BAL/INITIALIZE LINE TABLES
         LC       MODE2,R2          LOGGING OFF
         BCS,8    COCIP01
         DO       2741CODE
********************************************************************************
*  IF 2741 BREAK RECEIVED (AS OPPOSED TO B-ATTN), DO THE FOLLOWING:
*  IF THIS IS A BREAK BEFORE THE TRANSLATE TABLE HAS BEEN IDENTIFIED,
*     TURN LINE AROUND, DO NOT REPORT THE BREAK EVENT; EXIT.
*  RELEASE OUTPUT BUFFERS.
*  IF OUTPUT EXISTS, DON'T REPORT THE FIRST BREAK, BUT
*     INCREMENT THE BREAK COUNT.
********************************************************************************
         BCR,1    BRKYC30           B/NOT 2741
         LB,R8    COCTERM,R2        L/COCTERM; SEE IF TRNS TBL IDENTIFIE
         BEZ      COCIP65E          BEZ; TURN LINE AROUND, DON'T REPORT
*                                   .. BREAK; THIS IS BREAK BEFORE
*                                   .. TRANSLATE TABLE IDENTIFIED
         LI,R8    ECHO1             L/RETURN ADR IF IGNORING EVENT
         LC       MODE,R2           L/EOA-PENDING FLAG
         BCS,4    BRKYC40           B/EOA PENDING; B-ATTN, NOT BREAK
         BAL,R8   COCIXC10          BAL/RELEASE INPUT AND OUTPUT BUFFERS
         LC       MODE,R2           L/READ PENDING FLAG
         BCR,1    %+2               B/NO READ PENDING; DON'T GIVE EOT
         BAL,R11  ECHO1             READ PENDING, GIVE EOT
         LB,R5    COCOC,R2          L/OUTPUT CHARACTER COUNT
         BEZ      BRKYC30           BEZ; NO OUTPUT EXISTED, REPORT
*                                   .. BREAK EVENT
         LB,R5    MODE,R2           L/BREAK COUNT
         CI,R5    2                 C/BREAK COUNT W/2
         BAZ      COCIP01           BAZ; BREAK COUNT < 2, DON'T
*                                   .. REPORT BREAK EVENT
BRKYC30  EQU      %
         LI,R8    COCIP01           L/RETURN ADR IF IGNORING EVENT
BRKYC40  EQU      %
         FIN
         BAL,D4   CCFLG811
         BCR,8    BRKYC1            NO TIC => NO PROBLEM
         CI,R7    E:CEC
         BE       IPCXY             IGNORE EC FOR COM PROC.
         AI,R6    -1                R6 SET UP BY CCFLG811.
         LC       UH:FLG2,R6
         BCR,4    IPCXY             IGNORE IF NO CP BRK CONT.
BRKYC1   EQU      %
         DO1      2741CODE
         LI,R8    BRKYC2            L/RETURN ADR IF REPORTING EVENT
         BAL,SR4  IPCXY1            TRIGGER BUFFER RELEASE
BRKYC2   EQU      %
         DO       CNM
         LI,D4    %+4
         LC       MODE5,2
         BCS,8    CHKPTAP2          BR IF SLAVE LINE
         B        SETACT2
         ELSE
         BAL,D4   SETACT2           PERFORM ACTIVATION
         FIN
         LW,R6    7
         B        COCIP94           BRANCH TO RECORD EVENT
         SPACE    3
COCIESC  EQU      %
         LB,D1    MODE,R2           SET
         OR,D1    X40                ESCAPE
         STB,D1   MODE,R2             BIT
         B        COCIP01
         SPACE    3
*
COCIXC   EQU      %
         DO1      2741CODE
         LI,SR1   ECHO1             SET TO GIVE EOT IF 2741
COCIXC10 EQU      %
         LH,R4    COCOR,R2
         BEZ      IPCXY             B/NO OUTPUT BUFFERS EXIST
         LI,R5    1                 RESET CNT
         STB,R5   COCOC,R2
         BAL,R6   COCPUTBL          RLS OUT BUFS
         BNEZ     %-1
         STH,R4   COCOR,R2
         DO       CNM
         LW,5     10                SAVE XLATE ADDRESS
         BAL,11   GETECBWT          GET ANY WRITE ECB
         BEZ      %+2               NONE
         BAL,6    COCOP10E          GOT ONE, POST IT
         DO1      2741CODE
         LI,SR1   ECHO1             RESTORE REG
         LW,10    5
         FIN
         LH,R5    COCIR,R2
         BNEZ     IPCXY             B/INPUT BUFFERS EXIST
         BAL,SR4  ESCX2             GIVE BACK ARROW, CR/LF
*
IPCXY    EQU      %
         LI,SR4   COCIP01           SET RETURN ADDRESS FOR ESCX1
IPCXY1   EQU      %
         BAL,SR2  CLEARLD           CLEAR LOST DATA FLAG
IPCXY5   EQU      %
         LH,R4    COCIR,R2
         DO       2741CODE=1
         BEZ      *SR1              RETURN IF NO INPUT BUFFERS
         ELSE
         BEZ      *SR4              RETURN IF NO INPUT BUFFERS
         FIN
         LH,R0    COCII,R2          SET TO RELEASE INPUT BUFFERS
         LH,R5    EOMTIME,R2
         BNEZ     ESCX1             RELEASE BUFS IF RD-AHD IS NOT ACTIVE
         STH,R5   COCIR,R2          READ ACTIVE, CLEAR INPUT BUF PTRS
         STH,R5   COCII,R2
         STH,SR4  EOMTIME,R2        SET EOMTIME NON-ZERO
         DO       2741CODE=1
         B        *SR1
         ELSE
         B        *SR4
         FIN
         SPACE    3
CLEARLD  EQU      %
         LB,R6    MODE3,R2
         AND,R6   F7                MASK OUT DATA LOST BIT
         STB,R6   MODE3,R2          AND UPDATE IN MODE3
         B        *SR2
         SPACE    3
COCIRUB  EQU      %
         LC       MODE2,R2
         BCS,4    COCIP01
         LC       MODE3,R2
         BCS,4    COCIP01
         LH,R4    COCII,R2
         BNEZ     COCIP9            BRANCH IF RUBOUT IS VALID
         B        COCIP01
         SPACE    3
COCIPBRK EQU      %
         LI,SR2   BRKYC
         LI,R7    E:CBK
         DO       CNM
         LC       MODE5,R2
         BCR,8    COCIPBRK1         BR IF MASTER
         BCS,1    COCIP01           BR IF BREAK PENDING
         MTB,0    LB:UN,R2
         BEZ      COCIP01           IGNORE NON-OWNED SLAVE LINES
         LC       MODE2,R2
         BCR,1    %+3               BR IF NOT 2741
         MTB,0    COCTERM,R2        CHECK IF TERM TYPE SET
         BEZ      *SR2              NOT YET, PROCESS AS NORMAL BREAK
         LW,10    2                 SAVE LINE #
         BAL,1    ECBGBLK           GET A 4 WORD BLOCK
         XW,10    2                 RESTORE LINE #
         BEZ      COCIP01           NO BUFFER, IGNORE BRK
         LW,14    BRKWD0            BREAK BLOCK WORD 0
         LB,R5    MODE5,R2
         CI,R5    8
         BAZ      %+3
         MTH,2    14                IF READ DONE, SET TO DO
         LI,SR2   COCIP01           BREAK LATER
         LW,15    2                 LINE # TO WORD 2
         STD,14   *10
         BAL,11   PUTDOLIST2        CHAIN UP REQUEST
         OR,R5    X10               SET BREAK PENDING BIT
         STB,R5   MODE5,R2
         LI,7     0
         LB,5     LB:UN,2           WAKE UP USER IF HE IS ZZZING
         LB,11    UB:US,R5
         CI,11    SW
         BNE      %+2
         LI,7     E:WU
         LB,5     COCTERM,2         RESTORE
         LH,10    COCOTV,5          TRANSLATE TABLE ADDRESS
         B        *SR2
BRKWD0   GEN,8,8,16 1,3,0
COCIPBRK1 EQU     %
         FIN
IPBRKCT  EQU      %
         LB,R5    MODE,R2
         AI,R5    1
         CI,R5    3
         BAZ      COCIYC            4 BRKS = CTL Y
         MTB,1    MODE,R2           BUMP BREAK COUNT
         B        *SR2
         SPACE    3
*
COCACK   EQU      %                 ESC 'Q'
         LB,R5    COCOC,R2
         BNEZ     COCIP01           DON'T ACKNOWLEGE IF OUTPUT EXISTS
         LI,R5    X'5A'             SET TO SEND ESCLAMATION POINTS
         BAL,SR2  COCSEND2
         BAL,SR2  COCSEND2
         B        COCIP01
         SPACE    3
*
KILLIN   EQU      %
         LH,R0    COCII,R2
         LH,R4    COCIR,R2
KILLIN1  EQU      %
         BAL,D3   COCFIB            RELEASE LINKS
         LI,R6    X'8000'
         LH,R4    TL,R2
         STH,R6   TL,R2             CLEAR TAB LINK
         BLEZ     *R9               B/NO TAB BUFFERS
         BAL,R6   COCPUTBL          RELEASE TAB BUFFERS
         BGZ      %-1
         B        *SR2
         PAGE
*
*                 VALID ESCAPE SEQ. PROCESSING
*
27ESCS   EQU      %
         DO 2741CODE=1
         DATA,1   0,X'FF',' ',8,'N','O','B','X'
         FIN
         BOUND    4
TTESCS   DATA,1   X'FF','F','L','U','(',')','T','S','R','C','Y'
N27ESCS  EQU      BA(%)-BA(27ESCS)-1
         DATA,1   X'30','P','E','I','Q',X'D',X'15','X'
         DATA,1   'O'               ESC-O; NON-2741 BACKSPACE OVERSTRIKE
NTTESCS  EQU      BA(%)-BA(TTESCS)-1
*
         BOUND    4
ESCCTLV  EQU      %
         DO       2741CODE=1
         DATA,1   0,0,X'1F',X'31',X'3F',X'3B',BATTN,XATTN
         FIN
         BOUND    4
         DATA,1   0,X'30',X'0C',X'34',X'35',X'36',X'37',X'38'
         DATA,1   X'3E',X'3A',ESCY,ESCESC,X'33'
         DATA,1   X'39',5,ESCQ,X'3F',X'3B',X'32'
         DATA,1   X'43'             ESC-O; BACKSPACE OVERSTRIKE EDIT
*                                   .. FOR NON-2741'S
         BOUND    4
ESCTV    EQU      COCIYC-X'80'
BATTN    EQU      COCIPBRK-ESCTV    B-ATTN ON 2741 IS SAME AS 'BREAK'
XATTN    EQU      COCIXC-ESCTV      X-ATTN ON 2741 IS SAME AS CTL-X
ESCQ     EQU      COCACK-ESCTV
ESCY     EQU      COCIYC-ESCTV      'Y' ATTN  =  ESC 'Y'  = CTL 'Y'
ESCESC   EQU      ESCY              ESC 'ESC'  =  CTL 'Y'
COCIP5B  EQU      %
         AI,SR4   ESCCTLV-27ESCS
         LB,R5    *SR4,R4           NEW CHARACTER INTO R5
         LC       *SR4,R4
         BCS,8    ESCTV,R5          GO TO
         LH,R4    COCII,R2          GET INSERTION POINT INTO R4
         CI,R5    X'32'
         BL       COCIP5C           BRANCH IF CHAR REQUIRES BUFFERING
         LC       MODE,R2
         BCS,1    COCIP5D           BRANCH IF READ IS PENDING
         DO 2741CODE=1
COCIP5C  EQU      %
         LC       MODE2,R2
         BCR,1    COCIP9
         B        COCIP93           2741, REPLACE LAST CHAR
COCIP5D  EQU      %
         LC       MODE2,R2
         BCR,1    IP930             BRANCH IF NOT 2741
         LI,R7    X'39'
         STB,R7   COCBUF,R4         NULLIFY CHAR AT INSERT POINT
         ELSE
COCIP5C  EQU      COCIP9
COCIP5D  EQU      IP930
         FIN
         B        IP930
*
         PAGE
         DO       2741CODE=1
*
*                 2741 INITIAL CHAR HANDLING.
*
*                 R5  CHARACTER TO PROCESS
*                 R2  LINE NO.
*
COCIP6   EQU      %
         AND,R5   M7
         DO       CNM
         LC       MODE5,R2
         BCR,8    %+3
         MTB,0    COCTERM,R2
         BEZ      COCIP65
         LC       MODE2,R2          RESTORE PREV CC
         FIN
         LB,SR2   LB:UN,R2
         BEZ      COCIP65           NO USER YET
         BCS,8    COCIP01           IGNORE INPUT FROM DISCONNECTED LINE
         SCS,R5   32
         BEV      COCIP54           BAD PARITY
         AND,R5   M6                SCRUB
         LC       MODE3,R2
         BCR,1    COCIP61           KB NOT LOCKED
         LB,SR2   MODE3,R2
         AI,SR2   -X'10'
         STB,SR2  MODE3,R2          UNLOCK
         CI,R5    X'34'             EOA
         BNE      COCIP61           CHAR IS NOT AN EOA
         LI,R5    X'1F'             FORCE LC
COCIP61  EQU      %
         LH,R7    COCITV,R4
         AND,R4   XFE               SET LC
         CI,R5    X'1F'             LC
         BE       COCIP63           YES
         AI,R4    1
         CI,R5    X'1C'             UC
         BNE      COCIP64           NO
COCIP63  STB,R4   COCTERM,R2
         B        COCIP01
*
COCIP64  EQU      %
         CI,R5    X'3C'
         BE       COCIEOT           BRANCH IF CHAR IS ATTN
         CI,R5    X'2D'
         BNE      IP642             BRANCH IF CHAR NOT NEW-LINE
         LB,R4    MODE,R2
         OR,R4    X40               SET EOA PENDING TO IGNORE EOT
         STB,R4   MODE,R2
IP642    EQU      %
         LH,R4    COCII,R2
         BEZ      COCIP5F           BRANCH IF NO INPUT
         LB,R4    COCBUF,R4         GET LAST CHARACTER IN INPUT BUFFER
         AI,R4    -X'39'
         BNEZ     COCIP5F           BR IF CHAR IS NOT NULLED ATTN SEQ
         MTH,-1   COCII,R2          BACK UP INSERTION POINT
         B        COCIP5F
*
COCIP65  EQU      %
         CI,R5    X'7C'             EOT
         BNE      COCIP66
COCIP65E EQU      %
         BAL,SR2  EOTACT            TURN LINE AROUND
         LB,R4    COCTERM,R2
         BNEZ     COCIPBRK          KB ASSIGNED,ACT LIKE BRK
         LI,R5    X'40'
         BAL,SR2  COCSENDT          SP
         LI,R5    X'5D'
         BAL,SR2  COCSENDT          BS
IP681    EQU      %
         LI,SR4   COCIP01
         B        EOT1
*
*                 USER IS LOGGING ON, DETERMINE KEYBOARD TYPE
COCIP66  EQU      %
         LI,R4    NOSTARS           LENGTH OF ASTERISK TABLE IN R4
         CB,R5    STAR,R4
         BE       %+3
         BDR,R4   %-2
         B        COCIP01           NO FIND
         SLS,R4   1
         LH,R5    COCITV,R4
         BNEZ     COCIP63           BRANCH IF VALID TRANSLATION TABLE
         B        COCIP01
         SPACE    3
*
COCIEOT  EQU      %
         LB,R7    MODE,R2           REMEMBER EOA PENDING STATUS
         BAL,SR2  EOTACT            TURN LINE AROUND
         CI,R7    X'40'
         BANZ     COCIP01           IGNORE EOT FOLLOWING NEW-LINE
         BAL,SR2  IPBRKCT           INC BRK CT & GIVE CTL Y IF 4
         LH,R4    COCII,R2
*                 DETERMINE THE CURRENT BREAK SET IN EFFECT
         LB,R7    MODE2,R2
         CI,R7    2
         BAZ      IPEOT             BRANCH IF BREAK SET .NE. 2
         LI,R5    4                 SET EBCDIC EOT IN R5
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES
         BCR,12   COCIP9            EOT IF TEL OR DELTA NOT IN CONTROL
IPEOT    EQU      %
         LB,R6    COCBUF,R4
         LC       MODE,R2
         BCS,1    COCIP59           READ PENDING,TREAT ATTN AS ESC SEQ
         B        COCIP01
*
*
EOTACT   EQU      %
         LB,R5    MODE,R2
         OR,R5    X40               SET EOA PENDING BIT
         STB,R5   MODE,R2
         LB,R5    MODE3,R2
         OR,R5    X10
         STB,R5   MODE3,R2          LOCK KB
         LB,R5    COCTERM,R2
         AND,R5   XFE               SET TERM TO LOWER CASE
         STB,R5   COCTERM,R2
2741DEL  EQU      %
         MTB,1    COCOC,R2          BUMP CNT.
         LI,R5    X'7F'             SET 2741 'DEL' CHAR TO START OUTPUT
         B        SENDXMIT          AND SEND IT
         FIN
         TITLE    'C H A NG E  M O D E  A T  T E R M I N A L'
************************************************************************
*
*                 ROUTINE TO SET, RESET OR TOGGLE THE APPROPRIATE MODE
*
*   LINKAGE: BAL,SR2 COCCM
*
*        IN: R1 = BIT POSITION TO BE CHANGED/0,1,2,.. MEANS BIT 7,6,5,..
*            R2 = LINE NUMBER OF ORIGINATING MESSAGE
*            R5 = EBCDIC CHARACTER
*           SR3 = ADDRESS OF TRANSLATION TABLE
*
*  DESTROYS: R1,D3,D4
*
************************************************************************
*
COCCM    EQU      %
         AND,R1   M3                GET BIT POSITION TO BE CHANGED
         LI,D4    1
         SLS,D4   *R1               SHIFT MASK TO BIT POSITION
         LB,R1    TOGTAB2-12,R5
         AND,R1   M2                GET MODE IDENTIFIER
         LH,R1    MODENO,R1         ADDR OF MODE BEING CHANGED
         LB,D3    *R1,R2            GET CURRENT DATA IN MODE BYTE
         LC       TOGTAB2-12,R5
         BCS,8    CM2               BRANCH IF MODE IS TO BE TOGGLED
         OR,D3    D4
         BCS,4    CM3               BRANCH IF MODE IS TO BE SET
CM2      EOR,D3   D4                TOGGLE BIT
CM3      STB,D3   *R1,R2            UPDATE MODE BYTE
         B        *R9               RETURN
MODENO   DATA,2   MODE,MODE2,MODE3,MODE4,
         BOUND    2                 HALF-WORD BOUNDARY
TOGTAB1  DO1      1-(ABSVAL(HA(%))&1)    DO IF WORD BOUNDARY
         DATA,2   0                 FORCE HALFWORD BOUNDARY
         DATA,1   0,'P','U','(',')','T','S','E','C','O',X'11',X'13'
         DATA,5                     DUMMY ENTRIES; .3E -> .42
         DATA,1   'O'               .43; ESC-O; BACKSPACE OVERSTRIKE
*                                   .. EDIT FOR NON-2741'S
         BOUND    2                 HALF-WORD BOUNDARY
TOGTAB2  DO1      1-(ABSVAL(HA(%))&1)    DO IF WORD BOUNDARY
         DATA,2   0                 FORCE HALF-WORD BOUNDARY
         DATA,1   0,X'82',X'80',X'01',X'41',X'80'
         DATA,1   X'81',X'80',X'82',X'82',X'41',X'01'
         DATA,5                     DUMMY ENTRIES; .3E -> .42
         DATA,1   X'82'             .43; ESC-O; BACKSPACE  OVERSTRIKE
*                                   .. EDIT FOR NON-2741'S; TOGGLE
         BOUND    4
         TITLE    'E C H 0  I N P U T  R O U T I N E S'
************************************************************************
*    USES ALL REGISTERS
*
*   LINKAGE:  BAL,SR4 COCECHO
*
*        IN:  R0 = HEAD OF INPUT BUFFER CHAIN
*             R2 = LINE NUMBER OF ORIGINATING MESSAGE
*             R4 = POINTER TO CURRENT POSITION IN BUFFER
*             R5 = CHARACTER TO BE PROCESSED
*            SR3 = TRANSLATE TABLE ADDRESS
*
*    RETURN:  NORMAL IS TO BAL + 1. RETURN TO BAL + 2 IF ACTIVATION RCVD
*
*
************************************************************************
COCECHO  EQU      %
*                 OBTAIN BSEPOS ADDRESS
         ANLZ,R7  MUHT1             INITIALIZE R7 WITH HA(TL)
         AI,R7    -HA(COCBUF)       AND BIAS IT FROM COCBUF
         B        %+2
ECHO0    EQU      %
         SCD,R6   31                GET HA(LINKAGE) INTO R7
         LH,R6    COCBUF,R7         NEXT LINK INTO R6
         AI,R6    -2                POINT TO BYTE 0 OF BUFFER
         BGZ      ECHO0             BRANCH IF NOT LAST TAB LINK
         CW,R4    R0
         BNE      ECHO0A            BRANCH IF NOT FIRST CHAR OF MESSAGE
         LI,R6    X'8000'
         STH,R6   COCBUF,R7         SET TRSZ AND BSEPOS TO ZERO
ECHO0A   EQU      %
         SLS,R7   1
         AI,R7    1                 POINT R7 TO BSEPOS
         LC       MODE,R2
         BCS,2    ECHO6C            B/TRANSPARENT MODE
*                 DETERMINE CHARACTERISTICS OF INPUT CHARACTER
         LC       *SR3,R5
         BCR,8    ECHO8             BRANCH IF NOT SPECIAL
         SPACE
         BCS,2    ECHO2             BRANCH IF NORMAL OR DELTA ACTIVATION
         LB,R1    *SR3,R5           GET OUTPUT TRANSLATION VALUE
         LB,R6    ECHOBYTE-X'20',R1
*                 'GO TO SPECIFIC ROUTINE' IF GO TO CHARACTER SENSED
         BCR,4    ECHOBASE,R6       GO TO SPECIFIC ROUTINE
         SPACE
*
*                 'MODE CHANGE' CHARACTER SENSED
         BAL,SR2  COCCM             EFFECT MODE CHANGE
         LB,R5    TOGTAB1-12,R5     GET EBCDIC CHARACTER TO ECHO
         LW,SR2   SR4               RETURN ADDRESS INTO SR2
         CI,R5    X'13'
         BLE      COCSEND1          BRANCH IF 'XON' OR 'XOFF' CHARACTER
         BAL,D4   ECHOESC           ECHO ESCAPE SEQUENCE
ECHO1    EQU      %
         DO       2741CODE=1
2741EOT  EQU      %
         LC       MODE3,R2
         BCS,1    EOT1              SEND EOT IF KEYBOARD IS LOCKED
         LC       MODE2,R2
         BCR,1    *SR4              RETURN IF NOT 2741
         LC       MODE,R2
         BCR,4    *SR4              RETURN IF NO EOA PENDING
EOT1     EQU      %
         LI,R5    X'7C'             SET TO SEND 2741 EOT
         BAL,SR2  COCSENDT          SEND 2741 EOT
         FIN
         B        *SR4
         SPACE    3
*
*
*                 VECTOR OF BIASES FROM COCECHOB TO THE 'GO TO' ROUTINES
EB       COM,8    AF-ECHOBASE
ECHOBYTE EQU      %
         EB       ECHOFF
         EB       ECHOHT
         EB       ECHOCRLF
         EB       ECHONL
         EB       ECHOESCF
         EB       ECHOESCX
         EB       ECHORUB
         EB       ECHOESCR
         EB       ECHOESCCR
         EB       ECHOBRAC
         EB       ECHONOR
         EB       ECHOBS
         EB       ECHOESCLF
         EB       ECHO2741LF
         EB       ECHOPARITY
         EB       ECHOBS            BSBS; CONTIGUOUS BACKSPACES
         DO1      32-BA(%)+BA(ECHOBYTE)
         EB       ECTBLERR
         BOUND    4
         SPACE    3
COCECHOB CSECT
         DO       SECTB=0
         USECT    COCCODE
ECHOBASE EQU      ECHO3
         ELSE
ECHOBASE EQU      COCECHOB
         FIN
*
*                 'NORMAL OR DELTA ACTIVATION' CHARACTER SENSED
ECHO2    BCS,4    ECHO3             BRANCH IF NORMAL ACTIVATION CHAR
*                 'DELTA ACTIVATION' CHARACTER SENSED
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES
         BCS,8    ECHO4             BRANCH IF TEL IS IN CONTROL
         BCR,4    ECHO8A            BRANCH IF DELTA IS NOT IN CONTROL
*
ECHO3    BAL,D4   SETACT            SET ACTIVATION
*
ECHO4    EQU      %
         CI,R5    X'40'
         BL       %+2               DON'T BUMP CPOS IF CTL CHAR
ECHO41   EQU      %
         MTB,1    CPOS,R2
         LB,R5    COCBUF,R4
         LB,R1    MODE2,R2
         CI,R1    8
         BAZ      ECHO5             BRANCH IF NOT LOWER CASE SHIFT MODE
*                 MAP UPPER CASE CHARACTERS TO LOWER CASE
         DO       2741CODE=1
         CI,R1    X'10'
         BAZ      ECHO45            BRANCH IF NOT 2741
*                 MAP EBCDIC UPPER CASE ALPHABETIC'S TO LOWER CASE
         CLM,R5   HILET
         BCS,9    ECHO5             BRANCH IF NOT UPPER CASE ALPHABETIC
         AI,R5    -X'40'            MAP TO LOWER CASE
         B        ECHO49            BRANCH TO UPDATE BUFFER
         USECT    COCCODE
         FIN
*                 MAP ASCII UPPER CASE (X'40'-X'5F') TO LOWER CASE
ECHO45   EQU      %
         LB,R1    *SR3,R5           TRANSLATE EBCDIC BACK TO ASCII
         LC       *SR3,R5
         BCR,8    ECHO47            BRANCH IF NOT SPECIAL
         BCR,6    ECHO5             BRANCH IF SPECIAL IS 'GO TO' TYPE
         AND,R1   M6
         LB,R1    *SR3,R1           RETRANSLATE SITUTATION
ECHO47   EQU      %
         CI,R1    X'40'
         BAZ      ECHO5             BRANCH IF NOT AT LEAST UPPER CASE
         OR,R1    X20               MAP TO LOWER CASE ASCII
         LB,R5    COCTERM,R2
         LH,R5    COCITV,R5         INPUT TRANSLATION TABLE ADDRESS
         LB,R5    *R5,R1            TRANSLATE FROM ASCII TO EBCDIC
ECHO49   EQU      %
         STB,R5   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER
ECHO5    EQU      %
         LB,R1    MODE,R2
         CI,R1    4
         BAZ      ECHO6             BRANCH IF NOT IN CASE RESTRICT MODE
         CLM,R5   LOWLET
         BCS,9    ECHO6             BRANCH IF NOT LOWER CASE ALPHABETIC
         AI,R5    X'40'             MAP LOWER CASE EBCDIC TO UPPER CASE
         STB,R5   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER
ECHO6    EQU      %
         LC       MODE,R2
         BCR,8    ECHO6             B/NOT IN ECHOPLEX MODE
         BAL,R9   COCSEND1          ECHO CHAR
ECHO6C   EQU      %
         LI,D3    1                 SET INCREMENT FOR ARSZ AT ONE
         CW,SR4   Y01
         BANZ     ECHO7             BRANCH IF ACTIVATION HAS OCCURED
*                 ADJUST BSEPOS AND ARSZ BY INCREMENT
INCSIZE  LB,D4    COCBUF,R7
         BEZ      ECHO7             BRANCH IF NOT BACKSPACE EDITING
         SW,D3    D4
         BLZ      ECHO4A            BRANCH IF STILL BACKSPACE EDITING
         LI,D4    0
         STB,D4   COCBUF,R7         NO LONGER BACKSPACE EDITING
         B        ECHO7
*
ECHO4A   LCW,D3   D3                STILL BACKSPACE EDITING,
         STB,D3   COCBUF,R7         UPDATE BSEPOS
         B        *SR4
         SPACE
*
ECHO7    LB,D4    ARSZ,R2
         AW,D4    D3                COMPUTE NEW ARSZ
         CB,D4    RSZ,R2
         BL       ECHO7A
         BAL,D4   SETACT            ARSZ SATISFIES RSZ, ACTIVATION RCVD
         LB,D4    RSZ,R2            SET NEW ARSZ = RSZ
ECHO7A   STB,D4   ARSZ,R2           UPDATE ARSZ
         B        *SR4
*
*                 OUTPUT TRANSLATION HAS NO SPECIAL FLAG FOR THIS CHAR
ECHO8    EQU      %
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES
         BCS,12   ECHO4             BRANCH IF TEL OR DELTA IS IN CONTROL
ECHO8A   LB,D4    MODE2,R2
         AND,D4   M2                OBTAIN BREAK SET
         BEZ      ECHO4             BRANCH IF NO BREAK SET
         CI,R5    X'40'
         BE       ECHO41            BRANCH IF BLANK CHARACTER
         DO       2741CODE=1
         BG       ECHO9             BRANCH IF NOT A CONTROL CHARACTER
         LC       MODE2,R2
         BCR,1    ECHO3             BRANCH TO ACTIVATE IF NOT 2741
ECHO9    EQU      %
         ELSE
         BL       ECHO3             BRANCH IF CHARACTER IN EITHER BREAK SET
         FIN
         AI,D4    -2
         BEZ      ECHO4             BRANCH IF BREAK SET 2
         CI,R5    X'81'
         BL       ECHO3             ACTIVATE IF CHAR. IN BREAK SET 1
         CLM,R5   DWB1B5
         BCS,9    ECHO4             BRANCH IF NOT
         B        ECHO3
         SPACE    3
*
*                 PROCESS PARITY ERROR
ECHOPARITY EQU    ECHO3
         SPACE    3
*
*                 INPUT CHARACTER IS LEFT OR RIGHT BRACKET
         DO1      SECTB
         USECT    COCECHOB
ECHOBRAC EQU      %
         LW,R1    R5
         LB,SR2   COCTERM,R2
         LB,R6    MODE2,R2
         CI,R6    8
         BAZ      ECHOBRC2          BRANCH IF NOT LOWER CASE SHIFT MODE
         AI,R1    -2                MAP EBCDIC BRACKETS TO BRACES
         B        ECHOBRC4          BRANCH TO UPDATE INPUT BUFFER
         USECT    COCCODE
ECHOBRC2 EQU      %
         AI,SR2   -3
         BNEZ     ECHO8             BRANCH IF NOT MODEL 7015 TELETYPE
         SLS,R1   4
         AI,R1    15                MAP EBCDIC BRACKETS TO OR & NOT
ECHOBRC4 EQU      %
         STB,R1   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER
         B        ECHO8
         SPACE    2
*                 INPUT CHARACTER IS NOT OR OR
ECHONOR  EQU      ECHO8
         SPACE    3
*
ECTBLERR  EQU     %
         B        TTABERR           TRANSLATE TABLE ERROR
         SPACE    3
*                 PROCESS ESCAPE LINE FEED
ECHOESCLF EQU     %
         BAL,D4   ECHOLF
         B        *SR4
         PAGE
*
*                 PROCESS ESCAPE CARRIAGE RETURN
ECHOESCCR EQU     %
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    ESCCR             BRANCH IF NOT 2741
         BAL,D4   2741ESC           ECHO 'N ATTN' ESCAPE SEQUENCE
         FIN
ESCCR    BAL,D4   ECHOCR            ECHO 'CR,LF'
         B        ECHO1
         SPACE    3
*
*                 PROCESS FORM FEED CHARACTER
ECHOFF   EQU      ECRLF3
         DO       2741CODE=0
ECHONL   EQU      ECTBLERR
ECHO2741LF EQU    ECTBLERR
         FIN
         SPACE    3
*
*                 PROCESS ESCAPE F
ECHOESCF EQU      %
         LI,R5    'F'
         BAL,D4   ECHOESC           ECHO 'ESCAPE F' SEQUENCE
         PAGE
*
*                 PROCESS CR/LF
ECHOCRLF EQU      %
         CI,R5    X'15'
         BNE      ECRLF3            BRANCH IF CHAR IS NOT A LINE FEED
         LB,SR2   ARSZ,R2           CHARACTER IS LINE FEED
         BNEZ     ECRLF2            BRANCH IF ARSZ IS NON-ZERO
         LC       MODE2,R2
         BCS,4    ECRLF1            BRANCH IF XON
         LC       MODE3,R2
         BCR,4    ECRLF2            BRANCH IF NOT ESC P
ECRLF1   LI,R5    X'39'
         STB,R5   COCBUF,R4         PUT 'NUL'(ESC CR) INTO INBUF
         B        *SR4              RETURN
ECRLF2   BAL,D4   ECHOLF            ECHO 'LF'
         B        %+2
ECRLF3   BAL,D4   ECHOCR            SEND 'CR,LF'
ECRLF4   BAL,D4   SETACT            SET ACTIVATION
         MTB,1    ARSZ,R2           BUMP ACCUMULATED RECORD SIZE
         B        *SR4              RETURN
         SPACE    3
         DO       2741CODE
ECHONL   EQU      %
         LI,R15   ECRLF4            L/RETURN ADR FOR ECHOCR1
         FIN
ECHONL1  EQU      %
         LI,R9    ECHOCR1           SEND IDLES AFTER CR
         B        SIACR             GO TO SIACR; HE'LL GO TO ECHOCR1
         DO       2741CODE
         PAGE
*
*                 PROCESS 2741 LINE FEED (INDEX KEY)
ECHO2741LF EQU    %
         BAL,D4   ECHOCR2           UPDATE LINE COUNT
         B        ECHO8             TO NORMAL CHARACTER PROCESSING
         FIN
         USECT    COCCODE
*
*                 THIS ROUTINE ECHOS  LF, MAINTAINING LINE COUNT
ECHOLF   EQU      %
         LC       MODE,R2
         BCS,8    ECHOCR            B/ECHOPLEX MODE
         BAL,R9   SIBCR             SEND IDLES BEFORE CR
         LI,R5    X'29'             L/CR CODE
         LI,R9    ECHONL1           SEND CR ONLY
         B        COCSEND1          GO TO COCSEND1; HE'LL GO TO ECHONL1
*
*                 THIS ROUTINE SENDS CR/LF, MAINTAINING LINE COUNT
ECHOCR   EQU      %
         LI,R5    X'15'             SET TO SEND 'NEW LINE'
         BAL,SR2  COCSEND1
ECHOCR1  EQU      %
         LI,SR2   1
         STB,SR2  CPOS,R2           RESET CARRIAGE POSITION
ECHOCR2  EQU      %
         DO       COCPCP=1
         LB,SR2   MODE3,R2
         AI,SR2   1
         CI,SR2   7
         BAZ      *D4
         MTB,1    MODE3,R2          INCREMENT LINE COUNT
         FIN
         B        *D4
         PAGE
         DO1      SECTB
         USECT    COCECHOB
*
*                 PROCESS BACKSPACE CHARACTER
ECHOBS   EQU      %
         LB,SR2   CPOS,R2
         BEZ      ECRLF1            BRANCH,CARRIAGE POSITION IS ZERO
         MTB,-1   CPOS,R2
         BEZ      ECRLF1
         LC       MODE3,R2
         BCR,2    ECHOBS1           BRANCH IF NOT OVERSTRIKE EDITING
         MTB,1    COCBUF,R7         INCREMENT BACKSPACE EDIT POSITION
         LC       MODE2,R2
         BCS,1    *R11              B/2741
         CI,R5    BSBS              C/CHAR W/CONTIGUOUS BS CHAR
         BE       ECHOBSF           B/CONTIG BS; DON'T GIVE LINE FEED
         LI,R5    X'20'             L/LINE FEED-ONLY CHAR
         BAL,R9   COCSEND1          SEND LINE FEED
         BAL,R15  ECHOCR2           INC LINE COUNTER
ECHOBSF  LI,R5    BS                L/BACKSPACE CHARACTER; TTY
         LW,R9    R11               L/RETURN ADR
         B        COCSEND1          B; SEND BACKSPACE CHAR
         USECT    COCCODE
         DO       2741ARUB=1
ECHOBS1  EQU      %
         CI,R5    X'18'
         BNE      ECHO8             BRANCH IF NOT 2741 CANCEL
*                 2741 CANCEL (STD UC'BS'), EFFECT DESTRUCTIVE RUB-OUT
         MTB,-1   ARSZ,R2           DECREMENT ACCUMULATED RECORD SIZE
         B        *SR4              RETURN
         ELSE
ECHOBS1  EQU      ECHO8
         FIN
         PAGE
         DO1      SECTB
         USECT    COCECHOB
*
*                 PROCESS RUBOUT
ECHORUB  EQU      %
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    ECHORUB1          BRANCH IF NOT 2741
         LC       MODE3,R2
         BCR,2    ECHORUB2          BRANCH IF NOT OVERSTRIKE EDIT MODE
         LI,R5    X'40'
         BAL,SR2  COCSEND1
         LB,SR2   CPOS,R2           SEND 1 OR 2 BLANKS AND AN 'EOT'
         BEZ      %+3               B/CPOS = 0; THE BS DIDN'T BUMP BSEPO
         MTB,-1   COCBUF,R7         -1 TO BSEPOS
         BAL,SR2  PCIB1             SEND 2ND SPACE & BUMP CPOS
         LI,R5    X'7C'
         BAL,SR2  COCSENDT          SEND 2741 'EOT'
         B        ECHO41
         USECT    COCCODE
         FIN
ECHORUB1 LB,R5    COCBUF,R7         L/BSEPOS; BACKSPACE EDIT POSITION
         BEZ      ECHORUB3          BEZ; NOT ACTIVELY BACKSPACE
*                                   .. EDITTING AT THIS POINT
         MTB,-1   COCBUF,R7         -1 TO BSEPOS
         LI,R5    X'40'             L/BLANK CHAR
         BAL,R9   PCIB1             SEND BLANK, INCREMENTING CPOS
         B        ECHO6C            B; FINISH ECHO PROCESSING
ECHORUB3 LI,R5    X'B1'             L/BACKSLASH (\) CHARACTER
         BAL,SR2  PCIB1             SEND 'BACKSLASH' & BUMP CPOS
         MTB,-1   ARSZ,R2           DECREMENT ARSZ
         BC       *SR4              RETURN IF ARSZ IS NOT LESS THAN ZERO
         DO 2741CODE=1
         B        ECHOESCX
         DO1      SECTB
         USECT    COCECHOB
ECHORUB2 MTB,-2   ARSZ,R2           DECREMENT ARSZ BY 2
         BC       EOT1              BRANCH IF ARSZ IS GREATER THAN ZERO
         FIN
         PAGE
*
*                 PROCESS ESCAPE X
ECHOESCX EQU      %
         DO1      2741CODE
         LI,SR1   ECHO1             SET TO GIVE EOT IF 2741
ESCX0    EQU      %
         XW,R0    R4                 BUFFER POSITION TO R0 FOR FIB
ESCX1    EQU      %
         BAL,D3   COCFIB            RELEASE INPUT BUFFERS
ESCX2    EQU      %
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    %+3               BRANCH IF TERM NOT A 2741
         LI,R5    X'08'
         BAL,SR2  COCSEND1          SEND 2741 'BACKSPACE'
         FIN
         LI,R5    X'6D'
         BAL,SR2  COCSEND1          SEND 'BACK ARROW'
         BAL,D2   ECHOCRCPI         SEND 'CR,LF' AND POSITION TO CPI
         STB,D4   ARSZ,R2           SET ARSZ TO ZERO
         DO       2741CODE=1
         B        *SR1              THIS NORMALLY BRANCHES TO ECHO1
         ELSE
         B        *SR4              RETURN TO CALLER
         FIN
         PAGE
*
*                 PROCESS ESCAPE R
ECHOESCR EQU      %
         LI,R5    'R'
         BAL,D4   ECHOESC           ECHO 'ESC R' SEQUENCE
         LB,R5    ARSZ,R2
         BEZ      ECHOESCX          PERFORM ESC X IF NOTHING TO RETYPE
         LW,R6    R2                SAVE LINE NO.
         LW,SR1   SR4               COCECHO RETURN ADDRESS TO SR1
         PUSH     5,R0
         LW,R3    R4                CURRENT BUFFER POSITION INTO R3
         LW,R4    R0                HEAD OF INPUT CHAIN INTO R4
         BAL,SR4  GMB               GET MONITOR BUFFER
         BEZ      ESCR3             BRANCH IF BUFFER IS NOT AVAILABLE
*
*                 MONITOR BUFFER HAS BEEN OBTAINED FOR RETYPING MESSAGE
         LW,R2    R6                RESTORE LINE NO.
         SLS,D3   2                 GIVE MONITOR BUFFER ADDRESS
         AI,D3    -1                BYTE AND BASE RESOLUTION
         LB,R1    ARSZ,R2           GET SIZE OF MESSAGE
         CI,R1    136
         BLE      %+2
         LI,R1    136               MAX SIZE FOR RETYPED MESSAGE IS 136
         BAL,SR2  COCMU             MOVE MESSAGE TO MONITOR BUFFER
         AI,D3    1
         SLS,D3   -2
         BAL,D2   ECHOCRCPI         SEND 'CR,LF' AND POSITION TO CPI
         LI,R3    0
ESCR1    EQU      %
         LB,R5    *D3,R3
         BAL,SR2  COCSEND1          SEND MESSAGE TO TERMINAL
         AI,R3    1
         BDR,R1   ESCR1
         LB,SR4   COCBUF,R7         BACKSPACE EDIT DISPLACEMENT INTO SR4
         AI,R7    -1
         LB,D4    COCBUF,R7         TAB DISPLACEMENT (TRSZ) INTO D4
         LI,R5    X'40'             SET TO FORWARD SPACE CARRIAGE
         SW,D4    SR4               COMPUTE NET DISPLACEMENT TO BE MADE
         AI,D4    -X'80'
         BEZ      ESCR2             BRANCH IF NO ADJUSTMENT IS REQUIRED
         BGZ      ESCRADJ           BRANCH IF FORWARD SPACING
         LC       MODE2,R2
         BCR,1    ESCR1X            B/NOT 2741
         AI,R7    1                 +1 TO TRSZ/BSEPOS PNTR; PNT TO BSEPO
         MTB,1    COCBUF,R7         +1 TO BSEPOS; ADJUST FOR R IN R-ATTN
         AI,R15   -1                -1 TO -(BS COUNT); EXTRA BS FOR R
ESCR1X   LI,R5    BS                L/BACKSPACE CHARACTER
ESCRADJ  EQU      %
         AW,R3    R15               +TRSZ OR BSEPOS; ADJUST CPOS
         LAW,R15  R15               MAKE SURE MOVEMENT COUNT POSITIVE
         BAL,SR2  COCSEND1          ADJUST CARRIAGE POSITION AT TERMINAL
         BDR,D4   COCSEND1
ESCR2    EQU      %
         LB,SR4   CPI,R2            CARRIAGE POSITION IS POSITION OF
         AW,R3    SR4               CPI + SIZE OF RETYPE MESSAGE
         STB,R3   CPOS,R2           UPDATE CARRIAGE POSITION
         BAL,SR4  RMB               RELEASE MONITOR BUFFER
ESCR3    EQU      %
         PULL     5,R0
         DO       2741CODE=1
         LW,SR4   SR1               RESTORE RETURN ADDRESS INTO SR4
         B        ECHO1             BRANCH TO SEE ABOUT 2741 EOT
         ELSE
         B        *SR1
         FIN
         PAGE
*
*                 PROCESS TAB CHARACTER
ECHOHT   EQU      %
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES
         BCR,4    %+2               BRANCH IF DELTA IS NOT IN CONTROL
         BCR,8    ECHO3             BRANCH IF TEL IS NOT IN CONTROL
         AI,R7    -1                POINT R7 AT TRSZ
         LB,R5    COCBUF,R7         GET TRSZ INTO R5
         LH,R1    TL,R2
         BGZ      ECHOHT4           BRANCH IF TAB BUFFER EXISTS
ECHOHT1  LI,D3    1                 INCREMENT FOR ARSZ IS ONE
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    ECHOHT7-1         BRANCH IF NOT 2741
         LI,D2    10                INCREMENT FOR CPOS IS 10
         B        ECHOHT7
         ELSE
         B        ECHOHT7-1         INCREMENT CPOS
         FIN
         USECT    COCCODE
*                 TAB BUFFER EXISTS
ECHOHT4  LB,D1    ARSZ,R2           ARSZ
         AW,D1    R5                 + TRSZ
         AI,D1    -X'80'                    (ADJUST FOR TRSZ FLAG BIT)
         LB,D3    CPI,R2              + CPI
         AW,D1    D3                    = POSITION FROM WHICH TO TAB
*                 GET VALUE OF TAB STOP
ECHOHT5  LB,D3    COCBUF,R1
         BEZ      ECHOHT1           BRANCH IF NO MORE STOPS EXIST IN BUF
         SW,D3    D1
         BGZ      ECHOHT6           BRANCH IF VALID TAB STOP FOUND
         AI,R1    1                 BUMP TO NEXT POSITION OF TAB BUFFER
         CI,R1    15
         BANZ     ECHOHT5           BRANCH IF POSITION IS IN BUFFER
         SLS,R1   -1                GIVE POINTER HALF-WORD RESOLUTION
         LH,R1    COCBUF-4,R1       GET NEXT TAB BUFFER LINK
         BGZ      ECHOHT5           BRANCH IF BUFFER EXISTS
         B        ECHOHT1
*                 VALID TAB STOP FOUND, COMPUTE ARSZ AND CPOS INCREMENTS
ECHOHT6  LB,D2    COCBUF,R1
         LB,R1    CPOS,R2
         SW,D2    R1                CPOS INCREMENT
         BGZ      ECHOHT7
         LI,D2    1                 CPOS ALWAYS MOVES AT LEAST ONE POS.
ECHOHT7  LC       MODE2,R2
         BCS,2    ECHOHT8           BRANCH IF SPACE INSERTION MODE IS ON
         AW,R5    D3
         AI,R5    -1                COMPUTE TRSZ
         CI,R5    X'100'
         BL       %+2               MAXIMUM VALUE OF TRSZ IS 127
         LI,R5    X'FF'
         STB,R5   COCBUF,R7
         LI,D3    1                 RESET ARSZ INCREMENT TO ONE
ECHOHT8  AI,R7    1                 POINT R7 AT BSEPOS
         LW,SR1   SR4               MOVE RETURN ADDRESS TO SR1
         BAL,SR4  INCSIZE           BRANCH TO UPDATE ARSZ WITH INCREMENT
         B        %+2               NORMAL RETURN
         AI,SR1   1                 ACTIVATION RETURN
         LB,SR2   COCTERM,R2
         BEZ      ECHOHT8A          BRANCH IF TTY-33
         AI,SR2   -3
         BEZ      ECHOHT8A          BRANCH IF 7015
         LC       MODE,R2
         BCR,8    ECHOHT9           BRANCH IF NON-ECHOPLEX
ECHOHT8A LB,R5    MODE,R2
         CI,R5    8
         BANZ     ECHOHT8B          BRANCH IF IN TAB SIMULATION MODE
         LI,D2    1                 SET TO ECHO A SINGLE CHARACTER
         LI,R5    X'05'
         AI,SR2   0
         BNEZ     ECHOHT8C          ECHO TAB CHAR IF NOT TTY33 OR 7015
ECHOHT8B LW,D3    D2
         LI,R5    X'40'
ECHOHT8C BAL,SR2  COCSEND1          MOVE CARRIAGE
         BDR,D3   COCSEND1
         CI,R5    X'40'             C/CHAR W/BLANK
         BE       ECHOHT9           B/BLANK SENT
         BAL,R9   SIAT              SEND IDLES AFTER TAB
ECHOHT9  EQU      %
         LB,R1    CPOS,R2
         AW,D2    R1
         STB,D2   CPOS,R2           UPDATE CPOS
         B        *SR1              RETURN
         PAGE
*
*                 THIS ROUTINE ECHOES RESPONSE TO ESCAPE SEQUENCES
ECHOESC  EQU      %
         LC       MODE,R2
         DO       2741CODE=1
         BCS,8    ECHOESC1          BRANCH IF ECHO-PLEX
         LC       MODE2,R2
         BCR,1    ECHOESC2          BRANCH IF NOT 2741
2741ESC  LI,R5    X'08'
         BAL,SR2  COCSEND1          SEND BACKSPACE
         LI,R5    X'6D'
         BAL,SR2  COCSEND1          SEND UNDERSCORE
         LB,SR2   COCBUF,R7
         BNEZ     *D4               RETURN IF BACKSPACE EDITING
         MTB,-1   ARSZ,R2           DECREMENT ARSZ
         B        *D4
         ELSE
         BCR,8    ECHOESC2
         FIN
ECHOESC1 BAL,SR2  COCSEND1          ECHO CHARACTER IN ESCAPE SEQUENCE
ECHOESC2 LI,R5    X'B1'
         BAL,SR2  COCSEND1          SEND BACKSLASH
         MTB,2    CPOS,R2           INCREMENT CARRIAGE POSITION BY TWO
         B        *D4               RETURN TO CALLER
         SPACE
*
*                 ROUTINE TO ECHO 'CR,LF' AND MOVE CARRIAGE POS TO CPI
ECHOCRCPI EQU     %
*
*  SINCE CPOS (CURRENT CARRIAGE POSITION) ISN'T ALWAYS CORRECT AT THIS
*  POINT, SET IT UP SO THAT THE TIMING ALGORITHMS WILL GENERATE
*  THE MAXIMUM NUMBER OF IDLES:  CPOS SHOULD BE HIGH FOR
*  NON-MEMOREX TERMINALS, AND LOW FOR MEMOREX TERMINALS.
*
         LB,R15   MODE4,R2          L/TIMING ALGORITHM #
         AND,R15  X38               &/ALGORITHM # W/.38; MASK
         AI,R15   -3**3             -3 FROM ALGO #; SEE IF MEMOREX
         BEZ      %+2               B/MEMOREX; SET CPOS TO 0
         LI,R15   130               L/130; CPOS FOR IDLE ALGORITHM
         STB,R15  CPOS,R2           S/CPOS; INSURE SUFFICIENT # OF IDLES
         BAL,D4   ECHOCR            SEND 'CR,LF'
         LB,D4    CPI,R2
         STB,D4   CPOS,R2           UPDATE CARRIAGE POSITION
         LI,R5    X'40'             SET TO SEND SPACES
         LI,SR2   %+1
         BDR,D4   COCSEND1          POSITION CARRIAGE TO CPI
         B        *D2
         PAGE
*                 THIS ROUTINE SETS RETURN FROM ECHO FOR ACTIVATION RCVD
SETACT   EQU      %
         CW,SR4   Y01
         BANZ     *D4               RETURN IF ACTIVATION ALREADY SENSED
         AW,SR4   X1000001          SET FOR ACTIVATION RETURN OF ECHO
SETACT1  EQU      %
         LCW,R1   R4
         STH,R1   TL,R2             SAVE ACTIVATION POINT
SETACT2  EQU      %
         DO       PMONOFF=1
         LW,SR2   R0                SAVE R0
         BAL,R0   CURNTIM
         LW,R0    SR2               RESTORE R0
         OR,R1    X1                 FORCE EOMTIME NON-ZERO
         STH,R1   EOMTIME,R2
         ELSE
         STH,D4   EOMTIME,R2        MAKE EOMTIME NON-ZERO
         FIN
         LB,R1    MODE,R2
         AND,R1   EF                TURN OFF READ PENDING MODE BIT
         STB,R1   MODE,R2
         DO1      CNM
CHKPTAP2 EQU      %
SENDXOFF LI,R1    XOFF              L/XOFF CHAR; STOP PAPER TAPE READER
CHKPTAP  EQU      %
         LC       MODE,R2
         BCR,8    *D4               RETURN IF NOT ECHOPLEX
         LC       MODE2,R2
         BCS,4    CHKPTAP1          BRANCH IF MODE IS 'XON'
         LC       MODE3,R2
         BCR,4    *D4               RETURN IF NOT MODE 'XON' OR 'ESC P'
CHKPTAP1 LI,R9    COCSEND2          L/ADR OF SEND ROUTINE IF CHAR IS XON
         CI,R1    XON               C/CHAR W/XON
         BE       %+2               YES, PUT IN BUFF
         LI,SR2   COCSUF            NO-XOFF, SUF
         LB,R1    *SR3,R1           XLATE AND MOVE
         XW,R1    R5                  CHAR TO R5
         BAL,SR2  *SR2
         LW,R5    R1
         B        *D4
         PAGE
*
*                 ROUTINE TO RELEASE BUFS STARTING AT C(R4) THRU C(R0)
COCFIB   EQU      %
         LI,R5    X'FFF0'
         AI,R4    0
         BEZ      FIB15             BRANCH IF NO BUFFERS EXIST
         CH,R4    COCIR,R2
         BNE      %+2               BRANCH IF NOT AT THE IR BUFFER
         OR,R5    Y8                REMEMBER IF CHAIN STARTS WITH IR BUF
COCFIB1  EQU      %
         CS,R4    R0
         BE       COCFIB2           RELEASE ALL COC BUFFERS STARTING
         BAL,R6   COCPUTBL          WITH C(R4) UNTIL THE BUFFER POINTED
         BNEZ     COCFIB1           TO BY R0 IS FOUND
FIB10    EQU      %
         AI,R5    0
         BLZ      LIER              ERROR IF REMOVAL POINT RELEASED
FIB15    EQU      %
         LI,R0    0
         B        *D3               RETURN, END OF CHAIN WAS ENCOUNTERED
*
COCFIB2  EQU      %
         CH,R0    COCII,R2
         BNE      COCFIB3           BRANCH IF NOT AT INSERTION POINT
         BAL,R6   COCPUTBL          RELEASE INSERTION POINT BUFFER
         BNEZ     LIER              ERROR IF END OF CHAIN NOT REACHED
         STH,R4   COCII,R2          ZERO THE INSERTION POINTER
         LI,R0    0
         AI,R5    0
         BLZ      COCFIB5           BRANCH IF REMOVAL POINT WAS RELEASED
LIER     SCREECH  X'12'             SCREECH .12
COCFIB3  EQU      %
         LW,R4    R0
         AI,R0    1
         CI,R0    15
         BANZ     COCFIB4           BRANCH IF NEW REMOVAL PT IN SAME BUF
*                 NOT ALL BUFFERS WILL BE RELEASED-OBTAIN NEW REMOVAL PT
*                 UPDATE REMOVAL POINTER
         BAL,R6   COCPUTBL          NEXT BUFFER IN THE INPUT CHAIN
         BEZ      FIB10             BRANCH IF END OF CHAIN DETECTED
         LW,R0    R4
         AI,R4    -1
COCFIB4  EQU      %
         AI,R5    0
         BGEZ     *D3               RETURN IF NOT UPDATING IR
COCFIB5  EQU      %
         STH,R0   COCIR,R2
         B        *D3               RETURN
         SPACE    3
*
*                 THIS ROUTINE LOADS CC'S WITH BITS 8-11 OF UH:FLG
CCFLG811 EQU      %
         LB,R6    LB:UN,R2
         SLS,R6   1
         AI,R6    1
         LC       UH:FLG,R6
         B        *D4
         SPACE    3
*        THIS ROUTINE CHECKS FOR LOGON BEING ASSOCIATED
CHKLOGON EQU      %
         LB,R6    LB:UN,R2
         LB,R6    UB:ACP,R6         L/ASSOCIATED COMMAND PROCESSOR #
         LD,D1    P:NAME,R6
         SD,R12   TCLOGON           SEE IF TEXTC 'LOGON'
         B        *D4               RETURN
         TITLE    'O U T P U T   I N T E R R U P T   R O U T I N E'
*                                                                          08810
*                                                                          08820
* TELETYPE OUTPUT INTERRUPT ROUTINE                                        08830
*                                                                          08840
*  ENTER INHIBITED, WITH REGISTER BLOCK 1, AND THE COC NUMBER IN R3.
*
COCOP    EQU      %                                                        08850
*        OUTPUT INTERRUPT ROUTINE - R3 = COC#
         EXU      CO:OUTRS,R3       OUTPUT RESPONSE - FIND LINE NUMBER
         AND,7     M6               MASK OFF EXTRA BITS
         LD,R4    COD:LPC,R3         R4 =  LOGICAL LINE # OF 1ST LINE IN
*                                   COC CURRENTLY PROCESSING- R5 = LAST#
         LW,R2    R7
         AW,R2    R4                R2 =  LOGICAL LINE TO PROCESS
         CW,R2    R5                CHECK FOR VALID LINE
         BG       COCOP30           BRANCH IF INVALID LINE
*
         DO1      CNM
COCOP05  EQU      %
         LB,SR4   COCOC,R2
         BEZ      COCOP30           BRANCH IF INTERUPT IS EXTRANEOUS
         DO       PMONOFF=1
         MTW,1    C:CO
         FIN
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    COCOP10           BRANCH IF NOT 2741
         LB,R5    MODE,R2
         AI,R5    -X'40'
         BLZ      COCOP10           BRANCH IF EOA IS NOT PENDING
         STB,R5   MODE,R2           RESET EOA PENDING BIT
         LI,R5    X'34'             SET TO XMIT EOA
         B        COCOP52           BRANCH TO TRANSMIT EOA
         FIN
COCOP10  EQU      %
         LH,R4    COCOR,R2          GET RMVL POINT
         BEZ      COCOP20           LINE FINISHED  -  EXIT
         LB,R5    COCBUF,R4         GET CHAR
         DO       CNM
         CI,R5    COC:SPECHAR       IS IT THE SPECIAL CHAR
         BNE      COCOP10A          NO
         PUSH     7
         BAL,13   COCDSABL
         BAL,SR4  GETECBWT          GET WAIT BLOCK
         BNEZ     COCOP10D          FOUND THE BLOCK
         PULL     7
         LB,SR4   COCOC,R2          NO BLOCK, RESTORE
         INHIBIT
         BAL,13   COCENABL
         B        COCOP10A          OUTPUT CHARACTER COUNT
COCOP10D EQU      %
         AI,R5    X'100'
         BAL,6    COCOP10E
         PULL     7
         INHIBIT
         BAL,13   COCENABL
         B        COCOP11
COCOP10E LW,10    2,7               GET ECB ADDRESS
         LW,9     Y01               SET TYC
         LB,8     LB:UN,R2          USER #
         BAL,11   ECBPOST1          POST THE ECB
         LC       7                 SEE IF BLOCK USED
         BCS,8    COCOP10C          YES, SKIP RELEASE
         XW,2     7                 SAVE LINE #
         BAL,1    ECBFBLK           RELEASE BLOCK
         XW,2     7                 RESTORE USER #
COCOP10C LB,SR4   COCOC,R2          SET COUNT AGAIN
         B        0,6
COCOP10A EQU      %
         FIN
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    COCOP11           BRANCH IF NOT 2741
         CI,R5    8
         BAZ      OP10A             NOT A 2741 CONTROL CODE
         CI,R5    4
         BAZ      OP10A             NOT A 2741 CONTROL CODE
         CI,R5    X'2D'
         BNE      COCOP11           BRANCH IF CONTROL CODE NOT A CR
OP10A    EQU      %
         LB,R6    COCTERM,R2
         CI,R5    X'40'
         BAZ      OPLC              LC CHAR
         BE       COCOP11           BRANCH IF CHAR IS A SPACE
         CI,R6    1
         BANZ     OP2741P           TERMINAL ALREADY UC
         LI,R5    X'1C'             UC SHIFT
         B        OPCS              CASE SHIFT
OPLC     EQU      %
         CI,R6    1
         BAZ      OP2741P           TERMINAL ALREADY LC
         LI,R5    X'1F'             LC SHIFT
OPCS     EQU      %
         LC       MODE3,R2
         BCR,1    OP2741P           DON'T SET TERM CASE IF KB UNLOCKED
         EOR,R6   X1
         STB,R6   COCTERM,R2        REVERSE TERMINAL CASE
         B        COCOP52           OUTPUT CASE SHIFT CHARACTER
OP2741P  EQU      %
         SCS,R5   32
         BOD      %+2
         EOR,R5   X40               SET PARITY ODD IF NOT
         FIN
COCOP11  EQU      %
         MTB,-1   COCOC,R2          DECREMENT OUTPUT COUNT
         AI,SR4   -2
         BGZ      COCOP35           BRANCH IF MORE CHAR'S IN BUFFER
         BEZ      COCOP40           BRANCH IF LAST CHAR IN OUTPUT BUF'S
         SCREECH  X'13'             SCREECH .13
COCOP35  EQU      %
         AI,R4    1                 BUMP REMOVAL POINT
         CI,R4    X'F'
         BANZ     COCOP50           BRANCH IF STILL IN SAME BUFFER
         AI,R4    -1                BACK UP R4 TO WITHIN BUFFER
COCOP40  EQU      %
         BAL,R6   COCPUTBL          RELEASE, RTN LINK
COCOP50  EQU      %
         STH,R4   COCOR,R2
COCOP52  EQU      %
         LW,R6    R7
         DO       CNM
         CI,R5    COC:SPECHAR+X'100' IS IT THE SPECIAL CHAR
         BE       COCOP05           YES, GET ANOTHER THEN
         FIN
         SLS,R5   8
         OR,R6    R5                MERGE CHAR, LINE #
         EXU      CO:XDATA,R3       XMIT
*                 CHECK IF USER SHOULD BE UNBLOCKED.
         CW,SR4   SL:UB
         BNE      COCOP57           BRANCH IF NOT AT UNBLOCK LIMIT
COCOP54  EQU      %
         LB,R6    LB:UN,R2
         LB,R6    UB:US,R6          PICK UP USER STATE
         AI,R6    -STOBO
         BEZ      OP57
         AI,R6    STOBO-STOB
         BNEZ     COCOP57           BRANCH IF USER IS NOT BLOCKED
OP57     EQU      %
         LW,R5    CO:OUT,R3         L/ADR OF INTERRUPTED PSD
         LD,R0    *R5               L/PSD AT TIME OF INTERRPUT
         STD,R0   CO:IN0            SAVE FOR ENVIRONMENT PUSH
         BAL,R13  COCDSABL          SET T:COCHC LOCKOUT, DISABLE COC INTS
*                                   .. RESET INHIBITS
         LW,R7    R2                LINE # TO R7 FOR T:TCE
         LI,R6    E:CUB             RECORD EVENT
         BAL,SR4   T:RCE                                                   09850
SCHDEXIT EQU      %
         LRP      CO:IN0+1          L/RGSTR PNTR FROM INTERRUPTED PSD
         T:PUSHE  CO:IN0            PUSH ENVIRONMENT
         LI,R13   T:SSE             L/EXIT ADR FOR COCENABL
SCHDXITC LPSD,3   SCHPSD            ARM (CLEAR) ACTIVE INT LEVEL,
*                                   .. ENABLE COC INTS, CLEAR T:COCHC
*                                   .. LOCK-OUT FLAG, GO TO T:SSE
*
*                                                                          10100
COCOP20  EQU      %
         STB,R4   COCOC,R2          ZERO OUTPUT COUNT
         LC       MODE2,R2
         BCR,8    COCOP25           BRANCH IF LINE NOT REPORTED OFF
         STB,R4   COCTERM,R2        RESET TERM TYPE TO 0
         EXU      CO:RCVDOFF,R3     TURN RECEIVER DATA SET OFF
         STH,R4   TL,R2             TL=0 SAYS THAT LOGOFF WAS PERFORMED
         EXU      CO:RCVON,R3       AND REINITIALIZE
COCOP25  EQU      %
         EXU      CO:XSTOP,R3       CLEAR SCANNER
         B        COCOP54
COCOP30  EQU      %
         MTW,1    COCOEC            BUMP OUTPUT ERROR COUNT
         STB,R3   COCOEL            S/COC #
         EXU      CO:XSTOP,R3       CLEAR SCANNER
COCOP57  EQU      %
         LW,R4    CO:OUT,R3
         LPSD,11  *R4               EXIT LEVEL
         TITLE    'E N A B L E / D I S A B L E   S U B R O U T I N E S'
********************************************************************************
*
*  CO:INTFL VALUES/STATES
*
*  .FF00XXXX
*
*  1  WE'RE IN INPUT INTERRUPT PROCESSING.
*  2  COC 0'S INPUT INTERRUPT LEVEL IS ACTIVE (IT ALSO IS THE HIGHEST
*     PRIORITY COC INTERRUPT).
*  3  ALL COC INTERRUPT LEVELS ARE ENABLED.
*  4  T:COCHC IS LOCKED OUT.
*
*  .0001XXXX
*
*  1  ONE OF THE FOLLOWING PROCESSES IS ACTIVE:
*     A  OUTPUT INTERRUPT PROCESSING.
*     B  THE COCOFF SUBROUTINE IS BEING EXECUTED.
*     C  COC READ/WRITE PROCESSING THRU COCIO WITH A DCB.
*     D  'SEND' KEYIN PROCESSING THRU COCSENDX.
*  2  ALL COC INTERRUPT LEVELS ARE DISABLED.
*  3  T:COCHC IS LOCKED OUT.
*
*  .0000XXXX
*
*  1  EITHER WE AREN'T IN ANY INTERRUPT-SENSITIVE AREA OF COC OR
*     WE ARE INHIBITED.
*  2  COC INTERRUPTS ARE ENABLED.
*  3  T:COCHC WILL PERFORM IT'S LOGON/LOGOFF FUNCTIONS IF CALLED.
*
*  IF WE AREN'T IN T:COCHC, XXXX IS THE NUMBER OF TIMES THAT
*  T:COCHC WAS BY-PASSED BECAUSE OF ACTIVE COC PROCESSING.  UPON
*  ENTRY TO T:COCHC, XXXX IS INCREMENTED.
*
********************************************************************************
         PAGE
********************************************************************************
*
*  RESET T:COCHC LOCK-OUT FLAG TO PERMIT HANG-UP AND LINE
*  INITIALIZATION.  ENABLE COC INPUT AND OUTPUT INTERRUPTS.
*
********************************************************************************
COCENABL EQU      %
         LI,R14   0                 L/0
         STH,R14  CO:INTFL          CLEAR T:COCHC FLAG
         LW,R14   CO:AIL            L/ALL COC INT LEVEL SELECT BITS
         :WD,R14  ENABLE,COA:IG     ENABLE ALL COC INTERRUPTS
         B        *R13              RETURN
         SPACE    2
********************************************************************************
*
*  SET INHIBITS.
*
*  SET T:COCHC LOCK-OUT FLAG TO PREVENT CALLS FROM CLOCK3 TO THE HANG-UP
*  AND CALL-UP ROUTINES (T:COCHC).  IT ALSO TELLS COCINIT WHETHER OR NOT
*  TO ENABLE THE COC INPUT AND OUTPUT INTERRUPT LEVELS.
*
*  DISABLE THE COC INPUT AND OUTPUT INTERRUPT LEVELS.
*
*  RESET INHIBITS.
*
********************************************************************************
COCDSABL EQU      %
         INHIBIT                    INHIBIT
         MTH,1    CO:INTFL          SET T:COCHC LOCK-OUT FLAG
         LW,R14   CO:AIL            L/ALL COC INT LEVEL SELECT BITS
         :WD,R14  DISABLE,COA:IG    DISABLE ALL COC INTERRUPTS
         RINHIBIT                   RESET INHIBITS
         B        *R13              RETURN
         PAGE
********************************************************************************
*
*  PERFORM ENTRY AND EXIT TO T:REG IN SSS.
*
*  BEFORE ENTERING, SET INHIBITS, RESET T:COCHC LOCK-OUT FLAG,
*  ENABLE COC INPUT AND OUTPUT INTERRUPTS.
*
*  AFTER RETURN FROM T:REG, DISABLE COC INPUT AND OUTPUT INTERRUPTS
*  AND SET T:COCHC LOCK-OUT FLAG.
*
*  T:REG SAVES ALL REGISTERS.
*
********************************************************************************
C:REG    EQU      %
         PUSH     (R13,R14)         PUSH R13 -> R14
         INHIBIT                    SET INHIBITS; CAN'T ALLOW ANY T:RCE
*                                   .. CALLS (E.G., E:CIC ON THIS LINE)
         BAL,R13  COCENABL          CLEAR T:COCHC LOCKOUT, ENABLE COC INTS
         BAL,R11  T:REG             BAL/T:REG
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT, DISABLE COC INTS
         PULL     (R13,R14)         PULL R13 -> R14
         B        *R12              RETURN
         SPACE    3
********************************************************************************
*
*  ENABLE AND DISABLE COC INPUT AND OUTPUT INTERRUPTS
*
*  THE PURPOSE OF THIS IS TO AVOID RING BUFFER OVER-RUNS AND TO
*  KEEP OUTPUT INTERRUPT PROCESSING RUNNING SMOOTHLY.
*
********************************************************************************
C:ENABLE%DISABLE ;
         EQU      %
         BAL,R13  COCENABL          CLEAR T:COCHC LOCK-OUT, ENABLE COC INTS
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT, DISABLE COC INTS
         B        *R12              RETURN
         TITLE    'B L O C K I N G   B U F F E R   A L L O C A T O R'
         SPACE    1                                                        10590
* INPUT/OUTPUT BUFFER BLOCK ALLOCATOR                                      10600
*  CALL:  BAL,6  COCGETB
*  EXIT WITH RELATIVE BUFFER ADDRESS IN R4
* NOTE:  AVAILABLE BUFFER CHAIN IS RIGHT LINKED
         SPACE    3                                                        10620
COCGETB  RES      0
         LW,4     COCHPB            HEAD
         BEZ      0,R6              RETURN IF NO BUFFERS ARE AVAILABLE
         DO1      1-COCGBUG
         BLZ      SCR
         STW,R6   COCHPB            SAVE R6
         DO       COCGBUG=1
         LW,R6    R4
GETB0    EQU      %
         BLZ      SCR
         CW,R4    COCBUF,R6
         BE       SCR
         CI,R6    HRBA
         BG       SCR
         CI,R6    3
         BANZ     SCR
         DO       COCGBUGE
         RD,0     0                 CHECK SENSE SWITCH 4
         ELSE
GETBR    B        GETB1             REPLACE WITH RD,0 0 TO KEY BUF
*                                   .. CHECKING OFF OF SENSE SWITCH 4
         FIN
         BCR,1    GETB1             BRANCH IF NOT SECURITY CHECKING
         LW,R6    COCBUF,R6
         BNEZ     GETB0
         FIN
GETB1    EQU      %
         LW,R6    COCBUF,R4         CHAIN INTO R6
         XW,R6    COCHPB            RESTORE R6, SET HEAD TO CHAIN
         MTB,1    BUFCNT,R2         BUMP BUFFER COUNT FOR THIS USER
         SLS,R4   2                 POINT 2 INTO BUF (LINK OF BUF = 0)
         AI,R4    2
         B        1,R6
         PAGE                                                              10900
* INPUT/OUTPUT LINE BUFFER BLOCK UPDATE ROUTINE                            10910
*        AVAILABLE BUFFERS ARE RIGHT LINKED
*
COCPUTBL RES      0                 6= RETURN , 4=BUFF
         CI,R4    HRBA+HRBA+HRBA+HRBA+15
         BG       SCR               BUFFER ADDRESS TOO BIG
         CI,R4    15
         BG       PUTBL1
SCR      SCREECH  X'10'             SCREECH .10
PUTBL1   EQU      %
         MTB,-1   BUFCNT,R2         DECREMENT BUFFER COUNT FOR THIS USER
         AND,R4   XFFF0
         SLS,R4   -2
         XW,6     COCHPB            OLD CHAIN TO 6
         DO       COCPBUG=1
         BEZ      PUTBL3
         PUSH     R6
PUTBL0   EQU      %
         CW,R6    R4
         BE       SCR
         CI,R6    HRBA
         BG       SCR
         CI,R6    3
         BANZ     SCR
         DO       COCPBUGE
         RD,0     0                 CHECK SENSE SWITCH 4
         ELSE
PUTBR    B        PUTBL2            REPLACE WITH RD,0 0 TO KEY BUF
*                                   .. CHECKING OFF OF SENSE SWITCH 4
         FIN
         BCR,1    PUTBL2            BRANCH IF NOT SECURITY CHECKING
         LW,R6    COCBUF,R6
         BGZ      PUTBL0
         BLZ      SCR
PUTBL2   EQU      %
         PULL     R6
PUTBL3   EQU      %
         FIN
************************************************************************
*  RELEASE THE BUFFER WHOSE RELATIVE ADDRESS IS IN R4.
************************************************************************
         XW,R6    COCBUF,R4         X/ADR OF FIRST BUFFER IN FREE POOL
*                                   .. (R6) W/FLINK CONTAINED IN THE
*                                   .. BUFFER WE'RE RELEASING (COCBUF,R4
*                                   .. LEFT HALF)
         XW,R4    COCHPB            X/ADR OF BUFFER WE'RE RELEASING (R4)
*                                   .. W/BAL ADR (COCHPB)
         XW,R6    R4                X/FLINK CONTAINED IN THE BUFFER WE
*                                   .. RELEASED (R6) W/BAL ADR (R4)
         LH,R4    R4                RJ/FLINK CONTAINED IN THE BUFFER WE
*                                   .. JUST RELEASED
         B        0,R6
         TITLE    'R E A D   R O U T I N E'
************************************************************************   11030
*                                                                          11040
*       USES ALL REGISTERS
*   LINKAGE:  BAL,11  COCRD                                                11060
*        IN:  R7 = BYTE ADDRESS WHERE INPUT IS TO BE PLACED                11070
*             R0 = OPERATION CODE
*            SR1 = MAXIMUM BYTE SIZE OF MESSAGE                            11080
*             R1 = ADDRESS OF USER'S DCB
*            SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*             R2 = LINE NUMBER OF ORIGINATING MESSAGE
*       OUT:  D1 = TYPE OF COMPLETION CODE
*            SR1 = BYTE SIZE OF MESSAGE TRANSFERRED                        11100
*                                                                          11110
************************************************************************   11120
COCRD    EQU      %                                                        11130
* AVOID A POSSIBLE LINE TIE-UP BY AN EXIT CONTROL ROUTINE
*  WITH THE LINE ALREADY SIGNALED AS OFF
         LI,R13   KICKOFF           L/EXIT ADR FOR COCENABL
         LC       MODE2,R2          LINE OFF BIT SET
         BCS,8    COCENABL          B/LINE OFF; ABORT VIA STEP
         DO       PMONOFF=1
         BAL,4    READREQ           RECORD PERFORMANCE DATA
         FIN
         PUSH     1,SR4             SAVE REGISTER
         STB,SR1  RSZ,R2            SAVE REQUESTED MESSAGE SIZE
         LI,R3    X'8000'
         STH,R3   TL,R2             INITIALIZE TAB LINK
         PUSH     R1                SAVE DCB ADDRESS
*                 INITIALIZE MODE AS TO TRANSPARENT OR NON-TRANSPARENT
         DO       2741CODE=1
         LC       MODE2,R2
         BCS,1    COCRD20           BRANCH IF 2741
         FIN
         SPACE
         AND,R0   M2                GET OPER CODE BITS 6 & 7
         AI,R0    X'1D'             TRANSPARENT RD OP CODE BECOMES X'20'
         LI,R1    X'20'             MASK TO SELECT TRANSPARENT BIT
         LB,D4    MODE,R2
         CS,R0    D4
         BE       COCRD20           BRANCH IF MODE DOES NOT CHANGE
         SPACE
*                 CHANGE FROM TRANSPARENT TO NON-TRANS. (OR VICE-VERSA)
         EOR,D4   R1                FLIP TRANSPARENT MODE BIT
         STB,D4   MODE,R2
         BAL,SR2  KILLIN            RELEASE ALL INPUT BUFFERS
*                 SEND PROMPT IF REQUIRED
COCRD20  EQU      %
         PUSH     R7                SAVE BUFFER ADDRESS
         BAL,D4   CCFLG811
         BCS,12   COCRD38           BRANCH IF TEL OR DELTA IS IN CONTROL
         DO       CNM
         LC       MODE5,R2          SLAVE LINES GET NO PROMPT CHAR
         BCS,8    COCRD30
         FIN
         LI,R5    JB:PROMPT
         LB,R5    0,R5              PICK-UP PROMPT CHARACTER
         BEZ      COCRD30           BRANCH IF NO PROMPT
         BAL,SR2  COCPCIB
*                 TAB BUFFER INITIALIZATION
COCRD30  EQU      %
         DO       CNM
         LI,R7    M:UC+19           SET UP DEFAULT DCB TO USE
         STW,R7   J:BASE
         LC       MODE5,R2
         BCR,8    COCRD30A
         LI,7     -1
         LW,1     *TSTACK,7         GET DCB ADDRESS
         LW,R7    R1
         AI,R7    19
         STW,R7   J:BASE
         LI,R7    BATAB             IS SLAVE, USE TABS FROM USERS DCB IF ANY
         LB,D3    *R1,R7            ANY THERE
         BEZ      COCRD38           NO
         B        COCRD30B
COCRD30A EQU      %
         FIN
         LB,D3    M:UC+15           GET FIRST TAB STOP IN M:UC DCB
         BEZ      COCRD38           BRANCH IF NONE
         DO1      CNM
COCRD30B EQU      %
         LC       MODE,R2
         BCS,2    COCRD38           BRANCH IF IN TRANSPARENT TEXT MODE
         ANLZ,R5  MUHT1             INITIALIZE R5 WITH TL AS A
         AI,R5    8-HA(COCBUF)      HALF-WORD DISPLACEMENT FROM COCBUF+4
         LI,SR1   0
         LI,R7    -16               SET TO MOVE 16 TAB STOPS
         LC       MODE3,R2
         BCR,8    COCRD32           BRANCH IF NOT TABBING RELATIVE
         LB,SR1   CPOS,R2
         AI,SR1   -1
         B        COCRD32
*
COCRD36  EQU      %
         BANZ     COCRD34
         BDR,R4   COCRD35           DECRE R4.
*                 PREPARE TO MOVE NEXT TAB STOP INTO TAB BUFFER
COCRD31  EQU      %
         AI,R4    1                 INCREMENT BUFFER POSISTION
         CI,R4    15
         DO       CNM
         LB,D3    *J:BASE,R7
         ELSE
         LB,D3    M:UC+19,R7        GET NEXT TAB STOP FROM DCB
         FIN
         BEZ      COCRD36
         BANZ     COCRD33           BRANCH IF ROOM IN BUFFER FOR TAB STP
*                 OBTAIN TAB BUFFER IN ORDER TO STORE THIS TAB STOP
         SCD,R4   31
COCRD32  EQU      %
         BAL,R6   COCGETB           GET A BUFFER
         B        COCRD80           NONE AVAILABLE, REG FOR BUFFER
         STH,R4   COCBUF-4,R5       LINK NEW BUFFER TO TAB BUFFER CHAIN
*
COCRD33  EQU      %
         AW,D3    SR1               APPLY RELATIVE TAB ADJUSTMENT
         STB,D3   COCBUF,R4         AND STORE INTO BUFFER
         BIR,R7   COCRD31
         AI,R4    1
*                 TAB STOPS HAVE BEEN MOVED, FLAG END OF TABS WITH ZERO
COCRD34  EQU      %
         STB,R3   COCBUF,R4
COCRD35  EQU      %
         SCD,R4   28
         AI,R5    1
         SLS,R5   3
         STH,R3   COCBUF-4,R5       LINKAGE POSITION OF LAST TAB BUFFER
         SPACE
*                 INITIALIZE CARRIAGE POSITION AT START OF READ (CPI)
COCRD38  EQU      %
         LB,D4    CPOS,R2
         STB,D4   CPI,R2
         STB,R3   ARSZ,R2           INITIALIZE ARSZ TO ZERO
         LH,R3    TL,R2             SAVE TAB LINK IN R3 FOR ACTIVATION
         SPACE
         DO 2741CODE=1
*                 UNLOCK 2741 KEYBOARD
         BAL,SR4  2741EOT           SEND EOT TO UNLOCK 2741 KEYBOARD
         FIN
         SPACE
*                 ECHO ALL CHARACTERS READ AHEAD FOR THIS RECORD
COCRD40  EQU      %
         AND,R3   M16
         LH,R0    COCIR,R2          SET HEAD OF BUFFER POINTER FOR ECHO
         LH,R4    COCIR,R2          INITIALIZE BUFFER POSITION FOR ECHO
         BEZ      COCRD70           BRANCH IF NO DATA READ AHEAD
COCRD45  EQU      %
         LI,R5    0
         STH,R5   EOMTIME,R2         EOMTIME=0 MEANS READER USING ECHO
         LB,R5    COCBUF,R4         GET EBCDIC CHARACTER FROM BUFFER
         BAL,SR4  COCECHO           ECHO CHARACTER
         B        %+2
         OR,R3    Y8                SET TO INDICATE ACTIVATION OCCURANCE
         CH,R0    COCIR,R2
         BE       COCRD60           BRANCH IF NO CTL-X OR CTL-Y OCCURED
         LI,R0    0                 SET TO RELEASE READER INPUT CHAIN
         DO       2741CODE=1
         BAL,SR1  ESCX0             RELEASE CHAIN & SEND LINE DELETE SEQ
         ELSE
         BAL,SR4  ESCX0             RELEASE CHAIN & SEND LINE DELETE SEQ
         FIN
*
         BAL,SR4  CHKBRKYC
         BAZ      COCRD40           BRANCH IF NO BREAK OR CTL-Y RECEIVED
         PAGE
*                 ACTIVATION CHARACTER HAS BEEN RECEIVED
COCRD50  EQU      %
         C:EN%DSABL                 ENABLE COC INTS, CLEAR T:COCHC
*                                   .. LOCK-OUT, DISABLE COC INTS, SET
*                                   .. T:COCHC LOCK-OUT FLAG
COCRD50E EQU      %
         PULL     D3                BUFFER ADDRESS INTO D3
         LH,R7    EOMTIME,R2        SAVE ACTIVATION TIME
         LW,R1    R3
         LCH,R3   TL,R2             GET ACTIVATION REQUEST
         STH,R1   TL,R2             RESTORE TAB LINK FROM R3
         BAL,SR4  CHKBRKYC
         BANZ     COCRD51           BRANCH IF BREAK OR CTL-Y OCCURED
         LC       MODE2,R2
         BCS,8    COCRD51           BRANCH IF TERMINAL IS OFF
         LB,R1    ARSZ,R2
         BEZ      COCRD51           LOST DATA IF ARSZ=0
         LI,R4    0
         STH,R4   EOMTIME,R2        PREVENT BUFFER RELEASE AT INT LEVEL
         LH,R4    COCIR,R2
         LW,R0    R4                SAVE REMOVAL POINT IN R0
         BAL,SR2  COCMU             MOVE INPUT TO USER'S BUFFER
         C:EN%DSABL                 ENABLE COC INTS, CLEAR T:COCHC
*                                   .. LOCK-OUT, DISABLE COC INTS, SET
*                                   .. T:COCHC LOCK-OUT FLAG
         PAGE
*
*        PERFORM ALL NECCESSARY CLEAN-UP REQUIRED FOR END OF READ
*
         LW,D4    R5                SAVE PSEUDO TYC IN D4
         CB,D4    YBE
         BNE      COCRD52           BRANCH IF NO DATA LOST IN MESSAGE
         SPACE
COCRD51  EQU      %
         LH,R4    COCII,R2          SET TO RELEASE BUF'S THRU INSERT PT.
         BAL,SR2  CLEARLD           CLEAR LOST DATA BIT IN LINE TABLE
         LW,D4    Y03               SET PSEUDO TYC TO 'LOST DATA'
         SPACE
COCRD52  EQU      %
         PULL     R1                RESTORE DCB ADDRESS
         XW,R0    R4
         CH,R4    COCIR,R2
         BE       %+2               BR IF CTL-X OR CTL-Y DIDN'T OCCUR
         LI,R0    0                 SET TO RELEASE ALL BUF'S IN CHAIN
         STH,R7   EOMTIME,R2        RESTORE TIME OF ACTIVATION
         BAL,SR2  KILLIN1           FREE INPUT BUF'S THRU ACTIVATION  PT
*                 SET TYC IN D1 & SEND HEADING IF NECESSARY
         LI,D1    1                 INITIALIZE TYC
         STB,D1   CPI,R2            INITIALIZE CPI
         BAL,SR4  CHKBRKYC
         BAZ      COCRD53           BRANCH IF NO BREAK OR CTL-Y OCCURED
         DO       CNM
         LC       MODE5,2
         BCS,8    COCRD53           NO BREAKS ON SLAVE LINES
         FIN
         MTW,-1   TSTACK+2          SET USER'S PSD AT START OF READ
         LI,D4    0
COCRD53  EQU      %
         DO       COCPCP=1
         BAL,SR4  WRNLB             ADJUST JB:LC & SEE ABOUT PAGE
         MTB,-1   D4
         BNC      COCRD55           BRANCH IF NO PSEUDO TYC
         BNEZ     COCRD54           BRANCH IF PSEUDO TYC IS NOT FORM FEED
         LI,SR4   COCRD55           SET RETURN FOR PAGE
         B        PAGE
         ELSE
         MTB,-1   D4
         BNC      COCRD55           BRANCH IF NORMAL TYC
         BEZ      COCRD55           BRANCH IF FORM FEED
         FIN
COCRD54  EQU      %
         LB,D1    D4                UPDATE TYC IN D1
         SPACE
*        SET ARS AND RETURN TO CALLER
COCRD55  EQU      %
         LB,SR1   ARSZ,R2           ARS INTO SR1 FOR CALLER
         DO       PMONOFF=1
         BAL,R4   RDMSGSIZ          RECORD SIZE OF INPUT MESSAGE
         FIN
         MTW,1    J:INTER           INCREMENT COUNT OF USER INTERACTIONS
         DO       CNM
         LB,R5    MODE5,R2          RESET READ DONE FLAG
         AND,R5   XF7
         STB,R5   MODE5,R2
         CI,R5    X'80'             IS IT SLAVE
         BAZ      PULLSR4           NO
         LI,10    X'1FFFF'
         AND,10   DCB:ECB,R1        GET ECB ADDR
         BEZ      PULLSR4           NONE, QUIT
         LC       *10
         BCS,8    PULLSR4           DONE IF ECB IS POSTED
         STB,D1   9                 SET TYC
         LB,8     LB:UN,R2          GET USER NUMBER
         BAL,11   ECBPOST           POST USERS ECB
         LB,8     ARSZ,R2           RESTORE ARS
         FIN
         B        PULLSR4           PULL SR4 & RETURN TO CALLER
         DO1      CNM
XF7      DATA     X'F7'
         SPACE    3
*                 SETS CONDITION CODE 2 IF BREAK OR CTL-Y WAS RECEIVED
CHKBRKYC EQU      %
         DO       CNM
         LC       MODE5,R2
         BCR,8    %+6
         BCR,1    %+3
         LCI      4
         B        *SR4
         LCI      0
         B        *SR4
         FIN
         LB,R6    LB:UN,R2
         LH,R6    UH:DL,R6
         CI,R6    X'3000'
         B        *SR4              RETURN
         PAGE
COCRD60  EQU      %
         AI,R3    0
         BLZ      COCRD50           BRANCH IF ACTIVATION OCCURED
         CH,R4    COCII,R2
         BE       COCRD70           BRANCH IF NO MORE CHARS TO READ AHD.
         AI,R4    1                 BUMP TO NEXT CHARACTER IN BUFFER
         CI,R4    15
         BANZ     COCRD45           BRANCH IF STILL IN SAME BUFFER
         SLS,R4   -1
         LH,R4    COCBUF-4,R4       LINK TO NEXT CHARACTER
         BNEZ     COCRD45           BRANCH IF LINK EXISTS
         SPACE    3
************************************************************************
*  IF TERMINAL IS IN A PAPER TAPE MODE, TRANSMIT AN XON CHARACTER
*  TO START THE READER.
************************************************************************
COCRD70  EQU      %
         LI,R1    XON               L/XON CHARACTER
         BAL,R15  CHKPTAP           BAL/SEND XON IF IN PAPER TAPE MODE
********************************************************************************
*
*  ALL CURRENTLY COMPLETE INPUT RECORDS HAVE BEEN READ (GIVEN
*  TO USER).  REG, REPORTING COC READ EVENT.  WE COME BACK WHEN
*  THE READ IS SATISFIED.
*
*  INITIALIZE TIMEOUT FOR READ.  THE SYSTEM LIMIT IS IN 1.2
*  SECOND INTERVALS.
*
********************************************************************************
         LW,D3    SL:OITO           INITIALIZE D3 WITH TIMEOUT FOR READ
         BAL,D4   CHKLOGON          CHECK IF LOGON IS ASSOCIATED
         BNE      %+2
         LW,D3    SL:OLTO           RESET D3 TO TIMEOUT FOR LOGON
         STH,D3   EOMTIME,R2
         LC       MODE2,R2
         BCS,8    COCRD50           BRANCH IF LINE REPORTED OFF
         LB,R6    MODE,R2           SET READ PENDING FLAG
         AI,R6    X'10'
         STB,R6   MODE,R2           UPDATE MODE WITH READ PENDING BIT SET
*
*  CLEAR T:COCHC LOCK-OUT FLAG, ENABLE COC INTERRUPTS,
*  GO TO T:REG IN SSS, DISABLE COC INTERRUPTS, SET T:COCHC LOCK-OUT FLAG
*
         DO       CNM
         LC       MODE5,R2          IF SLAVE & ECB SPECIFIED
         BCS,8    COCRD75           THEN DON'T REG
COCRD74  EQU      %
         FIN
         LI,R6    E:CRD             REPORT COC READ EVENT
         C:REG
         DO1      CNM
COCRD77  EQU      %
         LI,R0    0                 CLEAR OLD HEAD OF INPUT
         B        COCRD50E
         DO       CNM
COCRD75  LI,0     X'1FFFF'
         LI,1     -1
         LW,1     *TSTACK,1         GET DCB ADDRESS
         AND,0    DCB:ECB,R1        ANY ECB
         BEZ      COCRD74           NO, REG
         LW,15    2                 SAVE LINE NUMBER
         BAL,1    ECBGBLK           GET A BLOCK
         XW,15    2                 RESTORE LINE NUMBER
         BEZ      COCRD74           NO GOTTUM, REG THE USER
         STW,10   *15               SAVE TRANSLATE TABLE ADDRESS
         LW,10    2                 SAVE USER #
         BAL,1    ECBGBLK           GET WAIT BLOCK
         XW,10    2                 RESTORE USER #
         BEZ      COCRD78           CAN'T GET BLOCK, REG
         PULL     D3                RESTORE BUFFER ADDR
         LW,1     15                BLOCK ADDR TO INDEX REG
         STW,3    2,1               SAVE TAB LINK
         STW,D3   1,1               SAVE BUFFER ADDRESS
         PULL     R1                RESTORE DCB ADDRESS
         LI,14    X'10000'
         STB,2    1                 SET LINE NUMBER
         LCI      4
         STM,14   *10
         LI,D1    0                 SET TYC
         ANLZ,7   GETECB99          GET HA(COC:ECB HEAD)
         BAL,11   WLDLCHN           HOOK TO CHAIN
         BAL,13   COCENABL
         PULL     8,R5
         B        *SR4              RETURN TO USER
COCRD78  XW,2     15
         BAL,1    ECBFBLK           FREE 1ST BLOCK
         LW,2     15                RESTORE LINE #
         B        COCRD74           REG THE USER
         FIN
         SPACE    3
********************************************************************************
*
*  CAN'T GET A BUFFER FOR TABS
*
*  CLEAR T:COCHC LOCK-OUT FLAG, ENABLE COC INTERRUPTS,
*  GO TO T:REG IN SSS, DISABLE COC INTERRUPTS, SET T:COCHC LOCK-OUT FLAG,
*  GO TO COCRD32
*
********************************************************************************
COCRD80  EQU      %
         LI,R6    E:CFB
         C:REG    COCRD32           REG, RETURN TO COCRD32
         TITLE    'M O V E  M E S S A G E  T O  R E A D E R'
************************************************************************
*
*                 MOVES A MESSAGE IN THE COC BUFFER TO CALLER'S BUFFER
*
*   LINKAGE: BAL,SR2 COCMU
*
*        IN: R1 = SIZE OF MESSAGE TO BE MOVED
*            R2 = LINE NUMBER OF ORIGINATING MESSAGE
*            R3 = POINTER TO END OF MESSAGE IN THE COC BUFFER
*            R4 = POINTER TO START OF MESSAGE IN THE COC BUFFER
*            SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*            D3 = BYTE ADDRESS-1 OF CALLER'S BUFFER
*
*    RETURN: R4 = POINTER TO END OF MESSAGE IN THE COC BUFFER
*            R5 = : BYTE 0 = PSEUDO 'TYC', BYTE 3 = LAST CHARACTER MOVED
*
*  DESTROYS: R6,SR4,D1,D2, AND D4
*
************************************************************************
         SPACE    3
*
*
MOVECHAR AI,D1    1                 INCREMENT POSITION OF USER BUFFER
         CB,D1    D1                COMPARE WITH HIGHEST POSITION MOVED
         BG       MOVEC1            BRANCH IF HIGHER POSITION BEING MOVED
         CI,R5    X'40'             BACK-SPACE EDITING MODE IS IN EFFECT
         BNE      MOVEC2            BRANCH ON NON-BLANK CHARACTERS
         B        *SR4              RETURN IF CHARACTER IS BLANK
MOVEC1   STB,D1   D1                UPDATE HIGHEST POSITION MOVED
         CS,D1    R1
         BG       *SR4              RETURN IF ARSZ HAS BEEN EXCEEDED
MOVEC2   EQU      %
         LI,R6    1
         LH,R6    D1,R6             PUT CURRENT POSITION INTO R6
         AW,R6    D3                COMPUTE BYTE LOCATION IN USER BUFFER
         STB,R5   0,R6              MOVE CHARACTER TO USER'S BUFFER
         B        *SR4              RETURN
         SPACE
*                 OUTPUT TRANSLATION TABLE YIELDS SPECIAL FLAG
MUSPEC   EQU      %
         BCS,4    MU4               BRANCH TO IGNORE MODE CHANGE CHAR.
*
         LB,R6    *SR3,R5           GET OUTPUT TRANSLATION VALUE
         LB,R6    MUBTBL-X'20',R6
         B        MUBYTE,R6         GO TO SPECIAL HANDLING ROUTINE
MB       COM,8    AF-MUBYTE
MUBTBL   EQU      %
         MB       MUFF
         MB       MUHT
         MB       MUCRLFNL
         MB       MUCRLFNL
         MB       MUESCF
         MB       MUESCX
         MB       MURUB
         MB       MUESCR
         MB       MUESCCR
         MB       MUBRAC
         MB       MUNOTOR
         MB       MUBS
         MB       MUESCLF
         MB       MU2741LF
         MB       MUPARITY
         MB       MUBS              CONTIGUOUS TTY BS'S
         DO1      32-BA(%)+BA(MUBTBL)
         MB       MUTBLERR
         BOUND    4
         SPACE    3
*
MUBYTE   EQU      MU3               BASE ADDR OF SPECIAL MOVE HANDLERS
MUTBLERR EQU      WRTBLERR          TRANSLATE TABLE ERROR
*
MUESCX   EQU      MUTBLERR          ERROR IF ESC X CHARACTER
MUESCR   EQU      MU4               ESC 'R'  . . .  IGNORE
MUESCCR  EQU      MU4               ESC 'CR'  . . .  IGNORE
MUESCLF  EQU      MU4               ESC 'LF'  . . .  IGNORE
         DO       2741CODE=1
MU2741LF EQU      MU3               2741 'LF', HANDLE AS NORMAL CHAR.
         ELSE
MU2741LF EQU      MUTBLERR          ERROR IF 2741 LINE FEED (INDEX KEY)
         FIN
         PAGE
*
*                 ENTRY POINT
*
COCMU    EQU      %
         LD,D1    DM8               INITIALIZE UBUF POSITION AND MASK
MU1      LB,R5    COCBUF,R4         GET NEXT CHARACTER FROM COC BUFFER
         LC       MODE,R2
         BCS,2    MU3               BRANCH IF TRANSPARENT TEXT
         LC       *SR3,R5
         BCR,8    MU3               BRANCH IF NOT SPECIAL
         BCR,2    MUSPEC            BRANCH IF NOT ACTIVATION CHARACTER
MU3      BAL,SR4  MOVECHAR          MOVE IT TO CALLER'S BUFFER
MU4      EQU      %
         CW,R3    R4
         BE       *SR2              RETURN IF END OF MESSAGE
         AI,R4    1
         CI,R4    X'F'
         BANZ     MU1               UPDATE POINTER TO COC BUFFER
         SLS,R4   -1
         LH,R4    COCBUF-4,R4
         B        MU1
         SPACE    3
*        TTY LEFT OR RIGHT BRACKET CHARACTER
MUBRAC   EQU      MU3
*                 TTY NOT OR OR CHARACTER
MUNOTOR  EQU      MU3
*
MUESCF   LW,R5    X500000D          ESC F  . . . PUT 'CR' IN BUF, TYC=7
*
MUPARITY AW,R5    Y02               PARITY ERROR  . . . TYC = 2
*
MUFF     AW,R5    Y01               FORM FEED  . . . TYC(FOR READER) = 1
*
MUCRLFNL LW,R6    R1                'CR','LF', OR 'NL'  . . .  TYC = 0
         AW,R6    D3
         STB,R5   0,R6              STORE CHARACTER AT END OF MESS. POS.
         B        *SR2              RETURN
         PAGE
*
*                 BACKSPACE CHARACTER
MUBS     EQU      %
         DO       2741ARUB
         CI,R5    X'18'             C/CHAR W/UC BACKSPACE
         BE       %+2               BE; NOT BS-BS, SO LEAVE AS IS
         FIN
         LI,R5    BS                L/BS CHAR IN CASE THIS IS BS-BS
         LC       MODE3,R2          CHECK OVERSTRIKE EDIT MODE FLAG
         BCR,2    MUBS2             BRANCH IF OFF
*                 OVER-STRIKE EDITING MODE IS ON
         CB,D1    D2                CHECK FOR USER BUFFER POSITION = 0
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS IS ZERO
         AI,D1    -1                DECREMENT USER BUFFER POSITION
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
         DO       2741ARUB=1
MUBS2    EQU      %
         CI,R5    X'18'
         BNE      MU3               BRANCH IF NOT 2741 CANCEL (UC'BS')
         ELSE
MUBS2    EQU      MU3
         FIN
*
*                 RUB-OUT CHARACTER
MURUB    LC       MODE3,R2          CHECK OVER-STRIKE EDIT MODE FLAG
         BCS,2    MURUB1            BRANCH IF ON
MURUB0C  EQU      %
         CB,D1    D2                CHECK FOR USER BUFFER POSITION = 0
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS = ZERO
         SW,D1    X1000001          DECREMENT BUFFER POSITIONING INFO
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
MURUB1   LC       MODE2,R2          CHECK MODE2 FOR 2741
         BCS,1    MURUB1C           B/2741
         CB,R12   R12               C/CUR POS W/HIGHEST POS MOVED
         BGE      MURUB0C           BGE; NOT ACTIVELY BS EDITTING
*                                   .. AND NOT 2741; TREAT AS RUBOUT
MURUB1C  AI,R12   1                 BS OVERSTRIKE EDIT, INC USER
*                                   .. BUFFER POSITION
         LI,R5    X'40'             MOVE BLANK TO CALLER'S BUFFER
         BAL,SR4  MOVEC2
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
         PAGE
*
*                 TAB CHARACTER
MUHT     EQU      %
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES
         BCR,4    %+2               BRANCH IF DELTA IS NOT IN CONTROL
         BCR,8    MU3               BRANCH IF TEL IS NOT IN CONTROL
         LC       MODE2,R2          CHECK FOR SPACE INSERTION MODE ON
         BCR,2    MU3               BRANCH TO NORMAL PROCESS IF NOT ON
MUHT1    LH,R6    TL,R2             CHECK FOR A TAB BUFFER
         BLEZ     MUHT4             BRANCH TO MOVE SINGLE BLANK IF NOT
         INT,D4   D1
         LB,R5    CPI,R2            COMPUTE CURRENT CARRIAGE POSITION
         AW,R5    D4
MUHT3    LB,D4    COCBUF,R6         GET VALUE OF TAB STOP
         BEZ      MUHT4             BRANCH TO MOVE SINGLE BLANK IF ZERO
         CW,R5    D4
         BL       MUHT5             BRANCH IF VALID TAB STOP IS FOUND
         AI,R6    1
         CI,R6    15
         BANZ     MUHT3             GET NEXT TAB STOP
         SLS,R6   -1
         LH,R6    COCBUF-4,R6       LINK TO NEXT BUFFER
         BGZ      MUHT3
MUHT4    LI,R5    X'40'             SET TO MOVE A BLANK TO USER
         B        MU3
*                 VALID TAB STOP FOUND
MUHT5    SW,D4    R5                COMPUTE NUMBER OF BLANKS TO MOVE
         LI,R5    X'40'             SET FOR INSERTING BLANKS
         BAL,SR4  MOVECHAR
         BDR,D4   MOVECHAR          MOVE THE CORRECT NUMBER OF BLANKS
         B        MU4
*                                                                          11740
*                                                                          11750
*                                                                          11760
         TITLE    'W R I T E   R O U T I N E'
************************************************************************   11780
*                                                                          11790
*   USES ALL REGISTERS
*
*   LINKAGE:  BAL,11  COCWR                                                11810
*          IN: R2 = LINE NUMBER
*              R7 = BYTE ADDRESS OF USER BUFFER - ONE
*             SR1 = MAXIMUM BYTE SIZE OF MESSAGE
*             SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*              R1 = DCB ADDRESS
*
************************************************************************   11820
COCWR    EQU      %                                                        11830
         DO       PMONOFF=1
         MTW,1    C:CTW             BUMP COUNT OF TERMINAL WRITES
         FIN
         LW,R0    SR1
         BEZ      *SR4              RETURN IF RECORD SIZE IS ZERO
         PUSH     SR4               SAVE RETURN ADDRESS
         LB,SR2   COCOC,R2
         SW,SR2   SL:TB
         BLZ      COCWR1            BRANCH IF BLOCK LIMIT NOT REACHED
********************************************************************************
*
*  THE USER'S OUTPUT CHARACTER COUNT IS GREATER THAN THE MAX
*  ALLOWED (SL:TB).  REPORT THIS WITH A REG.  WE'LL COME BACK
*  WHEN COC OUTPUT INTERRUPT PROCESSING REPORTS TO SCHEDULING
*  THAT THE OUTPUT COUNT IS LESS THAN SL:UB.
*
*  CLEAR T:COCHC LOCK-OUT FLAG, ENABLE COC INTERRUPTS,
*  GO TO T:REG IN SSS, DISABLE COC INTERRUPTS, SET T:COCHC LOCK-OUT FLAG
*
********************************************************************************
         LI,R6    E:CBL
         C:REG
         BAL,SR4  CHKBRKYC
         BAZ      COCWR1            BRANCH IF NO BREAK OR CTL-Y OCCURED
         MTW,-1   TSTACK+2          SET USER'S PSD AT START OF WRITE
         B        COCWR801
COCWR1   EQU      %
         LI,R5    X'28000'
         CS,R5    0,R1
         BNE      COCWR4            BRANCH IF NON-TRANSPARENT TEXT
*                 TRANSPARENT TEXT WRITE
COCWR2   EQU      %
         AI,R7    1
         LB,R5    0,R7
         BAL,SR2  COCSENDT          MOVE RECORD OUT UNTRANSLATED
         BDR,R0   COCWR2
         B        PULLSR4           BRANCH TO RETURN
*
*                 NON-TRANSPARENT TEXT WRITE
COCWR4   EQU      %
         AW,R7    R0                POINT R7 AT END OF USER'S BUFFER
         DO       CNM
         LC       MODE5,R2          CHECK DRC
         BCR,8    COCWR5            BUT ONLY FOR SLAVE
         LW,SR2   0,R1              GET DCB WORD 0
         CI,SR2   X'8000'           IS DRC ON
         BANZ     COCWR8            YES, DON'T KILL BLANKS
         FIN
COCWR5   LB,SR2   0,R7
         AI,SR2   -X'40'
         BNEZ     COCWR8            BRANCH ON NON-BLANK CHARACTER
         AI,R7    -1                ADJUST COUNTS TO REFLECT TRAILING
         BDR,R0   COCWR5            BLANKS THAT WILL NOT BE TRANSMITTED
         AI,R7    1                 BUFFER IS ALL BLANKS, SEND 1
*
COCWR8   EQU      %
         SW,R7    R0                REPOSITION R7 TO BA(UBUF)-1
         SW,SR1   R0
         CI,SR1   3
         BG       %+2
         AW,R0    SR1               DON'T REMOVE BLANKS IF LESS THAN 4
         LW,SR1   R0                UPDATE ARS
         AI,R7    1                 POINT R7 TO 1ST POS OF USER'S BUF
         LW,R5    0,R1              PICK UP FIRST WORD OF DCB
         CI,R5    X'10100'
         BAZ      COCWR38           BRANCH IF TOF AND VFC BIT OFF
         CI,R5    X'10000'
         BAZ      COCWR30           BRANCH IF TOF BIT OFF
         AI,R5    -X'10000'         TURN OFF TOF BIT
         STW,5    0,R1              UPDATE DCB
COCWR30  EQU      %
*                 VERTICAL FORMAT CONTROL IS SPECIFIED IN DCB
         LB,D1    0,R7              GET FIRST CHARACTER
         STB,D1   R7                SAVE CHAR FOR SPACE SUPPRESSION CHECK
         AI,D1    -X'F1'
         BEZ      COCWRFF           BRANCH IF TOP OF FORM CHARACTER
*                 CHECK FOR FORMAT CONTROL CHARACTER'S (X'C1'-X'CF')
         LC       R7
         BCS,3    COCWR70           NOT A FORMAT CHARACTER
         AI,D1    X'F1'-X'C0'
         BLEZ     COCWR70           BRANCH IF NOT A FORMAT CHARACTER
         LI,D2    COCWR70
*                 SEND THE NUMBER OF NL'S AS SPECIFIED IN D1
COCWR36  EQU      %
         LI,R3    JB:LC
         BAL,SR2  COCNL             SEND NEW LINE
         DO       CNM
         LC       MODE5,R1          SLAVE TERMINALS
         BCS,8    COCWR37           DON'T HAVE PAGE BOUNDRIES
         FIN
         LB,SR2   0,R3
         BEZ      *D2               BRANCH IF PAGE BOUNDARY REACHED
COCWR37  EQU      %
         BDR,D1   COCWR36
         B        *D2               BRANCH WHEN COMPLETED
*                 VFC WAS NOT SPECIFIED, SET TO SEND C(SVA)-1 NL'S
COCWR38  EQU      %
         LI,D2    COCWR40
         LW,D1    19,R1             GET WORD 19 OF DCB
         SCS,D1   15
         AND,D1   M7                GET SPACE PARAMETER (SVA) FROM DCB
         BNEZ     COCWR37           BRANCH IF SPACES TO BE SENT
*                 PROCESS CHAR'S FROM USER BUFFER INTO OUTPUT BUFFERS
COCWR40  EQU      %
         LB,R5    0,R7
         DO       CNM
         BEZ      COCWR72
         ELSE
         BEZ      COCWR80
         FIN
         LI,SR2   COCWR70
         LC       *SR3,R5
         BCR,8    COCWR95           B/NOT SPEC CHAR
         BCS,6    COCPCIB
         LB,R4    *SR3,R5
         LB,R4    WRBTBL-X'20',R4
         B        WRBYT,R4
*
*
WRBTBL   EQU      %
WB       COM,8    AF-WRBYT
         WB       COCWRFF           FF
         WB       COCWRHT           HT
         WB       COCWRNL           CR,LF
         WB       COCWRNL           NL
         DO1      5
         WB       COCWR70           ESCF,XC,RUB,ESCR,ESCCR
         WB       COCPCIB           BRACKETS
         WB       COCPCIB           NOT,OR
         WB       COCWRBS           BS
         WB       COCWR70           ESCLF
         WB       COCWRNDX          2741 INDEX
         WB       COCPCIB           PARITY ERROR
         WB       COCWR70           BS-BS (CONTIGUOUS BACKSPACE)
         DO1      32-BA(%)+BA(WRBTBL)
         WB       WRTBLERR          TRANSLATE TABLE ERROR
         BOUND    4
WRBYT    EQU      %
COCWRHT  LW,R6    1
         AI,R6    19
         LI,R3    -16
         LB,SR2   MODE,R2
         LB,D2    CPOS,R2
         LB,D1    *R6,R3            CHECK FOR TABS IN USER DCB
         BNEZ     COCWRHT1
         DO       CNM
         LC       MODE5,R2          SLAVE NEVER
         BCS,8    COCWRHT2          USES M:UC DCB TABS
         FIN
         LI,R6    M:UC+19
         LB,D1    *R6,R3            AND IN UC
         BNEZ     COCWRHT1
COCWRHT2 LI,D1    10                10 ASSUMED IF NOT ESCT
         CI,SR2   8
         BAZ      WRHT3A
         LI,D1    1
COCWRHT3 CI,SR2   8
         BANZ     COCWRHT4
WRHT3A   EQU      %
         AW,D2    D1
         STB,D2   CPOS,R2
         BAL,SR2  COCSEND1          SEND TAB (AND IDLES)
         LW,R13   R12
         BAL,R9   SIAT              SEND IDLES AFTER TAB
         B        COCWR70
COCWRHT4 EQU      %                 SIMULATE TABS
         LI,R5    X'40'
         BAL,SR2  COCPCIB           SEND BLANKS
         BDR,D1   COCPCIB
         B        COCWR70
COCWRHT1 LB,D1    *R6,R3            FIND NEXT TAB
         SW,D1    D2                SPACE COUNT TO NEXT STOP
         BGZ      COCWRHT3
         BIR,R3   COCWRHT1          ARE THERE MORE
         B        COCWRHT2          NO, USE DEFAULT
*
SENDBYT  EQU      %
WRTBLERR EQU      %
SETBLERR EQU      %
TTABERR  EQU      SETBLERR
         SCREECH  X'11'             SCREECH .11
COCNL    EQU      %
         LI,R5    X'15'             SET TO SEND 'NEW LINE'
COCWRNL  EQU      %
         LI,SR4   WRNLA             SET RETURN ADDRESS FOR SEND
WRNL     EQU      %
         DO       COCPCP=1
         DO       CNM
         LC       MODE5,R2          SLAVE DOESN'T HAVE LINE COUNTER
         BCS,8    %+3
         FIN
         LI,R6    JB:LC
         MTB,1    0,R6              BUMP LINE CNT
         FIN
         XW,SR2   SR4               SET RETURN ADDRESS'S
         B        COCSEND1
WRNLA    EQU      %
         LI,SR2   1
         STB,SR2  CPOS,R2           SET CARRIAGE POSITION TO 1
WRNLB    EQU      %
         DO       COCPCP=1
         LI,R5    7
         LB,R6    MODE3,R2
         AND,R5   R6                GET LINE COUNT FROM MODE3
         SW,R6    R5
         STB,R6   MODE3,R2          ZERO LINE COUNT IN MODE3
         DO       CNM
         LC       MODE5,R2          SLAVE NEVER EXCEEDS
         BCS,8    *SR4              LINES PER PAGE
         FIN
         LI,R6    JB:LC
         LB,SR2   0,R6
         AW,R5    SR2               UPDATE LINE COUNT IN JIT TO
         STB,R5   0,R6              REFLECT COUNT FROM MODE3
         LI,R6    JB:LPP
         CB,R5    0,R6
         BLE      *SR4              BRANCH IF LINES/PAGE NOT EXCEEDED
         AND,D4   BIT4T6            KNOCK OUT PENDING PAGE REQUEST
         B        PAGE              GIVE PAGE HEADING
         ELSE
         B        *SR4
         FIN
COCWRNDX EQU      %
         LI,SR4   WRNLB             SET RETURN ADDRESS FOR SEND
         B        WRNL
COCWRBS  EQU      %
         LB,R4    CPOS,R2
         AI,R4    -1
         BLEZ     COCWR70           BRANCH TO IGNORE BACKSPACE
         MTB,-1   CPOS,R2           DECREMENT CARRIAGE POSITION
         B        COCSEND1
*
COCWRFF  EQU      %
         DO       COCPCP
         LI,R6    1                 L/1; SET CPI TO 1 IN PAGE ROUTINE
         BAL,R11  PAGE10            BAL/GIVE PAGE HEADING
WRFFBAL  EQU      %
         FIN
COCWR70  LB,R5    0,R7
         AI,R7    1                 INCREMENT BYTE POINTER
         CI,R0    X'F'              C/BC W/.F
         BANZ     COCWR74           PERMIT COC INTS EVERY 16 CHARS
         C:EN%DSABL                 ENABLE COC INTS, CLEAR T:COCHC
*                                   .. LOCK-OUT, DISABLE COC INTS, SET
*                                   .. T:COCHC LOCK-OUT FLAG
COCWR74  EQU      %
         BDR,R0   COCWR40           GET NEXT (IF ANY)
         DO       CNM
COCWR72  LC       MODE5,R2          IS IT SLAVE
         BCR,8    COCWR80           NO
         LI,0     X'1FFFF'
         AND,0    DCB:ECB,R1        CHECK IF ANY ECB
         BEZ      COCWR80           NO, DON
         MTB,0    COCOC,2           ANY CHARS THERE
         BNEZ     %+4               YUP, OK
         LI,5     X'40'             NO, SEND A DUMMY SO WE SEE
         LB,5     *SR3,5            THE SPECIAL CHAR & POST ECB
         BAL,SR2  COCSENDT
         LI,R5    COC:SPECHAR       YES, SET CHAR MARKER IN BUFFER
         BAL,SR2  COCSENDT
         LW,10    1                 SAVE DCB ADDR
         LW,9     2                 SAVE LINE #
         BAL,1    ECBGBLK           GET A BLOCK
         BNEZ     COCWR75           GOT IT
         LI,6     E:CFB             CAN'T, REG THE USER
         C:REG
         B        %-4               THEN TRY AGAIN
COCWR75  LW,1     10                RESTORE DCB ADDRESS
         LI,14    X'20000'          SET UP
         LI,15    0                   4 WORD
         STB,9    1
         LCI      4                     BLOCK
         STM,14   0,2
         LW,10    2                 SET BLOCK ADDRESS
         LW,2     9                 RESTORE LINE NUMBER
         ANLZ,7   GETECB99          GET HA(COC:ECB)
         BAL,11   WLDLCHN           CHAIN TO WAIT LIST
         AND,R1   M17               KNOCK OFF BAD BITS
         FIN
COCWR80  EQU      %
         LI,SR2   COCWR801          SET RETURN ADDR FOR COCNL & KILLIN
         CI,R1    M:UC
         BE       COCWR81           BRANCH IF M:UC DCB
         DO       CNM
         LC       MODE5,R2          SLAVE USERS
         BCS,8    COCWR81           ALWAYS PRETEND TO USE M:UC DCB
         FIN
         LI,R6    -NNOCR
         CB,R5    LNOCR,R6          TEST LAST CHAR OF RECORD TO SEE IF
         BE       COCWR801          IT DOESN'T NEED TRAILING CR,LF'S
         BIR,R6   %-2
         AND,R7   Y7F
         CW,R7    Y6
         BNE      COCNL             BRANCH IF NOT SPACE SUPPRESSION
         BAL,R9   SIBCR             SEND IDLES BEFORE CR
         LI,R5    X'29'             'CR' ONLY FOR SPACE SUPPRESSION
         BAL,SR2  COCSEND1
         BAL,R9   SIACR             SEND IDLES AFTER CR
         LI,R5    1
         STB,R5   CPOS,R2
COCWR81  EQU      %
         AI,R5    -X'04'
         BNEZ     COCWR801          BRANCH IF LAST CHAR IS NOT AN EOT
         BAL,D4   CHKLOGON
         BE       KILLIN            RELEASE INPUT AND TAB BUFFERS
COCWR801 EQU      %
         LH,7     *1
         CI,7     X'80'
         BAZ      PULLSR4           BRANCH IF NOT MONITOR BUFFER
         AI,7     -X'80'
         STH,7    *1                RESET MON BUFFER FLAG
         LW,14    7,1               BUFFER ADDRESS
         LW,SR1   R1
         BAL,SR4  RMB               RETURN MONITOR BUFFER
         LW,R1    SR1
PULLSR4  EQU      %
         PULL     1,SR4             PULL RETURN POINT
         B        *SR4              RETURN
NOCR     EQU      %
         DATA     X'1620150D'         SYNC , SPC LF,   LF  ,   CR
LNOCR    EQU      %
NNOCR    EQU      BA(%)-BA(NOCR)
         BOUND    4
         PAGE
         DO       CNM
*
* REMOVES READ/WRITE WAIT BLOCKS FOR THIS USER FROM COC:ECB CHAIN.
*        R2 HAS LINE NUMBER
*        R7 RETURNS WA(4 WORD BLOCK) OR 0
*        CC SET ON RETURN
*        VOLATILE: 8,6
*        LINK, R11
*
GETECBWT LI,8     2                 WRITE CODE
         B        %+2
GETECBRD LI,8     1                 READ CODE
         STB,8    11                REMEMBER CODE
         ANLZ,6   GETECB99          GET HA(CHAIN HEAD)
         INHIBIT
GETECB10 LH,7     0,6               GET NEXT BLOCK
         BEZ      GETECB90          ---> CAN'T FIND ANY.
         SLS,7    2                 DA TO HA
         LH,8     0,7               GET TYPE FROM BLOCK
         AI,7     1                 POINT TO LINK
         CB,8     11                IS IT CORRECT TYPE...
         BE       GETECB50          ---> YES.
         LW,6     7                 NO. ADVANCE DOWN CHAIN
         B        GETECB10           AND CHECK NEXT ONE.
GETECB50 LH,8     0,7               GET FLINK.
         STH,8    0,6               UNCHAIN BLOCK.
         SLS,7    -1                CONVERT HA TO WA.
GETECB90 RINHIBIT
         AI,7     0                 SET CC.
         B        *SR4              RETURN.
GETECB99 LH,0     COC:ECB,R2        **  FOR ANLZ ONLY  **
         FIN
         PAGE
COCWR95  EQU      %
         CI,R0    1                 C/(REMAINING CHAR CNT + 1) W/1
         BNE      COCPCIB           BNE; NOT LAST CHAR
         CI,R5    SYN               C/LAST CHAR W/SYN
         BE       COCWR801          BE; DON'T BUFFER OR XMIT; IGNORE
         TITLE    ' PLACE CHAR. IN BUFFER ROUTINE '
*        CALL     BAL,SR2 COCSEND1,COCSENDT  FOR SEND, NO CHECK.
*        CALL     BAL,SR2 COCPCIB   FOR LINEATION AND PAGINATION CHECKS.
*
*        INPUT:
*                 R2 = LOGICAL LINE NUMBER
*                 R5 = CHAR TO STORE
*                 SR3 = XLATE TBL, BYTE 0=1 FOR CHECKING O/P BLOCK LIMITS
*        USES:    REGISTER R6
*
*        MAY BE USED RECURSIVELY.
*
COCPCIB  EQU      %
         CI,R5    X'40'
         BL       COCSEND1          DON'T POSITION CTL CHARACTERS
         DO       CNM
         LC       MODE5,R2          SLAVE GETS NO MONITOR FORMATTING
         BCS,8    PCIB1
         FIN
         LI,R6    JB:PCW
         LB,R6    0,R6
         CI,R6    12                DONT BUST LINES < 12
         BL       PCIB1
         CB,R6    CPOS,R2           OR IF CPOS < JB:PCW
         BGE      PCIB1
*                                   MUST BREAK UP LINE - SEE ABOUT PAGE
         PUSH     7,R5              SAVE CHARACTER AND LINKAGES
         BAL,SR2  COCNL
         PULL     7,R5              RESTORE
PCIB1    MTB,1    CPOS,R2           RESET CPOS
*
*
COCSEND1 EQU      %                 NORMAL ENTRY TO BUFFER CHAR(AND TRANSLATE)
         LC       MODE3,R2          DO NOT SEND IF
         BCS,4    *SR2                  ESCP + (XON.ESCE NOT)
         LC       MODE2,R2
         BCR,4    %+3
         LC       MODE,R2
         BCR,8    *SR2
*
COCSEND2 EQU      %                 ALT ENTRY TO BUFFER CHAR(AND TRANSLATE)
COCSENDX EQU      %
         PUSH     6,R4              PRESERVE REGISTERS
*
SENDXL   EQU      %
         LW,R6    R5
         LB,R5    *SR3,R5
         CI,R5    X'80'
         BAZ      SENDNORM          NO SPECIAL CHAR
         CI,R5    X'20'
         BAZ      %+3
         AND,R5   M6                RETRANSLATE SITUATION
         B        SENDXL
         LB,R4    SENDTAB-X'20',R5  OFFSET TO GO ROUTINE
         CI,R5    X'40'
         BAZ      SENDBYT,R4        USED IF NOT TOGGLE
SENDXIT  EQU      %
         PULL     6,R4              RESTORE
         B        *SR2
*
*
SENDTAB  EQU      %
SB       COM,8    AF-SENDBYT
         SB       SENDNOP           FF
         SB       SENDHT            HT
         SB       SENDCR            CR,LF
         SB       SENDNL            NL
         DO1      5
         SB       SENDNOP           ESCF,XC,RUB,ESCR,ESCCR
         SB       SENDBRAC          BRACKETS
         SB       SENOTOR           NOT,OR
         SB       SENDBS            BS
         SB       SENDXIT           ESCLF
         SB       SENDNDX           2741 INDEX
         SB       SENDPER           PARITY ERROR
         SB       SENDNOP           BS-BS (CONTIGUOUS BACKSPACE)
         DO1      32-BA(%)+BA(SENDTAB)
         SB       SETBLERR
         BOUND    4
*
*
*
*
SENDCR   EQU      %
SENDNL   EQU      %
         BAL,R9   SIBCR             SEND IDLES BEFORE CARRIAGE RETURN
         LI,R5    X'29'             L/CR CODE
         BAL,R9   COCSEND2          SEND CR
         DO       2741CODE=1
         LC       MODE2,R2
         BCS,1    SIACR1            SEND IDLES AFTER CR CHAR
         FIN
SENDNDX  EQU      %
         LI,R5    X'2E'             L/LINE FEED CODE
         BAL,R9   COCSEND2          SEND LF
         CI,R6    X'20'
         BE       SEND1I1           SEND 1 IDLE IF LINE FEED ONLY
         B        SIACR1            SEND IDLES AFTER CARRIAGE RETURN
SENDNOP  B        SENDXIT
SENDHT   LI,R5    X'40'
         LB,SR2   COCTERM,R2
         BEZ      SENDXL            BRANCH IF MODEL 33 TELETYPE
         AI,SR2   -3
         BEZ      SENDXL            BRANCH IF MODEL 7015 TELETYPE
         AI,R5    1                 FOR CHANGING '81' TO '2D'
SENDPER  EQU      %
         AI,R5    X'4C'             FOR CHANGING '8E' TO '7A'
SENDBS   EQU      %
         AI,R5    -X'60'            FOR CHANGING '8B' TO '2B'
         B        SENDXL
SENDBRAC EQU      %
         AI,R6    8                 CHANGE 'B4','B5' TO 'BC','BD'
SENBR1   EQU      %
         LW,R5    R6
         B        SENDXL            RETRANSLATE
*
SENOTOR  EQU      %
         AI,R6    X'60'             CHANGE '4F','5F' TO 'AF','BF'
         LB,SR2   COCTERM,R2
         AI,SR2   -3
         BNEZ     SENBR1            BRANCH IF NOT 7015 TELETYPE
         SLS,R6   -4
         AI,R6    X'B2'             CHANGE '4F','5F' TO 'BC','BD'
         B        SENBR1
*
*
*
SENDNORM EQU      %
         DO 2741CODE=1
         LC       MODE2,R2          CHECK 2741
         BCS,1    SENDCMN           BRANCH IF 2741
         FIN
         SCS,R5   32
         BEV      %+2
         AI,R5    X'80'             MAKE PARITY EVEN
SENDCMN  EQU      %
         LI,R6    SENDNXTI          SET RETURN ADDRESS FOR SENCKOC
         SPACE    2
SENCKOC  EQU      %
         LB,R4    COCOC,R2
         BEZ      SENCKLOK          BRANCH IF NO ACTION ON LINE
         CI,R4    253               C/OUTPUT CHAR COUNT W/253; PREVENT
*                                   .. OVERFLOWING OF COCOC (BYTE); USE
*                                   .. 253 INSTEAD OF 255 BECAUSE OF
*                                   .. 2741DEL ROUTINE
         BLE      CKOC2             BLE; OUT COUNT NOT AT MAX, BUF CHAR
CKOC1    EQU      %
         LI,R6    E:CBL             SET TO BLOCK USER
         B        SENDBLK2
CKOC2    EQU      %
         LH,R4    COCOR,R2
         BNEZ     0,R6              RETURN IF OUTPUT CHAIN EXISTS
*                 INITIATE AN OUTPUT BUFFER CHAIN FOR THIS USER
SENDGFB  EQU      %
         BAL,R6   COCGETB           GET A BUFFER
         B        SENDBLK1          BRANCH IF NO BUFFERS ARE AVAILABLE
         STH,R4   COCOR,R2          SET REMOVAL POINT
         B        SENDSIP           BRANCH TO SET INSERT POINT
*                 OBTAIN INSERT POINT FOR OUTPUT CHARACTER
SENDNXTI EQU      %
         LH,R4    COCOI,R2
         AI,R4    1                 BUMP INSERT POINT
         CI,R4    X'F'              SEE IF BUF FULL
         BANZ     SENDSIP           BRANCH IF ROOM IN BUFFER
*                 CURRENT OUTPUT BUFFER IS FULL, GET ANOTHER
         PUSH     R4                SAVE OLD BUFFER ADDRESS
         BAL,R6   COCGETB           GET A BUFFER
         B        SENDBLOK          BLOCK USER IF NONE ARE AVAILABLE
         PULL     R6
         SLS,R6   -1                BACK TO BUF
         STH,R4   COCBUF-4,R6       SET LINK
*                 UPDATE INSERT POINT AND PUT CHAR IN BUFFER
SENDSIP  STH,R4   COCOI,R2          SET INSERT POINT
         STB,R5   COCBUF,R4         PUT BYTE IN LINE BUF
SENDINC  MTB,1    COCOC,R2          INC COUNT
         B        SENDXIT
*                 BUFFER IS UNAVAILABLE, REG IF USER CAN BE BLOCKED
SENDBLOK EQU      %
         PULL     R4
SENDBLK1 EQU      %
         LI,R6    E:CFB             SET TO REG FOR BUFFER
SENDBLK2 EQU      %
         CW,SR3   Y01
         BAZ      SENDXIT           BRANCH IF USER IS NOT TO BE BLOCKED
         PUSH     5,R11             PUSH R11 - R15
*
*  CLEAR T:COCHC LOCK-OUT FLAG, ENABLE COC INTERRUPTS,
*  GO TO T:REG IN SSS, DISABLE COC INTERRUPTS, SET T:COCHC LOCK-OUT FLAG
*
         C:REG
         PULL     5,R11             PULL R11 - R15
         B        SENDCMN           TRY AGAIN
*
*                 CHECK 2741 TERMINALS FOR LOCKED KEYBOARDS
SENCKLOK EQU      %
         DO 2741CODE=1
         LC       MODE2,R2
         BCR,1    SENDIT            TTY OK
         BCS,8    %+3               2741 - BRANCH IF LINE REPORTED OFF
         LC       MODE3,R2
         BCR,1    SENDGFB           2741 - BUF CHAR IF KB NOT LOCKED.
         LW,R7    R5
         BAL,SR2  2741DEL           TRANSMIT A 2741 DELETE
         LW,R5    R7
         B        SENDGFB           BUFFER FIRST CHAR
         FIN
SENDIT   LI,SR2   SENDINC           SET RETURN ADDRESS FOR XMIT
*                 TRANSMIT CHARACTER TO TERMINAL
SENDXMIT EQU      %
         LW,R6    R5
         SLS,R6   8                 CHARACTER ALIGNED IN R6
         LI,R4    -1
         AI,R4    1                 STEP TO NEXT 7611
         CLM,R2   COD:LPC,R4
         BCS,9    %-2               NOT HERE, TRY NEXT
         LD,R5    COD:LPC,R4        LOG LIMS FOR 7611
         AW,R6    R2
         SW,R6    R5                CONVERT LINE # TO PHYS
         EXU      CO:XDATA,R4       GO
         B        *SR2
         TITLE    'T I M I N G   A L G O R I T H M S'
SIBCR    EQU      %                 SEND IDLES BEFORE CARRIAGE RETURN
         PUSH     6,R4
SIBCR1   EQU      %
         LI,R6    IDBCR
         B        IDLE1
*
SIACR    EQU      %                 SEND IDLES AFTER CR
         PUSH     6,R4
SIACR1   EQU      %
         LI,R6    IDACR
         B        IDLE1
*
SIAT     EQU      %                 SEND IDLES AFTER TAB
         PUSH     6,R4
         LI,R6    IDAT
*
IDLE1    EQU      %
         LC       MODE3,R2
         BCS,4    SENDXIT           B/HALF DUPLEX PAPER TAPE
         LC       MODE2,R2
         BCR,4    %+3               B/NOT FULL DUPLEX PAPER TAPE MODE
         LC       MODE,R2
         BCR,8    SENDXIT           B/ECHOPLEX OFF
         LB,R4    MODE4,R2          L/MODE4; ALGORITHM #, LINE SPEED
         SLD,R4   -3                SHIFT SPEED FROM R4 INTO R5
         SLS,R5   -29               RJ/SPEED
         AND,R4   M3                MASK ALGORITHM #
IDLE20   EQU      %
         LB,R7    *R6,R4            ALGORITHM DISPLACEMENT FROM SENDIDLE
         B        SENDIDLE,R7       B/APPROPOS IDLE ROUTINE
         PAGE
*
ID       COM,8    AF-SENDIDLE
*
********************************************************************************
*
*  FOLLOWING ENTRIES SEND IDLE BEFORE CR
*
********************************************************************************
         BOUND    4
IDBCR    EQU      %
         ID       IDLXIT            ALGORITHM 0 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 1 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 2 - BEFORE CARRIAGE RETURN
         ID       ID3BC             ALGORITHM 3 - BEFORE CARRIAGE RETURN
         ID       ID4BC             ALGORITHM 4 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 5 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 6 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 7 - BEFORE CARRIAGE RETURN
         BOUND    4
********************************************************************************
*
*  FOLLOWING ENTRIES SEND IDLE AFTER CR
*
********************************************************************************
IDACR    EQU      %
         ID       IDLXIT            ALGORITHM 0 - AFTER CARRIAGE RETURN
         ID       ID1AC             ALGORITHM 1 - AFTER CARRIAGE RETURN
         ID       ID2AC             ALGORITHM 2 - AFTER CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 3 - AFTER CARRIAGE RETURN
         ID       ID4AC             ALGORITHM 4 - AFTER CARRIAGE RETURN
         ID       ID5AC             ALGORITHM 5 - AFTER CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 6 - AFTER CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 7 - AFTER CARRIAGE RETURN
         BOUND    4
         PAGE
********************************************************************************
*
*  FOLLOWING ENTRIES SEND IDLE AFTER TAB
*
********************************************************************************
IDAT     EQU      %
         ID       IDLXIT            ALGORITHM 0 - AFTER TAB CHARACTER
         ID       ID1AT             ALGORITHM 1 - AFTER TAB CHARACTER
         ID       ID2AT             ALGORITHM 2 - AFTER TAB CHARACTER
         ID       ID3AT             ALGORITHM 3 - AFTER TAB CHARACTER
         ID       ID4AT             ALGORITHM 4 - AFTER TAB CHARACTER
         ID       ID5AT             ALGORITHM 5 - AFTER TAB CHARACTER
         ID       IDLXIT            ALGORITHM 6 - AFTER TAB CHARACTER
         ID       IDLXIT            ALGORITHM 7 - AFTER TAB CHARACTER
         BOUND    4
         PAGE
SENDIDLE EQU      %
*
SEND1I   EQU      %                 SEND ONE IDLE
         PUSH     6,R4
SEND1I1  EQU      %
         LI,R4    1                 SET # OF IDLES TO 1
         B        IDLE3
*
ID2AC    EQU      %
ID4AC    EQU      %
         LB,R4    IDV1,R5           # OF IDLES TO SEND
         B        IDLE2
*
ID5AC    EQU      %
         LB,R4    CPOS,R2           L/CARRIAGE POSITION
ID5AC1   AI,R4    15                +15 TO MOVEMENT IN COLUMNS
         DH,R4    IDV4,R5           DIVIDE; IF 2741 (ALGO 1), IDLES =
*                                   .. COLUMNS / 10 ROUNDED UP + 1
         B        IDLE2             B; SEND IDLES IF # > 0
*
ID3BC    EQU      %
ID4BC    EQU      %
         LB,R4    IDV2,R5           L/MINIMUM # OF CHARACTERS
         LB,R5    CPOS,R2           L/CARRIAGE POSITION
         SW,R4    R5                # IDLES = MIN - CPOS
IDLE2    EQU      %
         BLEZ     SENDXIT           EXIT IF # IDLES NOT > 0
IDLE3    EQU      %
         LI,R5    RUBOUT            L/RUBOUT CHAR; USE FOR TIMING
         DO       2741CODE
         LC       MODE2,R2          CHECK FOR 2741
         BCR,1    %+2               B/NOT 2741
         LI,R5    SYN               L/SYN CHAR; 2741 TIMING CHAR
         FIN
         BAL,R9   COCSEND2          SEND IDLES
         BDR,R4   COCSEND2
IDLXIT   EQU      %
         B        SENDXIT
*
ID5AT    EQU      %
         LW,R4    R13
         AI,R4    10                +10 TO MOVEMENT IN COLUMNS;
*                                   ..  ON PHYSICAL TABS, 2741 IDLES =
*                                   .. (MOVEMENT + 25) / 10  (TRUNCATED)
         B        ID5AC1
*
ID2AT    EQU      %
ID3AT    EQU      %
ID4AT    EQU      %
         LB,R4    IDV3,R5
         B        IDLE2
ID1AT    EQU      %
ID1AC    EQU      %
         LI,R5    HA(Y000A)-HA(IDV4)    L/FUDGE FACTOR TO GET US
*                                   .. FROM IDV4 TO A LITERAL 10
         LI,R4    5                 L/5; USE AS ALGORITHM NUMBER
         B        IDLE20            CONTINUE AS ALGO 5
         SPACE    1
********************************************************************************
*
*  THIS TABLE CONTAINS THE NUMBER OF IDLES TO SEND FOLLOWING CR.
*  THE TABLE IS INDEXED BY RATE.
*
*  IT IS USED BY IDLE ALGORITHMS 2 AND 4.
*
********************************************************************************
IDV1     EQU      %
         DATA,1   1,4,8,12
         DATA,1   16,16,16,16
         BOUND    4
         PAGE
********************************************************************************
*
*  THIS TABLE CONTAINS THE MINIMUM NUMBER OF CHARACTERS THAT MUST BE
*  SENT PRIOR TO A CR.  THEREFORE, THE NUMBER OF IDLES TO SEND BEFORE
*  A CR IS CPOS-IDV2(RATE).
*
*  THIS TABLE IS USED BY IDLE ALGORITHMS 3 AND 4.
*
********************************************************************************
IDV2     EQU      %
         DATA,1   7,10,20,40
         DATA,1   40,40,40,40
         BOUND    4
************************************************************************
*
*  THIS TABLE CONTAINS THE NUMBER OF IDLES TO SEND FOLLOWING A TAB.
*  THE TABLE IS INDEXED BY RATE.
*
*  USED BY ALGORITHMS 2, 3, AND 4.
*
************************************************************************
IDV3     EQU      %
         DATA,1   1,1,2,4
         DATA,1   8,8,8,8
         BOUND    4
         PAGE
************************************************************************
*
*  THIS TABLE CONTAINS ENTRIES THAT ARE DIVIDED INTO A COMPUTED
*  DISPLACEMENT AS FOLLOWS:
*
*     # IDLES = (MOVEMENT IN COLUMNS + 15) / IDV4(RATE)
*
*  THIS TABLE IS USED BY IDLE ALGORITHM 5.
*
************************************************************************
IDV4     EQU      %
         DATA,2   60,50,18,15
         DATA,2   15,15,15,15
         BOUND    4
         TITLE    'PLACE CHAR. IN BUFFER ROUTINE'
*
*                 SENDS CHARACTER TRANSPARENT (WITH NO TRANSLATION)
COCSENDT EQU      %
         PUSH     6,R4              PRESERVE REGISTERS
         B        SENDCMN
*
*                 SENDS CHARACTER IN R5 TO TERM IN FRONT OF QUEUED OUTPUT
*                 IF POSSIBLE.
COCSUF   EQU      %
         PUSH     6,R4
         SCS,R5   32                SHIFT; CHECK PARITY
         BEV      %+2               B/EVEN; OK
         AI,R5    X'80'             ODD, SET .80 BIT, MAKE EVEN
         BAL,R6   SENCKOC           CHECK OUTPUT COUNT, ETC.
         AI,R4    -1                BACK-UP BUFFER
         CI,R4    X'E'
         BANZ     COCSUF1           BRANCH IF BUF POS IS VALID
         BAL,R6   COCGETB           GET A BUFFER
         B        CKOC1             BRANCH IF NONE ARE AVAILABLE
         AI,R4    -2                POS TO FRONT OF BUFFER OBTAINED
         LH,R6    COCOR,R2
         SLS,R4   -1
         STH,R6   COCBUF,R4         LINK BUFFER TO FRONT OF CHAIN
         SLS,R4   1
         AI,R4    15                POINT R4 TO LAST POS OF BUF OBTAINED
COCSUF1  EQU      %
         STH,R4   COCOR,R2          UPDATE REMOVAL POINT
         B        SENDSIP+1         BRANCH TO INSERT CHAR IN BUF
         TITLE    'P A G E   H E A D I N G   R O U T I N E'
*
*        CALL:    BAL,SR4  PAGE
*         USES:   PCIB, CRLF, AND REGISTER CONVENTIONS OF THE OUTPUT
*                 ROUTINES.
*
PAGE     EQU      %
         DO       COCPCP=1
         LB,R6    CPOS,R2           L/CPOS; CURRENT CARRIAGE POSITION
PAGE10   EQU      %
         STB,R6   CPI,R2            S/CPI FOR ECHOCRCPI; 1 IF USER
*                                   .. WRITING .0C (FF), ELSE CPOS
         DO       CNM
         LC       MODE5,R2          SLAVE USERS GET NO
         BCS,8    *SR4              PAGE HEADINGS
         FIN
         PUSH     (R4,R15)          PUSH R4 -> R15
         LI,R7    JB:LC             L/BA(JB:LC)
         LI,R6    JB:LPP
         LB,SR1   0,R6              LINES PER PAGE
         BEZ      PA98              B/LINES/PAGE=0; NO HEADER OR SPACES
         CI,R8    11                C/LINES/PAGE W/11
         BLE      PA79X             BLE; GIVE SPACES INSTEAD OF HEADER
         LI,6     JH:PC             PAGE COUNT
         MTH,1    0,R6              INC IT
         LB,R9    0,R7              L/JB:LC; LINE COUNT WITHIN PAGE
         LI,SR4   0                 ZERO THE LINE COUNT
         STB,R11  0,R7              0/LINE COUNT
         SW,SR1   SR2
         AI,R8    5                 LPP-LC+5= LINES TO TOP OF PAGE
         BAL,SR2  COCNL
         LI,R5    X'15'             L/NEW-LINE (CR/LF)
         BAL,SR2  COCSEND1          UPSPACE
         BDR,SR1  COCSEND1
         LI,R7    1
         LH,R7    *R1,R7
         BLZ      PA80              DON'T GIVE HEADING IF DRC SET IN DCB
*
*        PUT TIME, DATE, NAME, AND ACCOUNT IN HEADER
*
         LI,R4    HEADSZ
PA3      EQU      %
         LW,R7    HEAD-1,R4         SOURCE STRING DESCRIPTOR
         LB,SR1   R7                GET COUNT INTO SR1
         LB,5     0,7
         B        PA5               ALWAYS OUTPUT 1ST CHAR
PA4      LB,5     0,7               CHAR FROM SOURCE
         CI,5     ' '
         BE       PA6               SUPPRESS BLANKS
PA5      EQU      %
         BAL,SR2  COCPCIB
PA6      AI,7     1
         BDR,SR1  PA4               GO FOR NEXT CHARACTER
         BDR,R4   PA3               FOR NEXT DESCRIPTOR
*
*        PUT  USER NUMBER AND LINE NUMBER IN HEAD
*
         LI,R7    0
         INT,SR2  J:JIT             GET USER ID
         LI,D1    16                SET FOR HEX CONVERSION
         BAL,SR4  PA72              CONVERT TO EBCDIC
         LI,5     '-'
         BAL,SR2  COCPCIB
         LW,SR2   R2                GET LINE NUMBER INTO SR2
         BAL,SR4  PA72              CONVERT HEX TO EBCDIC
*
*                 PAD WITH BLANKS TO COLUMN 34
*
         LB,R7    CPOS,R2
         AI,R7    -35
         LI,5     ' '               SPACE
         LI,SR2   %+1               SET RETURN ADDRESS FOR COCPCIB
         BIR,R7   COCPCIB           POSITION CARRIAGE TO COLUMN 35
         LI,R5    X'B4'             SET TO SEND 'LEFT BRACKET'
         BAL,SR2  COCPCIB
*
*                 CONVERT AND OUTPUT PAGE NUMBER
*
         LI,R6    JH:PC
         LH,SR2   0,R6              GET PAGE COUNT
         AND,SR2  M16
         LI,D1    10                SET FOR DECIMAL CONVERSION
         BAL,SR4  PA72              CONVERT FROM DECIMAL TO EBCDIC
         LI,5     X'B5'             CLOSE SQUARE BRACKET
         BAL,SR2  COCPCIB
         LI,5     ' '               SPACE
         BAL,SR2  COCPCIB
*
*                 MOVE ADMINISTRATIVE MESSAGE  TO HEADING
*
         LI,R4    1
PA79     EQU      %
         CB,R4    COCMESS
         BG       PA80              BRANCH IF MESSAGE MOVED
         LB,R5    COCMESS,R4        GET NEXT BYTE OF MESSAGE
         BAL,SR2  COCPCIB           AND SEND IT TO TERMINAL
         AI,R4    1
         B        PA79              BRANCH FOR NEXT CHAR IN MESSAGE
PA79X    CI,R11   WRFFBAL           C/BAL REG W/COCWRFF BAL+1 ADR
         BNE      PA98              BNE; EXIT
         AI,R8    -3                -3 TO JB:LPP VALUE
         LCW,R8   R8                LCW/JB:LPP-3
         B        PA82
PA80     EQU      %
*
*                 SPACE TO TOP OF BODY OF PAGE
*
         LI,R7    JB:LC
         LB,SR1   0,R7
         AI,SR1   -6
PA82     LI,R6    1                 L/1
         LI,R5    X'15'             L/NEW-LINE (CR/LF)
         BAL,SR2  COCSEND1
         STB,R6   CPOS,R2           S/1 IN CURRENT CARRIAGE POSITION
         BIR,SR1  COCSEND1
         STB,SR1  0,R7
         BAL,D2   ECHOCRCPI         REPOSITION CARRIAGE
PA98     EQU      %
         PULL     12,R4
         B        *SR4
*
PA72     EQU      %
         AI,R7    1                 BUMP POSITION FOR NEXT REMAINDER
         LI,SR1   0
         DW,SR1   D1                DIVIDE
         STB,SR1  D2,R7             SAVE REMAINDER
         BNEZ     PA72              CONTINUE UNTIL DIVIDEND IS ZERO
PA74     EQU      %
         LB,R5    D2,R7
         LB,R5    HEX,R5            CONVERT TO EBCDIC
         BAL,SR2  COCPCIB           PUT CHARACTER IN OUTPUT BUFFER
         BDR,R7   PA74
         B        *SR4
         SPACE    3
*
*        DESCRIPTOR TABLE FOR PAGE HEAD FORMATTING
*
TE       COM,8,5,19  AF(1),0,AF(2)
*
HEAD     EQU      %
         TE       1,BA(SPACE)
         TE       8,BA(J:ACCN)
         TE       1,BA(SPACE)
         TE       2,BA(DATE)+6
         TE       1,BA(SLASH)
         TE       2,BA(DATE)+2
         TE       1,BA(SLASH)
         TE       2,BA(DATE)
         TE       1,BA(SPACE)
         TE       2,BA(TIME)+2
         TE       1,BA(COLON)
         TE       2,BA(TIME)
HEADSZ   EQU      %-HEAD
         ELSE
         B        *SR4
         FIN
*
         TITLE    ' COMMON CODE FOR READ AND WRITE '
*                                                                          13190
*   LINKAGE:  BAL,11 COCIO
*                                                                          13180
*   CALL ACCEPTANCE
COCIO    EQU      %
*  COMMON CODE FOR READ AND WRITE
         PUSH     7,R5              PUSH NON-VOLATILE REGISTERS (5-11)
         LW,1     SR1
         AND,1    M17               MASK TO DCB ADDRESS
         LB,R0    SR1               OPERATION CODE INTO R0
         LW,SR1   6,1               WORD 6 OF DCB
         SLS,SR1  -17               RIGHT-JUSTIFY BYTE COUNT
         LW,7     7,1               WORD 7 OF DCB
         LI,D1    3                 TYC=BEG OF TAPE
         AND,7    M17               BUFFER ADDRESS (15-31)
         DO       CNM
         BEZ      COC70
         ELSE
         BEZ      COC10             READ ZERO BYTES
         FIN
         SLS,R7   2                 MULT. BY 4 TO GET BYTE ADDRESS
         LI,R6    X'C0'
         AND,R6   0,R1              GET BYTE DISPLACEMENT (HBTD)
         SLS,R6   -6                RIGHT-JUSTIFY BYTE DISPLACEMENT
         AW,R7    R6                ADD BYTE DISPLACEMENT
         CI,SR1   C:140
         BLE      %+2
         LI,SR1   C:140             SET REC SIZE AT MAX IF GREATER
         DO       CNM
         LI,2     X'800'            CHECK IF SLAVE DCB
         CW,2     0,1
         BAZ      COC05             BR IF NOT
         LI,2     BARNDV            YES, GET LINE NUMBER FROM DCB
         LB,2     *1,2
         AI,2     -1                MAKE RELATIVE TO ZERO
         B        COC05A
COC05    EQU      %
         FIN
         LI,R2    X'FF'
         AND,R2   M:UC+COCLN        PICK UP LINE NUMBER
         DO1      CNM
COC05A   EQU      %
         LB,R6    COCTERM,R2
         LH,SR3   COCOTV,R6         ADDR OF TRANSLATION TABLE INTO SR3
         AW,SR3   Y01               SET FOR O/P BLOCK LIMIT CHECK
         AI,R7    -1                BYTE ADDR OF  USER'S BUFFER - 1
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT FLAG,
*                                   .. DISABLE COC INTERRUPTS
*  TEST FOR READ OR WRITE
         CI,R0    12
         BAZ      COC60             BRANCH IF READ OPERATION (0 - 3)
         CI,R0    8
         DO       CNM
         BANZ     COC70
         ELSE
         BANZ     COC10             BRANCH IF NOT A WRITE OPERATION
         FIN
         BAL,SR4  COCWR             WRITE MESSAGE
         DO       PMONOFF=1
         LW,R5    SR1
         BAL,R4   WTMSGSIZ
         FIN
         LI,D1    1                 SET TYC FOR WRITE
*  CALL COMPLETE PROCESSING
COC10    EQU      %
         BAL,R13  COCENABL          CLEAR T:COCHC LOCK-OUT FLAG,
*                                   .. ENABLE COC INTERRUPTS
         SLS,SR1  17                SHIFT ARS
         LI,SR2   X'E0000'          STORE INTO BITS 0-14
         STS,SR1  4,1               STORE ARS IN DCB
         AI,R1    7                 R1 POINTS TO WD 7 OF DCB
         MTB,-1   *R1               DECREMENT FCN (I/O COUNT)
         PULL     7,R5              PULL REGISTERS
         BAL,0    SETTYC            SETUP TYC IN DCB
         B        *SR4              RETURN
COC60    EQU      %
         AI,SR1   0
         DO       CNM
         BEZ      COC70
         ELSE
         BEZ      COC10             READ OF ZERO BYTES REQUESTED
         FIN
         BAL,SR4  COCRD             READ MESSAGE
         B        COC10             WRAPUP
         DO       CNM
COC70    LI,10    X'1FFFF'
         AND,10   DCB:ECB,R1        GET ECB ADDRESS
         BEZ      COC10             NONE, DON'T POST
         LW,9     Y01               SET TYC
         LW,8     S:CUN             GET USER #
         BAL,11   ECBPOST           POST ECB
         LI,8     0                 SET ARS AGAIN
         B        COC10             ENTER NORMAL CODE
         TITLE    'DOLIST PROCESSING'
*
*        COC WRITE COMPLETE ROUTINE
*
         DEF      COC:WTCOMP
COC:WTCOMP EQU    %
         LD,10    2,5               GET ECB ADDRESS
         LW,9     Y01               SET TYC
         LW,8     4                 SET USER #
         BAL,11   ECBPOST           POST ECB
         B        T:DOLISTR         RETURN
         REF      T:DOLISTR,J:INTENT
         SPACE    5
*
*        COC READ COMPLETE ROUTINE
*        R5 -> DA(4 WORD BLOCK)
*        R6,R7   HAS 1ST DOUBLE WORD OF 4 WORD BLOCK
*
         DEF      COC:RDCOMP
COC:RDCOMP EQU    %
         LW,SR3   0,R7              SR3=> XLATE TABLE.
         LW,8     1,R7               8 => USER BUFFER.
         LW,R3    2,R7              R3 =  TAB LINK.
         LW,2     7
         BAL,1    ECBFBLK           FREE FIRST BLOCK.
         LD,6     2,5               6= ECB ADDR, 7= DCB ADDR.
         LB,2     7                 2= LINE #.
         LC       MODE5,2
         BCR,2    T:DOLISTR         ---> NO DCB OPEN, FORGET THE READ.
         STW,6    DCB:ECB,7         PUT ECB ADDR BACK IN DCB.
         LW,6     7
         LI,SR4   COC:RD90
         PUSH     7,5               (5=DA(BLOCK),6=WA(DCB),11=RETURN)
         LI,6     COC10
         PUSH     3,6               (<COC10>,DCBADDR,USERBUFF)
         BAL,13   COCDSABL
         B        COCRD77           (2=LINE#,3=TABLINK,10=XLATE)
*
*
COC:RD90 LW,4     S:CUN
         B        T:DOLISTR         (4=CUN,5=DA(BLOCK))
         SPACE    5
*
*        BREAK LATER ROUTINE
*
         DEF      COC:BRKLTR
COC:BRKLTR EQU    %
         PUSH     2,R4              SAVE USER#, BLOCK ADDR.
         LW,2     7                 GET LINE #.
         LB,4     COCTERM,2
         LH,10    COCOTV,4          GET TRANSLATION TABLE.
         BAL,13   COCDSABL
         DO       2741CODE
         BAL,SR1  IPCXY1            RELEASE INPUT
         ELSE
         BAL,SR4  IPCXY1
         FIN
         LW,7     2
         BAL,13   COCENABL
         PULL     2,R4              RESTORE USER#, BLOCK ADDR.
*                                   FALL THROUGH TO
         SPACE    5
*
*        BREAK ROUTINE
*
         DEF      COC:BRK
COC:BRK  MTW,0    J:INTENT
         BEZ      T:DOLISTR         NO M:INT, JUST RETURN
         LW,2     5
         SLS,2    1
         BAL,1    ECBFBLK           RELEASE BLOCK
         INHIBIT
         LB,R5    MODE5,R2
         AND,R5   XEF               TURN OFF BREAK PENDING BIT
         STB,R5   MODE5,R2
         RINHIBIT
         LW,0     7                 GET LINE NUMBER.
         SLD,0    -12               ,INTO R1(0-11).
         LI,0     -X'100'+'C'       FFFFFFC3 IN R0.
         LI,2     3                   DO 3 DIGITS.
COC:BRKLP SCS,0   4                 ZONE TO R0(28-31); DIGITS LEFT.
         SLD,0    4                 DIGIT TO R0(28-31).
         CB,0     L('9'**24)        SEE IF NEED TO ADJUST ZONE.
         BLE      %+2               --> NO. DIGIT IS 0-9.
         AI,0     'A'-'9'-1           YES. DIGIT IS A-F. ADJUST.
         BDR,2    COC:BRKLP         REPEAT FOR 3 DIGITS.
         LH,15    UH:FLG,4          GET USER FLAGS.
         B        SE7A              ENTER BREAK CODE IN SCHED.
         REF      SE7A
XEF      DATA     X'EF'
         TITLE    ' '
*
* WLDLCHN - CHAIN 4 WORD BLOCK BY PRIORITY.
*        BYTE 0, WORD 0 HAS PRIORITY
*        HIGHEST PRIORITY IS LAST IN CHAIN
*        R10 -> WA(BLOCK)
*        R7 -> HA(HEAD OF CHAIN)
*        R11 -> RETURN
*        NO VOLATILES
*
WLDLCHN  PUSH     7,5
         INHIBIT
         LW,5     7                 SAVE HEAD POINTER
         LH,6     0,7               GET HEAD
         AND,6    XF000             GET FLAGS
         LB,11    *10               GET PRIORITY OF NEW DUDE
         STH,6    11                SAVE FLAGS
         SLS,10   -1                GET DA FROM WA
WLDL10   LH,6     0,7               GET DA OF BLOCK
         AND,6    M12               CLEAR FLAGS
         BEZ      WLDL80            END OF CHAIN, PUT NEW HERE
         LD,8     0,6               GET 1ST DW OF BLOCK
         CB,11    8                 CHECK PRIORITY
         BL       WLDL70            CHAIN IT HERE
         LW,7     6                 GET HA OF LINK POINTER
         SLS,7    2
         AI,7     1
         B        WLDL10
*
WLDL70   INT,7    8                 GET DA OF FWD
         AND,8    YFFFF             CLEAR RT HALF WORD
         OR,8     10                PUT IN NEW BLOCK AS FWD LINK
         STD,8    0,6               PUT PREV DUDE BACK
WLDL75   LW,6     10                DA TO INDEX REG.
         LD,8     0,6               GET 1ST DW OFNEW BLOCK
         AND,8    YFFFF             MASK OFF RT HALF WD
         OR,8     7                 PUT IN FWD LINK
         STD,8    0,6               PUT IT BACK
         LH,6     0,5               GET NEW HEAD
         SLS,11   -16               MOVE FLAGS OVER
         OR,6     11                INSERT FLAGS
         STH,6    0,5               STORE HEAD WITH FLAGS
         RINHIBIT
         PULL     7,5
         B        *11               RETURN
*
WLDL80   STH,10   0,7               PUT BLOCK ADDR IN POINTER
         LI,7     0                 SET FWD LINK
         B        WLDL75            JOIN NORMAL CODE
XF000    DATA     X'F000'
         FIN
         DO       CNM
         TITLE    'CLEAN UP SLAVE LINE TABLES'
*
*        KILLIO - RUN DOWN AND CANCEL ALL IO ON A SLAVE LINE.
*                 THE LINE MUST BE SLAVE.
*                 ALL COC BUFFERS WILL BE RELEASED.
*        BAL,11
*        R2 HAS LINE #
*        ALL REGS NON-VOLATILE
*
Y0D      DATA     X'0D000000'
         DEF      KILLIO
KILLIO   EQU      %
         LC       MODE5,2           DO NOTHING IF NO A SLAVE LINE
         BCR,8    *11
         PUSH     16,3              MAKE LINE # AT TOP OF STACK
         INHIBIT
         LB,5     MODE,2
         AND,5    XEF               CLEAR READ PENDING BIT
         STB,5    MODE,2
         LB,5     MODE5,2
         AND,5    XEF               CLEAR BREAK PENDING
         STB,5    MODE5,2
         RINHIBIT
         BAL,11   GETECBRD          GET ANY READ WAIT BLOCK
         BEZ      KILL05
         LB,8     LB:UN,2           GOT ONE, POST THE ECB
         LW,10    2,7
         LW,9     Y0D               SET TYC
         BAL,11   ECBPOST
         LW,2     1,7               GET LINKED BLOCK
         BAL,1    ECBFBLK
         BAL,0    RELIF1
KILL05   LB,5     MODE5,2
         CI,5     8
         BANZ     %+3               DON'T KILL INPUT IF READ DONE
         BAL,13   COCDSABL
         BAL,9    KILLIN            RELEASE INPUT BUFFERS
         LI,11    KILL20            SET RETURN
*
*        KILLOUT - RELEASE ALL OUTPUT BUFFERS
*        BAL,11
*        R2 HAS LINE #
*        VOLATILE 4 - 10, 13-15
*
         DEF      KILLOUT
KILLOUT  BAL,13   COCDSABL          NO OUTPUT INT'S PLEASE
         PUSH     2
         LH,4     COCOR,2           GET REMOVAL POINT
         BEZ      KILL10            NO OUTPUT CHARS, OK
         LI,5     1                 THERE ARE SOME, SET COUNT TO 1
         STB,5    COCOC,2
         BAL,6    COCPUTBL          RELEASE THE BUFFER
         BNEZ     %-1               TILL ALL GONE
         STH,4    COCOR,2           ZAP REMOVAL POINT
KILL10   BAL,13   COCENABL
         LW,4     11                SAVE RETURN ADDRESS
*
         BAL,11   GETECBWT          GET WRITE WAIT BLOCK
         BEZ      KILL15
         LB,8     LB:UN,2           GOT ONE, POST THE ECB
         LW,10    2,7
         LW,9     Y0D
         BAL,11   ECBPOST
         BAL,0    RELIF1
KILL15   PULL     2                 RESTORE LINE NUMBER
         B        0,4               AND RETURN
KILL20   PULL     16,3
         B        *11               AND WE ARE DONE
*
*        RELIF - RELEASE 4 WORD BLOCK IF ANY GOTTEN
*        BAL,0
*
RELIF1   LW,2     7                 BLOCK TO PROPER REG
         BAL,1    ECBFBLK           FREE THE BLOCK
         LW,2     *TSTACK           RESTORE LINE #
         B        *0                RETURN
         FIN
         TITLE    'BUFFER STATS ROUTINE'
         DO       CNM
*
*        COCSTAT - GET COC LINE STATISTICS
*
*        BAL,SR4
*        R2 HAS LINE NUMBER
*        SR1 RETURN # CHARS INPUT, BIT 0 SET MEANS AN ACTIVATION
*                 CHARACTER HAS BEEN RECIEVED
*        SR2 RETURN # OUTPUT CHARS TO BE SENT
*        SR3 RETURNS MAX # CHARS BEFORE USER IS BLOCKED
*
         DEF      COCSTAT
COCSTAT  LI,SR1   0                 # INPUT CHARS
         INHIBIT
         LH,4     COCIR,2
         BEZ      STAT20            NO CHARS
         LH,3     COCII,2           END OF CHARS
         BEZ      STAT20            (CAN'T BE ZERO OF COCIR ISN'T)
         LB,5     COCTERM,2         TERMINAL TYPE
         LH,SR3   COCOTV,5          TRANSLATE TABLE ADDRESS
STAT10   LB,R5    COCBUF,R4         GET NEXT CHAR
         AI,SR1   1                 INCREMENT COUNT
         LC       *SR3,R5
         BCR,2    %+2               BR IF NOT AN ACTIVATION CHAR
         OR,SR1   Y8                SET FLAG
         CW,R4    R3
         BE       STAT20            WE HAVE HIT THE END
         AI,R4    1
         CI,R4    X'F'
         BANZ     STAT10            MORE IN THIS BUFFER
         SLS,R4   -1                GET FORWARD LINK
         LH,R4    COCBUF-4,R4
         BNEZ     STAT10
*
STAT20   RINHIBIT
         LB,SR3   COCOC,R2          GET OUTPUT COUN
         LW,SR2   SL:ONCB           MAX # BUFFERS
         MI,SR2   14                TIMES # CHARS PER BUF = MAX CHARS
         XW,SR2   SR3               MOVE TO CORRECT REGS
         B        *SR4              AND GO BACK
         FIN
         TITLE    'A U T O H A N G U P - - C A L L U P  R O U T I N E'
*
*  CALLED FROM CLOCK4 EVERY 1.2 SECONDS
*
*        CALL:    BAL,8             T:COCHC
*
T:COCHC  EQU      %
         MTW,1    CO:INTFL          INCREMENT T:COCHC BY-PASS COUNT
         LH,R3    CO:INTFL          L/LH OF CO:INTFL
         BNEZ     *R8               BNEZ; WE'VE INTERRUPTED COC PROCESSING
         PUSH     R8                SAVE BAL REGISTER
         LI,R5    LCOC              INITIALIZE REG 5 TO LAST 7611 NUMBER
COCHC0   EQU      %
         LH,R7    COH:DN,R5         L/DEVICE ADR FOR THIS COC
         TIO,0    0,R7              TIO COC; SEE IF THIS COC IS RUNNING
         BCS,8    COCHC63           B/ADR NOT RECOGNIZED
         BCR,4    COCHC64           B/SIO POSSIBLE; CALL COCINIT
         LD,SR1   COD:HWL,R5        GET HARDWIRE BITS IN SR1&SR2
         LD,R6    COD:LPC,R5        RANGE OF LOGICAL LINES ON 7611
         SW,R6    R7
         LCW,SR3  R6                LAST PHYSICAL LINE INTO SR3
COCHC1   EQU      %
         SCD,SR1  -1                BIT 0 OF SR1 IS HDWIRE BIT FOR TERM
         LI,SR4   2
         LW,R2    R7                L/LINE # FOR 2741DEL, CHKLOGON, COCM
COCHC2   EQU      %
         EXU      CO:STAT,R5        SENSE RECEIVER STATUS
         BCS,1    COCHC5            BRANCH IF RECEIVER IS ON
         BDR,SR4  COCHC2
         LB,R6    LB:UN,R7          USER NUMBER
         BEZ      COCHC8            BRANCH IF NO USER ON THIS LINE
         LC       MODE2,R7
         BCS,8    COCHC81           LINE IS OFF.
         DO 2741CODE=1
         BCR,1    COCHC26
         STB,SR4  COCTERM,R7        DISABLE AUTO LOGON
         FIN
COCHC26  EQU      %
         DO       CNM
         LC       MODE5,R7
         BCS,8    SETIOERR
         FIN
         LI,R6    E:OFF             SET TO REPORT 'OFF' EVENT
COCHC28  EQU      %
         PUSH     5                 REG FIVE DESTROYED BY RUE
         BAL,SR4  T:RCE             REPORT EVENT
         PULL     5
COCHC8   EQU      %
         AI,R7    -1                NEXT LOGICAL LINE
         AI,SR3   -1                NEXT PHYSICAL LINE
         BGEZ     COCHC1            CONTINUE FOR ALL LINES ON THIS COC
COCHC9   EQU      %
         AI,R5    -1                DECREMENT 7611 NUMBER
         BGEZ     COCHC0            BRANCH AFTER ALL 7611'S PROCESSED
*
         LW,R4    COCHPB
         BEZ      HCXIT             BRANCH IF NO COC BUFFERS AVAILABLE
         INHIBIT                    INHIBIT
         LI,R5    1
         LI,R6    E:CBA             REPORT BUFFERS AVAIL
         BAL,SR4  T:RUE
*                                   .. RETURN WITH INHIBITS OFF
HCXIT    EQU      %
         LI,R8    0                 L/0
         STW,R8   CO:INTFL          RESET T:COCHC L0CK-OUT/BY-PASS FLAG
         PULL     R8                PULL RETURN ADR
         B        *SR1
*
COCHC81  EQU      %
         DO       2741CODE=1
         LC       MODE2,R7
         BCR,1    COCHC8            B/NOT 2741
         BCR,8    COCHC65           B/NOT REPORTED OFF
         LH,SR4   COCOR,R7          BUFFS EXIST??
         BEZ      COCHC8
         PUSH     SR2
         PUSH     R5                PUSH R5
         BAL,SR2  2741DEL           START OUTPUT.
         PULL     R5                PULL R5
         PULL     SR2
         FIN
         B        COCHC8
*
COCHC5   EQU      %
         DO       CNM
         LC       MODE5,R7          DON'T CHECK
         BCS,8    COCHC8            SLAVE LINES
         FIN
         RD,0     0                 READ SENSE SWITCHES
         LW,SR1   SR1               HARDWIRE BIT TO CC4
         BCS,5    COCHC81           BR IF SS ON OR HARDWIRED TERMINAL
         LB,R6    LB:UN,R7
         BNEZ     COCHC7            BRANCH IF USER EXISTS FOR THIS LINE
         DO       2741CODE=1
         LC       MODE2,R7          CHECK FOR 2741 TERMINAL
         BCR,1    COCHC6            BRANCH IF NOT 2741
         LB,R6    COCTERM,R7        CHECK IF KEYBOARD STILL INITIALIZED
         BEZ      COCHC8            DO NOT LOGON IF KEYBOARD TYPE = 0.
         LC       MODE3,R7
         BCR,1    COCHC8            LOGON UNDERWAY IF KEYBOARD UNLOCKED
         FIN
         LC       MODE2,R7
COCHC6   EQU      %
         BCR,8    COCHC62           BRANCH IF NOT LOGGING OFF
         LH,R6    TL,R7
         BNEZ     COCHC8            BRANCH IF NOT LOGGED OFF YET
COCHC62  EQU      %
         BAL,R4   COCMINT           INITIALIZE MODE CONTROL BITS
         LI,R6    E:CBK             SET TO REPORT BREAK (CALL'S LOGON)
         B        COCHC28           BRANCH TO REPORT EVENT
COCHC63  LC       COB:SIOS,R5       L/SIO CC'S FROM PREVIOUS START
         BCS,8    COCHC9            B/ADR NOT RECOGNIZED NOW OR AT SIO
*                                   .. TIME; DON'T CHECK LINES
COCHC64  PUSH     R5                PUSH R5
         BAL,R13  COCDSABL          DISABLE COC INTERRUPTS
         BAL,R11  COCINIT           START ANY STARTABLE COCS
         BAL,R13  COCENABL          ENABLE COC INTERRUPTS
         PULL     R5                PULL R5
         B        COCHC9            B; PROCESS NEXT COC
         DO       2741CODE
         PAGE
********************************************************************************
*
*  2741 LINE AND EITHER HARDWIRED OR SENSE SWITCH 2 IS UP.
*  LINE IS NOT FLAGGED AS OFF.
*
*  IF LOGON IS ASSOCIATED, EXECUTE THE TIME-OUT ROUTINE IN CASE
*  THE USER DIDN'T HIT THE '*' KEY WHEN IDENTIFYING HIS CHARACTER
*  SET, OR WANTS TO CHANGE CHARACTER SETS.  THIS WAY THE LINE WILL
*  TIME OUT AND COCTERM WILL BE RESET, ALLOWING THE USER
*  TO RE-IDENTIFY.
*
********************************************************************************
COCHC65  EQU      %
         BAL,R15  CHKLOGON          SEE IF LOGON ASSOCIATED
         BNE      COCHC8            B/NOT LOGON; DON'T TIME OUT
         FIN
*
*                 TIME OUT USERS HAVING READS PENDING
COCHC7   EQU      %
         LC       MODE,R7
         BCR,1    COCHC8            BRANCH IF NO READ IS PENDING
         INT,R3   CO:INTFL          L/T:COCHC BY-PASS COUNT + 1
         MTH,-1   EOMTIME,R7        DECREMENT TIMER
         BEZ      COCHC7C           BEZ; READ HAS TIMED OUT
         BDR,R3   %-2               BDR IF T:COCHC WAS BY-PASSED
         B        COCHC8            B; USER HAS TIME LEFT
COCHC7C  MTH,-1   EOMTIME,R7        MAKE EOMTIME NON-ZERO; OTHERWISE,
*                                   .. BUFFER POINTERS MAY BE RESET
*                                   .. WITHOUT RELEASING BUFFERS
         B        COCHC26           B; REPORT E:OFF EVENT
         DO       CNM
SETIOERR BCR,2    COCHC8            DON'T CHECK IF DCB NOT OPEN
         PUSH     7,5
         PSW,7    TSTACK            PUT LINE # AT TOP OF STACK
         LW,2     7
         BAL,11   GETECBRD          GET ANY READ WAIT BLOCK
         BEZ      SETERR20          NONE, LOOK FOR WRITE
         LW,2     1,7               GET LINKED BLOCK
         BAL,1    ECBFBLK           AND RELEASE IT
         LI,9     RD:ERRCODE        ERROR CODE
         LI,5     SETERR20          RETURN ADDRESS
COCHC8A  LW,2     *TSTACK           SET LINE #
         LB,8     LB:UN,2           .. USER NUMBER
         LW,10    2,7               .. ECB ADDRESS
         SLS,9    24                .. TYC
         BAL,11   ECBPOST1          POST USERS ECB
         LC       7                 SEE IF BLOCK USED
         BCR,8    SETIO50           NO, RELEASE IT
         B        0,5               YES, RETRN
*
SETERR20 LW,2     *TSTACK           SET LINE #
         BAL,11   GETECBWT          GET WRITE BLOCK
         BEZ      COCHC8B           NONE, QUIT
         LI,9     WT:ERRCODE        SET ERROR CODE
         BAL,5    COCHC8A           POST ECB
COCHC8B  PLW,2    TSTACK
         PULL     7,5
         B        COCHC8
SETIO50  LW,2     7
         BAL,1    ECBFBLK           RELEASE WAIT BLOCK
         B        0,5
         FIN
         PAGE
*        SETUP COC FOR OFF -- CALLED FROM T:RCE
*        WHEN EVENT IS OFF
*
COCOFF   EQU      %
         BAL,R13  COCDSABL          DISABLE COC INTERRUPTS
         LB,R4    MODE2,R7
         OR,R4    BIT24
         STB,R4   MODE2,R7          SET REPORTED OFF BIT
         DO 2741CODE=1
         LC       MODE2,R7
         BCS,1    COCOFF4           BRANCH IF 2741
         FIN
         LI,R4    0                 L/0
         STB,R4   COCTERM,R7        RESET TERMINAL TYPE TO MOD 33
COCOFF4  EQU      %
         LW,R2    R7                LOGICAL LINE # INTO R2 FOR ACT.
         PUSH     R11-R5+1,R5       PUSH R5 - R11
         LB,R4    COCTERM,R7        L/TRANS TABLE #
         LH,R10   COCOTV,R4         L/OUTPUT TRANS TABLE ADR
         BAL,S:S(2741CODE,R11,R8) ; IF 2741CODE, BAL ON R8, ELSE R11
                  IPCXY5            RELEASE IN BUFS IF PRESENT AND OK
         LC       MODE,R7           L/MODE
         BCR,1    COCOFF6           B/NO READ PENDING; DON'T ACTIVATE
         BAL,R15  SETACT2           READ PENDING, SET ACTIVATION RCV'D
COCOFF6  PULL     R11-R5+1,R5       PULL R5 - R11
         LW,R13   R11               L/RETURN ADR
         B        COCENABL          RETURN TO SCHEDULER THRU COCENABL
BIT24    EQU      ALTMODES
         PAGE
*
*        INITIALIZE LINE MODE CONTROL BITS BEFORE NEW USER IS LOGGED ON.
*        THIS ROUTINE IS ENTERED FROM COCIP IF A BREAK IS RECEIVED ON A
*        LINE WITH NO USER NUMBER ASSIGNED AND FROM COCHC IF A LINE IS
*        READY AND NO USER NUMBER IS ASSIGNED.
*
*        R4 = RETURN REG
*
COCMINT  EQU      %                 INITIALIZE MODE CONTROL BITS
         LI,R6    X'2088'           MODE BITS
         STH,R6   EOMTIME,R2        RESET EOMTIME NONZERO.
         DO 2741CODE=1
         LC       MODE2,R2
         BCR,1    MINT1             BRANCH IF TERM NOT A 2741
         LI,R6    X'1440'           MODE BITS FOR 2741
         LC       MODE,R2
         BCS,4    MINT1             BRANCH IF EOA IS PENDING
         LI,R6    X'1400'           RESET EOA BIT
         FIN
MINT1    EQU      %
         STB,R6   MODE,R2
         SLS,R6   -8
         STB,R6   MODE2,R2
         AND,R6   X10               SET 2741 KEYBOARD LOCKED
         STB,R6   MODE3,R2
         LB,R6    MODE4INIT,R2      L/INITIAL VALUE FOR MODE4
         STB,R6   MODE4,R2          S/MODE4
         B        0,R4
         TITLE    'C O C   I N I T I A L I Z A T I O N'
********************************************************************************
*
*  COC INITIALIZATION - START/RESTART THE COC HARDWARE
*
*  THIS ROUTINE IS CALLED FROM GHOST1D, PFSR, AND T:COCHC TO
*     DO THE FOLLOWING:
*
*  RE-INITIALIZE THE RING BUFFER POINTER IN CASE OF POWER FAIL-SAFE.
*
*  EXECUTE AN SIO TO THE COC HARDWARE.  IF THERE IS NO ADDRESS
*     RECOGNITION, AN ERROR MESSAGE IS GIVEN ON THE OC, AND
*     INITIALIZATION SKIPS TO THE NEXT COC.  IF THE COC IS ALREADY
*     RUNNING, THE COC IS LEFT RUNNING, BUT THE NULL CHARACTERS ARE
*     NOT SENT TO LINES ON THAT COC.
*
*  IF THE RCVRCHK ASSEMBLY FLAG IS ON, ALL COC RECEIVERS ARE CHECKED
*     TO MAKE SURE THAT THE RECEIVER IS INSTALLED.  IF THE RECEIVER
*     INTERFACES TO A DATA SET, THE DATA SET IS CHECKED TO MAKE SURE
*     THAT IT IS ON (DATA SET READY TRUE).  IF NOT, AN ERROR MESSAGE
*     IS PRINTED ON THE OC, AND WE SKIP TO THE NEXT LINE.
*
*  TURN THE RECEIVER ON.
*
*  TRANSMIT A NULL CHARACTER.  THIS IS TO RESTART OUTPUT INTERRUPT
*     PROCESSING IN CASE OF A POWER FAIL-SAFE.
*
*  ARM AND ENABLE THE COC INTERRUPTS.  IF THIS IS A POWER FAIL-SAFE,
*     WE MAY HAVE HAD THE COC INTERRUPTS DISABLED, IN WHICH CASE
*     WE AGAIN DISABLE THE COC INTERRUPTS.
*
*  INPUT:
*     R11         RETURN ADDRESS
*
*  ENTRY POINTS:
*     AT COCINIT
*
*  EXIT POINTS:
*     AT INIT350 (WITH A BRANCH *R11)
*
*  REGISTERS DESTROYED:
*     ASSUME THAT ALL REGISTERS ARE DESTROYED
*
********************************************************************************
COCINIT  EQU      %
         LI,R3    0                 L/0; COC NUMBER
         STW,R3   CO:HIIL           0/HIGHEST INPUT INTERRUPT LEVEL
*                                   .. SELECT BIT
         STW,R3   CO:AIL            0/ALL INTERRUPT LEVEL SELECT
*                                   .. BITS CELL
INIT050  EQU      %
         LW,R0    CO:XPSDI          L/INPUT INTERRUPT XPSD INSTRUCTION
         LH,R5    COH:II,R3         L/INPUT INTERRUPT ADR FOR THIS COC
         STW,R0   0,R5              S/XPSD INST
         LCH,R0   COH:RBS,R3        L/COMPLEMENT OF RING BUFFER SIZE
         STW,R0   CO:LST,R3         S/RING BUFFER POINTER
         LW,R0    CO:CMND,R3        L/DA OF COMMAND DOUBLE WORD
         LH,R5    COH:DN,R3         L/COC ADR FOR THIS COC
         SIO,R0   *R5               START COC
         STCF     COB:SIOS,R3       S/SIO CC'S IN STATUS TABLE
         BCR,8    INIT100           B/ADR RECOGNIZED
********************************************************************************
*  SIO FAILURE ON THIS COC HAS OCCURED.
*  GIVE THE OPERATOR A MESSAGE OF THE FOLLOWING FORM:
*
*     !!BAD COC - MENDD
*
*  GO ON TO NEXT COC
********************************************************************************
         LI,R2    3                 L/# OF CHARS TO CONVERT
         LI,R1    BA(COCM1)+16      L/BA OF FIRST CONVERTED BYTE
         AI,R5    X'A00'            +.A00 TO COC ADR
         SLS,R5   20                LJ/COC ADR
         BAL,R6   HEXCON            BAL/CONVERT COC ADR TO EBCDIC
         LI,R13   COCM1             L/ADR OF MESSAGE
         PUSH     R3                PUSH R3
         LI,R1    0                 L/DCTX OF 0; DON'T PRECEED MESSAGE
*                                   .. WITH DEVICE NAME
         LI,R3    Y00FE+1-BA(IOQ14) L/DUMMY IOQX; POINT IOQ14 TO .FE,
*                                   .. USE .FE AS PRIO FOR MESSAGE
         BAL,R5   MSGOUT            BAL/WRITE MESSAGE ON OC
         PULL     R3                PULL R3
         B        INIT300           SKIP TO NEXT COC
         PAGE
INIT100  EQU      %
         BCS,4    INIT250           B/COC ALREADY WAS RUNNING
         LI,R7    0                 L/0; PHYSICAL LINE #
INIT150  EQU      %
         DO       RCVRCHK
***********************************************************************
*  CHECK RECEIVERS TO MAKE SURE THAT THE RECEIVER IS INSTALLED AND
*  EITHER HARDWIRED OR DATA SET READY IS TRUE.
***********************************************************************
         LW,R10   R7                L/RECEIVER NUMBER
         EXU      CO:STAT,R3        SENSE RECEIVER L STATUS
         BCS,C3C4 INIT200           B/RECEIVER INSTALLED AND EITHER
*                                   .. HARDWIRED OR DATA SET READY
         STB,R7   R5                LEFT JUSTIFY RCVR # IN R5
         LI,R1    BA(COCM2)+25      L/BA OF RCVR # IN MESSAGE
         LI,R2    2                 L/# OF CHARS TO CONVERT
         BAL,R6   HEXCON            BAL/MAKE RCVR # EBCDIC, PUT IN MESSAGE
         LI,R1    BA(COCM2)+14      L/BA OF COC # IN MESSAGE
         LW,R4    R3                L/COC #
         BAL,R6   HEXCON10          BAL/MAKE COC # EBCDIC, PUT IN MESSAGE
         LI,R13   COCM2             L/ADR OF MESSAGE
         PUSH     R3                PUSH R3
         LI,R1    0                 L/DCTX OF 0; DON'T PRECEED MESSAGE
*                                   .. WITH DEVICE NAME
         LI,R3    Y00FE+1-BA(IOQ14) L/DUMMY IOQX; POINT IOQ14 TO .FE,
*                                   .. USE .FE AS PRIO FOR MESSAGE
         BAL,R5   MSGOUT            BAL/WRITE MESSAGE ON OC
         PULL     R3                PULL R3
INIT200  EQU      %
         FIN
***********************************************************************
*  TURN RECEIVER ON, TRANSMIT .FF CHARACTER
***********************************************************************
         EXU      CO:RCVON,R3       TURN RECEIVER L ON
         LW,R6    R7                L/LINE #
         AI,R6    X'FF00'           +.FF00 TO LINE #; CHAR = .FF
         EXU      CO:XDATA,R3       TRANSMIT .FF TO RESTART OUTPUT IN
*                                   .. CASE OF PFSR
         AI,R7    1                 +1 TO LINE #
         LD,R4    COD:LPC,R3        L/LIMITS OF LOGICAL LINES FOR COC
         SW,R5    R4                LAST PHYSICAL LINE = LAST LOGICAL -
*                                   .. FIRST LOGICAL LINE #
         AW,R4    R7                (1ST LOGICAL LINE # FOR THIS COC) +
*                                   .. (PHYSICAL LINE #)
         MTB,1    COCOC,R4          INC OUTPUT CHAR COUNT
         CW,R7    R5                C/CURRENT LINE # W/LAST LINE #
         BLE      INIT150           BLE; CHECK NEXT LINE
***********************************************************************
*  ALL LINES ON THIS COC HAVE BEEN SET UP.
***********************************************************************
INIT250  LW,R5    CO:IIL,R3         L/INPUT INTERRUPT LEVEL SELECT BITS
         CW,R5    CO:HIIL           C/THIS COC'S INT LEVEL W/CURRENT
*                                   .. HIGHEST PRIO INT LEVEL
         BLE      %+3               BLE; THIS COC ISN'T HIGHEST
         STW,R5   CO:HIIL           S/HIGHEST PRIO INPUT INT LEVEL
         STW,R3   COCBLN            S/HIGHEST PRIORITY COC #
         OR,R5    CO:OIL,R3         OR IN OUTPUT INT LEVEL SELECT BITS
         STS,R5   CO:AIL            ADD INPUT AND OUTPUT SELECT BITS
*                                   .. FOR THIS COC TO SELECT BITS FOR
*                                   .. ALL COCS
INIT300  EQU      %
         AI,R3    1                 +1 TO COC #
         CI,R3    LCOC              C/COC # W/LAST COC #
         BLE      INIT050           BLE; CHECK NEXT COC
         LW,R3    COCBLN            L/COC # W/HIGHEST PRIORITY
         LH,R5    COH:II,R3         L/ADR OF HIGHEST PRIO INT LOCATION
         MTW,-4   0,R5              -4 TO XPSD REF ADR; POINT TO CO:IN0
************************************************************************
*  ARM AND ENABLE/DISABLE THE COC INTERRUPTS
************************************************************************
         LW,R4    CO:AIL            L/ALL COC INT LEVEL SELECT BITS
         :WD,R4   ARM%DISABLE,COA:IG    ARM & DISABLE INPUT AND
*                                   .. OUTPUT INTERRUPTS
         LH,R6    CO:INTFL          CHECK LH OF T:COCHC LOCK-OUT FLAG
         BGZ      %+2               BGZ; DON'T ENABLE
         BAL,R13  COCENABL          WE WEREN'T IN DISABLED CODE, SO ENABLE
*                                   .. COC INPUT AND OUTPUT INTERRUPTS
INIT350  B        *R11              EXIT
         PAGE
***********************************************************************
*
*  CONVERT BINARY NUMBER TO EBCDIC HEX
*
*  INPUT:
*     R1          BYTE ADDRESS OF 1ST BYTE IN OUTPUT BUFFER
*     R2          NUMBER OF HEX CHARACTERS TO CONVERT
*     R5          LEFT JUSTIFIED, THE BINARY INPUT VALUE
*     R6          RETURN ADDRESS
*
*  REGISTERS DESTROYED:
*     R1, R2, R4, R5
*
***********************************************************************
HEXCON   EQU      %
         LI,R4    0                 L/0; SET UP FOR CONVERSION
         SLD,R4   4                 SHIFT 1 HEX CHAR FROM R5 TO R4
HEXCON10 EQU      %
         LB,R4    HEX,R4            L/EBCDIC EQUIVALENT OF HEX DIGIT
         STB,R4   0,R1              S/CONVERTED CHAR
         AI,R1    1                 +1 TO CHAR POINTER
         BDR,R2   HEXCON            BDR/GET NEXT CHAR
         B        0,R6              RETURN
         TITLE    'A S C I I   = = = >   E B C D I C   T A B L E'
*                                                                       KD000020
*
*        TTY AND K/D  INPUT TRANSLATE TABLE --ASCII TO EBCDIC
*
*
TTYIN    EQU      %
*                 EBCDIC EQUIVAVENT OF ..... ASCII CHARACTERS
*    0
*
*
  DATA,8 X'0001020304090607'    NUL,  SOH,  STX,  ETX,  EOT,  ENQ,  ACK,  BEL
  DATA,8 X'0805150B0C0D0E0F'     BS,   HT, NL(LF), VT,   FF,   CR,   SO,   SI
*    1
  DATA,8 X'103C123D140A1617'   DLE,DC1(XON),DC2,DC3(XOFF),DC4, NAK, SYN,  ETB
  DATA,8 X'32191A301C1D1E1F'  CAN(CTL-X),EM(CTL-Y),SUB,ESC,FS, GS,  RS ,  US
*    2
  DATA,8 X'405A7F7B5B6C507D'  BLANK,EXCL MK,QUOT MK, #,   %,    %,    &,    '
  DATA,8 X'4D5D5C4E6B604B61'      (,    ),   *,    +,    ,,    -,    .,    /
*    3
  DATA,8 X'F0F1F2F3F4F5F6F7'      0,    1,    2,    3,    4,    5,    6,    7
  DATA,8 X'F8F97A5E4C7E6E6F'      8,    9,    :,    ;,    <,    =,    >,QUEST MK
         PAGE
*    4
  DATA,8 X'7CC1C2C3C4C5C6C7'      @,    A,    B,    C,    D,    E,    F,    G
  DATA,8 X'C8C9D1D2D3D4D5D6'      H,    I,    J,    K,    L,    M,    N,    O
*
*    5
  DATA,8 X'D7D8D9E2E3E4E5E6'      P,    Q,    R,    S,    T,    U,    V,    W
  DATA,8 X'E7E8E9B4B1B56A6D'      X,    Y,    Z,(BRAC, BK/ ,BRAC),ARROW,UNLINE
* FOR TTY'S OTHER THAN 7015, ASCII '5B' & '5D'(LEFT & RIGHT BRACKETS)
* ARE TRANSLATED RESPECTIVELY INTO - 'B4' & 'B5'
* FOR 7015'S, ASCII '5B' & '5D' (OR & NOT)
* ARE TRANSLATED RESPECTIVELY INTO '4F' & '5F'
*    6
  DATA,8 X'4A81828384858687'   CENTS,LC'A',LC'B',LC'C',LC'D',LC'E',LC'F',LC'G'
  DATA,8 X'8889919293949596'   LC'H',LC'I',LC'J',LC'K',LC'L',LC'M',LC'N',LC'O'
*    7
  DATA,8 X'979899A2A3A4A5A6'   LC'P',LC'Q',LC'R',LC'S',LC'T',LC'U',LC'V',LC'W'
  DATA,8 X'A7A8A9B24FB35FFF'   LC'X',LC'Y',LC'Z',BRACE(, OR,BRACE), NOT, RUB
         SPACE    5
ALTMODES DATA     X'311B1B80'       ACTIVE RUB, ALT-ESC, ALT-ESC, RUBOUT
         TITLE    'E B C D I C   = = = >   A S C I I   T A B L E'
*
*        TTY AND K/D  OUTPUT TRANSLATE TABLE -- EBCDIC TO ASCII
*
TTYOUT   EQU      %
*   00
  DATA,8  X'00010203EA810607'   NUL,  SOH,  STX,  ETX, +EOT,  *HT,  ACQ,  BEL
  DATA,8  X'8B05150B80820E0F'  +*BS,  ENQ,  NAK,   VT,  *FF,  *CR,   SO,   SI
*   01
  DATA,8  X'1011121314821617'   DLE,  XON,  DC2, XOFF,  DC4,*NL(LF),SYN,  ETB
  DATA,8  X'18E58E1BE1E2E3E4'   CAN,  +EM, *SUB, *ESC,  +FS,  +GS,  +RS,  +US
*   02
  DATA,8  X'8D1C1D1E1F192F5E'   *LF,   FS,   GS,   RS,   US,   EM,    /,ARROW
  DATA,8  X'3D0D040829090A23'    = ,   CR,  EOT,   BS,    ),   HT,   LF,  SUB
*    3
  DATA,8  X'848685D6D2C3CBD3'  ESC*F,*RUB,ESC*X,ESC&P,ESC&U,ESC&(,ESC&),ESC&T
  DATA,8 X'D5D7D78CCEC68788'   ESC&S,ESC&E,ESC&C,ESC*LF,*XON,*XOFF,ESC*R,ESC*CR

*    4
  DATA,8  X'202323D523238F23'  BLANK, SUB , SUB ,ESC&O, SUB , SUB ,*BSBS, SUB
  DATA,8  X'2323602E3C282B8A'   SUB , SUB ,CENTS,   . ,   < ,   ( ,   + , *OR
*    5
  DATA,8  X'2623232323232323'     &,  SUB , SUB , SUB , SUB , SUB , SUB , SUB
  DATA,8  X'232321242AAC3B8A'   SUB, SUB ,EXCL.,   % ,   * ,  +) ,   ; , NOT
*    6
  DATA,8  X'2DA6232323232323'     -,   +/,  SUB , SUB , SUB , SUB , SUB , SUB
  DATA,8  X'2323A72C255F3E3F'   SUB , SUB ,+UP-ARROW, ,,  %,BK-ARROW, >,QUEST MK
*    7
  DATA,8  X'2323232323232323'   SUB , SUB , SUB , SUB , SUB , SUB , SUB , SUB
  DATA,8  X'23233A234027A822'   SUB , SUB ,   :,    #,    @,    ',   +=,'
*    8
  DATA,8  X'2361626364656667'   SUB ,LC'A',LC'B',LC'C',LC'D',LC'E',LC'F',LC'G'
  DATA,8  X'6869232323232323'  LC'H',LC'I', SUB , SUB , SUB , SUB , SUB , SUB
*    9
  DATA,8  X'236A6B6C6D6E6F70'   SUB ,LC'J',LC'K',LC'L',LC'M',LC'N',LC'O',LC'P'
  DATA,8  X'7172232323232323'  LC'Q',LC'R', SUB , SUB , SUB , SUB , SUB , SUB
*    A
  DATA,8  X'2323737475767778'   SUB , SUB ,LC'S',LC'T',LC'U',LC'V',LC'W',LC'X'
  DATA,8  X'797A23232323237C'  LC'Y',LC'Z', SUB , SUB , SUB , SUB , SUB , OR
*    B
  DATA,8  X'235C7B7D89892323'   SUB ,BK'/',(BRAC,BRAC),*(BRK,*BRK), SUB , SUB
  DATA,8  X'232323235B5DEF7E'   SUB , SUB , SUB , SUB ,(BRAK,BRAK),+DATA, NOT
*    C
  DATA,8  X'2041424344454647'  SPACE,   A,    B,    C,    D,    E,    F,    G
  DATA,8  X'4849232323232323'     H,    I,  SUB , SUB , SUB , SUB , SUB , SUB
*    D
  DATA,8  X'234A4B4C4D4E4F50'   SUB ,   J,    K,    L,    M,    N,    O,    P
  DATA,8  X'5152232323232323'     Q,    R,  SUB , SUB , SUB , SUB , SUB , SUB
*    E
  DATA,8  X'2D23535455565758'    -  , SUB,    S,    T,    U,    V,    W,    X
  DATA,8  X'595A232323232323'     Y,    Z,  SUB , SUB , SUB , SUB , SUB , SUB
*    F
  DATA,8  X'3031323334353637'     0,    1,    2,    3,    4,    5,    6,    7
  DATA,8  X'383923232323237F'     8,    9,  SUB , SUB , SUB , SUB , SUB , DEL
*
*
*
* THE SYMBOL *, +, AND &, WHICH PRECEED OR ARE IMBEDDED IN COMMENTARY SYMBOLS
* INDICATE CATAGORIES OF CHARACTERS WHICH REQUIRE SPECIAL HANDLING.
*  THE SPECIAL CATAGORIES ARE:
*
*          *   . . .   UNIQUE ACTION IS GENERALLY REQUIRED.
*
*          +   . . .   THE CHARACTER WILL NORMALLY ACTIVATE, OR
*                      IT IS A DELTA ACTIVATION CHARACTER.
*
*          &   . . .   CHANGE APPROPRIATE MODE IN LINE TABLE.
*
*
*
* END OF K/D OUTPUT TRANSLATE TABLE                                     KD000950
*                                                                       KD000960
END      EQU      %
         TITLE    'S U M M A R Y'
         END                                                            KD000970

