COCR:,COCR EQU    %
************************************************************************
*
*
*M*      COC      7611 CHARACTER ORIENTED COMMUNICATION HANDLER (ROOT)
*
*
************************************************************************
*P*  NAME:    COC
*P*  PURPOSE: TO PROVIDE ALMOST ALL OF THE MAPPED/UNMAPPED FUNCTIONS
*P*           UNIQUE TO A 7611 CHARACTER ORIENTED COMMUNICATIONS DEVICE.
************************************************************************
 TITLE 'C O C R   -   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 'C O C R   -   M O D E   T A B L E   D E S C R I P T I O N S'
************************************************************************
*
*
*
*  MODE   |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | | <=> BREAK COUNT
*           | | | | | > SHIFT LOWER-CASE INPUT TO UPPER-CASE
*           | | | | > TAB SIMULATION (CARRIAGE POSITIONING)
*           | | | > READ PENDING
*           | | > TRANSPARENT MODE INPUT
*           | > TTY ESCAPE PENDING / 2741 EOA PENDING
*           > ECHOPLEX
*
*
************************************************************************
*
*
*
*  MODE2  |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | | <=> ACTIVATION CHARACTER SET
*           | | | | | > CHECK PARITY
*           | | | | > SHIFT UPPER-CASE INPUT TO LOWER CASE
*           | | | > 2741
*           | | > INSERT SPACES FOR TABS ON INPUT
*           | > FULL DUPLEX PAPER TAPE
*           > HUNG UP / TIMED OUT / OPERATOR ABORTED
*
*
************************************************************************
           PAGE
************************************************************************
*
*
*  MODE3  |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | <===> # OF LINES UPSPACED WHILE NOT CURRENT USER
*           | | | | > COC BUFFER OVER-RUN ON INPUT
*           | | | > 2741 KEYBOARD LOCKED
*           | | > BACKSPACE EDIT
*           | > HALF-DUPLEX PAPER TAPE
*           > TAB RELATIVE TO START OF READ POSITION
*
*
************************************************************************
*
*  MODE4  |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | <===> CURRENT TIMING ALGORITHM (SEE MODE4INIT)
*           | | | <=> UNUSED
*           | | > INSERT MODE
*           | > COUPLE REJECTED
*           >  CURRENTLY COUPLED / COUPLE OK
*
************************************************************************
           PAGE
*  MODE4INIT
*         |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | <===> LINE SPEED INDICATOR
*           | | <===> INITIAL TIMING ALGORITHM # (SEE MODE4)
*           <=> UNUSED
*
*
*  LINE SPEED    CHARACTERS
*   INDICATOR    PER SECOND    BAUD
*
*           0            10     110
*           1            15 134/150
*           2            30     300
*           3            60     600
*           4           120    1200
*           5           240    2400
*           6           480    4800
*           7           960    9600
*
*
*  ALGORITHM    APPLICABLE TERMINALS
*
*          0    TTY 33, 35, 37, MOST CRT'S
*          1    2741-TYPES, TEXAS INSTRUMENTS 733
*          2    EXECUPORT, DATAPOINT
*          3    MEMOREX
*          4    ALL (COMBINATION OF 2 & 3)
*          5    TEXAS INSTRUMENTS 725
*          6    TELETYPE MODEL 40 HARDCOPY PRINTER
*          7    UNUSED
           PAGE
************************************************************************
*
*
*  MODE5  |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | | | > DEFAULT TO MASTER
*           | | | | | | > DEFAULT TO SLAVE
*           | | | | | > ACQUIRE-ENABLE FOR TP SLAVE MODE
*           | | | | > TP READ COMPLETE
*           | | | > TP BREAK PENDING
*           | | > DCB OPEN TO LINE
*           | > MASTER
*           > SLAVE
*
*
************************************************************************
*
*
*  MODE6  |----------------|
*         | 0 1 2 3|4 5 6 7|
*         |-+-+-+-+-+-+-+-+|
*           | | | | | | | |
*           | | | | | | | > HARDWIRED
*           | | | | | | > UNUSED
*           | | | | | > HALF-DUPLEX LINE TURN-AROUND, PHASE 2
*           | | | | > HALF-DUPLEX LINE TURN-AROUND, PHASE 1
*           | | | > OUTPUT-HALT MODE
*           | | > READ WITH USER-CONTROLLED TIMEOUT
*           | > HALF-DUPLEX IN INPUT MODE
*           > HALF-DUPLEX
*
*
************************************************************************
 TITLE 'C O C R   -   D A T A   D E S C R I P T I O N S'
************************************************************************
*
*  J:COCOPT  (OPTIONS PASSED BY M:READ/M:WRITE CAL)
*
*  |----------------------------------------------------------------|
*  |                |    1 1 1 1 1 1|1 1 1 1 2 2 2 2|2 2 2 2 2 2 3 3|
*  | 0 1 2 3 4 5 6 7|8 9 0 1 2 3 4 5|6 7 8 9 0 1 2 3|4 5 6 7 8 9 0 1|
*  |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+|
*    | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
*    | | | | | | | | | | | | | | | | | | | | | | | | <=   CPOS    =>
*    | | | | | | | | | | | | | | | | <= USER'S READ TIMEOUT VALUE =>
*    | | | | | | | | | | | | | | <=> OVER-RIDING ACTIVATION CHARACTER SET
*    | | | | | | | | | | | | | > OVER-RIDING ACTIVATION CHAR SET SPECIFIED
*    | | | | | | | <=UNUSED==>
*    | | | | | | > USER SPECIFIED CPOS
*    | | | | | > RE-READ REQUESTED
*    | | | | > DELETE OUTPUT BUFFERS
*    | | | > DELETE INPUT BUFFERS
*    | | > CONDITIONAL READ
*    | > USER-CONTROLLED READ TIMEOUT
*    > 0
*
*
************************************************************************
         PAGE
************************************************************************
*
*  COCGFLG  (COC GHOST REQUEST FLAGS)
*
*  ---------------------------------|
*   |1 1 1 1 2 2 2 2|2 2 2 2 2 2 3 3|
*   |6 7 8 9 0 1 2 3|4 5 6 7 8 9 0 1|
*  --+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+|
*    | | | | | | | | <=============> UNUSED
*    | | | | | | | > POWER FAIL-SAFE INIT REQUEST
*    | | | | | | > CLOCK3/T:COCHC INIT REQUEST
*    | | | | > CSECOM INIT REQUEST
*    | | | > ONLINE USER MAX INCREASED
*    | | > UNUSED
*    | > GHOST1D/BOOT COC INIT REQUEST
*    > GHOST1D/RECOVERY COC INIT REQUEST
*  < UNUSED
*
*
************************************************************************
         PAGE
************************************************************************
*
*  JB:COCOPT2  (BYTE 0 OF WORD 14 OF M:UC IN THE JIT)
*
*  |----------------|
*  | 0 1 2 3|4 5 6 7|
*  |-+-+-+-+-+-+-+-+|
*    | | | | | | | |
*    | | | | | <===> PAGINATION MODE
*    | <=====> UNUSED
*    > ESCAPE-Z (IGNORE INPUT)
*
*
*  PAGINATION   APPLICABLE    DESCRIPTION  (ACTION TAKEN AT END OF
*        MODE   TERMINALS     PAGE)
*
*           0   ANY           'NORMAL' PAGINATION
*           1   TEKTRONIX     PLACE IN OUTPUT HALT MODE; WHEN CLEARED,
*                                SEND ESC-FF ERASE/HOME SEQUENCE, WAIT
*                                .8 SECONDS
*           2   TELETYPE 40   PLACE IN OUTPUT HALT MODE;  WHEN CLEARED
*                                SEND ESC-H, ESC-J ERASE/HOME SEQUENCE,
*                                WAIT .25 SECONDS
*           3   MOST SCOPES   PLACE IN OUTPUT HALT MODE
*         4-7   SPARE ENTRIES PATCHABLE
*
************************************************************************
 TITLE 'C O C R   -   A S S E M B L Y   F L A G S'
*
*  THE CONDITIONAL ASSEMBLY FLAGS IN COC CAN BE CONTROLLED BY 'SET'
*  DIRECTIVES INSERTED AT THE BEGINNING OF THE COCR MODULE.
*
*  1  IF THERE ISN'T A 'SET' FOR A PARTICULAR FLAG,
*     AN ASSEMBLED-IN DEFAULT IS USED.
*  2  IF THERE IS A 'SET' FOR A FLAG, THE VALUE SPECIFIED
*     WILL BE USED.
*     A  TO INCLUDE A PARTICULAR FEATURE, THE CORRESPONDING
*        LABEL SHOULD BE 'SET' TO A 1 (E.G., 2741CODE SET 0).
*     B  TO EXCLUDE A PARTICULAR FEATURE, THE LABEL SHOULD
*        BE 'SET' TO A 0 (E.G., 2741CODE SET 0).
*     C  VALUE-TYPE ASSEMBLY PARAMETERS SHOULD BE 'SET' TO THE
*        DESIRED VALUE (E.G., C:140 SET 200).
*
*  IF THE LABEL FIELD HAS NOT BEEN DEFINED YET, SET IT TO THE VALUE
*  OF THE ARGUMENT FIELD
*
MINCOC   EQU      1                 MINI VERSION OF COCR
*
*
ASSEMCON CNAME
         PROC
         DO1      TCOR(S:FR,LF(1))
LF(1)    SET      AF(1)
         DISP     LF(1)
         PEND
*
TP       ASSEMCON 0                 GEN TRANSACTION PROCESSING CODE
MINCOC   ASSEMCON 0                 GENERATE SUBSET OF 'NORMAL' COC
*
*  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  ASSEMCON MINCOC=0          GEN CODE FOR GET BUF CHECKING
COCPBUG  ASSEMCON MINCOC=0          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 ASSEMCON 0                 EXECUTE GET BUF CHECKING CODE
COCPBUGE ASSEMCON 0                 EXECUTE PUT BUF CHECKING CODE
COCPCP   ASSEMCON MINCOC=0          GEN PAGE HEADING CODE
C:140    ASSEMCON 140               MAX SIZE FOR READ AND WRITE REQUEST
PMONOFF  ASSEMCON MINCOC=0          GEN PERFORMANCE MONITORING CODE
RCVRCHK  ASSEMCON 0                 CHECK RECEIVERS DURING COC INIT
2741ARUB ASSEMCON 0                 UPPER-CASE BACKSPACE RUBOUT CODE
2741CODE ASSEMCON MINCOC=0          GEN 2741-HANDLING CODE
TCOUPL   ASSEMCON MINCOC=0          FOR COUPLING FEATURE
ZFLG     ASSEMCON MINCOC=0          FOR ESCAPE-Z FEATURE
HALF%DUPLEX ;
         ASSEMCON MINCOC=0          HALF-DUPLEX LINE SUPPORT
RT       ASSEMCON 1                 REAL TIME IN SYSTEM
HALT     ASSEMCON MINCOC=0          HALT OUTPUT MODE (ESC-H, PAGINATION)
L6FEP    ASSEMCON 1                 LEVEL 6 FEP
OUTPUTIGNORE ;
         ASSEMCON MINCOC=0          IGNORE OUTPUT UNTIL NEXT READ (ESC-W)
         DEF      COCRFL            COC ASSEMBLY FLAGS; CONTAINS BITS
*,*                                 DESCRIBING ASSEMBLY OPTIONS AS FOLLOWS:
*,*                                 BIT MEANING
*,*                                 1   HALF-DUPLEX LINE SUPPORT
*,*                                 2   ESCAPE-Z (IGNORE INPUT) IN
*,*                                 3   COUPLING CODE ASSEMBLED IN
*,*                                 4   TP ASSEMBLED IN
*,*                                 5   GET BUF ERROR CHECKING CONTROLLED
*,*                                     BY SENSE SWITCH 4
*,*                                 6   PUT BUF ERROR CHECKING CONTROLLED
*,*                                     BY SENSE SWITCH 4
*,*                                 7   MINCOC VERSION
*,*                                 8   RECEIVER CHECKING IS ASSEMBLED IN
*,*                                 9   PAGE HEADING CODE ASSEMBLED IN
*,*                                 10  2741 CODE ASSEMBLED IN
*,*                                 11  PERFORMANCE CODE ASSEMBLED IN
*,*                                 12  GET BUF ERROR CHECKING CODE IN
*,*                                 13  PUT BUF ERROR CHECKING CODE IN
*,*                                 15  2741 ALTERNATE RUBOUT ASSEMBLED IN
*,*                                 17  REAL-TIME SUPPORT IN
*,*                                 18  OUTPUT-HALT (ESC-H, PAGINATION)
*,*                                 19  OUTPUT IGNORE (ESC-W) CODE IN
*,*                                 20 L6 FEP CODE IN
COCRFL   EQU      HALF%DUPLEX**30+;
                  ZFLG**29+;
                  TCOUPL**28+;
                  TP**27+;
                  COCGBUGE**26+;
                  COCPBUGE**25+;
                  MINCOC**24+;
                  RCVRCHK**23+;
                  COCPCP**22+;
                  2741CODE**21+;
                  PMONOFF**20+;
                  COCGBUG**19+;
                  COCPBUG**18+;
                  2741ARUB**16+;
                  RT**14+;
                  HALT**13+;
                  OUTPUTIGNORE**12+;
                  L6FEP**11+;
                  0
         TITLE    ' LEVEL 6 FRONT END REFS & SREFS'
         REF      L6#FIRST          COC # OF FIRST L6 FEP
         REF      L6LIMS            DW LOGICAL LINE LIMITS FOR FEP LINES
         SREF     L6HLTGO           RESTART LEVEL 6 OUTPUT
         SREF     L6COCKO           FLUSH OUT L6'S Q OF CHARS FOR LINE
         SREF     L6SUF             LEVEL 6 SEND UP FRONT
         SREF     L6BSEND           BLOCKABLE USER CHARACTER SEND
         SREF     L6ECBQ            LEVL 6 ECB POST QUERY
           DO1    TP                RETURN POINT FOR ABOVE ROUTINE
           DEF    L6ECBR            ...
 TITLE 'C O C R   -   C O M M A N D   D E F I N I T I O N S'
BITS     SET      1                 REF'S MASKS&BT31TO0 & GETS
*                                   EQU'S FOR M'S, X'S, & Y'S.
         SYSTEM   UTS
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
*
INHIBIT  COM,32   X'6D000037'       INHIBIT
UNINHIBIT COM,32  X'6D000027'       RESET INHIBITS
*
C:REG    CNAME                      PERFORM REG (REPORT EVENT, GIVE UP
         PROC                       .. CONTROL)
         DO       NUM(AF)=0
LF       BAL,R12  C:REG
         ELSE
LF       LI,R12   AF(1)
         B        C:REG
         FIN
         PEND
*
COCUNMAP COM,8,24 X'0F',COCUNMAP    XPSD,0 COCUNMAP
 TITLE 'C O C R   -   S Y M B O L I C   C O N S T A N T S'
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
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
COLON    EQU      BA(TTYIN)+X'3A'
RUBOUT   EQU      X'FF'             RUBOUT CHAR; NON-2741 TIMING CHAR
ESCAPE   EQU      X'1B'             ESCAPE CHARACTER
FORMFEED EQU      X'B0'             FORM FEED CHARACTER ('EBCDIC')
SLASH    EQU      BA(TTYIN)+X'2F'
SPACE    EQU      BA(TTYIN)+X'20'
SYN      EQU      X'16'             SYN CHAR; IDLE, FOR 2741 TIMING
XOFF     EQU      X'13'             XOFF CHAR; STOP PAPER TAPE READER
*
*  MODE4 TABLE BIT DEFINITIONS
*
*  THE FOLLOWING SYMBOLIC DEFINITIONS ARE USED TO SET, RESET, AND CHECK
*  MODE4 PARAMETERS.
*
IM       EQU      6                 INSERT MODE
XON      EQU      X'11'             XON CHAR; START PAPER TAPE READER
IGNORCHR EQU      X'51'             'EBCDIC' CHARACTER THAT GETS IGNORED
*                                   .. THROUGHOUT INPUT PROCESSING
         DO       TP
BARNDV   EQU      4*5+2
COC:SPECHAR EQU   X'88'
         FIN
         PAGE
*
*  MODE6 TABLE BIT DEFINITIONS
*
*  THE FOLLOWING SYMBOLIC DEFINITIONS ARE USED TO SET, RESET, AND CHECK
*  MODE6 PARAMETERS.
*
HD       EQU      8                 HALF-DUPLEX LINE
HDIN     EQU      7                 HALF-DUPLEX LINE IN INPUT MODE
UTO      EQU      6                 READ WITH USER-CONTROLLED TIME-OUT
HLT      EQU      5                 HALT OUTPUT INTERRUPT PROCESSING
HDTA     EQU      4                 HALF-DUPLEX LINE TO BE TURNED AROUND
HDTA2    EQU      3                 HALF-DUPLEX LINE IN SECOND PHASE
*                                   .. OF TURN-AROUND
HW       EQU      1                 HARDWIRED LINE
*
*  REGISTER 9 FLAG BIT DIFINITIONS
*
R9IM     EQU      32                INSERT MODE ACTIVE IN COCMU ROUTINE
MUNOACT  EQU      31                'NO ACTIVATION RECEIVED' IN COCMU
*
*  REGISTER 10 FLAGS BIT DEFINITIONS
*
RUTO     EQU      31                REQUEST USER TIMEOUT
CRD      EQU      30                CONDITIONAL READ
DI       EQU      29                DELETE INPUT
DO       EQU      28                DELETE OUTPUT
RR       EQU      27                RE-READ REQUESTED
SCPOS    EQU      26                SET CPOS TO PASSED VALUE
BLOCK    EQU      25                OK TO BLOCK USER
OACS     EQU      19                OVER-RIDE ACTIVATION CHARACTER SET
*                                   .. SET SPECIFIED
CC       FNAME                      DEFINE CONDITION CODE
         PROC
         ERROR,3,AF(1)<5|AF(1)>8 'AF OUT OF RANGE'
         PEND     1**(AF(1)-5)
AC       FNAME                      DEFINE ABSOLUTE CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     1**(AF(1)-1)
LC       FNAME                      DEFINE LITERAL CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     BT31TO0+AF(1)
NLC      FNAME                      DEFINE .NOT. LITERAL CONSTANT
         PROC
         ERROR,3,AF(1)<1|AF(1)>32 'AF OUT OF RANGE'
         PEND     NB31TO0+AF(1)
 TITLE 'C O C R   -   D E F S'
         DEF      COCR:             XDELTA/PATCH SYMBOL
         DEF      COCR              BASE ADR AND PRESENCE INDICATOR
*,*                                 FOR THE COCR MODULE
         DEF      COCFLAG           PRESENCE INDICATOR FOR COC MODULE
         DEF      COC               PRESENCE INDICATOR FOR COC MODULE
COCFLAG  EQU      1
COC      EQU      1
 TITLE 'C O C R   -   E N T R Y   P O I N T   D E F S'
         DEF      COCDSABL          DISABLE COC INTERRUPTS
         DEF      COCENABL          ENABLE COC INTERRUPTS
         DEF      COCIO             ENTRY FOR DCB READS AND WRITES
         DEF      COCSENDX          SEND 1 CHARACTER TO TERMINAL ROUTINE
         DEF      COCCLN            CHECK COC LINE NUMBER
         DEF      COCGLN            GET, CHECK COC LINE NUMBER
         DEF      ECHOCR2           ROUTINE FOR INCREMENTING LINES-
*,*                                 UPSPACED WHILE OUT OF CORE
         DEF      COCMINT           REINITIALIZE LINE TABLES
         DEF      COCSTERM          SET TERM TYPE IN COCTERM
         DEF      COCSTRMC          SET TERM TYPE IF LB:UN = 0
         DEF      KILLIN            FREE INPUT BUFFERS ROUTINE
         DEF      COCGETB           GET COC BUFFER ROUTINE
         DEF      COCPUTBL          RETURN COC BUFFER ROUTINE
         DEF      ECHOCR            ECHO CR ROUTINE
         DO       HALF%DUPLEX
         DEF      T:TURNOUT         TURN HALF-DUPLEX LINE TO OUTPUT MODE
         FIN
         DEF      COCPHYLN          GET PHYSICAL LINE, COC NUMBERS
         DEF      T:DEFER           DEFER SEND KEYIN TIL JOB STEP
         DO       TP
         DEF      COC:BRK           TPCOC BREAK ROUTINE
         DEF      COC:BRKLTR        TPCOC BREAK LATER ROUTINE
         DEF      COC:RDCOMP        TPCOC READ COMPLETE ROUTINE
         DEF      KILLIO            TPCOC DELETE INPUT AND OUTPUT ROUTINE
         DEF      KILLOUT           TPCOC DELETE OUTPUT ROUTINE
         FIN
         DO       TCOUPL=1
         DEF      DECOUPLE%         DECOUPLE LINES ENTRY
         DEF      COCPCIB           PLACE CHAR. IN BUFFER ROUTINE
         FIN
 TITLE 'C O C R   -   C O C U   E N T R Y   P O I N T   D E F S'
         DEF      COCACSET          GET ACTIVATION CHARACTER SET
         DEF      COCCPT1           SEND BELL FOR BUF DEPLETION
         DEF      COCRLD            RESET LOST-DATA FLAG
         DEF      COCECHO           ECHO CHARACTER
         DEF      COCSENDT          SEND TRANSPARENT CHARACTER
         DEF      COCECESC          ECHO ESC SEQUENCE
         DEF      COCECHO1          TURN 2741 AROUND
         DO1      2741CODE
         DEF      COCEOT1           SEND 2741 EOT
         DO       HALT
         DEF      COCSHALT          SET HALT FLAG
         DEF      COCHLTGO          RESET HALT, CONTINUE
         FIN
         DEF      COCESCX1          PORTION OF ESC-X PROCESSING
         DEF      COCESCX2          PORTION OF ESC-X PROCESSING
         DO       TP
         DEF      COCGECBR          GET READ ECB
         DEF      COCGECBW          GET WRITE ECB
         DEF      COCKIOHU          KILL I/O ON HANG-UP
         DEF      COCPECB           POST ECB
         DEF      COCWLDLC          CHAIN ECB
         FIN
         DEF      COCINIT           INITIALIZATION ENTRY FOR COC
         DEF      COCINIT2          INITIALIZATION ENTRY FOR COC
         DEF      COCKIO            KILL INPUT & OUTPUT BUFS
         DEF      COCKO             KILL OUTPUT
         DEF      COCSNXOF          SEND XOFF CHARACTER
         DEF      COCSACTO          SET ACTIVATION ON READ TIMEOUT
         DEF      COCSACT1          SET ACTIVATION RECEIVED
         DEF      COCSACT2          SET ACTIVATION RECEIVED
         DEF      COCSNDFF          SEND .FF CHARACTER
         DEF      COCUMER           COCUNMAP ROUTINE
         DEF      COCGETE           ENTRY FOR XPSD TO COCGETB
         DEF      COCPUTE           ENTRY FOR XPSD TO COCPUTB
 TITLE 'C O C R   -   D E F S'
         DEF      COCRDPND          READ PENDING REPORTING POINT
         DEF      COCSETAC          SET ACTIVATION RECEIVED POINT
         DEF      MODENO            HALFWORD TABLE CONTAINING THE ADRS OF
*,*                                 THE MODE TABLES
         DEF      COB:CPS           INDEXED BY MODE4 SPEED, CONTAINS
*,*                                 .. THE CHARACTERS PER SECOND
         DEF      COB:MNIC          INDEXED BY MODE4 IDLE ALGORITHM,
*,*                                 .. CONTAINS THE COLUMN NUMBER FOR
*,*                                 .. MAXIMUM # OF IDLES ON A CARRIAGE RETURN
         DEF      LOWLET            LOWER-CASE-A, LOWER-CASE-Z
 TITLE 'C O C R   -   T E R M   T Y P E   I N D E X E D   T A B L E S'
         DEF      COB:STAR          INDEXED BY COCTERM/2, GIVES THE STAR (*)
*,*                                 .. VALUE FOR 2741 CODE SETS
*
         SREF     COCSTR0           STAR FOR SPARE TRANSLATE TABLES 0 & 1
         SREF     COCSTR2           STAR FOR SPARE TRANSLATE TABLES 2 & 3
*
COB:STAR DATA,1   0,0               TTY ENTRIES
         DATA,1   X'04'             EBCD - STANDARD
         DATA,1   X'79'             EBCD - APL
         DATA,1   X'38'             SELECTRIC - STANDARD
         DATA,1   X'0B'             SELECTRIC - APL
         DATA,1   COCSTR0           STAR FOR SPARE TRANSLATE TABLES 0 & 1
         DATA,1   COCSTR2           STAR FOR SPARE TRANSLATE TABLES 2 & 3
         DATA,1   0                 ASCII APL, SPARE ENTRIES
*
         DEF      NOSTARS           COCHTT/2
NOSTARS  EQU      BA(%)-BA(COB:STAR)-1
         BOUND    4
*
*                 INPUT AND OUTPUT  TRANSLATE TABLE VECTORS
         DEF      TTYIN             ASCII -> EBCDIC TRANSLATION TABLE
         DEF      COCITV            INPUT TRANSLATE TABLE POINTER TABLE
         DEF      AAPLXI            TRANS TBL INDEX FOR ASCII APL TAB
*
         SREF     ESTDLC            EBCD STANDARD LOWER CASE
         SREF     ESTDUC            EBCD STANDARD UPPER CASE
         SREF     EAPLLC            EBCD APL LOWER CASE
         SREF     EAPLUC            EBCD APL UPPER CASE
         SREF     SSTDLC            SELECTRIC STANDARD LOWER CASE
         SREF     SSTDUC            SELECTRIC STANDARD UPPER CASE
         SREF     SAPLLC            SELECTRIC APL LOWER CASE
         SREF     SAPLUC            SELECTRIC APL UPPER CASE
*
         SREF     COCITT0           SPARE INPUT TRANSLATE TABLE POINTER
         SREF     COCITT1           SPARE INPUT TRANSLATE TABLE POINTER
         SREF     COCITT2           SPARE INPUT TRANSLATE TABLE POINTER
         SREF     COCITT3           SPARE INPUT TRANSLATE TABLE POINTER
         SREF     AAPLIN            ASCII APL INPUT TRANS TBL
*
COCITV   DATA,2   TTYIN             M33
         DATA,2   TTYIN             M35
         DATA,2   TTYIN             M37
         DATA,2   TTYIN             XEROX MODEL 7015
         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
         DATA,2   COCITT0           SPARE INPUT TRANSLATE TABLE POINTER
         DATA,2   COCITT1           SPARE INPUT TRANSLATE TABLE POINTER
         DATA,2   COCITT2           SPARE INPUT TRANSLATE TABLE POINTER
         DATA,2   COCITT3           SPARE INPUT TRANSLATE TABLE POINTER
         DATA,2   TTYIN             VP72 (HONEYWELL VIP 7200/7205)
AAPLXI   EQU      HA(%)-HA(COCITV)  INDEX OF ASCII APL TRANS TBL
         DATA,2   AAPLIN            ASCII APL INPUT TRANS TBL
         BOUND    4
*
*                 OUTPUT TABLES
*
         DEF      TTYOUT            EBCDIC -> ASCII TRANSLATION TABLE
         DEF      COCOTV            OUTPUT TRANSLATION TABLE POINTER
*,*                                 TABLE
         SREF     ESTD              EBCD STANDARD OUTPUT TRANS TBL
         SREF     EAPL              EBCD APL OUTPUT TRANS TBL
         SREF     SSTD              SELECTRIC STANDARD OUTPUT TRANS TBL
         SREF     SAPL              SELECTRIC APL OUTPUT TRANS TBL
*
         SREF     COCOTT0           SPARE OUTPUT TRANSLATE TABLE POINTER
         SREF     COCOTT1           SPARE OUTPUT TRANSLATE TABLE POINTER
         SREF     COCOTT2           SPARE OUTPUT TRANSLATE TABLE POINTER
         SREF     COCOTT3           SPARE OUTPUT TRANSLATE TABLE POINTER
         SREF     AAPLOUT           ASCII APL OUTPUT TRANS TBL
*
COCOTV   DATA,2   TTYOUT            M33
         DATA,2   TTYOUT            M35
         DATA,2   TTYOUT            M37
         DATA,2   TTYOUT            XDS MODEL 7015
         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
         DATA,2   COCOTT0           SPARE OUTPUT TRANSLATE TABLE POINTER
         DATA,2   COCOTT1           SPARE OUTPUT TRANSLATE TABLE POINTER
         DATA,2   COCOTT2           SPARE OUTPUT TRANSLATE TABLE POINTER
         DATA,2   COCOTT3           SPARE OUTPUT TRANSLATE TABLE POINTER
         DATA,2   TTYOUT            VP72
         DATA,2   AAPLOUT           ASCII APL OUTPUT TRANS TBL
*
         DEF      COCHTT            HIGHEST LEGAL TERMINAL TYPE
COCHTT   EQU      HA(%)-HA(COCOTV)-1     LARGEST VALID TERMINAL TYPE
         BOUND    4
*
*  COB:TC, INDEXED BY COCTERM, YIELDS THE FOLLOWING TERMINAL
*  CHARACTERISTICS:
*
ESCDBS   EQU      8                 ESC-D IS THE BACKSPACE CHAR
ESC7D7E  EQU      7                 ASCII .7D & .7E ARE ESCAPES
NOB      EQU      6                 EXCHANGE NOT/OR AND BRACKETS
PT       EQU      5                 TERMINAL HAS PHYSICAL TABS
*
         DEF      COB:TC            COC TERMINAL CHARACTERISTICS
COB:TC   DATA,1   AC(ESC7D7E)+AC(NOB) TTY 33
         DATA,1   AC(ESC7D7E)+AC(PT) TTY 35
         DATA,1   AC(PT)            TTY 37
         DATA,1   AC(ESC7D7E)+AC(NOB) XDS 7015
         DO1      2*4               2741'S
         DATA,1   AC(PT)
         DO1      4                 SPARES
         DATA,1   AC(PT)
         DATA,1   AC(ESCDBS)+AC(PT) ESC-D IS THE BACKSPACE CHAR
         DATA,1   AC(PT)            ASCII APL
         BOUND    4
         SREF     COCBPR0           SPARE 0 BS EDIT POSITION RIGHT CHAR
         SREF     COCBPR1           SPARE 1 BS EDIT POSITION RIGHT CHAR
         SREF     COCBPR2           SPARE 2 BS EDIT POSITION RIGHT CHAR
         SREF     COCBPR3           SPARE 3 BS EDIT POSITION RIGHT CHAR
COB:BPR  DATA,1   X'47'             TTY 33
         DATA,1   X'47'             TTY 35
         DATA,1   X'47'             TTY 37
         DATA,1   X'47'             XEROX 7015
         DO1      8                 2741'S
         DATA,1   X'40'             BLANK
         DATA,1   COCBPR0           SPARE 0
         DATA,1   COCBPR1           SPARE 1
         DATA,1   COCBPR2           SPARE 2
         DATA,1   COCBPR3           SPARE 3
         DATA,1   X'47'             VP72
         DATA,1   X'47'             AAPL
         BOUND    4
COCSTX4  EQU      X'7FFFFFFF'||-(X'7FFFFFFF'&'VP72'+1)
         DEF      COCSTX4           TEXT TERM NAME FOR VP72 (VIP 7200)
 TITLE 'C O C R   -   A S C I I   = = = >   E B C D I C   T A B L E'
************************************************************************
*F*  NAME:    TTYIN
*F*  PURPOSE: PROVIDE INPUT TRANSLATION INFORMATION TO THE COC HANDLER
*F*           FOR ASCII TERMINALS.
*F*  DESCRIPTION:  TTYIN, INDEXED BY AN ASCII CHARACTER, YIELDS THE
*F*           CORRESPONDING EBCDIC CHARACTER.
************************************************************************
*
*
*        TTY AND K/D  INPUT TRANSLATE TABLE --ASCII TO EBCDIC
*
*
TTYIN    EQU      %
*                 EBCDIC EQUIVALENT 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'103C473D140A1617'  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'A7A8A9B24FB35F31'  LC'X',LC'Y',LC'Z',BRACE(, OR,BRACE), NOT, RUBOUT
*
 TITLE 'C O C R   -   E B C D I C   = = = >   A S C I I   T A B L E'
************************************************************************
*F*  NAME:    TTYOUT
*F*  PURPOSE: PROVIDE OUTPUT TRANSLATION INFORMATION TO THE COC HANDLER
*F*           FOR ASCII TERMINALS.
*F*  DESCRIPTION:  TTYOUT, INDEXED BY AN EBCDIC CHARACTER, YIELDS 1 OF
*F*           THE FOLLOWING:
*F*           1   IF THE .80 BIT IS SET, A COC INTERNAL CONTROL CODE.
*F*           2   ELSE, AN ASCII CHARACTER.
************************************************************************
*
*        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'3D0D040829090A1A'   = ,   CR,  EOT,   BS,    ),   HT,   LF,  SUB
*    3
 DATA,8  X'849485D6D2C3CBD3' ESC*F,*RUB,ESC*X,ESC&P,ESC&U,ESC&(,ESC&),ESC&T
 DATA,8 X'D5D7D7D5CEC68788'  ESC&S,ESC&E,ESC&C,ESC&O,*XON,*XOFF,ESC*R,ESC*CR
*    4
 DATA,8  X'2093238C23238F95' BLANK, ESC*J, SUB,ESC*LF, SUB, SUB,*BSBS, DC2
 DATA,8  X'2323602E3C282B8A'  SUB , SUB ,CENTS,   . ,   < ,   ( ,   + , *OR
*    5
 DATA,8  X'2691922390232323'    &,IGNORE,ESC*D, SUB ,ESC*Z, 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'0C5C7B7D89890023'  FF  ,BK'/',(BRAC,BRAC),*(BRK,*BRK), NULL, 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.
*
*
 TITLE 'C O C R   -   C O N S T A N T   R E F S'
         REF      HEX               TEXT '0123456789ABCDEF'
         REF      NB31TO0           MASK USED FOR MODE5 BYTE
         REF      XFFEF             MASK
EF       EQU      XFFEF
         REF      XFFF0             MASK
         REF      X1000001          MASK
         REF      X500000D          MASK
         REF      Y000A             MASK
         REF      Y03               MASK
         REF      Y6                MASK
         REF      Y7F               MASK
         REF      YBE               MASK
         REF      YFFFF
         REF      DOUBLEZERO        DOUBLE WORD OF ZERO'S
 TITLE 'C O C R   -   J I T   R E F S'
         REF      M:UC              SPECIAL COC DCB
         REF      JB:COCOPT2        SPECIAL COC OPTIONS
         REF      JB:LAPH           LINES AFTER PAGE HEADING
         REF      JB:LBPH           LINES BEFORE PAGE HEADING
         REF,1    JB:LPP            LINES PER TERMINAL PAGE
         REF,1    JB:PCW            PLATEN WIDTH, IN COLUMNS
         REF,1    JB:LC             LINE COUNT WITHIN PAGE
         REF,2    JH:PC             PAGE COUNT
         REF,1    JB:PROMPT         PROMPT CHARACTER, VIA M:PROMPT
         REF      J:JIT
         REF      J:INTER           COUNT # OF CONSOLE INTERACTIONS
         REF      J:COCOPT          COC OPTIONS FROM CAL
         REF      J:BASE            FIND & DECREMENT PSD IN TSTACK
         DO       TP
         REF      J:INTENT          TP CHECK FOR M:INT ENTRY POINT
         REF      J:RWECB           BITS 15-31 INPUT = ECB BLOCK ADDR.
*,*                                     OUTPUT ZEROED IF ECB USED.
         FIN
 TITLE 'C O C R   -   S Y S T E M   L I M I T   R E F S'
         REF      SL:OITO           NORMAL INPUT TIMEOUT, 1.2 SEC UNITS
         REF      SL:TB             TERMINAL BLOCK LIMIT, IN SECONDS OF
*,*                                 OUTPUT
*,*                                 OF OUTPUT
 TITLE 'C O C R   -   M O N I T O R   T A B L E   R E F S'
         REF      S:CUN             CURRENT USER #
         REF      U:MISC            SLEEP PERIOD
         REF      UH:DL             DEFERRED EVENT REPORTING
         REF      UH:FLG            USER FLAGS
         REF      DATE              PAGE HEADING DATE
         REF      TIME              PAGE HEADING TIME
         REF      #DLBLKS           ACCOUNTING FOR PIGEON'S 4-WD BLKS
         DO       TCOUPL=1
         REF      S:COUP            COUPLING FEATURE CONTROL CELL
         SREF     TIE               COUPLING CONTROL TABLE
         FIN
 TITLE 'C O C R   -   S C H E D   E V E N T / S T A T E   R E F S'
         REF      E:CBL             TERMINAL OUTPUT BLOCK EVENT
         REF      E:CFB             CANT FIND BUFFER
         REF      E:CRD             READ IN PROGRESS
         REF      E:SL              SLEEP EVENT
 TITLE 'C O C R   -   M O N I T O R   S U B R O U T I N E   R E F S'
         REF      T:GJOBSTRT        START COCG
         REF      T:REG             REPORT EVENT
         REF      GMB               GET MPOOL FOR ESC-R
         REF      RMB               REL MPOOL FOR ESC-R OR MESSAGE BUFFER
         REF      SETTYC            SET TYC
         REF      KICKOFF           ABORT USER READ IN EXIT CONTROL
         REF      T:DOLISTR         RET TO SCHED AFTER DO-LIST PROCESS.
         REF      PULL11B           PULL R11; B *R11
         DO       TP
         REF      ECBFBLK           FREE ECB
         REF      ECBGBLK           GET ECB
         REF      ECBPOST1          POST ECB
         REF      SE7A              SCHEDULER ENTRY
         FIN
         REF      C:CTUN            FOR HALF-DUPLEX TIMING, PERF MONITOR
         REF      C:TINC            FOR HALF-DUPLEX TIMING, PERF MONITOR
         DO1      HALF%DUPLEX
         REF      RTICBCLKHDR       HEAD/TAIL POINTERS FOR ACTIVE CLOCK3
*                                   .. INTERRUPT CONTROL BLOCKS
* PERFORMANCE MEASUREMENT ITEMS & ROUTINES
*
         DO       PMONOFF=1
         REF      C:CTW             TOTAL M:WRITES TO COC
         REF      C:TIC             FOR PERFORMANCE MONITORING
         REF      CURNTIM           GET CURRENT TIME
         REF      RDMSGSIZ          REPORT INPUT RECORD SIZE
         REF      READREQ           REPORT REQUESTED INPUT RECORD SIZE
         REF      WTMSGSIZ          REPORT OUTPUT RECORD SIZE
         FIN
 TITLE 'C O C R   -   C O C   I N D E X E D   T A B L E   R E F S'
         REF      LCOC              INDEX TO LAST COC (# OF COCS - 1)
         REF      LNOL              NUMBER OF COC LINES
         REF      COD:LPC           LIMITS OF LOGICAL LINES PER COC
         REF      CO:RCVOFF         'TURN RECEIVER OFF'
         REF      CO:XDATA          TRANSMIT CHARACTER
 TITLE 'C O C R   -   I N T E R R U P T   D A T A   R E F S'
         REF      COA:IG            COC EXTERNAL INTERRUPT GROUP #
*,*                                 .. LEVEL SELECT BIT
         REF      CO:AIL            ALL COC INTERRUPT LEVEL SELECT BITS
*,*                                 .. HIGHEST PRIORITY INPUT INT
         REF      CO:INTFL          COC INTERRUPT STATUS FLAGS
 TITLE 'C O C R   -   M I S C   C O C   D A T A   R E F S'
         REF      COCGETBPSD        PSD FOR UNMAPPING, INHIBITING IN COCGETB
         REF      COCPUTBPSD        PSD FOR UNMAPPING, INHIBITING IN COCPUTB
         REF      COCUNMAP          PSD FOR UNMAPPING/MAPPING IN COC
         REF      COCBUF            FREE COC BUFFER POOL ADR
         REF      COCHPB
         REF      COC#BUFS          NUMBER OF COC BUFFERS IN USE
         REF      COCMESS           HEADER/BREAK MESSAGE
         REF      COCGFLG           COCG GHOST REQUEST FLAGS
         DO       HALF%DUPLEX
         REF      COCHDFLN          LINE # OF FIRST HALF-DUPLEX LINE
*,*                                 .. BEING TURNED FROM INPUT TO
*,*                                 .. OUTPUT MODE
         REF      COCHDLLN          LINE # OF LAST HALF-DUPLEX LINE
*,*                                 .. BEING TURNED FROM INPUT TO
*,*                                 .. OUTPUT MODE
         REF      COCHDICB          INTERRUPT CONTROL BLOCK FOR HALF DUPLEX
*,*                                 .. LINE TURNAROUND TIMING
         FIN
         REF      HRBA              HIGHEST RELATIVE BUFFER ADDRESS
         DO       TP
         REF      COC:ECB
         FIN
 TITLE 'C O C R   -   L I N E   I N D E X E D   T A B L E   R E F S'
         REF      ARSZ              ACTUAL INPUT RECORD SIZE
         REF      BUFCNT            TOTAL BUFFER COUNT
         REF      COCII             INPUT INSERTION POINTER
         REF      COCIR             INPUT REMOVAL POINTER
         REF      COCOC             OUTPUT CHARACTER COUNT
         REF      COCOI             OUTPUT INSERTION POINTER
         REF      COCOR             OUTPUT REMOVAL POINTER
         REF      COCTERM           TRANSLATE TABLE INDEX, TERMINAL TYPE
         REF      COB:CTI           TERM TYPE INITIAL VALUE
         REF      CPI               CARRIAGE POSITION AT START OF READ
         REF      CPOS              CURRENT CARRIAGE POSITION
         REF      EOMTIME           READ TIMEOUT PERIOD, ACTIVATION TIME, FLAG
         REF      LB:UN             USER NUMBER
         REF      MODE              STATUS
         REF      MODE2             STATUS
         REF      MODE3             STATUS
         REF      MODE4             STATUS
         REF      MODE4INIT         INITIAL MODE4 STATUS
         REF      MODE5             STATUS
         REF      MODE6             STATUS
         REF      RSZ               REQUESTED MESSAGE SIZE ON READ
         REF      TL                TAB BUF ADR, ACTIVATION POINT
 TITLE 'C O C R   -   S T A T I C   D A T A'
         BOUND    8
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
TCCOCG   TEXTC    'COCG'            COC GHOST NAME
LIMSTAK  DATA     TSTACK+4          LOWEST VALUE FOR
*                                   .. WA(DA(ADR OF R0 IN TSTACK))
         DATA     TSTACK+4+121-1-8-16  HIGHEST VALUE FOR
*                                   .. WA(DA(ADR OF R0 IN TSTACK)),
*                                   .. ASSUMING SIZE OF 121 WORDS, PUSHALL
*                                   .. AND ENVIRONMENT IN TSTACK
COB:CPS  DATA,1   10,15,30,60,120,240,255,255  INDEXED BY MODE4
*                                   .. LINE SPEED, YIELDS CHARS/SEC
         BOUND    4
NOCR     DATA,1   X'16',X'20',X'15',X'0D' SYNC, SPC LF, LF, CR
LNOCR    EQU      %
NNOCR    EQU      BA(%)-BA(NOCR)
         BOUND    4
BT31TO0P1MX80 GEN,8,24 0,BT31TO0+1-X'80'  MAKE 560'S & SIGMA 9'S HAPPY
 TITLE 'C O C R   -   M I S C E L L A N E O U S   R O U T I N E S'
COCINIT  STS,R9   COCGFLG           IDENTIFY REQUEST FOR COCG
COCINIT2 PUSH     (R0,R15)          PUSH ALL REGISTERS
         LD,R0    TCCOCG            L/TEXTC 'COCG'; COC GHOST
         BAL,R10  T:GJOBSTRT        START COC GHOST
         PULL     (R0,R15)          PULL ALL REGS
         B        *R11              RETURN TO CALLER
*
COCUMER  EXU      *COCUNMAP         EXU THE BAL FOLLOWING THE XPSD
         MTW,1    COCUNMAP          INC THE IA IN PSD; POINT AFTER BAL
         LPSD,8   COCUNMAP          RETURN TO BAL + 1
*
COCSTRMC LB,R6    LB:UN,R2
         BNEZ     0,R4              RETURN IF USER STILL ASSOCIATED
COCSTERM LB,R6    COB:CTI,R2        L/INITIAL VALUE FOR TERM TYPE
         AND,R6   MASKS+5           MASK TERM TYPE (.1F)
         STB,R6   COCTERM,R2        S/CURRENT TERM TYPE
         B        0,R4              RETURN
*
COCGLN   LI,R2    X'FF'             L/MASK FOR LINE NUMBER
         AND,R2   M:UC+1            &/MASK W/LINE NUMBER
COCCLN   LC       J:JIT             CHECK JOB TYPE FLAGS
         BCR,8    0,R5              B/NOT ONLINE
         BCS,2    0,R5              B/560 REMOTE ASSIST STATION
         CI,R2    X'FF'             C/LINE # W/.FF; SAVED IMAGE LINE #
         BE       0,R5              B/SAVED IMAGE USER
         CI,R2    LNOL-1            C/LINE # W/MAX LEGAL
         BG       SCR32C0           BG; ILLEGAL
         LW,R4    S:CUN             L/CURRENT USER #
         CB,R4    LB:UN,R2          C/USER # W/THIS LINE'S USER NUMBER
         BE       1,R5              BE; TAKE 'GOOD' RETURN
************************************************************************
*S*  SCREECH CODE:    32-C0
*S*  REPORTED BY:     MINICOCR/COCR/TPCOCR
*S*  MESSAGE:         INVALID COC LINE NUMBER IN M:UC
*S*  TYPE:            SCREECH
*S*  REGISTERS:       R5 = BAL ADDRESS OF CALLING ROUTINE
*S*                   R2 = LINE NUMBER FOUND IN M:UC
*S*  REMARKS:         A LINE NUMBER WAS FOUND IN M:UC THAT IS INVALID:
*S*                   IT ISN'T X'FF', AND IT DOESN'T BELONG TO THE CURRENT
*S*                   USER.  COCR, STPNR AND UCAL CALL THIS ROUTINE.
************************************************************************
SCR32C0  SCREECH  X'32',X'C0'       SCREECH 32-C0
COCRLD   LB,R6    MODE3,R2
         AND,R6   NB31TO0+4         &/MODE3 W/.FFFFFFF7
         STB,R6   MODE3,R2          AND UPDATE IN MODE3
         B        *R9
*
         DO       HALT
COCSHALT LB,R1    MODE6,R2          L/MODE6
         OR,R1    LC(HLT)           SET OUTPUT-HALT FLAG
         STB,R1   MODE6,R2          S/MODE6
         B        *R15              RETURN
*
COCHLTGO LC       MODE6,R2
         BCR,CC(HLT) *R9            B/NOT IN HALT MODE; RETURN
         PUSH     (R1,R9)           PUSH R1 -> R9
         LB,R1    MODE6,R2          L/MODE6
         AND,R1   NLC(HLT)          &/MODE6 W/COMPLEMENT OF HALT BIT
         STB,R1   MODE6,R2          S/MODE6, W/HALT RESET
         DO       L6FEP
         CLM,R2   L6LIMS            IS THIS A L6 LINE ??
         BIL      L6HLTGO           B/ L6, START UP OUTPUT
         FIN
         BAL,R9   COCSNDFF          SEND OUT CHAR TO RESTART OUTPUT
         PULL     (R1,R9)           PULL R1 -> R9
         LCI      15                MAKE SURE CC(HLT) IN CC'S IS SET
         B        *R9               RETURN
         FIN
COCPHYLN LI,R3    LCOC              L/LAST COC INDEX
         CLM,R2   COD:LPC,R3        C/LINE # W/LIMITS FOR THIS COC
         BIL      %+2               BIL; FOUND IT
         BDR,R3   %-2               BDR/CHECK NEXT COC
         LD,R5    COD:LPC,R3        L/1ST LINE # FOR THIS COC
         LW,R7    R2                L/LOGICAL LINE #
         SW,R7    R5                G/PHYSICAL LINE NUMBER
         B        0,R6              RETURN
*
************************************************************************
*F*  NAME:    KILLIN
*F*  PURPOSE: DELETE INPUT AND TAB BUFFERS FOR A COC LINE.
************************************************************************
*
KILLIN   LH,R0    COCII,R2
         LH,R4    COCIR,R2
KILLIN1  BAL,R14  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        *R9
*
COCKO    EQU      %
         DO       L6FEP             FRONT END CODE ONLY
         CLM,R2   L6LIMS            IS THIS A LEVEL 6 LINES??
         BIL      L6COCKO           B/ LEVEL 6 TO FLUSH ITS BUFFERS
         FIN
         LH,R4    COCOR,R2          GET OUTPUT REMOVAL POINTER
         BEZ      *R13              B/NO OUTPUT; RETURN
         LI,R5    1                 L/1; ACCOUNT FOR PENDING OUTPUT INTERRUPT
         STH,R5   COCOC,R2          S/1 IN OUTPUT CHARACTER COUNT
         BAL,R6   COCPUTBL          RELEASE OUTPUT BUFFER
         BNEZ     %-1               B/MORE BUFFERS LEFT
         STH,R4   COCOR,R2          0/OUTPUT REMOVAL POINTER
         B        *R13              RETURN
COCKIO   LC       MODE,R2
         BCS,2    IPCXY20           B/TRANSPARENT MODE; DON'T DELETE
*                                   .. OUTPUT BUFFERS ON BREAK
         CW,R10   BT31TO0+31        C/FLAGS W/.40000000
         BANZ     IPCXY20           BANZ; PROCESSING ESCAPE
         PUSH     (R7,R11)          PUSH R7 -> R11
         DO       TP
         BAL,R11  COCGECBW          GET ANY WRITE ECB
         BEZ      %+3               ---> NONE.
         LI,9     X'01'             TYC = NORMAL.
         BAL,R11  COCPECB           POST ECB & FREE BLOCK.
         FIN
         LI,R6    -10               L/NEGATIVE NUMBER; FLAG
         BAL,R13  COCKO             DELETE OUTPUT BUFFERS
         BIR,R6   IPCXY             B/THERE WERE NO BUFFERS
         LH,R5    COCIR,R2
         BNEZ     IPCXY             B/INPUT BUFFERS EXIST
         BAL,R8   COCESCX2          SEND BACK ARROW, CR/LF
*
IPCXY    PULL     (R7,R11)          PULL R7 -> R11
IPCXY20  BAL,R9   COCRLD            CLEAR LOST DATA FLAG
         LH,R4    COCIR,R2
         BEZ      *R8               RETURN IF NO INPUT BUFFERS
         LH,R0    COCII,R2          SET TO RELEASE INPUT BUFFERS
         LH,R5    EOMTIME,R2
         BNEZ     COCESCX1          RELEASE BUFS IF RD-AHD IS NOT ACTIVE
         STH,R5   COCIR,R2          READ ACTIVE, CLEAR INPUT BUF PTRS
         STH,R5   COCII,R2
         STH,R11  EOMTIME,R2        SET EOMTIME NON-ZERO
         B        *R8
*
COCSNDFF EQU      %
         DO       HALF%DUPLEX
         LC       MODE6,R2
         BCS,CC(HDIN) T:TURNOUT     B/HALF-DUPLEX INPUT MODE
         FIN
         LI,R5    X'FF'
         DO       L6FEP
         CLM,R2   L6LIMS            IS THIS A LEVEL 6 LINE??
         BIL      SENDXMIT          IF SO, DONT BUMP COCOC
         FIN
         MTH,1    COCOC,R2          BUMP COCOC FOR NON-FEP LINE
         B        SENDXMIT          NOW SEND CHAR
DECPSD   LI,R5    -2                L/-2; MASK FOR DOUBLE BOUND WA
         AND,R5   J:BASE            &/-2 W/POSS ADR OF R0 IN STACK
         CLM,R5   LIMSTAK           C/POSS ADR W/LIMITS
         BOL      0,R4              BOL; NOT LEGAL
         MTW,-1   -2,R5             DEC PSD (WE HOPE)
         B        0,R4              RETURN
 TITLE 'C O C R   -   E C H O   I N P U T'
************************************************************************
*    USES ALL REGISTERS
*
*   LINKAGE:  BAL,R11 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
*            R10 = 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    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
         LB,R6    MODE4,R2          L/MODE4
         AND,R6   NLC(IM)           &/MODE4 W/COMPL OF INSERT MODE BIT
         STB,R6   MODE4,R2          S/MODE4
         LI,R6    X'8000'
         STH,R6   COCBUF,R7         SET TRSZ AND BSEPOS TO ZERO
ECHO0A   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       *R10,R5
         BCR,8    ECHO8             BRANCH IF NOT SPECIAL
*
         BCS,2    ECHO2             BRANCH IF NORMAL OR DELTA ACTIVATION
         LB,R1    *R10,R5           GET OUTPUT TRANSLATION VALUE
         BCS,4    ECMC              B/MODE CHANGE CHAR
         LB,R6    ECHOBYTE-X'20',R1 L/DISPLACEMENT FROM TV
         LW,R15   *BT31TO0P1MX80,R1 L/IM-OK FLAG FOR THIS SPEC FUNC
         CW,R15   IMTAB             C/FLAG W/LEGAL FLAGS
         BANZ     ECHOBASE,R6       BANZ; OK, GO TO SPEC FUNC ROUTINE
         BAL,R13  RESETIM           BAL/RESET INSERT MODE
         B        ECHOBASE,R6       B/GO TO ROUTINE
*
*
*                 'MODE CHANGE' CHARACTER SENSED
ECMC     BAL,R13  COCCM             EFFECT MODE CHANGE
COCECHO1 EQU      %
         DO       2741CODE
         LC       MODE2,R2
         BCR,1    *R11              B/NOT 2741; RETURN
         LC       MODE3,R2
         BCS,1    COCEOT1           SEND EOT IF KEYBOARD IS LOCKED
         LC       MODE,R2
         BCR,4    *R11              RETURN IF NO EOA PENDING
COCEOT1  LI,R5    X'7C'             SET TO SEND 2741 EOT
         BAL,R9   COCSENDT          SEND 2741 EOT
         FIN
         B        *R11
*
*
*
*
*                 'NORMAL OR DELTA ACTIVATION' CHARACTER SENSED
ECHO2    BCS,4    ECHO3             BRANCH IF NORMAL ACTIVATION CHAR
*                 'DELTA ACTIVATION' CHARACTER SENSED
         BAL,R15  COCACSET          COMPARE ACTIVATION CHAR SET W/1,2
         BCR,8    ECHO8A            B/NOT ACT CHAR SET 3
*
ECHO3    BAL,R15  SETACT            SET ACTIVATION
*
ECHO4    CI,R5    X'40'
         BL       %+2               DON'T BUMP CPOS IF CTL CHAR
ECHO41   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
         FIN
*                 MAP ASCII UPPER CASE (X'40'-X'5F') TO LOWER CASE
ECHO45   LB,R1    *R10,R5           TRANSLATE EBCDIC BACK TO ASCII
         LC       *R10,R5
         BCR,8    ECHO47            BRANCH IF NOT SPECIAL
         BCR,6    ECHO5             BRANCH IF SPECIAL IS 'GO TO' TYPE
         AND,R1   M6
         LB,R1    *R10,R1           RETRANSLATE SITUTATION
ECHO47   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   STB,R5   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER
ECHO5    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    LC       MODE,R2
         BCR,8    ECHO6C            B/NOT IN ECHOPLEX MODE
         DO       HALF%DUPLEX
         LC       MODE6,R2
         BCS,CC(HD) ECHO6C          B/HALF-DUPLEX LINE; DON'T ECHO
         FIN
         BAL,R9   COCSEND1          ECHO CHAR
ECHO6C   LI,R14   1                 SET INCREMENT FOR ARSZ AT ONE
         CW,R11   Y01
         BANZ     ECHO7             BRANCH IF ACTIVATION HAS OCCURED
*                 ADJUST BSEPOS AND ARSZ BY INCREMENT
INCSIZE  LB,R15   COCBUF,R7
         BEZ      ECHO7             BRANCH IF NOT BACKSPACE EDITING
         LC       MODE4,R2
         BCS,CC(IM) ECHO6K          B/INSERT MODE
         SW,R14   R15
         BLZ      ECHO6G            BRANCH IF STILL BACKSPACE EDITING
         LI,R15   0
         STB,R15  COCBUF,R7         NO LONGER BACKSPACE EDITING
         B        ECHO7
*
ECHO6G   LCW,R14  R14               STILL BACKSPACE EDITING,
         STB,R14  COCBUF,R7         UPDATE BSEPOS
         B        *R11
*
ECHO6K   AI,R7    -1                POINT TO TRSZ
         MTB,1    COCBUF,R7         INC TRSZ
         BNEZ     ECHO7             BNEZ; OK
         MTB,-1   COCBUF,R7         WENT TO 0, DEC BACK TO .FF
*
ECHO7    LB,R15   ARSZ,R2
         AW,R15   R14               COMPUTE NEW ARSZ
         CB,R15   RSZ,R2
         BL       ECHO7A
         BAL,R15  SETACT            ARSZ SATISFIES RSZ, ACTIVATION RCVD
         LB,R15   RSZ,R2            SET NEW ARSZ = RSZ
ECHO7A   STB,R15  ARSZ,R2           UPDATE ARSZ
         B        *R11
*
*                 VECTOR OF BIASES FROM COCECHOB TO THE 'GO TO' ROUTINES
LRR      SET      0
EB       CNAME    0
EBRR     CNAME    1
         PROC
         DO1      NAME
LRR      SET      LRR|1**(BA(%)-BA(ECHOBYTE))
         ERROR,8,AF<ECHOBASE 'ROUTINE CAN''T BE BEFORE ECHOBASE'
LF       DATA,1   AF-ECHOBASE
         PEND
*
ECHOBYTE EB       ECHOFF
         EBRR     ECHOHT            HORIZONTAL TAB
         EB       ECHOCRLF
         EB       ECHONL
         EB       ECHOESCF
         EB       ECESCX
         EB       S:S(2741CODE,ECTBLERR,EC2741RB)   2741 RUBOUT
         EB       COCECESCR
         EB       ECHOESCCR         ESC-CR
         EBRR     ECHOBRAC
         EBRR     ECHO8             NOT/OR -> BRACKETS
         EBRR     ECHOBS
         EB       COCECESCLF        ASCII ESC-LF
         EB       ECHO2741LF
         EB       ECHOPARITY
         EB       ECHOBS            BSBS; CONTIGUOUS BACKSPACES
         EB       S:S(ZFLG,ECHONOP,COCECESCZ) ESCAPE-Z
         EB       ECHONOP           'IGNORE' CHARACTER
         EB       ECHOESCD          ESC-D
         EB       ECHOESCJ          ESC-J
         EB       ECHORUB3          ASCII RUBOUT
         EB       ECHODC2           ASCII BS EDIT POS RIGHT CHAR
         DO1      32-BA(%)+BA(ECHOBYTE)
         EB       ECTBLERR
         BOUND    4
RRTAB    DATA     LRR
*
ECHOBASE,ECHO8 ;
         BAL,R15  COCACSET          COMPARE ACTIVATION CHAR SET W/1,2
ECHO8A   BCS,9    ECHO4             B/ACT CHAR SET 0 OR 3
         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 SE
         FIN
         CI,R6    2                 C/ACTIVATION CHAR SET W/2
         BE       ECHO4             BE
         CI,R5    X'81'
         BL       ECHO3             ACTIVATE IF CHAR. IN BREAK SET 1
         CLM,R5   DWB1B5
         BCS,9    ECHO4             BRANCH IF NOT
ECHOPARITY B      ECHO3
*                 INPUT CHARACTER IS LEFT OR RIGHT BRACKET
ECHOBRAC LW,R1    R5
         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
ECHOBRC2 LB,R6    COCTERM,R2        L/TERMINAL TYPE
         LC       COB:TC,R6         L/TERMINAL CHARACTERISTICS
         BCR,CC(NOB) ECHO8          B/DON'T EXCHANGE NOT/OR & BRACKETS
         SLS,R1   4
         AI,R1    15                MAP EBCDIC BRACKETS TO OR & NOT
ECHOBRC4 STB,R1   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER
         B        ECHO8
ECTBLERR B        TTABERR           TRANSLATE TABLE ERROR
*
*                 PROCESS ESCAPE LINE FEED
COCECESCLF ;
         LC       MODE3,R2
         BCR,2    ECESLF8           B/BACKSPACE EDIT NOT ENABLED
         LB,R13   ARSZ,R2           L/ACCUM REC SIZE
         STB,R13  COCBUF,R7         S/BSEPOS TO ARSZ
         BAL,R13  ECHOCRCPI         SEND CR/LF, POS CARR TO CPI
         B        *R11              RETURN
ECESLF8  BAL,R15  ECHOLF
         B        ECRLF1            B; NULL (.39) CHAR; B *R11
         DO       ZFLG=1
*        PROCESS ESCAPE-Z
COCECESCZ LI,R5   'Z'
         BAL,R15  COCECESC          ECHO 'Z'
         B        *R11              AND RETURN.
         FIN
         PAGE
*
*                 PROCESS ESCAPE CARRIAGE RETURN
ECHOESCCR EQU     %
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    ESCCR             BRANCH IF NOT 2741
         BAL,R15  2741ESC           ECHO 'N ATTN' ESCAPE SEQUENCE
         FIN
ESCCR    BAL,R15  ECHOCR            ECHO 'CR,LF'
         B        COCECHO1
*
*
*                 PROCESS FORM FEED CHARACTER
ECHOFF   EQU      ECRLF3
         DO       2741CODE=0
ECHONL   EQU      ECTBLERR
ECHO2741LF EQU    ECTBLERR
         FIN
ECHOESCD LI,R5    'D'               L/'D'; ESC-D
         B        ECHOACT           B; ECHO D-BACKSLASH, ACTIVATE
*
*
*                 PROCESS ESCAPE F
ECHOESCF LI,R5    'F'
ECHOACT  BAL,R15  COCECESC          ECHO 'ESCAPE F' SEQUENCE
*
*                 PROCESS CR/LF
ECHOCRLF CI,R5    X'15'
         BNE      ECRLF3            BRANCH IF CHAR IS NOT A LINE FEED
         LB,R9    ARSZ,R2           CHARACTER IS LINE FEED
         BNEZ     ECRLF2            BRANCH IF ARSZ IS NON-ZERO
         BAL,R15  COCACSET          CHECK ACTIVATION CHARACTER SET
         BCS,8    ECRLF2            B/DELTA; DON'T IGNORE LF'S
         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
ECHONOP  B        *R11              RETURN
ECRLF2   BAL,R15  ECHOLF            ECHO 'LF'
         B        %+2
ECRLF3   BAL,R15  ECHOCR            SEND 'CR,LF'
ECRLF4   BAL,R15  SETACT            SET ACTIVATION
         MTB,1    ARSZ,R2           BUMP ACCUMULATED RECORD SIZE
         B        *R11              RETURN
*
         DO       2741CODE
ECHONL   LI,R15   ECRLF4            L/RETURN ADR FOR ECHOCR1
         FIN
ECHONL1  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,R15  ECHOCR2           UPDATE LINE COUNT
         B        ECHO8             TO NORMAL CHARACTER PROCESSING
         FIN
 TITLE 'C O C R   -   C H A N G E   M O D E   F U N C T I O N S'
*
*                 ROUTINE TO SET, RESET OR TOGGLE THE APPROPRIATE MODE
*
*   LINKAGE: BAL,R9 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
*           R10 = ADDRESS OF TRANSLATION TABLE
*
*  DESTROYS: R1,D3,R15
*
************************************************************************
*
ECHOESCJ LW,R13   R11               L/BAL ADR
         LC       MODE4,R2
         BCS,CC(IM)  RESETIM5       B/INSERT MODE SET
         LB,R1    COCBUF,R7         L/BSEPOS
         BEZ      *R11              B/BACKSPACE EDIT NOT ACTIVE
COCCMIM  LI,R1    IM-1              L/BIT TABLE INDEX FOR INSERT MODE
COCCM    PUSH     R5                PUSH R5
         LB,R5    TOGTAB1-12,R5     L/CHAR TO ECHO
         BAL,R15  COCECESC          BAL/ECHO CHAR, POSS \
         PULL     R5                PULL R5
         AND,R1   M3                GET BIT POSITION TO BE CHANGED
         LB,R6    TOGTAB2-12,R5
         AND,R6   M3                GET MODE IDENTIFIER
         LH,R6    MODENO,R6         ADDR OF MODE BEING CHANGED
         LB,R14   *R6,R2            GET CURRENT DATA IN MODE BYTE
         LC       TOGTAB2-12,R5
         BCS,8    CM2               BRANCH IF MODE IS TO BE TOGGLED
         OR,R14   BT31TO0+1,R1
         BCS,4    CM3               BRANCH IF MODE IS TO BE SET
CM2      EOR,R14  BT31TO0+1,R1      TOGGLE BIT
CM3      STB,R14  *R6,R2            UPDATE MODE BYTE
         B        *R13              RETURN
MODENO   DATA,2   MODE,MODE2,MODE3,MODE4,MODE5,MODE6,MODE4INIT
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,1   0,0,0             .3E -> .40
         DATA,1   X'39'             ESC-J
         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,1   0,0,0             .3E -> .40
         DATA,1   X'83'             ESC-J; TOGGLE MODE4
         BOUND    4
 TITLE 'C O C R   -   E C H O   I N P U T'
         PAGE
*
*                 PROCESS BACKSPACE CHARACTER
ECHOBS   LB,R9    CPOS,R2
         BEZ      ECRLF1            BRANCH,CARRIAGE POSITION IS ZERO
         LB,R15   COCBUF,R7         L/BS EDIT POS
         BEZ      %+3               B/BNE NOT ACTIVE
         CB,R9    CPI,R2            C/CPOS W/CPI
         BLE      ECRLF1            BLE; DON'T GO LEFT OF START OF READ
         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
         DO       2741ARUB=1
ECHOBS1  CI,R5    X'18'
         BNE      ECHOBS5           B/NOT 2741 CANCEL
*                 2741 CANCEL (STD UC'BS'), EFFECT DESTRUCTIVE RUB-OUT
         MTB,-1   ARSZ,R2           DECREMENT ACCUMULATED RECORD SIZE
         B        *R11              RETURN
         ELSE
ECHOBS1  EQU      %
         FIN
ECHOBS5  ;
         LI,R5    BS                L/BACKSPACE CHR (IN CASE BSBS)
         B        ECHO8             B
         PAGE
*
*                 PROCESS RUBOUT
         DO       2741CODE=1
EC2741RB LC       MODE3,R2
         BCR,2    ECHORUB2          BRANCH IF NOT OVERSTRIKE EDIT MODE
         LI,R5    X'40'
         BAL,R9   COCSEND1
         LB,R9    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,R9   PCIB1             SEND 2ND SPACE & BUMP CPOS
         LI,R5    X'7C'
         BAL,R9   COCSENDT          SEND 2741 'EOT'
         B        ECHO41
         FIN
ECHODC2  LI,R1    X'12'             L/.12; DC2 CHAR
         LB,R5    COCBUF,R7         L/BSEPOS; BACKSPACE EDIT POSITION
         BEZ      ECHOBRC4          BEZ; NOT ACTIVELY BACKSPACE
*                                   .. EDITTING AT THIS POINT
         LI,R5    X'40'             L/BLANK CHAR
         BAL,R9   PCIB1             SEND BLANK, INCREMENTING CPOS
         B        ECHO6C            B; FINISH ECHO PROCESSING
ECHORUB3 BAL,R15  COCECESC2         SEND BACKSLASH
         LW,R6    R7                L/POINTER TO BESPOS
         LC       MODE4,R2
         BCS,CC(IM) ECHORUB5        B/INSERT MODE
         LB,R15   COCBUF,R7         L/BSEPOS
         BEZ      ECHORUB4          B/BSE NOT ACTIVE
         B        ECHORUB6
ECHORUB5 ;
         AI,R6    -1                POINT TO TRSZ
         LB,R15   COCBUF,R6         L/TRSZ
         CI,R15   X'80'             C/TRSZ W/.80; MIN VALUE
         BE       RESETIMX          BE; RESET INSERT MODE; IGNORE RUBOUT
ECHORUB6 ;
         AI,R15   -1                DEC TRSZ
         STB,R15  COCBUF,R6         S/UPDATED TRSZ
ECHORUB4 MTB,-1   ARSZ,R2           DECREMENT ARSZ
         BC       *R11              RETURN IF ARSZ IS NOT LESS THAN ZERO
         DO       2741CODE
         B        ECESCX
ECHORUB2 MTB,-2   ARSZ,R2           DECREMENT ARSZ BY 2
         BC       COCEOT1           BRANCH IF ARSZ IS GREATER THAN ZERO
         FIN
         PAGE
*
*                 PROCESS ESCAPE X
ECESCX   LI,R8    COCECHO1          SET TO GIVE EOT IF 2741
ESCX0    XW,R0    R4                 BUFFER POSITION TO R0 FOR FIB
COCESCX1 BAL,R14  COCFIB            RELEASE INPUT BUFFERS
COCESCX2 EQU      %
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    %+3               BRANCH IF TERM NOT A 2741
         LI,R5    X'08'
         BAL,R9   COCSEND1          SEND 2741 'BACKSPACE'
         FIN
         LI,R5    X'6D'
         BAL,R9   COCSEND1          SEND 'BACK ARROW'
         BAL,R13  ECHOCRCPI         SEND 'CR,LF' AND POSITION TO CPI
         STB,R15  ARSZ,R2           SET ARSZ TO ZERO
         B        *R8               THIS NORMALLY BRANCHES TO COCECHO1
         PAGE
*
*                 PROCESS ESCAPE R
COCECESCR ;
         LI,R5    'R'
         BAL,R15  COCECESC          ECHO 'ESC R' SEQUENCE
         LB,R5    ARSZ,R2
         BEZ      ECESCX            PERFORM ESC X IF NOTHING TO RETYPE
ESCRAE   ;                          ALTERNATE ENTRY TO ESC-R (FROM ESC-J)
         LW,R6    R2                SAVE LINE NO.
         LB,R8    MODE2,R2          L/MODE2
         PUSH     (R0,R11)          PUSH R0 -> R11
         LB,R9    MODE,R2           L/MODE
         CI,R9    8                 C/MODE W/8; TAB SIMULATION BIT
         BAZ      %+3               BAZ; NOT TAB SIM MODE
         OR,R8    BT31TO0+6         OR/MODE2 W/.20; SPACE INSERTION
         STB,R8   MODE2,R2          S/UPDATED MODE2
         LW,R3    R4                CURRENT BUFFER POSITION INTO R3
         LW,R4    R0                HEAD OF INPUT CHAIN INTO R4
         BAL,R11  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,R14  2                 GIVE MONITOR BUFFER ADDRESS
         AI,R14   -1                BYTE AND BASE RESOLUTION
         LI,R13   136               MAX SIZE FOR RETYPED MESSAGE IS 136
         BAL,R9   COCMUNA           MOVE MESSAGE TO MPOOL
         AI,R14   1
         SLS,R14  -2
         LB,R8    R12               L/# OF CHARACTERS IN BUFFER
         INT,R1   R12               L/CURRENT POSITION IN BUFFER
         BAL,R13  ECHOCRCPI         POSITION CARRIAGE TO POINT OF START
*                                   .. OF READ
         LI,R3    0                 L/0; POINTER INTO BUFFER
ESCR1    LB,R5    *R14,R3           L/CHAR FROM MPOOL BUFFER
         BAL,R9   COCSEND1          SEND CHARACTER
         AI,R3    1                 INC POINTER
         BDR,R8   ESCR1             BDR/SEND NEXT CHAR
         SW,R3    R1                (SIZE OF MESSAGE) - (BUFFER POS)
         BLEZ     ESCR2             BLEZ; DON'T HAVE TO BACKSPACE
*                                   .. CARRIAGE FOR BACKSPACE EDIT
         LC       MODE2,R2
         BCR,1    %+2               B/NOT 2741
         MTB,1    COCBUF,R7         +1 TO BSEPOS; ADJUST FOR R IN R-ATTN
         BAL,R13  ECHOLFBS          SEND LINE-FEED, BACKSPACES
ESCR2    LB,R11   CPI,R2            CARRIAGE POSITION IS POSITION OF
         AW,R1    R11               (BUFFER POS) + (INITIAL CARR POS)
         STB,R1   CPOS,R2           S/CURRENT CARRIAGE POSITION
         BAL,R11  RMB               RELEASE MONITOR BUFFER
ESCR3    PULL     (R0,R11)          PULL R0 -> R11
         LI,R9    X'20'             L/.20; SPACE INSERTION BIT IN MODE2
         LB,R5    MODE2,R2          L/MODE2
         STS,R8   R5                S/SAVED SPC INS BIT INTO MODE2;
*                                   .. MODE2 WAS SAVED AT TOP OF ESC-R
         STB,R5   MODE2,R2          S/UPDATED MODE2
         B        COCECHO1          BRANCH TO SEE ABOUT 2741 EOT
         PAGE
*
*                 PROCESS TAB CHARACTER
ECHOHT   BAL,R15  COCACSET          COMPARE ACTIVATION CHAR SET W/1,2
         BCS,8    ECHO3             B/ACT CHAR SET 3
         LW,R6    R7                L/BSEPOS POINTER
         AI,R6    -1                POINT TO TRSZ
         LB,R5    COCBUF,R6         L/TRSZ
         LH,R1    TL,R2
         BGZ      ECHOHT4           BRANCH IF TAB BUFFER EXISTS
ECHOHT1  LI,R14   1                 INCREMENT FOR ARSZ IS ONE
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    ECHOHT6K          BRANCH IF NOT 2741
         LI,R13   10                INCREMENT FOR CPOS IS 10
         B        ECHOHT7
         ELSE
         B        ECHOHT6K          INCREMENT CPOS
         FIN
*                 TAB BUFFER EXISTS
ECHOHT4  LB,R12   ARSZ,R2           ARSZ
         AW,R12   R5                 + TRSZ
         AI,R12   -X'80'                    (ADJUST FOR TRSZ FLAG BIT)
         LB,R14   CPI,R2              + CPI
         AW,R12   R14                   = POSITION FROM WHICH TO TAB
         LB,R14   COCBUF,R7         L/BSEPOS
         SW,R12   R14               ARSZ + TRSZ + CPI - BSEPOS
*                 GET VALUE OF TAB STOP
ECHOHT5  LB,R14   COCBUF,R1
         BEZ      ECHOHT1           BRANCH IF NO MORE STOPS EXIST IN BUF
         SW,R14   R12
         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,R13   COCBUF,R1
         LB,R1    CPOS,R2
         SW,R13   R1                CPOS INCREMENT
         BGZ      ECHOHT7
ECHOHT6K LI,R13   1                 CPOS ALWAYS MOVES AT LEAST ONE POS.
ECHOHT7  LC       MODE2,R2
         BCS,2    ECHOHT8           BRANCH IF SPACE INSERTION MODE IS ON
         AW,R5    R14
         AI,R5    -1                COMPUTE TRSZ
         CI,R5    X'100'
         BL       %+2               MAXIMUM VALUE OF TRSZ IS 127
         LI,R5    X'FF'
         STB,R5   COCBUF,R6         S/TRSZ
         LI,R14   1                 RESET ARSZ INCREMENT TO ONE
ECHOHT8  LW,R8    R11               MOVE RETURN ADDRESS TO R8
         BAL,R11  INCSIZE           BRANCH TO UPDATE ARSZ WITH INCREMENT
         B        %+2               NORMAL RETURN
         AI,R8    1                 ACTIVATION RETURN
         LB,R5    COCTERM,R2        L/TERMINAL TYPE INDEX
         LB,R9    COB:TC,R5         L/TERMINAL CHARACTERISTICS
         AND,R9   LC(PT)            &/TERMINAL CHARACTERISTICS WITH
*                                   .. TERMINAL HAS PHYSICAL-TABS BIT
         BEZ      ECHOHT8A          B/NO PHYSICAL TABS
         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,R13   1                 SET TO ECHO A SINGLE CHARACTER
         LI,R5    X'05'
         BDR,R9   ECHOHT8C          ECHO TAB CHAR IF TERMINAL HAS TABS
ECHOHT8B LW,R14   R13
         LI,R5    X'40'
ECHOHT8C BAL,R9   COCSEND1          MOVE CARRIAGE
         BDR,R14  COCSEND1
         CI,R5    X'40'             C/CHAR W/BLANK
         BE       ECHOHT9           B/BLANK SENT
         BAL,R9   SIAT              SEND IDLES AFTER TAB
ECHOHT9  LB,R1    CPOS,R2
         AW,R13   R1
         STB,R13  CPOS,R2           UPDATE CPOS
         B        *R8               RETURN
         PAGE
ECHOLFBS LI,R5    X'20'             L/LINE-FEED CHAR
         BAL,R9   COCSEND1          SEND LINE-FEED
         BAL,R15  ECHOCR2           ACCOUNT FOR UPSPACED LINE
         LI,R5    BS                L/BS CHAR
         BAL,R9   COCSEND1          SEND BACKSPACE
         BDR,R3   COCSEND1          SEND BACKSPACE
         B        *R13              RETURN
*
*                 THIS ROUTINE ECHOS  LF, MAINTAINING LINE COUNT
ECHOLF   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
*
**************************************************************************
*F*  NAME:    ECHOCR
*F*  PURPOSE: SEND CARRIAGE RETURN
*F*  DESCRIPTION:  ECHOCR SENDS A CARRIAGE RETURN TO ANY LINE, AND
*F*           INCREMENTS THE LINES UPSPACED WHILE NOT CURRENT USER
*F*           COUNTER.
**************************************************************************
ECHOCR   LI,R5    X'15'             SET TO SEND 'NEW LINE'
         BAL,R9   COCSEND1
ECHOCR1  LI,R9    1
         STB,R9   CPOS,R2           RESET CARRIAGE POSITION
************************************************************************
*F*  NAME:    ECHOCR2
*F*  PURPOSE: INCREMENT THE COUNTER FOR NUMBER OF LINES UPSPACED WHILE
*F*           NOT CURRENT USER.
************************************************************************
ECHOCR2  EQU      %
         DO       COCPCP=1
         LB,R9    MODE3,R2
         AI,R9    1
         CI,R9    7
         BAZ      *R15
         MTB,1    MODE3,R2          INCREMENT LINE COUNT
         FIN
         B        *R15
*
*                 THIS ROUTINE ECHOES RESPONSE TO ESCAPE SEQUENCES
COCECESC LC       MODE,R2
         DO       2741CODE=1
         BCS,8    COCECESC1         BRANCH IF ECHO-PLEX
         LC       MODE2,R2
         BCR,1    COCECESC2         BRANCH IF NOT 2741
2741ESC  LI,R5    X'08'
         BAL,R9   COCSEND1          SEND BACKSPACE
         LI,R5    X'6D'
         BAL,R9   COCSEND1          SEND UNDERSCORE
         LB,R9    COCBUF,R7
         BNEZ     *R15              RETURN IF BACKSPACE EDITING
         MTB,-1   ARSZ,R2           DECREMENT ARSZ
         B        *R15
         ELSE
         BCR,8    COCECESC2
         FIN
COCECESC1 BAL,R9  COCPCIB           ECHO CHARACTER IN ESCAPE SEQUENCE
         CI,R5    X'13'             C/CHAR W/.13
         BLE      *R15              BLE; DON'T SEND BACKSLASH
COCECESC2 LI,R5   X'B1'
         BAL,R9   COCPCIB           SEND BACKSLASH
         B        *R15              RETURN TO CALLER
*
*
*                 ROUTINE TO ECHO 'CR,LF' AND MOVE CARRIAGE POS TO CPI
*
*  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 LOW FOR
*  ALGORITHMS 3 AND 6 (MEMOREX AND TELETYPE MODEL 40), AND
*  HIGH FOR ALL OTHERS.
*
ECHOCRCPI LB,R5   MODE4,R2          L/MODE4; TIMING ALGORITHM #
         AND,R5   M3                &/ALGO # W/7
         LB,R15   COB:MNIC,R5       L/CPOS VALUE FOR MAXIMUM # OF IDLES
         STB,R15  CPOS,R2           S/CPOS; INSURE SUFFICIENT # OF IDLES
         BAL,R15  ECHOCR            SEND 'CR,LF'
         LB,R15   CPI,R2
         STB,R15  CPOS,R2           UPDATE CARRIAGE POSITION
         LI,R5    X'40'             SET TO SEND SPACES
         LI,R9    %+1
         BDR,R15  COCSEND1          POSITION CARRIAGE TO CPI
         B        *R13
RESETIMX LW,R13   R11               L/RETURN ADR FOR RESETIM
         LI,R5    X'41'             L/ESC-J 'CHARACTER'
         STB,R5   COCBUF,R4         REPLACE CURRENT CHAR W/ESC-J
         LI,R1    ERFUNC-MUBTBL+X'80'         FUNCX TO DO ESC-R
         B        RESETIM5          B
RESETIMA LI,R1    NOERFUNC-MUBTBL+X'80' FUNCX TO NOT DO ESC-R
RESETIM  LC       MODE4,R2
         BCR,CC(IM) *R13            B/INSERT MODE NOT ON
RESETIM5 PUSH     (R0,R15)          PUSH R0 -> R15
         LW,R8    *BT31TO0P1MX80,R1 L/BIT CORRESPONDING TO FUNC INDEX
         LI,R5    X'41'             L/ESC-J 'CHAR' FOR COCCMIM
         BAL,R13  COCCMIM           BAL/CHANGE MODE4, ECHO \
         CW,R11   Y01
         BANZ     RESETIM8          B/ACTIVATION OCCURRED
         CW,R8    ERTAB             C/FUNCX BIT W/SIM ESC-R BIT TABLE
         BAZ      RESETIM6          B/RESET; DON'T DO ESC-R
         LB,R1    COCBUF,R4         L/CURRENT CHAR
         LI,R13   X'FF'             L/DEL CHR
         STB,R13  COCBUF,R4         PUT DEL IN CUR CHR POS SO ESC-R
*                                   .. WON'T DO ANY POSITIONING BASED
*                                   . ON CURRENT CHR
         BAL,R11  ESCRAE            DO ESC-R
         STB,R1   COCBUF,R4         RESTORE CURRENT CHR IN COC BUF
RESETIM6 ;
         AND,R7   NB31TO0+1         POINT TO TRSZ (.FFFFFFFE)
         LI,R5    X'80'             L/TRSZ INITIAL VALUE
         STB,R5   COCBUF,R7         RESET TRSZ
RESETIM8 ;
         PULL     (R0,R15)          PULL R0 -> R15
         B        *R13              RETURN
*
         PAGE
*                 THIS ROUTINE SETS RETURN FROM ECHO FOR ACTIVATION RCVD
SETACT   CW,R11   Y01
         BANZ     *R15              RETURN IF ACTIVATION ALREADY SENSED
         AI,R11   1                 INC RETURN ADR FOR ACTIVATION
COCSACT1 LCW,R1   R4
         STH,R1   TL,R2             SAVE ACTIVATION POINT
COCSACT2 LB,R9    MODE6,R2          L/MODE6
         AND,R9   NLC(UTO)          &/MODE6 W/COMPLEMENT OF USER
*                                   .. TIME-OUT BIT; RESET
         STB,R9   MODE6,R2          S/MODE6
         CW,R10   BT31TO0+25        C/R10 W/.01000000 (BLOCK) BIT
         BANZ     COCSETAC          B/BLOCK SET; DON'T CHANGE EOMTIME
COCSACTO EQU      %                 SET ACTIVATION FOR USER TIME-OUT
         DO       PMONOFF=1
         LW,R9    R0                SAVE R0
         BAL,R0   CURNTIM
         LW,R0    R9                RESTORE R0
         OR,R1    X1                 FORCE EOMTIME NON-ZERO
         STH,R1   EOMTIME,R2
         ELSE
         STH,R15  EOMTIME,R2        MAKE EOMTIME NON-ZERO
         FIN
COCSETAC LB,R1    MODE,R2
         AND,R1   EF                TURN OFF READ PENDING MODE BIT
         STB,R1   MODE,R2
         OR,R11   Y01               SET ACTIVATION-OCCURRED FLAG
         PUSH     R13               PUSH R13
         BAL,R13  RESETIMA          RESET INSERT MODE IF SET
         PULL     R13               PULL R13
COCSNXOF LI,R1    XOFF              L/XOFF CHAR; STOP PAPER TAPE READER
         DO       HALF%DUPLEX
         DO1      HALT
         BAL,R9   COCHLTGO          IF IN HALT MODE, START OUTPUT
         BAL,R9   T:TURNOUT         TURN TO OUTPUT MODE IF HALF DUPLEX
         FIN
CHKPTAP  LC       MODE,R2
         BCR,8    *R15              RETURN IF NOT ECHOPLEX
         LC       MODE2,R2
         BCS,4    COCCPT1           BRANCH IF MODE IS 'XON'
         LC       MODE3,R2
         BCR,4    *R15              RETURN IF NOT MODE 'XON' OR 'ESC P'
COCCPT1  LI,R9    COCSENDX          L/ADR OF SEND ROUTINE IF CHAR IS XON
         CI,R1    XON               C/CHAR W/XON
         BE       %+2               YES, PUT IN BUFF
         LI,R9    COCSUF            NO-XOFF, SUF
         LB,R1    *R10,R1           XLATE AND MOVE
         XW,R1    R5                CHAR TO R5
         BAL,R9   *R9
         LW,R5    R1
         B        *R15
         PAGE
*
*                 ROUTINE TO RELEASE BUFS STARTING AT C(R4) THRU C(R0)
COCFIB   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  CS,R4    R0
         BE       COCFIB2           RELEASE ALL COC BUFFERS STARTING
         BAL,R6   COCPUTB           WITH C(R4) UNTIL THE BUFFER POINTED
         BNEZ     COCFIB1           TO BY R0 IS FOUND
FIB10    AI,R5    0
         BLZ      LIER              ERROR IF REMOVAL POINT RELEASED
FIB15    LI,R0    0
         B        *R14              RETURN, END OF CHAIN WAS ENCOUNTERED
*
COCFIB2  CH,R0    COCII,R2
         BNE      COCFIB3           BRANCH IF NOT AT INSERTION POINT
         BAL,R6   COCPUTB           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
************************************************************************
*S*  SCREECH CODE:    12-00
*S*  REPORTED BY:     COC/MINICOC/TPCOC
*S*  MESSAGE:         COC - BAD INPUT BUF LINKAGE ON RELEASE REQUEST
*S*  TYPE:            SCREECH
*S*  REGISTERS:       R0  = REMOVAL POINT  (NOT ALWAYS SET)
*S*                   R1  = DCB ADDRESS  (NOT ALWAYS SET)
*S*                   R2  = LOGICAL LINE NUMBER
*S*                   R3  = COC NUMBER  (NOT ALWAYS SET)
*S*                   R4  = CURRENT RELEASE POINT  (NOT ALWAYS SET)
*S*                   R10 = OUTPUT TRANSLATE TABLE ADDRESS
*S*                   R14 = BAL ADR
*S*  REMARKS:         THE COC INPUT BUFFERS ARE BEING RELEASED, AND THERE
*S*                   IS A CONFLICT BETWEEN THE INSERTION AND REMOVAL
*S*                   POINTS AND THE CHAIN.
************************************************************************
LIER     SCREECH  X'12'             SCREECH .12
COCFIB3  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   COCPUTB           NEXT BUFFER IN THE INPUT CHAIN
         BEZ      FIB10             BRANCH IF END OF CHAIN DETECTED
         LW,R0    R4
         AI,R4    -1
COCFIB4  AI,R5    0
         BGEZ     *R14              RETURN IF NOT UPDATING IR
COCFIB5  STH,R0   COCIR,R2
         B        *R14              RETURN
*
*
COCACSET LB,R6    MODE2,R2          L/MODE2
         AND,R6   M2                &/MODE2 W/3; G/ACTIVATION CHAR SET
         CLM,R6   BT31TO0+1         C/ACTIVATION CHAR SET W/1,2
         B        *R15              RETURN
 TITLE 'C O C R   -   H A L F - D U P L E X   T U R N A R O U N D'
         DO       HALF%DUPLEX
**************************************************************************
*F*  NAME:    T:TURNOUT
*F*  PURPOSE: INITIATE THE TURN-AROUND TO OUTPUT OF A HALF-DUPLEX LINE.
*F*  DESCRIPTION:  THE CURRENT LINE, IF HALF-DUPLEX IN INPUT MODE, IS Q'D
*F*           UP FOR TURN-AROUND TO OUTPUT MODE.  IF NO OTHERS ARE
*F*           CURRENTLY BEING TURNED, COCHDICB IS LINKED IN AS
*F*           A SYSTEM ICB.
**************************************************************************
T:TURNOUT LC      MODE6,R2          CHECK HALF-DUPLEX FLAGS
         BCR,CC(HDIN) *R9           B/NOT HALF-DUPLEX IN INPUT MODE
         PUSH     (R3,R9)           PUSH R3 -> R9
         LB,R9    MODE6,R2          L/MODE6
         CI,R9    AC(HDTA)          C/MODE6 W/TURNAROUND FLAG
         BANZ     TRNOUT30          B/TURNING AROUND
         AI,R9    AC(HDTA)          SET TURNINGAROUND FLAG
         STB,R9   MODE6,R2          S/MODE6
         BAL,R6   COCPHYLN          G/PHYSICAL LINE # IN R7, COC # IN R3
         EXU      CO:RCVOFF,R3      TURN RECEIVER OFF
         CW,R2    COCHDFLN          C/LINE # W/1ST LINE TURNING AROUND
         BGE      %+2               BGE; WE DON'T HAVE A NEW 1ST LINE
         STW,R2   COCHDFLN          S/NEW 1ST LINE TURNING AROUND
         CW,R2    COCHDLLN          C/LINE # W/LAST LINE TURNING AROUND
         BLE      TRNOUT30          BLE; WE DON'T HAVE A NEW LAST LINE
         LW,R3    R2                L/CURRENT LINE #
         XW,R3    COCHDLLN          X/CURRENT LINE # W/LAST LINE #
         BGE      TRNOUT30          BGE; PREVIOUS LAST LINE # WAS
*                                   .. LEGITIMATE, SO THERE ARE
*                                   .. OTHER LINES TURNING AROUND
         STW,R2   COCHDFLN          S/CURRENT LINE # AS LAST LINE #;
*                                   .. ITS THE ONLY ONE TURNING AROUND
         LW,R8    Y004              L/SYSTEM ICB FLAG
         LI,R5    X'1FFFF'          L/.1FFFF MASK
         LI,R7    X'1FFFF'          L/.1FFFF MASK
         INHIBIT                    INHIBIT INTERRUPTS
         LW,R4    RTICBCLKHDR+1     L/ICB CHAIN TAIL POINTER
         LI,R6    COCHDICB          L/ADR OF COC'S ICB
         STS,R6   0,R4              S/COC ICB ADR AS FLINK IN PREVIOUS
*                                   .. TAIL ICB
         STS,R4   COCHDICB+4        S/PREVIOUS TAIL ADR AS BLINK IN
*                                   .. COC ICB
         STS,R6   RTICBCLKHDR+1     S/COC ICB ADR IN TAIL POINTER
         STW,R8   COCHDICB          0/COC ICB FLINK
         LW,R5    C:CTUN            L/# OF 2-MILLISECOND UNITS IN
*                                   .. CURRENT CLOCK3 PERIOD
         SW,R5    C:TINC            - # OF 2-MILLISEC UNITS LEFT IN
*                                   .. CURRENT CLOCK3 PERIOD
         AW,R5    COCHDICB+1        + # OF 2-MILLISEC UNITS IN COC
*                                   .. TURNAROUND ICB
         STW,R5   COCHDICB+2        S/# OF 2-MILLISEC UNITS TILL
*                                   .. WAKE-UP ON COC ICB
         SW,R5    C:CTUN            G/- # OF 2-MILLISEC UNITS THAT WE
*                                   .. HAVE TO SCHEDULE THE NEXT CLOCK3
*                                   .. INTERRUPT AHEAD OF THE TIME
*                                   .. THAT IT NORMALLY WOULD HAVE
*                                   .. GONE OFF
         BGE      TRNOUT20          BGE; DON'T HAVE TO SCHED AHEAD
         AWM,R5   C:CTUN            SCHEDULE AHEAD OF TIME
         AWM,R5   C:TINC            SCHEDULE AHEAD OF TIME
TRNOUT20 UNINHIBIT                  RESET INHIBITS
TRNOUT30 PULL     (R3,R9)           PULL R3 -> R9
         B        *R9               RETURN
         FIN
 TITLE 'C O C R   -   B L O C K I N G   B U F F E R   A L L O C A T O R'
************************************************************************
*F*  NAME:    COCGETB
*F*  PURPOSE: OBTAIN A COC BUFFER
*F*  DESCRIPTION:  COCGETB OBTAINS THE FIRST FREE COC BUFFER IN THE FREE
*F*           BUFFER CHAIN.  IF NONE ARE AVAILABLE, RETURN IS MADE TO
*F*           BAL+1.  IF A BUFFER IS OBTAINED, THE RELATIVE BYTE ADDRESS
*F*           THE 3RD BYTE IN THE BUFFER IS RETURNED IN R4, AND RETURN
*F*           IS MADE TO BAL+2.
************************************************************************
COCGETB ;
         XPSD,0   COCGETBPSD        GO UNMAPPED, INHIBITED, TO COCGETE
         B        0,R6              RETURN TO COCGETB CALLER
COCGETE ;
         LW,R4    COCHPB            L/BUFFER HEAD POINTER
         BEZ      COCGETR           B/NO BUFFERS AVAILABLE
         DO1      1-COCGBUG
         BLZ      SCR
         STW,R6   COCHPB            SAVE R6
         DO       COCGBUG=1
         LW,R6    R4
GETB0    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    MTW,1    COC#BUFS          INC # OF COC BUFS IN USE
         LW,R6    COCBUF,R4         CHAIN INTO R6
         XW,R6    COCHPB            RESTORE R6, SET HEAD TO CHAIN
         SLS,R4   2                 POINT 2 INTO BUF (LINK OF BUF = 0)
         AI,R4    2
         AI,R6    1                 INC RETURN ADR; RETURN BAL+2
COCGETR ;
         LPSD,8   COCGETBPSD        BACK TO CALLER'S MODE, GOTO B 0,R6
         PAGE
************************************************************************
*F*  NAME:    COCPUTBL
*F*  PURPOSE: RETURN A COC BUFFER TO THE FREE POOL
*F*  DESCRIPTION:  THE BUFFER WHOSE RELATIVE BUFFER ADDRESS IS CONTAINED
*F*           IN R4 IS PUT ON THE HEAD OF THE FREE COC BUFFER POOL.
************************************************************************
COCPUTB ;
         MTB,-1   BUFCNT,R2         DEC BUFCNT
COCPUTBL ;
         XPSD,0   COCPUTBPSD        GO UNMAPPED, INHIBITED, TO COCPUTE
         B        0,R6              RETURN TO COCPUTB CALLER
COCPUTE  ;
         CI,R4    HRBA+HRBA+HRBA+HRBA+15
         BG       SCR               BUFFER ADDRESS TOO BIG
         CI,R4    15
         BG       PUTBL1
************************************************************************
*S*  SCREECH CODE:    10-00
*S*  REPORTED BY:     COC/MINICOC/TPCOC
*S*  MESSAGE:         BAD COC BUF POOL, OR BAD BUF ADR ON RELEASE REQUEST
*S*  TYPE:            SCREECH
*S*  REGISTERS:       R2  = LOGICAL LINE NUMBER
*S*                   R4  = BUFFER ADDRESS
*S*                   R6  = BAL ADDRESS
*S*  REMARKS:         1   ON A COC BUFFER RELEASE, AN INVALID RELATIVE
*S*                       BUFFER ADDRESS WAS SPECIFIED (ADDRESS.LE.X'F' OR
*S*                       ADDRESS.GT.HRBA*4+X'F').
*S*                   2   ON A COC BUFFER GET OR RELEASE, AN INVALID
*S*                       RELATIVE BUFFER ADDRESS WAS FOUND IN THE FREE
*S*                       POOL CHAIN.  IF THE COC MODULE WAS ASSEMBLED
*S*                       WITH THE COCGBUGE AND COCPBUGE FLAGS SET
*S*                       (NORMALLY THEY'RE NOT) AND SENSE SWITCH 4 IS
*S*                       SET, THE ENTIRE FREE POOL CHAIN IS CHECKED ON
*S*                       EACH PUT AND GET OPERATION.  (THE R4 AND R6
*S*                       CONTENTS LISTED ABOVE ARE VALID ONLY AT ENTRY
*S*                       AND EXIT TIMES.)
************************************************************************
SCR      SCREECH  X'10'             SCREECH .10
PUTBL1   AND,R4   XFFF0
         SLS,R4   -2
         XW,6     COCHPB            OLD CHAIN TO 6
         DO       COCPBUG=1
         BEZ      PUTBL3
         PUSH     R6
PUTBL0   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   PULL     R6
PUTBL3   EQU      %
         FIN
************************************************************************
*  RELEASE THE BUFFER WHOSE RELATIVE ADDRESS IS IN R4.
************************************************************************
         MTW,-1   COC#BUFS          DEC # OF COC BUFS IN USE
         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
         STCF     COCPUTBPSD        S/CC'S INTO PSD TO BE LPSD'D
         LPSD,8   COCPUTBPSD        BACK TO CALLER'S MODE, GO TO B 0,R6
 TITLE 'C O C R   -   R E A D   R O U T I N E'
************************************************************************
*
*       USES ALL REGISTERS
*   LINKAGE:  BAL,11  COCRD
*        IN:  R7 = BYTE ADDRESS WHERE INPUT IS TO BE PLACED
*             R0 = OPERATION CODE
*            R8 =  MAXIMUM BYTE SIZE OF MESSAGE
*             R1 = ADDRESS OF USER'S DCB
*            R10 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*             R2 = LINE NUMBER OF ORIGINATING MESSAGE
*       OUT:  R12 = TYPE OF COMPLETION CODE
*            R8 =  BYTE SIZE OF MESSAGE TRANSFERRED
*
************************************************************************
COCRD    EQU      %
         LC       MODE2,R2          LINE OFF BIT SET
         BCS,8    KO                B/LINE OFF; ABORT VIA STEP
         DO       PMONOFF=1
         BAL,4    READREQ           RECORD PERFORMANCE DATA
         FIN
         PUSH     R11               SAVE REGISTER
         LB,R14   MODE2,R2          L/MODE2; SAVE FOR READ CLEANUP
         STB,R14  *TSTACK           S/MODE2 IN BYTE 0 OF 'R11' IN STACK
         CW,R10   LC(OACS)          C/FLAGS W/OVER-RIDING ACTIV CHAR SET BIT
         BAZ      COCRD10           B/NO OVER-RIDING ACTIV CHAR SET SPECIFIED
         LI,R15   3                 L/3; MASK FOR ACTIVATION CHAR SET
         LH,R11   J:COCOPT          L/CAL1 SUPPLIED OPTIONS
         LS,R14   R11               L/ACTIV CHAR SET INTO SAVED MODE2
         STB,R14  MODE2,R2          S/MODE2
COCRD10  STB,R8   RSZ,R2            SAVE REQUESTED MESSAGE SIZE
         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
*
         AI,R3    X'1D'             TRANSPARENT RD OP CODE BECOMES X'20'
         LB,R14   MODE,R2
         LI,R15   X'20'             MASK TO SELECT TRANSPARENT BIT
         CS,R14   R3
         BE       COCRD20           BRANCH IF MODE DOES NOT CHANGE
*
*                 CHANGE FROM TRANSPARENT TO NON-TRANS. (OR VICE-VERSA)
         EOR,R14  R15               FLIP TRANSPARENT MODE BIT
         STB,R14  MODE,R2
         BAL,R9   KILLIN            RELEASE ALL INPUT BUFFERS
*                 SEND PROMPT IF REQUIRED
COCRD20  LI,R3    X'8000'           L/.8000; INITIAL VALUE FOR TL
         STH,R3   TL,R2             S/.8000 IN TL; NO BUFS YET
         PUSH     R7                SAVE BUFFER ADDRESS
         LC       MODE,R2           CHECK TRANSPARENT-MODE BIT
         BCS,2    COCRD38           B/TRANSPARENT; DON'T PROMPT
         BAL,R15  COCACSET          COMPARE ACTIVATION CHAR SET W/1,2
         BCS,8    COCRD38           B/ACTIVATION CHAR SET 3; DELTA
         DO       TP
         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,R9   COCPCIB
*                 TAB BUFFER INITIALIZATION
COCRD30  EQU      %
         DO       TP
         LI,R15   M:UC+19           SET UP DEFAULT DCB FOR TABS
         LC       MODE5,R2
         BCR,8    COCRD30A
         LW,R15   R1                IF SLAVE, USE USER DCB
         AI,R15   19
COCRD30A LI,R7    -16               SET FOR 16 TAB STOPS
         LB,R14   *R15,R7           ANY THERE...
         BEZ      COCRD38           ---> NO.
         ELSE
         LB,R14   M:UC+15           GET FIRST TAB STOP IN M:UC DCB.
         BEZ      COCRD38           BRANCH IF NONE.
         LI,R7    -16               SET FOR 16 TAB STOPS
         FIN
         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,R8    0
         LC       MODE3,R2
         BCR,8    COCRD32           BRANCH IF NOT TABBING RELATIVE
         LB,R8    CPOS,R2
         AI,R8    -1
         B        COCRD32
*
COCRD36  BANZ     COCRD34
         BDR,R4   COCRD35           DECRE R4.
*                 PREPARE TO MOVE NEXT TAB STOP INTO TAB BUFFER
COCRD31  AI,R4    1                 INCREMENT BUFFER POSISTION
         CI,R4    15
         DO       TP
         LB,R14   *R15,R7
         ELSE
         LB,R14   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  BAL,R6   COCGETB           GET A BUFFER
         BAL,R4   COCRD80           B/NONE AVAILABLE; T:REG, RETURN TO %-1
         STH,R4   COCBUF-4,R5       LINK NEW BUFFER TO TAB BUFFER CHAIN
*
COCRD33  AW,R14   R8                APPLY RELATIVE TAB ADJUSTMENT
         STB,R14  COCBUF,R4         AND STORE INTO BUFFER
         BIR,R7   COCRD31
         AI,R4    1
*                 TAB STOPS HAVE BEEN MOVED, FLAG END OF TABS WITH ZERO
COCRD34  STB,R3   COCBUF,R4
COCRD35  SCD,R4   28
         AI,R5    1
         SLS,R5   3
         STH,R3   COCBUF-4,R5       LINKAGE POSITION OF LAST TAB BUFFER
*
*                 INITIALIZE CARRIAGE POSITION AT START OF READ (CPI)
COCRD38  LB,R15   CPOS,R2
         STB,R15  CPI,R2
         STB,R3   ARSZ,R2           INITIALIZE ARSZ TO ZERO
         BAL,R11  COCECHO1          TURN LINE AROUND
         CW,R10   LC(RR)            C/FLAGS W/RE-READ BIT
         BAZ      RR900             B/RESET
         LB,R1    MODE2,R2          L/MODE2
         AND,R1   M2                &/MODE2 W/3; ACTIVATION CHAR SET
         LW,R15   RRTAB             L/RE-READ SPEC CHAR FLAGS
         LW,R7    *TSTACK           L/USER BUFFER BYTE ADR - 1
         LB,R0    RSZ,R2            L/REQUESTED RECORD SIZE
         LI,R4    R8**2+2-BA(COCBUF-4) L/PHONY RELATIVE BA TO PUT
*                                   .. FIRST COC BUF ADR INTO R8
         LI,R8    0                 0/R8
         BAL,R5   COCWR3            STRIP TRAILING BLANKS
         CB,R0    RSZ,R2            C/NEW SIZE W/ORIGINAL SIZE
         BE       RR550             BE; DIDN'T STRIP ANY BLANKS
         AI,R0    1                 INC SIZE; POSSIBLY INCLUDE LAST
*                                   .. NON-BLANK CHAR IN RE-READ
RRTVBASE B        RR550             B
*
RRTV     COM,8    AF-RRTVBASE
*
RRTV1    RRTV     RR400             NORMAL ACTIVATION CHARACTER SET
         RRTV     RR270             CONTROL, GRAPHICS ACTIVATION
         RRTV     RR280             CONTROL CHARACTER ACTIVATION
         RRTV     RR400             DELTA ACTIVATION CHARACTER SET
*
RRTV2    RRTV     RR400             NORMAL ACTIVATION CHARACTER SET
         RRTV     RR260             CONTROL, GRAPHICS ACTIVATION
         RRTV     RR260             CONTROL CHARACTER ACTIVATION
         RRTV     RR600             DELTA ACTIVATION CHARACTER SET
*
RR200    LB,R5    0,R7              L/BYTE FROM USER BUF
         BEZ      RR600             B/NULL BYTE; TERMINATE
RR230    LB,R3    RRTV2,R1          L/TRANS VECTOR FOR DELTA ACT CHAR
         LC       *R10,R5           L/FLAGS FOR THIS CHAR
         BCR,8    RR260             B/NOT SPECIAL CHARACTER
*                                   CHAR IS: 1XXX XXXX
         BCS,4    RR600             B/NORMAL ACTIVATION OR MODE CHANGE CHAR
*                                   CHAR IS: 10XX XXXX
         BCS,2    RRTVBASE,R3       B/DELTA ACTIVATION CHAR
*                                   CHAR IS: 100X XXXX  ('GO TO' TYPE)
         LB,R3    *R10,R5           L/OUTPUT TRANS TBL ENTRY FOR CHAR
         CW,R15   *BT31TO0P1MX80,R3 C/'GO TO' LEGAL CHAR FLAGS W/BITS
         BAZ      RR600             B/NOT LEGAL FOR RE-READ
RR260    LB,R3    RRTV1,R1          L/TRANSFER VECTOR ENTRY FOR THIS TYPE ACT
         CI,R5    X'40'             C/CHAR W/BLANK
         B        RRTVBASE,R3       B/APPROPOS ROUTINE FOR ACT CHAR SET
RR270    BE       RR400             B/CHAR IS BLANK
         CLM,R5   DWB1B5            C/CHAR W/.B1, .B5
         BIL      RR600             BIL; ACTIVATION CHAR FOR SET 1
         CI,R5    X'81'             C/CHAR W/.81
RR280    BL       RR600             B/CHAR LT .40 OR .81
RR400    BIR,R4   RR420             INC BUFFER INSERT POINTER; B/1ST TIME
         CI,R4    X'F'              C/POINTER W/.F
         BANZ     RR450             BANZ; ROOM IN BUFF
RR420    LW,R3    R4                L/INSERTION POINTER
         BAL,R6   COCGETB           BAL/GET COC BUFFER
         BAL,R4   COCRD80           B/DIDN'T GET A BUFFER
         SLS,R3   -1                SHIFT BUF ADR; G/RELATIVE HA
         STH,R4   COCBUF-4,R3       S/FLINK IN OLD BUF TO NEW
         MTB,1    BUFCNT,R2         INC # OF INPUT BUFS LINE HAS
RR450    STB,R5   COCBUF,R4         S/CHARACTER
RR550    AI,R7    1                 INC USER BUF POINTER
         BDR,R0   RR200             BDR/CHAR COUNT, G/NEXT CHAR
RR600    CW,R8    M16               C/REMOVAL POINTER W/.FFFF
         BAZ      RR900             BAZ; NO RE-READ BUFS CREATED
         LH,R5    COCIR,R2          L/INPUT REMOVAL POINTER
         STH,R8   COCIR,R2          S/NEW REMOVAL POINTER
         BE       RR800             B/NO TYPE-AHEAD BUFS
         LI,R3    IGNORCHR          L/CHARACTER TO IGNORE IN ECHO/MU
RR640    AI,R4    1                 INC RE-READ INSERTION POINTER
         CI,R4    X'F'              C/POINTER W/.F
         BAZ      RR660             B/AT END OF BUF
         STB,R3   COCBUF,R4         S/CHAR TO BE IGNORED
         B        RR640             B; CHECK NEXT BYTE IN BUF
RR660    SLS,R4   -1                MAKE HA OF RE-READ INSERT BUF ADR
         STH,R5   COCBUF-4,R4       S/TYPE-AHEAD BUF ADR AS FLINK IN
*                                   .. LAST RE-READ BUF
         B        RR900             B
RR800    STH,R4   COCII,R2          S/NEW INPUT INSERTION POINTER
RR900    LH,R3    TL,R2             L/TL
         PUSH     R3                SAVE TL IN TSTACK
*
*                 ECHO ALL CHARACTERS READ AHEAD FOR THIS RECORD
COCRD40  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  LI,R5    0
         STH,R5   EOMTIME,R2         EOMTIME=0 MEANS READER USING ECHO
         LB,R5    COCBUF,R4         GET EBCDIC CHARACTER FROM BUFFER
         BAL,R11  COCECHO           ECHO CHARACTER
         B        %+2               B/ACTIVATION DIDN'T OCCUR
COCRD46  OR,R3    Y8                SET TO INDICATE ACTIVATION OCCURANCE
         CH,R0    COCIR,R2
         BE       COCRD60           BRANCH IF NO CTL-X OR CTL-Y OCCURED
         LI,R4    0                 SET TO RELEASE READER INPUT CHAIN
         BAL,R8   ESCX0             RELEASE CHAIN & SEND LINE DELETE SEQ
*
         BAL,R11  CHKBRKYC
         BAZ      COCRD40           BRANCH IF NO BREAK OR CTL-Y RECEIVED
         PAGE
*                 ACTIVATION CHARACTER HAS BEEN RECEIVED
         DO       PMONOFF           EQUIVALENT OF CURNTIM IN PM MODULE
COCRD50G LW,R7    C:CTUN
         SW,R7    C:TINC
         AW,R7    C:TIC
         STH,R7   EOMTIME,R2        S/EOMTIME
         ELSE
COCRD50G STH,R11  EOMTIME,R2        MAKE EOMTIME NON-ZERO
         FIN
COCRD50J PULL     R1                PULL R1; TAB LINK (TL)
         PULL     R14               PULL R14; BUFFER ADR
         LCH,R3   TL,R2             GET ACTIVATION REQUEST
         STH,R1   TL,R2             RESTORE TAB LINK FROM R3
         BAL,R11  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
         LH,R4    COCIR,R2
         LW,R0    R4                SAVE REMOVAL POINT IN R0
         LB,R13   RSZ,R2            L/RSZ; USE AS SIZE FOR COCMU
         BAL,R9   COCMU             MOVE INPUT TO USER'S BUFFER
         PAGE
*
*        PERFORM ALL NECCESSARY CLEAN-UP REQUIRED FOR END OF READ
*
*
*  CHECK FOR LOST DATA, WHICH IS FLAGGED VIA A X'BE' CHARACTER.
*  IF THE LOST DATA BIT ISN'T SET AND WE ARE IN TRANSPARENT MODE,
*  THEN DON'T CHECK FOR A X'BE' CHARACTER, SINCE A X'BE' COULD
*  LEGITIMATELY BE IN THE INPUT BUFFER.
*
         LB,R15   MODE3,R2
         CI,R15   X'08'
         BANZ     %+3               B/LOST-DATA SET
         LC       MODE,R2
         BCS,2    COCRD52           B/LOST-DATA RESET AND TRANSPARENT SET
         LW,R15   R5                SAVE PSEUDO TYC IN R15
         CB,R15   YBE
         BNE      COCRD52           BRANCH IF NO DATA LOST IN MESSAGE
*
COCRD51  LH,R4    COCII,R2          SET TO RELEASE BUF'S THRU INSERT PT.
         BAL,R9   COCRLD            CLEAR LOST DATA BIT IN LINE TABLE
         LW,R15   Y03               SET PSEUDO TYC TO 'LOST DATA'
*
COCRD52  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
         BAL,R9   KILLIN1           FREE INPUT BUF'S THRU ACTIVATION  PT
*                 SET TYC IN R12 & SEND HEADING IF NECESSARY
         LI,R12   1                 INITIALIZE TYC
         STB,R12  CPI,R2            INITIALIZE CPI
         DO       TP
         LC       MODE5,R2
         BCS,8    COCRD53           B/SLAVE LINE
         FIN
         LI,R9    3                 L/MASK FOR ACTIVATION CHAR SET IN MODE2
         LB,R8    *TSTACK           L/SAVED MODE2 FROM TSTACK
         LB,R5    MODE2,R2          L/MODE2
         STS,R8   R5                S/ORIGINAL ACTIV CHAR SET IN MODE2
         STB,R5   MODE2,R2          S/MODE2 W/ORIGINAL ACTIV CHAR SET
         CW,R2    LC(RR)            C/R2 FLAGS W/RE-READ BIT
         BANZ     COCRD52K          B/RE-READ; DEC PSD
         LC       MODE2,R2
         BCS,8    COCRD52K          B/LINE REPORTED OFF; DEC PSD IN
*                                   .. CASE OF RE-ASSOCIATE
         DO       ZFLG=1
         LC       JB:COCOPT2        CHECK FOR ESC-Z FLAG SET
         BCR,8    COCRD52G          B/NOPE, CHECK FOR CNTL Y OR BRK.
         BAL,R11  CHKBRKYC
         BAZ      COCRD52K          B/NO BREAK OR CNTL-Y, JUST ESC-Z
         LW,R13   Y8                L/Y8
         STS,R12  JB:COCOPT2        RESET ESC-Z BIT IN JIT
         FIN
COCRD52G BAL,R11  CHKBRKYC
         BAZ      COCRD53           B/NO BREAK OR CONTROL-Y
COCRD52K BAL,R4   DECPSD            DEC IA IN PSD
         LI,R15   0
COCRD53  EQU      %
         DO       COCPCP=1
         BAL,R11  WRNLB             ADJUST JB:LC & SEE ABOUT PAGE
         MTB,-1   R15
         BNC      COCRD55           BRANCH IF NO PSEUDO TYC
         BNEZ     COCRD54           BRANCH IF PSEUDO TYC IS NOT FORM FEED
         CW,R15   BT31TO0+24        CHECK PAGE-GIVEN FLAG (.00800000)
         BANZ     COCRD55           B/PAGE ALREADY GIVEN
         LI,R11   COCRD55           L/RETURN ADR FOR PAGE ROUTINE
         B        PAGE              B; GIVE NEW PAGE
         ELSE
         MTB,-1   R15
         BNC      COCRD55           BRANCH IF NORMAL TYC
         BEZ      COCRD55           BRANCH IF FORM FEED
         FIN
COCRD54  LB,R12   R15               UPDATE TYC IN R12
*
*        SET ARS AND RETURN TO CALLER
COCRD55  LC       MODE6,R2
         BCR,CC(UTO) COCRD56        B/NOT TIMED-OUT USER TIME-OUT
         LB,R12   MODE6,R2          L/MODE6
         AND,R12  NLC(UTO)          &/MODE6 W/COMPLEMENT OF TIME-OUT BIT
         STB,R12  MODE6,R2          S/MODE6
         LI,R12   X'10'             L/.10; TYC FOR TIMED-OUT USER
*                                   .. CONTROLLED TIME-OUT READ
COCRD56  LB,R8    ARSZ,R2           ARS INTO R8 FOR  CALLER
         DO       PMONOFF=1
         BAL,R4   RDMSGSIZ          RECORD SIZE OF INPUT MESSAGE
         FIN
         MTW,1    J:INTER           INCREMENT COUNT OF USER INTERACTIONS
         DO       TP
         LB,R5    MODE5,R2          RESET READ DONE FLAG
         AND,R5   NB31TO0+4         &/MODE5 W/.FFFFFFF7
         STB,R5   MODE5,R2
         FIN
         B        PULL11B           PULL R11 & RETURN TO CALLER
*
*                 SETS CONDITION CODE 2 IF BREAK OR CTL-Y WAS RECEIVED
CHKBRKYC EQU      %
         LB,R6    LB:UN,R2
         LH,R6    UH:DL,R6
         CI,R6    X'3000'
         DO       TP
         BANZ     *R11              B/BRK OR CNTRL-Y RCV'D
         LC       MODE5,R2
         BCR,8    *R11              B/MASTER
         BCR,1    %+3               B/SLAVE, NO BRK RCV'D
         LCI      4
         B        *R11              SLAVE, BRK RCV'D
         LCI      0                 SLAVE, NO BRK RCV'D
         FIN
         B        *R11              RETURN
COCRD57  LCW,R1   R4                L/COMPLEMENT OF CURRENT INPUT POINTER
         STH,R1   TL,R2             S/POINTER; SAVE ACTIVATION POINT
         BAL,R15  COCSACTO          SET ACTIVATION RECEIVED, TIME-OUT
         B        COCRD46           B
         PAGE
COCRD60  AI,R3    0
         BLZ      COCRD50G          B/ACTIVATION OCCURRED
         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
*
************************************************************************
*  IF TERMINAL IS IN A PAPER TAPE MODE, TRANSMIT AN XON CHARACTER
*  TO START THE READER.
************************************************************************
COCRD70  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.
*
**************************************************************************
         CW,R10   LC(RUTO)          C/FLAGS W/REQUEST USER TIMEOUT BIT
         BAZ      COCRD72           BAZ; NO USER-CONTROLLED TIME-OUT
         LB,R15   MODE6,R2          L/MODE6
         OR,R15   LC(UTO)           OR IN USER-TIME-OUT
         STB,R15  MODE6,R2          S/MODE6
         LI,R6    1                 L/1; INDEX
         LH,R14   J:COCOPT,R6       L/TIME-OUT VALUE (1.2 SEC UNITS)
         BEZ      COCRD57           BEZ; IMMEDIATE TIME-OUT
         B        COCRD73           B; SET UP T:REG
COCRD72  LW,R14   SL:OITO           INITIALIZE R14 WITH TIMEOUT FOR READ
COCRD73  STH,R14  EOMTIME,R2        S/TIME-OUT VALUE (1.2 SEC UNITS)
         LC       MODE2,R2
         BCS,8    COCRD50J          BRANCH IF LINE REPORTED OFF
COCRDPND LB,R6    MODE,R2           SET READ PENDING FLAG
         AI,R6    X'10'
         STB,R6   MODE,R2           UPDATE MODE WITH READ PENDING BIT SET
         DO       TP
         LC       MODE5,R2
         BCR,8    COCRD74           NON-SLAVE LINES JUST REG.
         LI,R7    X'1FFFF'
         AND,R7   J:RWECB           GET ECB 4-WORD BLOCK ADDRESS.
         BEZ      COCRD74           ---> NO ECB, REG.
         LW,R6    R2                SAVE LINE#.
         BAL,R1   ECBGBLK           GET SUPPLEMENTARY BLOCK.
         XW,R6    R2                RESTORE USER#.
         BEZ      COCRD74           ---> NO BLOCKS; REG EVEN W/ ECB.
         PULL     R3                PULL TL
         PULL     R14               GET BUFFER ADDRESS.
         STW,R14  1,R6              SBLOCK W1= BUFFER ADDRESS.
         STW,R3   2,R6              SBLOCK W2= SAVED TL.
         STW,R6   2,R7               BLOCK W2=>SBLOCK.
         PULL     R1                GET DCB ADDRESS.
         STB,R2   R1                  ALSO LINE#.
         STW,R1   3,R6              SBLOCK W3= LINE#, DCBADDRESS.
         STW,R1   3,R7               BLOCK W3= LINE#, DCBADDRESS.
*                                    BLOCK W1 ALREADY= ECB ADDRESS.
         LI,R5    X'10000'
         STW,R5   0,R7               BLOCK W0= 'READ WAIT BLOCK'.
         LI,R6    0
         STS,R6   J:RWECB           WE'VE USED UP THE ECB NOW.
         LW,R10   R7                10= BLOCK ADDRESS.
         ANLZ,R7  GETECB99           7= HA(COC:ECB THIS LINE).
         BAL,R11  COCWLDLC          HOOK TO CHAIN.
         BAL,13   COCENABL          ** READ NOT DONE YET, SO JUST
         PULL     (R5,R12)            RETURN TO CALLER OF COCIO
         B        *R11                NOT TYC'ING OR DECR'ING DCBFCN.
COCRD74  EQU      %
         FIN
         DO       OUTPUTIGNORE
         DO       2741CODE
         LC       MODE2,R2
         BCS,1    %+4               B/2741
         FIN
         LB,R6    MODE3,R2
         AND,R6   NB31TO0+5         RESET .10 BIT IN MODE3
         STB,R6   MODE3,R2
         FIN
*
*  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:CRD             REPORT COC READ EVENT
         C:REG
COCRD77  LI,R0    0                 CLEAR OLD HEAD OF INPUT
         B        COCRD50J
*
**************************************************************************
*
*  CAN'T GET A BUFFER FOR TABS OR RE-READ
*
*  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 BACK TO BAL,R6 COCGETB.
*
**************************************************************************
COCRD80  LI,R6    E:CFB
         C:REG                      T:REG
         B        -2,R4             RETURN TO BAL,R6 COCGETB
 TITLE 'C O C R   -   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,R9 COCMU
*
*        IN: R13 = 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
*            R10 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*            R14 = 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 R15
*
************************************************************************
MOVECHAR CW,R9    LC(MUNOACT)       C/R9 FLAGS W/NO ACTIVATION FLAG
         BANZ     MOVECHRX          B/NO ACTIVATION (ESC-R)
         CW,R3    R4                C/BUFFER POINTERS
         BE       MUCRLFNL          BE; LAST CHAR, PUT AT END OF BUF
MOVECHRX CB,R13   R12               C/ARSZ W/HI BUF POS
         BLE      *R11              BLE; NO MORE ROOM IN BUF
         AI,R12   1                 INCREMENT POSITION OF USER BUFFER
         CB,R12   R12               COMPARE WITH HIGHEST POSITION MOVED
         BG       MOVEC1            BRANCH IF HIGHER POSITION BEING MOVED
         LB,R6    COCTERM,R2        L/TERM TYPE
         CB,R5    COB:BPR,R6        C/CHAR W/BACKSPACE EDIT
*                                   .. POSITION RIGHT CHAR
         BE       *R11              B/POSITION RIGHT CHAR
         CW,R9    LC(R9IM)          C/R9 FLAGS W/INSERT MODE BIT
         BAZ      MOVEC2            B/NOT INSERT MODE
         LB,R1    R12               L/HI BUF POS
         LW,R6    R1                L/HI BUF POS
         INT,R15  R12               L/CUR BUF POS
         SW,R6    R15               G/# OF CHARS TO SHIFT - 1
         AI,R6    1                 G/# OF CHARS TO SHIFT
         AW,R1    R14               G/BA OF HI BUF POS
         AI,R1    3                 POINT 3 BYTES PAST HI POS
         AW,R1    =1**24-2          L/BC OF 1, -2 FROM BA
         MBS,R1   -1                SHIFT RIGHT 1 BYTE
         BDR,R6   %-2               BDR/SHIFT NEXT CHAR
         MTB,1    R12               INC HI BUF POS
         B        MOVEC2            B; MOVE IN THE INSERT CHAR
MOVEC1   STB,R12  R12               UPDATE HIGHEST POSITION MOVED
         B        MOVEC2            B/AROUND CODE; REPL W/FOLLOWING LINE
*****    LI,R1    1                 L/INDEX INTO R12 TO LOGICAL POS
         CI,R5    X'40'             C/CHR W/.40
         BGE      MOVEC1G           B/CHR POSITIONS 1 COL RIGHT
         CI,R5    BS                C/CHR W/BACKSPACE
         BNE      MOVEC2            B/NOT BS
         MTB,-2   R12,R1            DEC LOGICAL POS BY 1 (-2+1)
MOVEC1G  MTB,1    R12,R1            INC LOGICAL POS
MOVEC2   INT,R1   R12               L/CURRENT USER BUF POSITION
         AW,R1    R14               COMPUTE BYTE LOCATION IN USER BUFFER
         STB,R5   0,R1              MOVE CHARACTER TO USER'S BUFFER
         B        *R11              RETURN
*
*                 OUTPUT TRANSLATION TABLE YIELDS SPECIAL FLAG
MUSPEC   BCS,4    MU4               BRANCH TO IGNORE MODE CHANGE CHAR.
*
         LB,R6    *R10,R5           GET OUTPUT TRANSLATION VALUE
         LW,R15   *BT31TO0P1MX80,R6 L/BIT CORRESPONDING TO THIS SPEC FUNC
         CW,R15   IMTAB             C/BIT W/TABLE OF LEGAL SPEC FUNC'S
*                                   .. TO PROCESS WHILE INSERT MODE
*                                   .. IS ON
         BANZ     %+2               BANZ; LEGAL
         AND,R9   NLC(R9IM)         RESET INSERT MODE IN R9
         LB,R6    WA(BA(MUBTBL)-X'80'),R6  L/GOTO DISPLACEMENT
         B        MU3,R6            GO TO SPECIAL HANDLING ROUTINE
*
LIM      SET      0                 INITIALIZE IM BITS
ERIM     SET      0                 INITIALIZE SIMULATED ESC-R ON IM EXIT BITS
*
MB       CNAME    0
MBIM     CNAME    1                 FUNCTION LEGAL IN INSERT MODE (ESC-J)
MBER     CNAME    2                 FUNCTION CAUSES SIMULATED ESC-R IF
*                                   .. IN INSERT MODE
MBIMER   CNAME    3                 FUNCTION LEGAL IN INSERT MODE, AND
*                                   .. CAUSES SIMULATED ESC-R IF IN INSERT
*                                   .. MODE
         PROC
         DO1      (NAME&2)>0
ERIM     SET      ERIM|1**(BA(%)-BA(MUBTBL))
         DO1      (NAME&1)>0
LIM      SET      LIM|1**(BA(%)-BA(MUBTBL))
         ERROR,8,AF<MU3 'ROUTINE CAN''T BE BEFORE MU3'
LF       EQU      BA(%)
         DATA,1   AF-MU3            DISPLACEMENT TO 'GOTO'
         PEND
*
MUBTBL   MB       MUFF
ERFUNC   MBER     MUHT              HORIZONTAL TAB
         MB       MUCRLFNL
         MB       MUCRLFNL
         MB       MUESCF
         MB       WRTBLERR          ESCAPE-X
         MB       MU2741RUB         2741 RUBOUT
NOERFUNC MB       MU4               ESC-R
         MBER     MU4               ESC-CR
         MBIM     MU3               BRACKET
         MBIM     MU3               NOT/OR
         MBER     MUBS              BACKSPACE
         MBER     MUESCLF           ESC-LF
         MB       S:S(2741CODE,WRTBLERR,MU3)
         MB       MUPARITY
         MBER     MUBS              CONTIGUOUS ASCII BACKSPACES
         MBER     S:S(ZFLG,MU4,MUESCZ) ESC-Z CHARACTER
         MBIM     MU4               'IGNORE' CHARACTER
         MB       MUESCD            ESC-D
         MBIMER   MUESCJ            ESC-J
         MBIM     MUASCIIRUB        ASCII RUBOUT
         MBER     MU3               ASCII BS EDIT POS RIGHT CHAR
         DO1      32-BA(%)+BA(MUBTBL)
         MB       WRTBLERR
         BOUND    4
IMTAB    DATA     LIM               LEGAL SPEC FUNC'S FOR INSERT MODE
ERTAB    DATA     ERIM              FUNCTIONS WHICH CAUSE SIMULATED ESC-R
*                                   .. IF ISSUED WHILE IN INSERT MODE
         PAGE
*
*                 ENTRY POINT
*
COCMUNA  OR,R9    LC(MUNOACT)       SET 'NO ACTIVATION RECEIVED'
COCMU    ;
         LI,R12   1**16             L/LOGICAL POSITION VAL OF 1, OTHERS 0
MU1      LB,R5    COCBUF,R4         GET NEXT CHARACTER FROM COC BUFFER
         LC       MODE,R2
         BCR,2    MU2               B/NOT TRANSPARENT MODE
         LI,R11   MU4               L/RETURN ADR FOR MOVECHRX
         B        MOVECHRX          B/MOVE CHAR
MU2      LC       *R10,R5           L/FLAGS FOR CHAR
         BCR,8    MU3               BRANCH IF NOT SPECIAL
         BCR,2    MUSPEC            BRANCH IF NOT ACTIVATION CHARACTER
MU3      BAL,R11  MOVECHAR          MOVE IT TO CALLER'S BUFFER
MU4      CW,R3    R4
         BE       *R9               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
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 LB,R1    R12               L/HI BUF POS
         AW,R1    R14               (HI BUF POS) + (BUF BA - 1)
         AI,R1    1                 +1
         STB,R5   0,R1              STORE CHARACTER AT END OF MESS. POS.
         B        *R9               RETURN
         PAGE
MUESCJ   EOR,R9   LC(R9IM)          TOGGLE INSERT MODE
         B        MU4               B
         DO       ZFLG=1
MUESCZ   LB,R11   JB:COCOPT2        L/INPUT IGNORE FLAG
         EOR,R11  BT31TO0+8         EOR/FLAG W/.80
         STB,R11  JB:COCOPT2        S/FLAG BACK INTO JIT
         B        MU4
         FIN
MUESCD   OR,R2    LC(RR)            SET RE-READ FLAG
         LB,R5    ARSZ,R2           L/ACCUM REC SIZE (INCL ESC-D 'CHAR')
         CI,R5    1                 C/SIZE W/1
         BLE      MU4               B/ONLY ESC-D INPUT; DON'T APPEND CR
         LI,R5    X'0D'             L/CR CHAR; PUT CR AT END OF MSG
         B        MUCRLFNL          B
*
*                 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,R12   DOUBLEZERO        CHECK FOR USER BUFFER POSITION = 0
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS IS ZERO
         AI,R12   -1                DECREMENT USER BUFFER POSITION
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
         DO       2741ARUB=1
MUBS2    CI,R5    X'18'
         BNE      MU3               BRANCH IF NOT 2741 CANCEL (UC'BS')
         ELSE
MUBS2    EQU      MU3
         FIN
*
*                 2741 RUB-OUT CHARACTER
MU2741RUB LC      MODE3,R2          CHECK OVER-STRIKE EDIT MODE FLAG
         BCS,2    MURUB1            BRANCH IF ON
MURUB0C  CB,R12   DOUBLEZERO        CHECK FOR USER BUFFER POSITION = 0
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS = ZERO
         SW,R12   X1000001          DECREMENT BUFFER POSITIONING INFO
         LI,R1    1                 L/INDEX TO LOGICAL POS IN R12
         MTB,-1   R12,R1            DEC LOGICAL POS
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
MURUB1   AI,R12   1                 BS OVERSTRIKE EDIT, INC USER
*                                   .. BUFFER POSITION
         LI,R5    X'40'             MOVE BLANK TO CALLER'S BUFFER
         BAL,R11  MOVEC2
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS
MUASCIIRUB ;
         CB,R12   R12               C/CUR BUF POS W/HI BUF POS
         BGE      MURUB0C           BGE; BSE NOT ACTIVE
         CW,R9    LC(R9IM)          C/R9 FLAGS W/INSERT MODE BIT
         BAZ      %+2               B/NOT INSERT MODE
         AI,R12   -1                DEC CUR BUF POINTER; POINT
*                                   .. 1 CHAR LEFT OF EDIT POINT
         INT,R1   R12               L/CUR BUF POS
         AI,R1    1                 INC TEMP CUR BUF POS
         LB,R6    R12               L/HI BUF POS
         SW,R6    R1                G/# OF CHARS TO SHIFT
         AW,R1    R14               G/BA(1ST DESTINATION BYTE)
         STB,R6   R1                S/BC FOR MBS
         MBS,R1   1                 MBS; SHIFT STRING LEFT 1 BYTE
         MTB,-1   R12               DEC HI BUF POS
         B        MU4               B
*
MUESCLF  AND,R12  YFFFF             SET CUR BUF POS TO 0
         B        MU4               CONTINUE
         PAGE
*
*                 TAB CHARACTER
MUHT     BAL,R15  COCACSET          COMPARE ACTIVATION CHAR SET W/1,2
         BCS,8    MU3               B/ACTIV CHAR SET 3; DELTA
         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
         LC       MODE3,R2
         NOP                        FOR FIXING UP W/PATCH
*****    BCR,2    MUHT2             B/NOT BS EDIT
         INT,R15  R12
         LB,R5    CPI,R2            COMPUTE CURRENT CARRIAGE POSITION
         AW,R5    R15
MUHT3    LB,R15   COCBUF,R6         GET VALUE OF TAB STOP
         BEZ      MUHT4             BRANCH TO MOVE SINGLE BLANK IF ZERO
         CW,R5    R15
         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
MUHT2    ;
         LI,R5    1                 L/INDEX IN R12 TO LOGICAL POS
         LB,R5    R12,R5            L/LOGICAL POS
         B        MUHT3
*
*                 VALID TAB STOP FOUND
MUHT5    SW,R15   R5                COMPUTE NUMBER OF BLANKS TO MOVE
         LB,R6    COCTERM,R2        L/COCTERM
         LB,R5    COB:BPR,R6        L/BSE POS RIGHT CHAR
MUHT6    CB,R12   R12               C/CUR BUF POS W/HI BUF POS
         BL       %+2               BL; BSE STILL ACTIVE
         LI,R5    X'40'             L/BLANK
         BAL,R11  MOVECHRX          MOVE CHAR, SKIP LST CHR CHK
         BDR,R15  MUHT6             MOVE THE CORRECT NUMBER OF BLANKS
         B        MU4
*
*
*
 TITLE 'C O C R   -   W R I T E   R O U T I N E'
************************************************************************
*
*   USES ALL REGISTERS
*
*   LINKAGE:  BAL,11  COCWR
*          IN: R2 = LINE NUMBER
*              R7 = BYTE ADDRESS OF USER BUFFER - ONE
*             R8 =  MAXIMUM BYTE SIZE OF MESSAGE
*             R10 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE
*              R1 = DCB ADDRESS
*
************************************************************************
COCWR    EQU      %
         DO       PMONOFF=1
         MTW,1    C:CTW             BUMP COUNT OF TERMINAL WRITES
         FIN
         LW,R0    R8
         BEZ      *R11              RETURN IF RECORD SIZE IS ZERO
         PUSH     R11               SAVE RETURN ADDRESS
         DO       HALT
         LC       MODE6,R2
         BCS,CC(HLT) COCWREG        B/OUTPUT-HALT (ESC-H) ON; REG
         FIN
         LB,R5    MODE4INIT,R2      L/LINE SPEED INDICATOR FROM MODE4INIT
         AND,R5   M3                &/SPEED W/7
         LB,R5    COB:CPS,R5        L/CHARACTERS PER SECOND
         MW,R5    SL:TB             (CHARS/SEC) X (BLOCK LIMIT IN SECS)
         CH,R5    COCOC,R2          C/BLOCK LIMIT W/CHARS Q'D
         BG       COCWR1            BG; DON'T BLOCK YET
**************************************************************************
*
*  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
*
**************************************************************************
COCWREG  LI,R6    E:CBL             COC BLOCK
         C:REG
         BAL,R11  CHKBRKYC
         BAZ      COCWR1            BRANCH IF NO BREAK OR CTL-Y OCCURED
         BAL,R4   DECPSD            DEC IA IN PSD
         B        COCWR801
COCWR1   EQU      %
         DO       OUTPUTIGNORE
         DO       2741CODE
         LC       MODE2,R2
         BCS,1    %+3               B/2741
         FIN
         LC       MODE3,R2
         BCS,1    PULL11B           B/OUTPUT-IGNORE SET; RETURN
         FIN
         LI,R5    X'28000'
         CS,R5    0,R1
         BNE      COCWR6            BRANCH IF NON-TRANSPARENT TEXT
*                 TRANSPARENT TEXT WRITE
COCWR2   AI,R7    1
         LB,R5    0,R7
         BAL,R9   COCSENDT          MOVE RECORD OUT UNTRANSLATED
         BDR,R0   COCWR2
         B        PULL11B           BRANCH TO RETURN
COCWR3   AW,R7    R0                POINT R7 TO END OF BUFFER
         LI,R9    X'40'             L/BLANK
COCWR4   CB,R9    0,R7              C/BLANK W/CHAR IN BUF
         BNE      COCWR5E           BRANCH ON NON-BLANK CHARACTER
         AI,R7    -1                ADJUST COUNTS TO REFLECT TRAILING
         BDR,R0   COCWR4
COCWR5E  SW,R7    R0                REPOSITION R7 TO BA(UBUF)-1
         B        0,R5              RETURN
*
*                 NON-TRANSPARENT TEXT WRITE
COCWR6   LW,R9    0,R1              L/WD 0 OF DCB
         CI,R9    X'8000'           C/WD 0 W/.8000; DRC BIT
         BANZ     COCWR9            B/DRC SET; DON'T STRIP BLANKS
COCWR7   BAL,R5   COCWR3            CHECK FOR TRAILING BALNKS
         SW,R8    R0
         CI,R8    3
         BG       %+2
         AW,R0    R8                DON'T REMOVE BLANKS IF LESS THAN 4
COCWR9   LW,R8    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
*                 VERTICAL FORMAT CONTROL IS SPECIFIED IN DCB
COCWR30  LB,R12   0,R7              GET FIRST CHARACTER
         STB,R12  R7                SAVE CHAR FOR SPACE SUPPRESSION CHECK
         CI,R12   X'D1'
         BNE      COCWR31
         LI,R12   '-'
         STB,R12  R7
         B        %+3
COCWR31  ;
         AI,R12   -X'F1'
         BNE      COCWR33           B/NOT TOP OF FORM CHARACTER
         LI,R3    JB:LPP            L/BA OF LINES/PAGE IN JIT
         LB,R12   0,R3              L/# OF LINES PER PAGE
         BEZ      COCWRFF           DO PAGE HEADING
         CI,R12   11                C/LINES/PAGE W/11
         BG       COCWRFF           BG; GIVE PAGE HEADING
         BAL,R9   COCNL             SEND CR/LF TO UPSPACE PAGE
         BDR,R12  %-1               BDR # OF LINES/PAGE
         B        COCWR70           B; CONTINUE PROCESSING OF WRITE
COCWR33  EQU      %
*                 CHECK FOR FORMAT CONTROL CHARACTER'S (X'C1'-X'CF')
         LC       R7
         BCS,1    COCWRFF           DO PAGE HEADING
         BCR,2    COCWR34
         LI,R3    '-'
         STB,R3   R7
         AI,R12   -X'20'
COCWR34  ;
         AI,R12   X'F1'-X'C0'
         BLEZ     COCWR70           BRANCH IF NOT A FORMAT CHARACTER
         LI,R13   COCWR70
*                 SEND THE NUMBER OF NL'S AS SPECIFIED IN R12
COCWR36  LI,R3    JB:LC
         BAL,R9   COCNL             SEND NEW LINE
         DO       TP
         LC       MODE5,R2          SLAVE TERMINALS
         BCS,8    COCWR37           DON'T HAVE PAGE BOUNDRIES
         FIN
         LB,R9    0,R3
         BEZ      *R13              BRANCH IF PAGE BOUNDARY REACHED
COCWR37  BDR,R12  COCWR36
         B        *R13              BRANCH WHEN COMPLETED
*                 VFC WAS NOT SPECIFIED, SET TO SEND C(SVA)-1 NL'S
COCWR38  LI,R13   COCWR40
         LW,R12   19,R1             GET WORD 19 OF DCB
         SCS,R12  15
         AND,R12  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  LB,R5    0,R7
         BEZ      COCWR80
         LI,R9    COCWR70
         LC       *R10,R5
         BCR,8    COCWR95           B/NOT SPEC CHAR
         BCS,6    COCPCIB
         LB,R4    *R10,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,2741 RUBOUT,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)
         WB       COCWR70           ESCAPE-Z
         WB       COCWR70           'IGNORE' CHARACTER
         WB       COCWR70           ESC-D
         WB       COCWR70           ESC-J
         WB       COCWR70           ASCII RUBOUT
         WB       COCWR70           ASCII BS EDIT POS RIGHT CHAR
         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,R9    MODE,R2
         LB,R13   CPOS,R2
         LB,R12   *R6,R3            CHECK FOR TABS IN USER DCB
         BNEZ     COCWRHT1
         DO       TP
         LC       MODE5,R2          SLAVE NEVER
         BCS,8    COCWRHT2          USES M:UC DCB TABS
         FIN
         LI,R6    M:UC+19
         LB,R12   *R6,R3            AND IN UC
         BNEZ     COCWRHT1
COCWRHT2 LI,R12   10                10 ASSUMED IF NOT ESCT
         CI,R9    8
         BAZ      WRHT3A
         LI,R12   1
COCWRHT3 CI,R9    8
         BANZ     COCWRHT4
WRHT3A   AW,R13   R12
         STB,R13  CPOS,R2
         BAL,R9   COCSEND1          SEND TAB (AND IDLES)
         LW,R13   R12
         BAL,R9   SIAT              SEND IDLES AFTER TAB
         B        COCWR70
COCWRHT4 LI,R5    X'40'
         BAL,R9   COCPCIB           SEND BLANKS
         BDR,R12  COCPCIB
         B        COCWR70
COCWRHT1 LB,R12   *R6,R3            FIND NEXT TAB
         SW,R12   R13               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
************************************************************************
*S*  SCREECH CODE:    11-00
*S*  REPORTED BY:     COC/MINICOC/TPCOC
*S*  MESSAGE:         INVALID INTERNAL CONTROL CODE TRANSLATE REQUEST
*S*  TYPE:            SCREECH
*S*  REGISTERS:       R1 =  DCB ADDRESS  (NOT ALWAYS SET)
*S*                   R2  = LOGICAL LINE NUMBER
*S*                   R5  = CHARACTER (CONTROL CODE)
*S*                   R7  = BYTE ADDRESS OF USER BUFFER  (NOT ALWAYS SET)
*S*                   R9  = BAL ADDRESS
*S*                   R10 = OUTPUT TRANSLATION TABLE ADDRESS, BLOCK FLAGS
*S*  REMARKS:         CAUSE IS TRANSLATE TABLE ERROR OR BAD INPUT BUFFER
*S*                   CHAIN.
************************************************************************
         SCREECH  X'11'             SCREECH .11
COCNL    LI,R5    X'15'             SET TO SEND 'NEW LINE'
COCWRNL  LI,R11   WRNLA             SET RETURN ADDRESS FOR SEND
WRNL     EQU      %
         DO       COCPCP=1
         DO       TCOUPL=1
         CW,R10   Y02               IS COUPLE IN PROGRESS BIT SET?
         BANZ     *R9               IF SO, DONT MODIFY WRONG JIT.
         FIN
         DO       TP
         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,R9    R11               SET RETURN ADDRESS'S
         B        COCSEND1
WRNLA    LI,R9    1
         STB,R9   CPOS,R2           SET CARRIAGE POSITION TO 1
         DO       TCOUPL=1
         CW,R10   Y02               IF COUPLE IN PROGRESS BIT SET,
         BANZ     *R11              NO HEADINGS TO COUPLED LINES.
         FIN
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       TP
         LC       MODE5,R2          SLAVE NEVER EXCEEDS
         BCS,8    *R11              LINES PER PAGE
         FIN
         LI,R6    JB:LC
         LB,R9    0,R6
         AW,R5    R9                UPDATE LINE COUNT IN JIT TO
         STB,R5   0,R6              REFLECT COUNT FROM MODE3
         LI,R6    JB:LPP
         CB,R5    0,R6
         BLE      *R11              BRANCH IF LINES/PAGE NOT EXCEEDED
         OR,R15   BT31TO0+24        SET PAGE-GIVEN FLAG (.00800000)
         B        PAGE              GIVE PAGE HEADING
         ELSE
         B        *R11
         FIN
COCWRNDX LI,R11   WRNLB             SET RETURN ADDRESS FOR SEND
         B        WRNL
COCWRBS  LB,R4    CPOS,R2
         AI,R4    -1
         BLEZ     COCSEND1          BLEZ; DON'T DECREMENT CPOS
         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
         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
         BAL,R13  COCENABL          CLEAR T:COCHC LOCK-OUT, ENABLE COC INT
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT, DISABLE COC INTS
COCWR74  BDR,R0   COCWR40           GET NEXT (IF ANY)
COCWR80  EQU      %
         DO       TP
         LC       MODE5,R2
         BCR,8    COCWR80A          GO IF NOT A SLAVE LINE.
         LI,R11   X'1FFFF'
         AND,R11  J:RWECB           IS THERE AN ECB FOR THIS WRITE...
         BEZ      COCWR801          ---> NO. ALL DONE FOR SLAVE LINE.
         DO       L6FEP             FEP CODE ONLY
         CLM,R2   L6LIMS            LEVEL 6 LINE ??
         BIL      L6ECBQ            BRANCH IF SO, HALL L6 DO POST
         FIN
         MTH,0    COCOC,R2          ZERO OUTPUT COUNT ??
         BEZ      COCWR801           B/ZERO TO POST NOW
         LI,R5    COC:SPECHAR       SPECIAL CHAR FOR ECB POST
         BAL,R9   COCSENDT          INTO COC BUFFERS
L6ECBR   EQU      %
         LI,R10   0                 ZAP JIT ECB POINTER
         STS,R10  J:RWECB
         LI,R10   X'20000'          BLOCK TYPE 2(WRITE) TO
         STW,R10  *R11                BLOCK HALFWORD 0.
         LW,R10   R11               R10= BLOCK ADDRESS.
         ANLZ,R7  GETECB99          R7 = HA(COC:ECB THIS LINE).
         BAL,R11  COCWLDLC          CHAIN TO COC:ECB FOR LATER POST.
         B        COCWR801          ---> ALL DONE FOR SLAVE LINE.
COCWR80A EQU      %
         FIN
         LI,R9    COCWR801          SET RETURN ADDR FOR COCNL & KILLIN
         CI,R1    M:UC
         BE       COCWR801          BRANCH IF M:UC DCB
         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,R9   COCSEND1
         BAL,R9   SIACR             SEND IDLES AFTER CR
         LI,R5    1
         STB,R5   CPOS,R2
COCWR801 LH,7     *1
         CI,7     X'80'
         BAZ      PULL11B           BRANCH IF NOT MONITOR BUFFER
         AI,7     -X'80'
         STH,7    *1                RESET MON BUFFER FLAG
         LW,14    7,1               BUFFER ADDRESS
         PUSH     (R1,R2)           PUSH R1 -> R2
         BAL,R11  RMB               RETURN MONITOR BUFFER
         PULL     (R1,R2)           PULL R1 -> R2
         B        PULL11B           PULL R11; B *R11
         PAGE
COCWR95  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
         DO       TCOUPL=0
 TITLE 'C O C R   -   P U T   C H A R A C T E R   I N   B U F F E R'
         ELSE
 TITLE 'C O C R   -   T E R M I N A L   C O U P L I N G   R O U T I N E'
*
*        RTM      7/20/73
*        THE COUPLING INTERCEPT ROUTINE INTERCEPTS CALLS TO
*        COCPCIB,COCSEND1,COCSENDT, AND PCIB1
*        TO OUTPUT CHARACTERS TO THE TERMINAL, EXCEPT FOR CASES
*        OF PAGE HEADERS, 'SEND' OPERATOR KEYINS, AND 2741
*        SPECIAL CASES. THIS CODE, IF A TERMINAL IS COUPLED TO
*        ANOTHER, SEND THROUGH THE CHARACTERS TO THE OTHER
*        TERMINALS IN THE COUPLE RING. THIS CODE IS TRANSPARENT
*        TO BOTH THE CALLING AND CALLED ROUTINES.
*
**************************************************************************
*F*  NAME:    COCPCIB
*F*  PURPOSE: SEND A CHARACTER TO A COC LINE.
*F*  DESCRIPTION: COCSENDS WILL SEND A CHARACTER TO THE USER'S COC LINE,
*F*           PERFORMING THE FOLLOWING BASIC FUNCTIONS:
*F*           *   PERFORM LINE FOLD-OVER AND PAGINATION.
*F*           *   TRANSLATE FROM EBCDIC TO THE CORRECT CODE.
*F*           *   PROVIDE SPECIAL HANDLING OF CHARACTERS SUCH AS
*F*               CARRIAGE RETURNS, TABS, FORM FEEDS, ETC.
**************************************************************************
COCPCIB  LI,6     CCPCIB            THE REAL ROUTINE NAME
         B        COUPLE%
COCSEND1 LI,6     CCSEND1
         B        COUPLE%
COCSENDT LI,6     CCSENDT
         B        COUPLE%
PCIB1    LI,6     CPCIB1
COUPLE%  MTW,0    S:COUP            IS COUPLING ENABLED?
         BLE      0,6               ZERO-NO, GO TO ROUTINE
         PUSH     R6
         LI,6     TIE               DOES THE TABLE EXIST
         BG       %+3               YES. OK.
         PULL     R6
         B        0,6               IT DIDNT EXIST.
         PULL     R6                IT DID, CHECK FURTHER....
         CB,2     TIE,2             IS TERMINAL TIED TO ITSELF
         BE       0,6               YES. GO TO ROUTINE.
         LC       MODE4,2           IS THE COUPLED BIT ON
         BCR,8    0,6               NOPE. BYE..........
         CW,R10   Y02               IS TIE IN PROGRESS SET
         BANZ     0,6               YUP, BYE......
CPL0     PUSH     (R9,R10)          SAVE RTN AND TRANS TABLE
         PUSH     R6                WHICH ROUTINE TO CALL
         PUSH     R2                AND THE ORIGINAL LINE
CPL1     BAL,R9   0,6               CALL THE ROUTINE
         PULL     R9                GET ORIGINAL LINE #
         OR,R10   Y02               SET TIE IN PROGRESS.
         CB,R9    TIE,2             IF EQUAL, WE HAVE GONE
         BE       COUPLEX%          THROUGH THE RING.
         CB,2     TIE,2             IF IT POINTS TO ITSELF,
         BE       COUPLEX%          EXIT.
         LB,2     TIE,2             NEXT LINE TO SEND IT TO
         LC       MODE,2            CHECK TO SEE IF READ PENDING ON LINE
         BCR,1    %+3               NOPE. NO READ PENDING. IF WE FIND
         LW,6     SL:OITO           ONE WITH READ PENDING, WE RESET
         STH,6    EOMTIME,2         EOMTIME SO THE USER ISNT NAILED.
         LB,6     COCTERM,2         SET UP USER'S TRANSLATION TABLE
         LH,R10   COCOTV,6          SO THE TIMING WILL BE RIGHT.
         LW,6     *TSTACK           THE ROUTINE
         PUSH     R9                SAVE THE ORIGINAL LINE
         AND,R10  NB31TO0+25        &/R10 W/.FEFFFFFF; TURN OFF BLOCK BIT
         B        CPL1              SEND IT OUT
COUPLEX% LW,2     R9                RESTORE LINE#
         PULL     R6                GARBAGE
         PULL     R10               TRANSLATE TABLE
         PULL     R9
         B        *R9               AND RETURN
 TITLE 'COC   -   T E R M I N A L   D E C O U P L I N G   R O U T I N E'
************************************************************************
*F*  NAME:    DECOUPLE%
*F*  PURPOSE: DECOUPLE A COUPLED COC LINE
*F*  DESCRIPTION:  THE LINE WHOSE NUMBER IS IN R2 IS REMOVED FROM THE
*F*           COUPLE CHAIN, IF COUPLED.  COUPLE ENABLING IS RESET FOR
*F*           THIS LINE.
************************************************************************
DECOUPLE% CB,2    TIE,2             IS THE LINE COUPLED?
         BE       *R11              NOT REALLY.....
         PUSH     (R1,R4)
         INHIBIT                    SET INHIBITS
         LB,4     MODE4,2           LETS SEE IF THIS THING IS REALLY
         CI,4     X'80'             COUPLED.
         BANZ     DCPL0             I GUESS SO.
         AND,4    MASKS+6           &/MODE4 W/.3F; RESET COUPLE BITS
         STB,4    MODE4,2           IN MODE4
         B        DCPL1             AND GO RESET TIE BYTE.
DCPL0    LI,4     LNOL              WE'LL ONLY LOOK THIS LONG.
         LB,1     TIE,2             WHO WE POINT TO
         LW,3     1                 REMEMBER THAT FOR LATER
         CB,2     TIE,1             FIND SOMEBODY THAT POINTS TO ME
         BE       DECOUPLEX%        FOUND IT.
         CB,1     TIE,1             DOES IT POINT AT ITSELF??
         BE       DCPL1             BAD NEWS. CLEAN UP START POINT.
         LB,1     TIE,1             WALK DOWN THE PRIMROSE PATH.
         BDR,4    %-5               ...BUT ONLY FOR SO LONG.....
         B        DCPL1             A LOOP WE POINT TO. GET US OFF..
DECOUPLEX% EQU    %
         STB,3    TIE,1             POINT AROUND ME IN RING
DCPL1    STB,2    TIE,2             RESET THIS LINE
         UNINHIBIT                  RESET INHIBITS
         PULL     (R1,R4)
         B        *R11              AND SPLIT.........
 TITLE 'C O C R   -   P U T   C H A R A C T E R   I N   B U F F E R'
         FIN
*        CALL     BAL,R9 COCSEND1,COCSENDT   FOR SEND, NO CHECK.
*        CALL     BAL,R9 COCPCIB    FOR LINEATION AND PAGINATION CHECKS.
*
*        INPUT:
*                 R2 = LOGICAL LINE NUMBER
*                 R5 = CHAR TO STORE
*                 R10 = XLATE TBL, BYTE 0=1 FOR CHECKING O/P BLOCK LIMITS
*        USES:    REGISTER R6
*
*        MAY BE USED RECURSIVELY.
*
         DO       TCOUPL=1
CCPCIB   EQU      %
         ELSE
COCPCIB  EQU      %
         FIN
         CI,R5    X'40'
         DO       TCOUPL=1
         BL       CCSEND1
         ELSE
         BL       COCSEND1          DONT POSITIONS CONTROL CHARACTERS
         FIN
         DO       TP
         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
         DO       TCOUPL=1
         BL       CPCIB1
         CB,R6    CPOS,R2
         BGE      CPCIB1
         LI,R6    TIE               L/ADR OF TIE TABLE
         BEZ      %+3               BEZ; COUPLE NOT SPECIFIED IN PASS2;
*                                   .. SKIP TIE CHECK
         CB,R2    TIE,R2
         BNE      CPCIB1
         ELSE
         BL       PCIB1
         CB,R6    CPOS,R2           OR IF CPOS < JB:PCW
         BGE      PCIB1
         FIN
*                                   MUST BREAK UP LINE - SEE ABOUT PAGE
         PUSH     (R5,R11)          SAVE CHARACTER AND LINKAGES
         BAL,R9   COCNL
         PULL     (R5,R11)          RESTORE
         DO       TCOUPL=1
CPCIB1   MTB,1    CPOS,R2           RESET CPOS
         SPACE    2
CCSEND1  EQU      %
         ELSE
PCIB1    MTB,1    CPOS,R2           RESET CPOS
         SPACE    2
COCSEND1 EQU      %
         FIN
         LC       MODE3,R2          DO NOT SEND IF
         BCS,4    *R9                   ESCP + (XON.ESCE NOT)
         LC       MODE2,R2
         BCR,4    %+3
         LC       MODE,R2
         BCR,8    *R9
*
**************************************************************************
*F*  NAME:    COCSENDX
*F*  PURPOSE: SEND A CHARACTER TO A COC LINE.
*F*  DESCRIPTION: COCSENDS WILL SEND A CHARACTER TO ANY GIVEN COC LINE,
*F*           PERFORMING THE FOLLOWING BASIC FUNCTIONS:
*F*           *   TRANSLATE FROM EBCDIC TO THE CORRECT CODE.
*F*           *   PROVIDE SPECIAL HANDLING OF CHARACTERS SUCH AS
*F*               CARRIAGE RETURNS, TABS, FORM FEEDS, ETC.
**************************************************************************
COCSENDX PUSH     (R4,R9)           PRESERVE REGISTERS
*
SENDXL   LW,R6    R5
         LB,R5    *R10,R5
         CI,R5    X'80'
         BAZ      SENDNORM          NO SPECIAL CHAR
         CI,R5    X'20'
         BAZ      %+3
         AND,R5   M6                RETRANSLATE SITUATION
         B        SENDXL
         LB,R7    COCTERM,R2        L/TERMINAL TYPE INDEX
         LB,R4    SENDTAB-X'20',R5  OFFSET TO GO ROUTINE
         CI,R5    X'40'
         BAZ      SENDBYT,R4        USED IF NOT TOGGLE
SENDXIT  PULL     (R4,R9)           RESTORE
         B        *R9
*
*
SENDTAB  EQU      %
SB       COM,8    AF-SENDBYT
         SB       SENDXIT           FF
         SB       SENDHT            HT
         SB       SENDCR            CR,LF
         SB       SENDNL            NL
         DO1      5
         SB       SENDXIT           ESCF,XC,2741 RUBOUT,ESCR,ESCLR
         SB       SENDBRAC          BRACKETS
         SB       SENOTOR           NOT,OR
         SB       SENDBS            BS
         SB       SENDXIT           ESCLF
         SB       SENDNDX           2741 INDEX
         SB       SENDPER           PARITY ERROR
         SB       SENDBSBS          BS-BS (CONTIGUOUS BACKSPACE)
         SB       SENDXIT           ESCAPE-Z
         SB       SENDXIT           'IGNORE' CHARACTER
         SB       SENDXIT           ESC-D
         SB       SENDXIT           ESC-J
         SB       SENDXIT           ASCII RUBOUT
         SB       SENDXIT           ASCII BS EDIT POS RIGHT CHAR
         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   COCSENDX          SEND CR
         DO       2741CODE=1
         LC       MODE2,R2
         BCS,1    SIACR1            SEND IDLES AFTER CR CHAR
         FIN
SENDNDX  LI,R5    X'2E'             L/LINE FEED CODE
         BAL,R9   COCSENDX          SEND LF
         CI,R6    X'20'
         BNE      SIACR1            SEND IDLES AFTER CARRIAGE RETURN
         LI,R6    IDALF             L/ADR OF IDLES-AFTER-LF TABLE
         B        IDLE1             B/SEND IDLES IF INDICATED
SENDHT   LI,R5    X'40'
         LC       COB:TC,R7         CHECK TERMINAL CHARACTERISTICS
         BCR,CC(PT) SENDXL          B/TERMINAL DOESN'T HAVE PHYSICAL TABS
         AI,R5    1                 FOR CHANGING '81' TO '2D'
SENDPER  AI,R5    -X'14'
         B        SENDXL
SENDBS   RES
SENDBSBS ;
         LI,R5    X'2B'             L/INTERNAL BS CHAR
         LC       COB:TC,R7
         BCR,CC(ESCDBS) SENDXL      B/NOT VP72
         LI,R5    X'1B'             L/ESC
         BAL,R9   COCSENDX          SEND ESC
         LI,R5    'D'               L/'D'
         B        SENDXL
SENDBRAC AI,R6    8                 CHANGE 'B4','B5' TO 'BC','BD'
SENBR1   LW,R5    R6
         B        SENDXL            RETRANSLATE
*
SENOTOR  AI,R6    X'60'             CHANGE '4F','5F' TO 'AF','BF'
         LC       COB:TC,R7         CHECK TERMINAL CHARACTERISTICS
         BCR,CC(NOB) SENBR1         B/DON'T EXCHANGE NOT/OR & BRACKETS
         SLS,R6   -4
         AI,R6    X'B2'             CHANGE '4F','5F' TO 'BC','BD'
         B        SENBR1
*
*
*
SENDNORM EQU      %
         DO       2741CODE
         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  LI,R6    SENDNXTI          SET RETURN ADDRESS FOR SENCKOC
*
SENCKOC  LH,R4    COCOC,R2          L/OUTPUT CHARACTER COUNT
         BNEZ     CKOC5             B/OUTPUT EXISTS
         LC       MODE6,R2
         BCR,CC(HDIN)|CC(HLT) SENCKLOK B/NOT HALF-DUPLEX INPUT MODE
*                                   .. AND NOT HALT MODE
         DO1      HALT
         BCS,CC(HLT) SENCKOC5       B/HALT MODE
         DO       HALF%DUPLEX
         LC       MODE,R2
         BCS,1    SENCKOC5          B/READ PENDING; DON'T TURN LINE
         BAL,R9   T:TURNOUT         TURN LINE TO OUTPUT MODE
         FIN
SENCKOC5 LH,R4    COCOR,R2
         BNEZ     0,R6              RETURN IF OUTPUT CHAIN EXISTS
*                 INITIATE AN OUTPUT BUFFER CHAIN FOR THIS USER
SENDGFB  EQU      %
         DO       L6FEP
         CLM,R2   L6LIMS            IS THIS A LEVEL 6 LINE ??
         BIL      SENCKLOK          B/ LEVEL 6, DONT BUFFER
         FIN
         BAL,R6   COCGETB           NOW GET A COC BUFFER FOR NON-L6 LINE
         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 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  EQU      %
         DO       L6FEP
         CLM,R2   L6LIMS            IS THIS A LEVEL 6 LINE??
         BIL      SENDXIT           B/LEVEL 6, DONT BUMP COCOC
         FIN
         MTH,1    COCOC,R2          INC COCOC FOR NON-FEP LINS
         B        SENDXIT
CKOC1    LI,R6    E:CBL             COC BLOCK EVENT
         B        SENDBLK2          B
CKOC5    ;
         LB,R4    MODE4INIT,R2
         AND,R4   MASKS+3           =7
         LB,R9    COB:CPS,R4        L/CHARS PER SEC
         MW,R9    SL:TB             G/CHARS FOR BLOCKING
         AI,R9    125               TRY NOT TO BLOCK IN MIDDLE OF WRITE
         CW,R10   LC(BLOCK)
         BANZ     %+2               B/BLOCKABLE
         AI,R9    75                ALLOW MORE LEEWAY IF UNBLOCKABLE
         CH,R9    COCOC,R2          C/LIMIT W/OUTPUT CHAR COUNT
         BG       SENCKOC5          B/OK
         B        SENDBLK1          B; BLOCK OR IGNORE OUTPUT ATTEMPTS
*                 BUFFER IS UNAVAILABLE, REG IF USER CAN BE BLOCKED
SENDBLOK PULL     R4
SENDBLK1 LI,R6    E:CFB             SET TO REG FOR BUFFER
SENDBLK2 CW,R10   Y01
         BAZ      SENDXIT           BRANCH IF USER IS NOT TO BE BLOCKED
         PUSH     (R11,R15)         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     (R11,R15)         PULL R11 -> R15
         B        SENDCMN           TRY AGAIN
*
*                 CHECK 2741 TERMINALS FOR LOCKED KEYBOARDS
SENCKLOK EQU      %
         DO       2741CODE
         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,R9   COCSNDFF          TRANSMIT A 2741 DELETE
         LW,R5    R7
         B        SENDGFB           BUFFER FIRST CHAR
         FIN
SENDIT   LI,R9    SENDINC           SET RETURN ADDRESS FOR XMIT
*                 TRANSMIT CHARACTER TO TERMINAL
SENDXMIT LW,R6    R5
         LI,R4    LCOC              L/INDEX TO LAST COC
         CLM,R2   COD:LPC,R4        C/LINE # W/LIMITS FOR THIS COC
         BIL      %+2               BIL; FOUND IT
         BDR,R4   %-2               BDR/CHECK NEXT COC
         LD,R5    COD:LPC,R4        LOG LIMS FOR 7611
         DO       L6FEP
         CI,R4    L6#FIRST          IS THIS A LEVEL 6 LINE ??
         BL       SNDXMT1           B/NOT L6 LINE
         CW,R10   Y01               MAY THIS USER BE BLOCKED ??
         BANZ     L6BSEND           B/ BLOCKABLE USER ON L6 LINE
SNDXMT1  EQU      %
         FIN
         SLS,R6   +8                SLIDE OVER CHAR
         AW,R6    R2
         SW,R6    R5                CONVERT LINE # TO PHYS
         EXU      CO:XDATA,R4       TRANSMIT CHARACTER
         B        *R9
 TITLE 'C O C R   -   T I M I N G   A L G O R I T H M S'
SIBCR    PUSH     (R4,R9)
SIBCR1   LI,R6    IDBCR
         B        IDLE1
*
SIACR    PUSH     (R4,R9)
SIACR1   LI,R6    IDACR
         B        IDLE1
*
SIAT     PUSH     (R4,R9)
         LI,R6    IDAT
*
IDLE1    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 #
         AND,R4   M3                MASK ALGORITHM #
         LB,R5    MODE4INIT,R2      L/MODE4INIT; LINE SPEED INDICATOR
         AND,R5   M3                MASK LINE SPEED INDICATOR
IDLE20   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    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       ID6BC             ALGORITHM 6 - BEFORE CARRIAGE RETURN
         ID       IDLXIT            ALGORITHM 7 - BEFORE CARRIAGE RETURN
         BOUND    4
**************************************************************************
*
*  FOLLOWING ENTRIES SEND IDLE AFTER CR
*
**************************************************************************
IDACR    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     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
************************************************************************
*
*  FOLLOWING ENTRIES SEND IDLE AFTER LINE-FEED-ONLY CHARACTER
*
************************************************************************
IDALF    ID       IDLXIT            ALGORITHM 0 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 1 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 2 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 3 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 4 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 5 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 6 - AFTER LINE-FEED-ONLY
         ID       SEND1I1           ALGORITHM 7 - AFTER LINE-FEED-ONLY
         PAGE
SENDIDLE EQU      %
*
SEND1I1  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    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
*
ID6BC    LB,R4    IDV6,R5           L/MINIMUM # OF CHARS PER LINE
         B        ID4BC10           B
ID3BC    EQU      %
ID4BC    EQU      %
         LB,R4    IDV2,R5           L/MINIMUM # OF CHARACTERS
ID4BC10  LB,R5    CPOS,R2           L/CARRIAGE POSITION
         SW,R4    R5                # IDLES = MIN - CPOS
IDLE2    BLEZ     SENDXIT           EXIT IF # IDLES NOT > 0
IDLE3    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   COCSENDX          SEND IDLES
         BDR,R4   COCSENDX
IDLXIT   B        SENDXIT
*
ID5AT    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    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
*
**************************************************************************
*
*  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     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     DATA,1   7,10,21,40
         DATA,1   40,40,40,40
         BOUND    4
         PAGE
************************************************************************
*
*  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     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     DATA,2   60,50,17,15
         DATA,2   2,15,15,15        1200 BAUD = HONEYWELL 120CPS PRINTER
         BOUND    4
         PAGE
************************************************************************
*
*  THIS TABLE CONTAINS THE MINUMUM NUMBER OF CHARACTERS THAT MUST BE
*  SENT PRIOR TO A CR.  THEREFOR, THE NUMBER OF IDLES TO SEND BEFORE
*  A CR IS CPOS-IDV6(RATE).
*
*  THIS TABLE IS USED BY IDLE ALGORITHM 6 (TELETYPE MODEL 40 HARDCOPY
*  PRINTER).
*
************************************************************************
IDV6     DATA,1   3,5,9,17
         DATA,1   34,67,134,255
         BOUND    4
         PAGE
************************************************************************
*
*  THIS TABLE CONTAINS THE VALUE TO BE PUT IN CPOS (CARRIAGE
*  POSITION) WHEN SENDING A CARRIAGE RETURN WITHOUT KNOWING
*  THE ACTUAL CARRIAGE POSITION.  IT CAUSES THE MAXIMUM NUMBER
*  OF IDLES TO BE SENT.  THE TABLE IS INDEXED BY THE ALGORITHM
*  NUMBER.
*
************************************************************************
COB:MNIC DATA,1   130,130,130,0
         DATA,1   130,130,0,130
 TITLE 'C O C R   -   P U T   C H A R A C T E R   I N   B U F F E R'
*
*                 SENDS CHARACTER TRANSPARENT (WITH NO TRANSLATION)
         DO       TCOUPL=1
CCSENDT  EQU      %
         ELSE
COCSENDT EQU      %
         FIN
         PUSH     (R4,R9)           PRESERVE REGISTERS
         B        SENDCMN
*
*                 SENDS CHARACTER IN R5 TO TERM IN FRONT OF QUEUED OUTPUT
*                 IF POSSIBLE.
COCSUF   PUSH     (R4,R9)
         SCS,R5   32                SHIFT; CHECK PARITY
         BEV      %+2               B/EVEN; OK
         AI,R5    X'80'             ODD, SET .80 BIT, MAKE EVEN
         DO       L6FEP             LEVEL 6 CODE ONLY
         CLM,R2   L6LIMS            IS THIS A LEVEL 6??
         BIL      L6SUF             B/ IF LEVEL 6 FOR SUF
         FIN
         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  STH,R4   COCOR,R2          UPDATE REMOVAL POINT
         B        SENDSIP+1         BRANCH TO INSERT CHAR IN BUF
 TITLE 'C O C R   -   P A G I N A T I O N   R O U T I N E'
*
*        CALL:    BAL,R11  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   STB,R6   CPI,R2            S/CPI FOR ECHOCRCPI; 1 IF USER
*                                   .. WRITING .0C (FF), ELSE CPOS
         DO       TP
         LC       MODE5,R2          SLAVE USERS GET NO
         BCS,8    *R11              PAGE HEADINGS
         FIN
         PUSH     (R1,R15)          PUSH R1 -> R15
         LI,R7    JB:LC             L/BA(JB:LC)
         LI,R6    JB:LPP
         LB,R8    0,R6              LINES PER PAGE
         CI,R8    11                C/LINES/PAGE W/11
         BLE      PA98              BLE; NO PAGE HEADING
         LI,6     JH:PC             PAGE COUNT
         MTH,1    0,R6              INC IT
         LB,R9    0,R7              L/JB:LC; LINE COUNT WITHIN PAGE
         LI,R11   0                 ZERO THE LINE COUNT
         STB,R11  0,R7              0/LINE COUNT
         SW,R8    R9
         LB,R7    JB:COCOPT2        L/PAGINATION OPTIONS
         AND,R7   M3                &/OPTIONS W/7
         BEZ      PAGE70            BEZ; NORMAL PAGINATION
         LB,R4    HALTX,R7          L/INDEX INTO HALT TEXT TABLE
         BAL,R6   PAGE30            BAL/SEND TEXT
         LI,R6    E:CBL             L/COC BLOCKED-ON-OUTPUT EVENT
PAGE20   LH,R4    COCOC,R2          L/OUTPUT CHARACTER COUNT
         BEZ      PAGE40            BEZ; NO OUTPUT
         C:REG                      REG ON BLOCK-FOR-OUTPUT
         B        PAGE20            B; MAKE SURE WE UN-REG'D BECAUSE
*                                   .. OUTPUT WENT TO 0, NOT SL:UB
PAGE30   LB,R5    ERASCHAR,R4       L/CHARACTER IN PAGE ERASE/RESTORE
*                                   .. SEQUENCE
         BEZ      0,R6              BEZ; DONE WITH CHAR STRING
         BAL,R9   S:S(TCOUPL,COCSEND1,CCSEND1) SEND CHARACTER
         AI,R4    1                 INC ERASCHAR INDEX
         B        PAGE30            B; PROCESS NEXT CHAR IN SEQUENCE
PAGE40   DO1      HALT
         BAL,R15  COCSHALT          SET HALT MODE ON OUTPUT
         C:REG                      REG FOR BLOCKED-ON-OUTPUT AGAIN
         LB,R4    ERASEX,R7         L/INDEX INTO ERASE CHARACTER TABLE
         BAL,R6   PAGE30            BAL/SEND TEXT
         LI,R6    1                 L/1; COMPUTE CHARS SENT IN 1/8 SEC
         LB,R4    MODE4INIT,R2      L/MODE4INIT
         AND,R4   M3                &/MODE4 W/7; G/LINE SPEED
         SLS,R6   0,R4              G/# OF CHARS SENT IN 1/8 SECOND
         MH,R6    ERASWAIT,R7       (# CHRS SENT IN 1/8 SEC) X (# OF
*                                   .. EIGHTH SECOND INTERVALS TO WAIT)
*                                   .. = (# OF CHARS TO SEND)
         BEZ      PAGE90            BEZ; NO DELAY NEEDED; CONTINUE
         CI,R7    75                C/# OF CHARS TO SEND W/75; 75 IS
*                                   .. ARBITRARY HIGH LIMIT ON # OF
*                                   .. CHARS TO BUFFER FOR DELAYING
         BL       PAGE60            BL; SEND THE CHARS
         LW,R6    S:CUN             L/CURRENT USER #
         LI,R11   2                 L/2; SLEEP APPROX 1.5 1.2 SEC UNITS
         STW,R11  U:MISC,R6         S/SLEEP VALUE
         LI,R6    E:SL              L/SLEEP EVENT
         C:REG                      REG FOR E:SL
         B        PAGE90            B
PAGE60   LI,R5    RUBOUT            L/RUBOUT CHAR
         BAL,R9   S:S(TCOUPL,COCSEND1,CCSEND1) SEND RUBOUT
         BDR,R7   S:S(TCOUPL,COCSEND1,CCSEND1) SEND RUBOUT
         B        PAGE90            B; SKIP HEADER CODE
PAGE70   ;
         LI,R7    BA(JB:LBPH)       L/BA OF LINES BEFORE HEADING
         LB,R7    0,R7              L/LINES BEFORE PAGE HEADING
         AW,R8    R7                + LINES BEFORE PAG HEADING
         BAL,R9   COCNL
         LI,R5    X'15'             L/NEW-LINE (CR/LF)
         DO       TCOUPL=1
         BAL,R9   CCSEND1
         LI,R5    X'20'             L/LINEFEED-ONLY CHAR
         BDR,R8   CCSEND1
         ELSE
         BAL,R9   COCSEND1
         LI,R5    X'20'             L/LINEFEED-ONLY CHAR
         BDR,R8   COCSEND1
         FIN
         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      LW,R7    HEAD-1,R4         SOURCE STRING DESCRIPTOR
         LB,R8    R7                GET COUNT INTO R8
         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      %
         DO       TCOUPL=1
         BAL,R9   CCPCIB
         ELSE
         BAL,R9   COCPCIB
         FIN
PA6      AI,7     1
         BDR,R8   PA4               GO FOR NEXT CHARACTER
         BDR,R4   PA3               FOR NEXT DESCRIPTOR
*
*        PUT  USER NUMBER AND LINE NUMBER IN HEAD
*
         LI,R7    0
         INT,R9   J:JIT             GET USER ID
         LI,R12   16                SET FOR HEX CONVERSION
         BAL,R11  PA72              CONVERT TO EBCDIC
         LI,5     '-'
         DO       TCOUPL=1
         BAL,R9   CCPCIB
         ELSE
         BAL,R9   COCPCIB
         FIN
         LW,R9    R2                GET LINE NUMBER INTO R9
         BAL,R11  PA72              CONVERT HEX TO EBCDIC
*
*                 PAD WITH BLANKS TO COLUMN 34
*
         LB,R7    CPOS,R2
         AI,R7    -35
         LI,5     ' '               SPACE
         LI,R9    %+1               SET RETURN ADDRESS FOR COCPCIB
         DO       TCOUPL=1
         BIR,R7   CCPCIB
         LI,R5    X'B4'
         BAL,R9   CCPCIB
         ELSE
         BIR,R7   COCPCIB
         LI,R5    X'B4'             SET TO SEND LEFT BRACKET
         BAL,R9   COCPCIB
         FIN
*
*                 CONVERT AND OUTPUT PAGE NUMBER
*
         LI,R6    JH:PC
         LH,R9    0,R6              GET PAGE COUNT
         AND,R9   M16
         LI,R12   10                SET FOR DECIMAL CONVERSION
         BAL,R11  PA72              CONVERT FROM DECIMAL TO EBCDIC
         LI,5     X'B5'             CLOSE SQUARE BRACKET
         DO       TCOUPL=1
         BAL,R9   CCPCIB
         LI,5     ' '               DONT COUPLE PAGE HEADINGS TO OTHER LINES
         BAL,R9   CCPCIB
         ELSE
         BAL,R9   COCPCIB
         LI,R5    ' '
         BAL,R9   COCPCIB
         FIN
*
*                 MOVE ADMINISTRATIVE MESSAGE  TO HEADING
*
         LI,R4    1
PA79     CB,R4    COCMESS
         BG       PA80              BRANCH IF MESSAGE MOVED
         LB,R5    COCMESS,R4        GET NEXT BYTE OF MESSAGE
         DO       TCOUPL=1
         BAL,R9   CCPCIB
         ELSE
         BAL,R9   COCPCIB           AND SEND IT TO TERMINAL
         FIN
         AI,R4    1
         B        PA79              BRANCH FOR NEXT CHAR IN MESSAGE
PA80     EQU      %
*
*                 SPACE TO TOP OF BODY OF PAGE
*
         LI,R7    JB:LC
         LB,R8    0,R7
         LI,R7    BA(JB:LAPH)       L/BA OF LINES AFTER PAGE HEADING
         LB,R7    0,R7              L/LINES AFTER PAGE HEADING
         SW,R8    R7                - LINES AFTER PAGE HEADING
         AI,R8    -1                ADJUST
         LI,R6    1                 L/1
         LI,R5    X'15'             L/NEW-LINE (CR/LF)
         DO       TCOUPL=1
         BAL,R9   CCSEND1
         STB,R6   CPOS,R2           S/1 IN CURRENT CARRIAGE POSITION
         LI,R5    X'20'             L/LINEFEED-ONLY CHAR
         BIR,R8   CCSEND1
         ELSE
         BAL,R9   COCSEND1
         STB,R6   CPOS,R2           S/1 IN CURRENT CARRIAGE POSITION
         LI,R5    X'20'             L/LINEFEED-ONLY CHAR
         BIR,R8   COCSEND1
         FIN
         LI,R7    JB:LC             0 -> JB:LC
         STB,R8   0,R7
PAGE90   BAL,R13  ECHOCRCPI         REPOSITION CARRIAGE
PA98     PULL     (R1,R15)          PULL R1 -> R15
         B        *R11
*
PA72     AI,R7    1                 BUMP POSITION FOR NEXT REMAINDER
         LI,R8    0
         DW,R8    R12               DIVIDE
         STB,R8   R13,R7            SAVE REMAINDER
         BNEZ     PA72              CONTINUE UNTIL DIVIDEND IS ZERO
PA74     LB,R5    R13,R7
         LB,R5    HEX,R5            CONVERT TO EBCDIC
         DO       TCOUPL=1
         BAL,R9   CCPCIB
         ELSE
         BAL,R9   COCPCIB           PUT IN OUTPUT BUFFER
         FIN
         BDR,R7   PA74
         B        *R11
*
*
*        DESCRIPTOR TABLE FOR PAGE HEAD FORMATTING
*
TE       COM,8,5,19  AF(1),0,AF(2)
*
HEAD     TE       1,BA(SPACE)
         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
ERASCHAR DATA,1   0
ERAX4013 DATA,1   ESCAPE,FORMFEED,0    PAGE ERASE FOR TEKTRONIX SCOPES
ERAXTT40 DATA,1   ESCAPE,'H',ESCAPE,'J',0     PAGE ERASE FOR TELETYPE 40
TXHALT   DATA,1   S:UT('(HALT)'),0         (HALT) MESSAGE
TXHBS    DATA,1   'H',BS,0          'H', BACKSPACE; FOR TTY40 HALT
         DO1      6                 SOME PATCH SPACE
         DATA
         BOUND    4
ERASEX   DATA,1                     INDEX TO 1ST CHAR IN ERASCHAR FOR
*                                   .. EACH SEQUENCE
         DATA,1   BA(ERAX4013)-BA(ERASCHAR) TEKTRONIX PAGE ERASE SEQUENCE
         DATA,1   BA(ERAXTT40)-BA(ERASCHAR) TELETYPE MODEL 40 ERASE/RESTORE
         DATA,1   0                 ENTRY FOR CRT'S THAT SCROLL
*                                   .. INDEFINITELY
         DATA,1   ,,,               EXTRA (SPARE) ENTRIES
         BOUND    4
HALTX    DATA,1                     INDEX TO 1ST CHAR IN ERASCHAR FOR
*                                   .. EACH HALT MESSAGE SEQUENCE
         DATA,1   BA(TXHALT)-BA(ERASCHAR) TEKTRONIX (HALT)
         DATA,1   BA(TXHBS)-BA(ERASCHAR)  TTY40 H BACKSPACE SEQUENCE
         DO1      5                 SPARE (3 -> 7) ENTRIES
         DATA,1   BA(TXHALT)-BA(ERASCHAR)  (HALT) MESSAGE
         BOUND    4
ERASWAIT DATA,2   0                 DUMMY ENTRY
         DATA,2   7                 TEKTRONIX; WAIT 7/8 SECOND
         DATA,2   2                 TELETYPE 40; WAIT 1/4 SECOND
         DATA,2   0                 ENTRY FOR CRT'S THAT SCROLL
*                                   .. INDEFINITELY; NO DELAY
         DATA,2   ,,,               EXTRA (SPARE) ENTRIES
         BOUND    4
         ELSE
         B        *R11
         FIN
*
 TITLE 'C O C R   -   E N A B L E / D I S A B L E   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
**************************************************************************
*F*  NAME:    COCENABL
*F*  PURPOSE: ENABLE COC INTERRUPTS
*F*  DESCRIPTION:  COCENABL ENABLES THE COC INTERRUPTS AND ADJUSTS
*F*           THE COC INTERRUPT STATUS FLAG (CO:INTFL) ACCORDINGLY.
**************************************************************************
KO       LI,R12   X'E'              L/TYC FOR ERROR X'5B'
         B        COC60L            LINE HUNG UP; GIVE ERROR RETURN
COCENABL 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
*
**************************************************************************
*F*  NAME:    COCDSABL
*F*  PURPOSE: DISABLE COC INTERRUPTS
*F*  DESCRIPTION:  COCDSABL DISABLES THE COC INTERRUPTS, ADJUSTS
*F*           THE COC INTERRUPT STATUS FLAG (CO:INTFL) ACCORDINGLY,
*F*           AND RESETS THE INTERRUPT INHIBITS.
**************************************************************************
COCDSABL 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
         UNINHIBIT                  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    PUSH     (R13,R14)         PUSH R13 -> R14
         INHIBIT                    SET INHIBITS; CAN'T ALLOW ANY T:RCE
*                                   .. CALLS ON THIS LINE (E.G., E:CIC)
         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
 TITLE 'C O C R   -   C O M M O N   R E A D / W R I T E   C O D E'
**************************************************************************
*F*  NAME:    COCIO
*F*  PURPOSE: PROCESS A READ OR WRITE REQUEST PASSED VIA A CAL1 AND DCB.
*F*  DESCRIPTION:  COCIO IS ENTERED FROM IOQ TO HANDLE A READ OR WRITE
*F*           FOR A DCB THAT IS OPEN TO A COC LINE.  COCIO PERFORMS
*F*           THE FOLLOWING BASIC FUNCTIONS:
*F*           *   DECODES THE REQUEST, AND INITIALIZES COC LINE TABLES
*F*               AND REGISTERS.
*F*           *   CALLS COCRD OR COCWR FOR A READ OR WRITE OPERATION,
*F*               RESPECTIVELY.
*F*           *   PERFORMS CLEANUP ON THE OPERATION AND DCB.
**************************************************************************
COCIO    EQU      %
*  COMMON CODE FOR READ AND WRITE
         PUSH     (R5,R11)          PUSH NON-VOLATILE REGISTERS (5-11)
         LI,R1    X'1FFFF'          L/WA MASK
         AND,R1   R8                G/DCB ADR INTO R1, CLEAN
         LB,R3    R8                L/OPERATION CODE
         AND,R3   M4                &/FUNCTION CODE W/.F; CLEAN UP
         LW,R8    6,1               WORD 6 OF DCB
         SLS,R8   -17               RIGHT-JUSTIFY BYTE COUNT
         LW,7     7,1               WORD 7 OF DCB
         LI,R12   3                 TYC=BEG OF TAPE
         AND,7    M17               BUFFER ADDRESS (15-31)
         BEZ      COC10             READ ZERO BYTES
         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,R8    C:140
         BLE      %+2
         LI,R8    C:140             SET REC SIZE AT MAX IF GREATER
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT FLAG,
*                                   .. DISABLE COC INTERRUPTS
         LI,R10   IOTV1             L/ADR OF TRANSFER VECTOR
         DO       TP
         LI,R5    COC05             L/'BAL' ADR FOR COCCLN/COCGLN
         LI,2     X'800'            CHECK IF SLAVE DCB
         CW,2     0,R1
         BAZ      COCGLN            B/NOT SLAVE; G/LINE NUMBER
         LI,2     BARNDV            YES, GET LINE NUMBER FROM DCB
         LB,2     *R1,2
         AI,2     -1                MAKE RELATIVE TO ZERO
         BAL,R5   COCCLN            CHECK LINE #
         B        COC05G
         B        COC05G
         ELSE
         BAL,R5   COCGLN            GET, CHECK COC LINE NUMBER
         FIN
COC05    LI,R10   IOTV2             L/ADR OF TV FOR BAD LINE NUMBERS
COC05G   ;
         LW,R6    R3                L/FUNCTION CODE
         SLS,R6   -2                RJ/BITS 5-6 OF CODE
         LB,R6    *R10,R6           L/DISPLACEMENT FROM KO TO GO TO
         B        KO,R6             B/APPROPOS ROUTINE
COC06    LB,R6    COCTERM,R2
         LH,R10   COCOTV,R6         ADDR OF TRANSLATION TABLE INTO R10
         AW,R10   Y01               SET FOR O/P BLOCK LIMIT CHECK
         AI,R7    -1                BYTE ADDR OF  USER'S BUFFER - 1
         DO       TP
         LC       MODE5,R2
         BCS,8    COC08             B/SLAVE LINE
         FIN
         LW,R11   =AC(RUTO)+AC(CRD)+AC(DI)+AC(DO)+AC(RR)+AC(OACS) L/MASK
         LS,R10   J:COCOPT          MOVE ABOVE OPTIONS TO R10
         CW,R10   LC(DI)            C/J:COCOPT W/DELETEIN BIT
         BAZ      %+2               B/DELETEIN NOT REQUESTED
         BAL,R9   KILLIN            BAL/KILL INPUT BUFFERS
         CW,R10   LC(DO)            C/J:COCOPT W/DELETEOUT BIT
         BAZ      %+2               BAZ; KILL-OUTPUT NOT REQUESTED
         BAL,R13  COCKO             BAL/KILL OUTPUT
*  TEST FOR READ OR WRITE
COC08    CI,R3    X'C'
         BAZ      COC60             BRANCH IF READ OPERATION (0 - 3)
         BAL,R11  COCWR             WRITE MESSAGE
         DO       PMONOFF=1
         LW,R5    R8
         BAL,R4   WTMSGSIZ
         FIN
         LI,R12   1                 SET TYC FOR WRITE
         DO       TP
         LC       MODE5,R2
         BCS,8    COC09             B/SLAVE LINE
         FIN
         LW,R4    J:COCOPT          L/COC OPTIONS FROM M:WRITE CAL1
         CW,R4    LC(SCPOS)
         BAZ      COC09             B/NOT REQUESTED TO SET CPOS
         AND,R4   MASKS+8           &/CPOS FIELD W/.FF; MASK
         BEZ      COC09             B/0; ILLEGAL
         STB,R4   CPOS,R2           S/CPOS
COC09    RES
*  CALL COMPLETE PROCESSING
COC10    RES      0
         DO       TP
         LC       MODE5,R2
         BCS,8    COC50             B/SLAVE LINE
         FIN
         AND,R2   LC(RR)            &/R2 FLAGS W/RE-READ BIT
         STW,R2   J:COCOPT          S/FOLLOW-ON FLAGS IN J:COCOPT, 0 -> REST
COC50    BAL,R13  COCENABL          CLEAR T:COCHC LOCK-OUT FLAG,
*                                   .. ENABLE COC INTERRUPTS
         SLS,R8   17                SHIFT ARS
         LI,R9    X'E0000'          STORE INTO BITS 0-14
         STS,R8   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     (R5,R11)          PULL REGISTERS
         BAL,0    SETTYC            SETUP TYC IN DCB
         B        *R11              RETURN
COC60    AI,R8    0
         BEZ      COC10             READ OF ZERO BYTES REQUESTED
         CW,R10   LC(CRD)           C/FLAGS W/CONDITIONAL BIT
         BAZ      COC60E            B/CONDITIONAL READ NOT SET
         LH,R4    COCII,R2          L/INPUT INSERTION POINTER
         BEZ      COC60H            BEZ; NO INPUT, GIVE ABN RETURN
COC60E   BAL,R11  COCRD             READ MESSAGE
         B        COC10             WRAPUP
**************************************************************************
*E*  ERROR:   24-00
*E*  DESCRIPTION:  ON-LINE CONDITIONAL READ ISSUED WITH NO TYPE-AHEAD.
**************************************************************************
COC60H   LI,R12   X'11'             L/TYC OF .11; CONDX READ W/NO INPUT
COC60L   ;
         LI,R8    0                 L/0; ACTUAL RECORD SIZE (ARS)
         B        COC10             B; ENTER READ/WRITE CLEANUP
*
IOTV     COM,8    AF-KO
*
*  TRANSFER VECTOR FOR GOOD LINE NUMBERS
*
IOTV1    IOTV     COC06             READ
         IOTV     COC06             WRITE
         IOTV     COC50             ILLEGAL
         IOTV     COC50             ILLEGAL
*
*  TRANSFER VECTOR FOR BAD (.FF) LINE NUMBERS
*
IOTV2    IOTV     KO                READ
         IOTV     COC50             WRITE
         IOTV     COC50             ILLEGAL
         IOTV     COC50             ILLEGAL
 TITLE 'C O C R   -   D O L I S T   P R O C E S S I N G'
***********************************************************************
*F*      NAME:    T:DEFER
*F*      PURPOSE: TO PROCESS THE TYPE-7 DO-LIST ITEM BUILT BY THE PIGEON
*F*               GHOST WHEN IT IS NECESSARY TO DEFER A 'SEND' KEYIN.
*F*      DESCRIPTION:  #DLBLKS IS DECREMENTED (SINCE WE WILL RETURN THE
*F*               4-WORD BLOCK WHEN WE RETURN TO T:DOLISTR) AND THE
*F*               USER'S COMMAND PROCESSOR IS NOTIFIED THAT THE USER HAS
*F*               REQUESTED THAT ANY 'SEND' KEYINS BE DEFERED UNTIL JOB-
*F*               STEP BY SETTING A FLAG IN J:TELFLGS.
***********************************************************************
*
T:DEFER  MTW,-1   #DLBLKS           SINCE WE ARE FREEING UP A 4-WD BLK
         LD,R8    2,R5              R5 = DA(DO-LIST ITEM)
         STS,R9   *R8               R8 = ADR OF J:TELFLGS
*                                   R9 = Y008 MASK
         B        T:DOLISTR         RETURN TO SCHED & RETURN D-L BLOCK
*
*
*
         DO       TP
**************************************************************************
*F*  NAME:    COC:RDCOMP
*F*  PURPOSE: ON A TP LINE, TO PROVIDE CLEANUP ON A READ REQUEST AFTER
*F*           ACTIVATION HAS OCCURRED.
*F*  DESCRIPTION:  COC:RDCOMP RESTORES THE STANDARD COC REGISTERS
*F*           AND ENTERS NORMAL COC READ CLEANUP PROCESSING.
**************************************************************************
*
*        COC READ COMPLETE ROUTINE
*        R5 -> DA(4 WORD BLOCK)
*        R6,R7   HAS 1ST DOUBLE WORD OF 4 WORD BLOCK
*
COC:RDCOMP EQU    %
         LW,8     R7                 8= BUFFER ADDRESS.
         LD,R6    2,R5              6=TL, 7=LINE#,DCB.
         LB,2     7                 2= LINE #.
         LC       MODE5,2
         BCR,2    T:DOLISTR         ---> NO DCB OPEN, FORGET THE READ.
         LW,R9    R6                L/SAVED TL ENTRY
         LB,R4    COCTERM,R2
         LH,R10   COCOTV,R4         SR3= OUTPUT TRANSLATE TABLE.
         OR,R10   Y01                  + OKAY-TO-REG-ME FLAG.
         LW,6     7
         LI,R11   COC:RD90
         PUSH     (R5,R11)          (5=DA(BLOCK),6=WA(DCB),11=RETURN)
         LI,6     COC10
         PUSH     (R6,R9)           PUSH COC10, DCBADR,USERBUFF,TL
         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))
**************************************************************************
*F*  NAME:    COC:BRKLTR
*F*  PURPOSE: ON A TP LINE, TO PERFORM CLEANUP AFTER A LINE HAS
*F*           RECEIVED A BREAK.
**************************************************************************
COC:BRKLTR EQU    %
         PUSH     (R4,R5)           SAVE USER#, BLOCK ADDR.
         LW,2     7                 GET LINE #.
         LB,4     COCTERM,2
         LH,10    COCOTV,4          GET TRANSLATION TABLE.
         BAL,13   COCDSABL
         BAL,R8   COCKIO            RELEASE INPUT & OUTPUT
         LW,7     2
         BAL,13   COCENABL
         PULL     (R4,R5)           RESTORE USER#, BLOCK ADDR.
**************************************************************************
*F*  NAME:    COC:BRK
*F*  PURPOSE: ON A TP LINE, TO PERFORM CLEANUP AFTER A LINE HAS
*F*           RECEIVED A BREAK.
**************************************************************************
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,R7
         AND,R5   NB31TO0+5         TURN OFF BREAK PENDING BIT
         STB,R5   MODE5,R7
         UNINHIBIT
         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     ='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.
 TITLE 'C O C R   -   E C B   H A N D L I N G'
*
* COCWLDLC - 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
*
COCWLDLC PUSH     (R5,R11)
         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
         UNINHIBIT
         PULL     (R5,R11)
         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'
         PAGE
*
* 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
*
COCGECBW LI,8     2                 WRITE CODE
         B        %+2
COCGECBR 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 UNINHIBIT
         AI,7     0                 SET CC.
         B        *R11              RETURN.
GETECB99 LH,0     COC:ECB,R2        **  FOR ANLZ ONLY  **
 TITLE 'C O C R  -  C L E A N   U P   S L A V E   L I N E   T A B L E S'
**************************************************************************
*F*  NAME:    KILLIO
*F*  PURPOSE: ON A SLAVE TP LINE, DELETE ALL INPUT AND OUTPUT.
*F*  DESCRIPTION:  KILLIO DELETES ALL INPUT AND OUTPUT FOR A LINE,
*F*           AND PERFORMS ECB POSTING.
**************************************************************************
*        BAL,11
*        R2 HAS LINE #
*        ALL REGS NON-VOLATILE
*
KILLIO   LC       MODE5,2           DO NOTHING IF NO A SLAVE LINE
         BCR,8    *11
         PUSH     (R3,R2)           MAKE LINE # AT TOP OF STACK
         LI,R12   X'0D'             READ TYC = I/O PURGED.
         LI,R15   X'0D'             WRITE TYC = I/O PURGED.
COCKIOHU INHIBIT
         LB,5     MODE,2
         AND,5    NB31TO0+5         CLEAR READ PENDING BIT
         STB,5    MODE,2
         LB,5     MODE5,2
         AND,5    NB31TO0+5         CLEAR BREAK PENDING
         STB,5    MODE5,2
         UNINHIBIT
         BAL,11   COCGECBR          GET ANY READ WAIT BLOCK
         BEZ      KILL05
         XW,2     2,7               GET LINKED BLOCK; SAVE LINE#.
         BAL,1    ECBFBLK           FREE LINKED BLOCK.
         LW,2     2,7               RESTORE LINE#.
         LW,R9    R12               GET PROPER READ TYC.
         BAL,11   COCPECB           POST ECB & FREE BLOCK.
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
         BAL,11   KILLOUTA          RELEASE OUTPUT BUUFFERS.
         PULL     (R3,R2)
         B        *11               AND WE ARE DONE.
**************************************************************************
*F*  NAME:    KILLOUT
*F*  PURPOSE: ON A SLAVE TP LINE, DELETE ALL OUTPUT.
*F*  DESCRIPTION:  KILLOUT DELETES ALL OUTPUT FOR A LINE, AND
*F*           PERFORMS ECB POSTING.
**************************************************************************
*        BAL,11
*        R2 HAS LINE #
*        VOLATILE 4 - 10, 13-15
*
KILLOUT  LI,R15   X'0D'             WRITE TYC = I/O PURGED.
KILLOUTA BAL,13   COCDSABL          NO OUTPUT INT'S PLEASE.
         BAL,R13  COCKO             KILL OUTPUT BUFFERS
         BAL,R13  COCENABL          ENABLE COC INTERRUPTS
         LW,4     11                SAVE RETURN ADDRESS
*
         BAL,11   COCGECBW          GET WRITE WAIT BLOCK
         BEZ      KILL15
         LW,R9    R15               GET PROPER WRITE TYC.
         BAL,11   COCPECB           POST ECB & FREE BLOCK.
KILL15   B        0,4               AND RETURN
         PAGE
*
*        COCPECB - POST AN ECB FROM 4-WORD BLOCK.
*        BAL,11
*        R2 HAS LINE#
*        R7 HAS 4-WORD BLOCK ADDRESS.
*                 WORD 1 HAS ECB ADDRESS
*        R9 HAS COMPLETION CODE IN 24-31.
*
*        R8,R10 VOLATILE.
*
COCPECB  LB,8     LB:UN,2           GET USER#
         SLS,9    +24               GET CC TO LH BYTE.
         LW,10    1,7               GET ECB ADDRESS.
         B        ECBPOST1          ---> WILL RETURN *11 & USE BLOCK.
         FIN
         PAGE
**************************************************************************
*F*  NAME:    COCMINT
*F*  PURPOSE: INITIALIZE THE COC MODE TABLES
*F*  DESCRIPTION:  COCMINT IS CALLED BEFORE A NEW USER IS LOGGED ON,
*             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.
**************************************************************************
MODTTY   DATA,1                     TELETYPE INITIAL VALUES
         DATA,1   X'88'             MODE; ECHOPLEX, TAB SIMULATION
         DATA,1   X'20'             MODE2; SPACE INSERTION
         DATA,1   X'00'             MODE3;
*
MOD2741  DATA,1                     2741 INITIAL VALUES
         DATA,1   X'08'             MODE; TAB SIMULATION
         DATA,1   X'34'             MODE2; SPACE INSERT, 2741, PARITY CHECK
         DATA,1   X'10'             MODE3; KEYBOARD LOCKED
*
*
COCMINT  LB,R6    MODE5,R2
         AND,R6   =X'DB'            TURN OFF 'PIDGEON REQUEST',
*                                   .. TP-REQUESTED LINE' BITS
         STB,R6   MODE5,R2
         STH,R4   EOMTIME,R2        MAKE EOMTIME NON-ZERO
         LW,R6    MODTTY            L/MODE TABLE INITIAL VALUES FOR TTY
         LC       MODE2,R2
         BCR,1    MINT20            B/NOT 2741
         LW,R6    MOD2741           L/MODE TABLE INITIAL VALUES FOR 2741
*                                   .. WITHOUT AN EOA PENDING
         LC       MODE,R2
         BCR,4    MINT20            B/NO EOA PENDING
         OR,R6    BT31TO0+23        OR/MODE W/.40 (SHIFTED); SET EOA PENDING
MINT20   STB,R6   MODE3,R2          S/MODE3
         SLS,R6   -8                POSITION MODE VALUES
         STB,R6   MODE2,R2          S/MODE2
         SLS,R6   -8                POSITION MODE VALUES
         STB,R6   MODE,R2           S/MODE
         LB,R6    MODE4INIT,R2      L/INITIAL VALUE FOR MODE4 ALGO #
         AND,R6   MASKS+6           &/ALGORITHM, LINE SPEED W/.3F
         SLS,R6   -3                RJ/ALGORITHM
         STB,R6   MODE4,R2          S/MODE4
         LB,R6    COB:MNIC,R6       L/COLUMN # TO SET FOR THE
*                                   .. MAXIMUM # OF IDLES ON CR
         STB,R6   CPOS,R2           S/'CURRENT' CARRIAGE POSITION
         DO       HALF%DUPLEX|HALT
         LB,R6    MODE6,R2          L/MODE6
         AND,R6   =-1||(AC(HLT)|AC(HDTA)|AC(HDTA2)) RESET HALT MODE,
*                                   .. TURNING-AROUND MODES
         DO       HALF%DUPLEX
         LC       MODE6,R2
         BCR,CC(HD) %+2             B/NOT HALF-DUPLEX
         OR,R6    LC(HDIN)          SET HALF-DUPLEX INPUT MODE
         FIN
         STB,R6   MODE6,R2          S/MODE6
         FIN
         B        0,R4
 TITLE 'C O C R   -   S U M M A R Y'
         END

