         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DO       #LN                                                           
         DEF      A:COCIO                                                       
         DEF      COCRIP,COCTIME,COCSRDV                                        
         DEF      COCINIT,COCOP,COCIP                                           
OLAYFLAG EQU      'COCI'                                                        
         SYSTEM   CPRMON                                                        
         PCC      0                                                             
         TITLE    'C O M M E N T A R Y   S Y M B O L S'                         
********************************************************************************
*                                                                               
*  COMMENTARY PREFIXES:                                                         
*                                                                               
*  SYMBOL         MEANING                                                       
*                                                                               
*  L/             'LOAD'                                                        
*  S/             'STORE'                                                       
*  X/             'EXCHANGE'                                                    
*  XVALUE         'MULTIPLY BY (VALUE)'                                         
*  &              'AND' (LOGICAL OPERATION)                                     
*  G/             'GET'                                                         
*  C/             'COMPARE'                                                     
*  W/             'WITH'                                                        
*  B/             'BRANCH IF' OR 'BRANCH AND'                                   
*  0/             'ZERO (CLEAR)' OR 'IF ZERO, THEN'                             
*  NZ/            'IF NON-ZERO, THEN'                                           
*  +              'ADD' OR 'IF POSITIVE, THEN'                                  
*  -              'SUBTRACT' OR 'IF NEGATIVE, THEN'                             
*  M/             'MULTIPLY BY' OR 'MOVE'                                       
*  /              'DIVIDE' OR 'DIVIDE BY'                                       
*  LJ/            'LEFT JUSTIFY'                                                
*  RJ/            'RIGHT JUSTIFY'                                               
*  MNEMONIC       LITERAL                                                       
*  VALUE/         'IF (VALUE), THEN'                                            
*                                                                               
********************************************************************************
         TITLE    'A S S E M B L Y   F L A G S'                                 
*  ASSEMBLY PARAMETERS                                                          
*                                                                               
         DO1      TCOR(S:FR,MINICOC)                                            
MINICOC SET 1                                                                   
*                                                                               
C:140    SET      140               MAX MESSAGE SIZE FOR RD & WR REQUESTS       
RCVRCHK  SET      0                 1/CHECK RECEIVERS DURING COC INIT           
2741CODE SET      MINICOC=0         1/PROVIDE 2741 CAPABILITY                   
PMONOFF  SET      MINICOC=0         1/PROVIDE PERFORMANCE MONITORING            
COCGBUG  SET      0                 1/DO GET BUFFER CHECKING                    
COCPBUG  SET      0                 1/DO PUT (RELEASE) BUFFER CHECKING          
SECTB    SET      0                 SET TO 1 FOR SECTIONING ECHO GO TO'S        
2741ARUB SET      0                 SET TO 1 FOR UC BS RUB CODE                 
*                                                                               
         TITLE    'C O M M A N D   D E F I N I T I O N S'                       
S69PROC  SET      0                                                             
*                                                                               
S:S      FNAME                                                                  
         PROC                                                                   
         PEND     AF(AF(1)+2)                                                   
*                                                                               
:PSD     CNAME                                                                  
         PROC                                                                   
         BOUND    8                                                             
P        SET      S:KEYS(2,*0,CC,IA,WK,RP,MA,EA,21,RES,FS,FZ,FN,;               
                  (SLAVE,MASTER),MAP,DM,AM,CI,II,EI)                            
LF   GEN,((P(2)&X'400')>0)*64,4,1,7,3,17,2,2,1,3,1,1,6,8,4,4    ;               
   ,AF(P(3),2),,P(2)**-3&X'7F',,AF(P(4),2),,AF(P(5),2),,P(2)&7,;                
   (NUM(AF(P(7)))=1)+AF(P(7),2),,AF(P(8),2),,AF(P(6),2),                        
         PEND                                                                   
*                                                                               
:WD      CNAME                                                                  
         PROC                                                                   
FC       SET      SCOR(AF(1),DISARM,ARM%ENABLE,ARM%DISABLE,ENABLE,;             
                  DISABLE,ENABLE%DISABLE,TRIGGER)                               
LF       WD,CF(2) 1**12+FC**8+AF(2)                                             
         PEND                                                                   
*                                                                               
INHIBIT  COM,32   X'6D000037'       INHIBIT                                     
RINHIBIT COM,32   X'6D000027'       RESET INHIBITS                              
*                                                                               
*                                                                               
C:EN%DSABL    CNAME                                                             
         PROC                                                                   
         BAL,R12  C:ENABLE%DISABLE  ENABLE COC INTS, CLEAR T:COCHC              
         PEND                       .. LOCK-OUT, DISABLE COC INTS, SET          
*                                   .. COCTIME LOCK-OUT FLAG                    
SCREECH  CNAME                                                                  
         PROC                                                                   
LF       XPSD     CRASHPSD                                                      
         DO1      #CRASH                                                        
         TEXTC    'COC'                                                         
         PEND                                                                   
         TITLE    'D E F S ,   S T A T I C   D A T A'                           
*                                                                               
*                                                                               
*        CHARACTER ORIENTED COMMUNICATIONS (7611) HANDLER                       
COC      EQU      %                                                             
COCCODE EQU      %                                                             
COCCODE  EQU      %                                                             
         PCC      0                                                             
CO:INTFL DATA     X'10000'          LOCK OUT FLAG - INTIALLY SET TO PREVENT CLK4
COC:RTS  DATA     0                 ACTIVEK:RTS AT INTERRUPT                    
COLUMNS  GEN,8,24 #COLUMNS,0        PLATEN LENGTH                               
SL:ONCB  DATA     14                ON-LINE BUFFER LIMIT (160 CHAR)             
SL:OITO  DATA     360               READ TIME-OUT (30 MINUTES)                  
SL:OLTO  DATA     36                LOGON TIME-OUT (3 MINUTES)                  
COCBLC   DATA     0                 BAD LINE INTERRUPT COUNT                    
COCBLN   DATA     0                 LAST BAD LINE                               
COCIPC   DATA     0                 PARITY ERROR COUNT                          
COCIPL   DATA     0                 LAST PARITY LINE                            
COCOEC   DATA     0                 OUTPUT ERROR COUNT                          
COCOEL   DATA     0                 LAST OUTPUT ERROR LINE                      
         BOUND    8                                                             
DM8      DATA     0,X'FF'                                                       
DWB1B5   DATA     X'B1',X'B5'                                                   
LOWLET   DATA     X'81',X'A9'       LIMITS OF EBCDIC LOWER CASE LETTERS         
HILET    DATA     'A','Z'           LIMITS FOR LOWER CASE SIMULATION            
*                                                                               
         TITLE    'D E F S   A N D   S T A T I C   D A T A'                     
*                                                                               
         DO       2741CODE=1                                                    
         SREF      ESTD,ESTDLC,ESTDUC                                           
         SREF      EAPL,EAPLLC,EAPLUC                                           
         SREF      SSTD,SSTDLC,SSTDUC                                           
         SREF      SAPL,SAPLLC,SAPLUC                                           
         FIN                                                                    
EF       EQU      XEF                                                           
C3C4     EQU      3                 CC'S 3 AND 4                                
*                                                                               
*        FOUR BITS TO EBCDIC CONVERSION                                         
*                                                                               
HEX      TEXT     '0123456789ABCDEF'                                            
         DO       PMONOFF=1                                                     
* PERFORMANCE MEASUREMENT ITEMS & ROUTINES                                      
         REF      C:CO                                                          
         REF      C:CI                                                          
         REF      C:CTW             COUNT OF TERMINAL WRITES                    
         REF      WTMSGSIZ                                                      
         REF      RDMSGSIZ                                                      
         REF      READREQ                                                       
         REF      CURNTIM                                                       
         FIN                                                                    
         DO 2741CODE=1                                                          
STAR     DATA,2   X'FFFF'           ASTERISK CODES FOR KEYBOARD SELECT          
         DATA,1   X'04'             EBCD - STANDARD                             
         DATA,1   X'79'             EBCD - APL                                  
         DATA,1   X'38'             SELECTRIC - STANDARD                        
         DATA,1   X'0B'             SELECTRIC - APL                             
NOSTARS  EQU      BA(%)-BA(STAR)-1                                              
         BOUND    4                                                             
         FIN                                                                    
*                                                                               
*                 INPUT AND OUTPUT  TRANSLATE TABLE VECTORS                     
COCITV   EQU      %                                                             
         DATA,2   TTYIN             M33                                         
         DATA,2   TTYIN             M35                                         
         DATA,2   TTYIN             M37                                         
         DATA,2   TTYIN             XDS MODEL 7015                              
         DO 2741CODE=1                                                          
         DATA,2   ESTDLC            EBCD STANDARD LOWER CASE                    
         DATA,2   ESTDUC            EBCD STANDARD UPPER CASE                    
         DATA,2   EAPLLC            EBCD APL LOWER CASE                         
         DATA,2   EAPLUC            EBCD APL UPPER CASE                         
         DATA,2   SSTDLC            SELECTRIC STANDARD LOWER CASE               
         DATA,2   SSTDUC            SELECTRIC STANDARD UPPER CASE               
         DATA,2   SAPLLC            SELECTRIC APL LOWER CASE                    
         DATA,2   SAPLUC            SELECTRIC APL UPPER CASE                    
         FIN                                                                    
         BOUND    4                                                             
*                                                                               
*                 OUTPUT TABLES                                                 
*                                                                               
COCOTV   EQU      %                                                             
         DATA,2   TTYOUT            M33                                         
         DATA,2   TTYOUT            M35                                         
         DATA,2   TTYOUT            M37                                         
         DATA,2   TTYOUT            XDS MODEL 7015                              
         DO 2741CODE=1                                                          
         DATA,2   ESTD              EBCD STANDARD                               
         DATA,2   ESTD              EBCD STANDARD                               
         DATA,2   EAPL              EBCD APL                                    
         DATA,2   EAPL              EBCD APL                                    
         DATA,2   SSTD              SELECTRIC STANDARD                          
         DATA,2   SSTD              SELECTRIC STANDARD                          
         DATA,2   SAPL              SELECTRIC APL                               
         DATA,2   SAPL              SELECTRIC APL                               
         FIN                                                                    
COCHTT   EQU      HA(%)-HA(COCOTV)-1     LARGEST VALID TERMINAL TYPE            
         DEF      COCHTT                                                        
         BOUND    4                                                        02090
  TITLE    'S Y M B O L I C   C O N S T A N T   D E F I N I T I O N S'          
SR1      EQU      8                                                             
SR2      EQU      9                                                             
SR3      EQU      10                                                            
SR4      EQU      11                                                            
D1       EQU      12                                                            
D2       EQU      13                                                            
D3       EQU      14                                                            
D4       EQU      15                                                            
         SPACE    3                                                             
BELL     EQU      X'07'             BELL CHAR; BUFFER EXHAUSTION WARNING        
XON      EQU      X'11'             XON CHAR; START PAPER TAPE READER           
XOFF     EQU      X'13'             XOFF CHAR; STOP PAPER TAPE READER           
SYN      EQU      X'16'             SYN CHAR; IDLE, FOR 2741 TIMING             
RUBOUT   EQU      X'FF'             RUBOUT CHAR; NON-2741 TIMING CHAR           
         TITLE    'I N P U T   I N T E R R U P T   R O U T I N E'               
* ROUTINE TO PROCESS INPUT CHARACTERS FROM COMMON INPUT RING BUFFER        04600
* AND MOVE EACH CHARACTER INTO PROPER LINE BUFFER                          04610
*                                                                               
*  ENTER WITH INHIBITS OFF, REGISTER BLOCK 1.                                   
*                                                                               
COCIP    EQU      %                                                        04620
         LI,R0    LMIRTS+(2*CTLMID) GET CONTROL TASK STACK                      
         XW,R0    K:RTS             USE IT                                      
         STW,R0   COC:RTS           SAVE ACTIVE                                 
         MTB,-1   CO:INTFL          SET COCTIME LOCK-OUT FLAG                   
         LI,R3    LCOC              SET COC 7611 NUMBER TO LAST COC             
*                                                                          04680
*                                                                          04690
COCIP01  EQU      %                                                             
         LW,R6    CO:LST,R3        RING POINTER (RELATIVE POSITION OF           
*                                   CHARACTER IN RING BUFFER)                   
         LW,R4    CO:RINGE,R3       END OF RING BUFFER                          
         LH,D4    COH:DN,R3         COC DEVICE ADDR                             
         TIO,D4   *D4               TEST DEV.                                   
         BCS,8    COCIP04                                                       
         AND,D4   M16               MASK REMAIN BYTE CNT                        
         AW,D4    R6                                                            
         BNEZ     COCIP5                                                        
COCIP04  EQU      %                                                             
         AI,R3    -1                DECREMENT 7611 NUMBER                       
         BGEZ     COCIP01           PROCESS INPUT FROM NEXT 7611                
         MTB,1    CO:INTFL          RESET COCTIME LOCK-OUT FLAG                 
         LW,R0    COC:RTS                                                       
         STW,R0   K:RTS             RESTORE ACTIVE STACK                        
         LPSD,11  CO:IN0            RETURN - ARM (CLEAR) INTERRUPT LEVEL        
         PAGE                                                                   
*                                                                          05030
*                                                                          05040
COCIP5   EQU      %                                                             
         LI,R7    COCIP512                                                      
         LB,R5    *R4,R6            L/CHARACTER FROM RING BUF                   
         AI,R6    1                 +1 TO RING BUFFER POINTER                   
         LB,R2    *R4,R6            L/LINE NUMBER FROM RING BUFFER              
         BIR,R6   %+2               +1 TO RING BUF POINTER; B/NOT AT END        
         LCH,R6   COH:RBS,R3        L/-(RING BUFFER SIZE); WRAP AROUND          
         STW,R6   CO:LST,R3        UPDATE RING POINTER                          
*                                                                               
*                 TEST FOR VALID LINE NUMBER                                    
*                                                                               
         LD,D3    COD:LPC,R3        1ST & LAST LOGICAL LINES FOR COC            
         AW,R2    D3                R2 IS LOGICAL LINE OF TERMINAL              
COCIP7   EQU      %                                                             
         LB,R4    COCTERM,R2                                                    
         LH,SR3   COCOTV,R4                                                     
         CW,R2    D4                                                            
         BLE      0,R7              BRCH IF VALID LOGICAL LINE                  
         AI,R2    -X'80'            REMOVE BREAK BIT                            
         LI,R7    COCIPBRK          SET R7 TO GO TO BREAK LOGIC                 
         CLM,R2   D3                                                            
         BCR,9    COCIP7            BRANCH IF BREAK FOR VALID LINE              
*                                                                               
*                 COUNT  INVALID  LINE INTERRUPTS                               
*                                                                               
         MTW,1    COCBLC            COUNT INTERUPTS FROM INVALID LINES          
         STW,R2   COCBLN            SAVE BAD LINE                               
         B        COCIP01                                                       
*                                                                               
         PAGE                                                                   
*                                                                               
*                 NORMAL CHAR PROCESSING - 2=LINE, 5= CHAR                      
*                                                                               
COCIP512 EQU      %                                                             
         DO       PMONOFF=1                                                     
         MTW,1    C:CI              BUMP COUNT OF CHARACTERS INPUT              
         FIN                                                                    
         LC       MODE2,R2                                                      
         DO1      2741CODE                                                      
         BCS,1    COCIP6            2741                                        
         BCS,8    COCIP01           IGNORE INPUT FROM DISCONNECTED LINE         
         LB,R7    LB:UN,R2          L/USER NUMBER                               
         BEZ      COCIP01           BEZ; NO USER; DON'T BUFFER CHAR             
         LC       MODE,R2                                                       
         BCS,2    COCIP55                                                       
         LB,R7    MODE2,R2                                                      
         CI,R7    4                                                             
         BAZ      COCIP51           DONT CHECK PARITY                           
         SCS,R5   32                                                            
         BEV      COCIP51           PARITY OK                                   
COCIP54  EQU      %                                                             
         LI,R5    X'1A'             SUB(PARITY ERR)                             
         MTW,1    COCIPC            COUNT PARITY ERRORS                         
         STW,R2   COCIPL            SAVE LINE NUMBER                            
COCIP55  EQU      %                 EBCDIC CHAR IN 5.                           
*        DISABLE                                                                
         LB,D1    MODE,R2                                                       
         AND,D1   XFC                                                           
         STB,D1   MODE,R2                                                       
*        ENABLE                                                                 
COCIP9   EQU      %                                                             
         LI,D1    COCIP98                                                       
         LB,SR4   MODE3,R2          MODE3 FLAGS INTO SR4                        
         CI,SR4   X'8'                                                          
         LH,R4    COCII,R2          INSERTION POINT IN R4                       
         BANZ     COCIP99           BRANCH IF IN THE LOST DATA MODE             
         BNEZ     COCIP91           ALREADY SOME INPUT                          
         BAL,R6   COCGETB           GET A BUFFER                                
         B        COCIP96           BRANCH IF NONE AVAILABLE                    
         STH,R4   COCIR,R2          SET UP NEW BUF                              
         B        COCIP92                                                       
*                                                                               
*                                                                               
COCIP91  EQU      %                                                             
         AI,R4    1                 BUMP BUFFER POSITION                        
         CI,R4    X'F'                                                          
         BANZ     COCIP92           BRANCH IF ROOM IN BUFFER                    
*                 OBTAIN A BUFFER AND LINK TO THIS USER'S CHAIN                 
         LW,R7    R4                PUT LINK INTO R7                            
         BAL,R6   COCGETB           GET A BUFFER                                
         B        COCIP96-1         BRANCH IF NONE AVAILABLE                    
         SLS,R7   -1                                                            
         STH,R4   COCBUF-4,R7       LINK BUFFER TO CHAIN                        
*                 MOVE TRANSLATED INPUT CHARACTER INTO BUFFER                   
COCIP92  EQU      %                                                             
         STH,R4   COCII,R2          UPDATE INSERTION POINT                      
*        ENABLE                                                                 
COCIP93  EQU      %                                                             
         STB,R5   COCBUF,R4         PUT CHARACTER IN BUFFER                     
*                 ECHO INPUT CHARACTER IF A READ IS PENDING                     
         LC       MODE,R2                                                       
         BCR,1    COCIP95                                                       
IP930    EQU      %                                                             
         LH,R0    COCIR,R2          HEAD OF INPUT FOR ECHO                      
         BAL,SR4  COCECHO                                                       
         B        COCIP95           NORMAL RETURN                               
*                 ACTIVATION RETURN, SET READ AHEAD.                            
         LI,R6    E:CIC             SET TO REPORT INPUT COMPLETE                
COCIP94  EQU      %                                                             
         LW,R7    R2                LINE NUMBER INTO R7                         
         XW,R3    R4                ACTIVATION POINT TO R3                      
         BAL,SR4  T:RCE             REPORT EVENT                                
         XW,R3    R4                RESTORE TO ORIGINAL                         
COCIPGO  EQU      %                                                             
         PUSH     0,R0              SAVE ALL REGS                               
         LB,R1    LB:UN,R2          GET DCT INDEX                               
         BEZ      %+2               NOT YET ACTIVE                              
         BAL,R2   SERDEV            CALL SERDEV                                 
         PULL     0,R0              RESTORE REGS                                
         B        COCIP01                                                       
*                                                                               
COCIP95  EQU      %                                                             
         LB,D4    BUFCNT,R2         GET USER COC BUFFER COUNT                   
         CW,D4    SL:ONCB                                                       
         BL       COCIP01           BRANCH IF BUFFER LIMIT NOT REACHED          
         LI,D1    COCIP01                                                       
         LI,R5    X'F'                                                          
         CS,R4    XF                                                            
         BNE      COCIP97           BRANCH IF BUFFER LIMIT NOT EXCEEDED         
         LH,R4    COCII,R2                                                      
*                 USER BUFFER LIMIT EXCEEDED OR BUFFERS ARE UNAVAILABLE         
COCIP96  EQU      %                                                             
*        ENABLE                                                                 
         LB,SR4   MODE3,R2                                                      
         OR,SR4   X8                SET MODE BIT REFLECTING LOST DATA           
         STB,SR4  MODE3,R2                                                      
*                 SEND 'BE'S TO ALARM THE TERMINAL USER                         
COCIP97  EQU      %                                                             
         BAL,R15  SENDXOFF          BAL/STOP PAPER TAPE READER                  
         LI,R1    BELL              L/BELL CHAR                                 
         BAL,D4   CHKPTAP1          SEND BELL TO FRONT OF OUTPUT BUFFERS        
         B        *D1                                                           
*                 OPERATING IN THE LOST DATA MODE                               
COCIP98  EQU      %                                                             
         LI,D1    COCIP01                                                       
         LC       MODE,R2                                                       
         BCR,1    IP980             BRANCH IF IN READ AHEAD MODE                
         BAL,D4   SETACT1           SET ACTIVATION                              
         LI,D1    COCIP94-1                                                     
IP980    EQU      %                                                             
         AI,R4    0                                                             
         BEZ      COCIP97           BRANCH IF NO INPUT BUFFERS EXIST            
         LI,R5    X'BE'                                                         
         STB,R5   COCBUF,R4         GIVE BUFFER EXHAUSTION CHAR TO USER         
         B        COCIP97                                                       
*                 INPUT RECEIVED WHILE LOST DATA MODE IS SET                    
COCIP99  EQU      %                                                             
         BEZ      COCIP97           DATA HAS BEEN LOST IF NO BUFFERS            
         LB,D4    COCBUF,R4                                                     
         AI,D4    -X'BE'                                                        
         BEZ      COCIP01           BRANCH IF LOST DATA CHAR IN BUFFER          
         LB,D4    BUFCNT,R2                                                     
         CW,D4    SL:ONCB                                                       
         BGE      COCIP97           BRANCH IF BUFFER LIMIT REACHED              
         LI,SR2   COCIP91           NO LOST DATA, SET RETURN FOR CLEARLD        
         B        CLEARLD           RESET LOST DATA AND CONTINUE                
COCIP51  EQU      %                                                             
         AND,R5   M7                SCRUB PARITY                                
         CI,R5    X'7D'                                                         
         BL       COCIP56           BR IF NOT ALTMODE OR DEL CHAR               
         CI,R5    X'7F'             C/CHAR W/.7F (RUBOUT)                       
         BE       COCIP53           BE; SET UP RUBOUT SEQUENCE                  
         CI,R4    2                                                             
         BE       COCIP56           NOT ALTMODE IF MODEL 37 TTY                 
COCIP53  EQU      %                                                             
         LB,R5    ALTMODES-X'1F',R5 ASCII ESCAPE IF ALTMODE CODE                
COCIP56  EQU      %                                                             
         LH,R7    COCITV,R4                                                     
         LC       MODE,R2                                                       
         BCR,4    COCIP5F           BRANCH IF NO ESCAPE PENDING                 
         LB,D1    MODE,R2                                                       
         AI,D1    -X'40'            RESET ESC                                   
         STB,D1   MODE,R2                                                       
         LB,R6    *R7,R5            TRANSLATE TO EBCDIC                         
COCIP59  EQU      %                                                             
         CLM,R6   LOWLET                                                        
         BCS,9    %+2                                                           
         AI,R6    X'40'             ADJUST LC                                   
         LI,SR4   TTESCS                                                        
         LI,R4    NTTESCS           SET UP                                      
         DO 2741CODE=1                                                          
         LC       MODE2,R2              TO CHECK                                
         BCR,1    %+3                        ESCAPE                             
         LI,SR4   27ESCS                          TABLE                         
         LI,R4    N27ESCS                                                       
         FIN                                                                    
         CB,R6    *SR4,R4                                                       
         BE       COCIP5B           FOUND AN ESCAPE                             
         BDR,R4   %-2                                                           
         DO 2741CODE=1                                                          
         LC       MODE2,R2                                                      
         BCS,1    IP681             IGNORE 2741 EOT IF NOT AN ATTN SEQ          
         FIN                                                                    
COCIP5F  EQU      %                                                             
         LB,R5    *R7,R5            TRANSLATE                                   
         BEZ      COCIP01           NULL = NOP                                  
         LC       *SR3,R5                                                       
         BCR,8    COCIP55           NO SPEC FLAG                                
         LI,R7    -4                SPEC FLAG, CHECK IMMED                      
         CB,R5    IMCHR,R7                                                      
         BE       %+3                                                           
         BIR,R7   %-2                                                           
         B        COCIP55                                                       
         LB,R7    IMOFF,R7                                                      
         B        IMOFF,R7          GO TO IMMED PROC.                           
         SPACE    3                                                             
         DATA     X'19303231'                                                   
         SPACE                                                                  
IMCHR    EQU      %                                                             
         DATA,1   COCIYC-IMOFF,COCIESC-IMOFF                                    
         DATA,1   COCIXC-IMOFF,COCIRUB-IMOFF                                    
IMOFF    EQU      %                                                             
         BOUND    4                                                             
         SPACE    3                                                             
COCIYC   EQU      %                                                             
         LI,R7    1                 CONTROL Y EVENT                             
         STB,R7   CPI,R2            RESET INITIAL CARRIAGE POSITION             
         LI,R7    E:CEC                                                         
BRKYC    EQU      %                                                             
         LB,R5    LB:UN,R2                                                      
         BEZ      BRKYCA            B/USER NEW                                  
         DO       #TJE                                                          
         LCF      MODECPR,R2        IS IT NONTJE                                
         BCS,8    BRKYCB            YES                                         
         LB,R5    DCTTJE,R5         IS ANY ACTION ON                            
         BNEZ     BRKYCB            YES NO INITIALIZATION                       
         ELSE     #TJE                                                          
         B        BRKYCB                                                        
         FIN      #TJE                                                          
BRKYCA   EQU      %                                                             
         BAL,R4   COCMINT           BAL/INITIALIZE LINE TABLES                  
BRKYCB   EQU      %                                                             
         LC       MODE2,R2          LOGGING OFF                                 
         BCS,8    COCIP01                                                       
         DO       2741CODE                                                      
********************************************************************************
*  IF 2741 BREAK RECEIVED (AS OPPOSED TO B-ATTN), DO THE FOLLOWING:             
*  IF THIS IS A BREAK BEFORE THE TRANSLATE TABLE HAS BEEN IDENTIFIED,           
*     TURN LINE AROUND, DO NOT REPORT THE BREAK EVENT; EXIT.                    
*  RELEASE OUTPUT BUFFERS.                                                      
*  IF OUTPUT EXISTS, DON'T REPORT THE FIRST BREAK, BUT                          
*     INCREMENT THE BREAK COUNT.                                                
********************************************************************************
         BCR,1    BRKYC30           B/NOT 2741                                  
         LB,R8    COCTERM,R2        L/COCTERM; SEE IF TRNS TBL IDENTIFIE        
         BEZ      COCIP65E          BEZ; TURN LINE AROUND, DON'T REPORT         
*                                   .. BREAK; THIS IS BREAK BEFORE              
*                                   .. TRANSLATE TABLE IDENTIFIED               
         LI,R8    ECHO1             L/RETURN ADR IF IGNORING EVENT              
         LC       MODE,R2           L/EOA-PENDING FLAG                          
         BCS,4    BRKYC40           B/EOA PENDING; B-ATTN, NOT BREAK            
         BAL,R8   COCIXC10          BAL/RELEASE INPUT AND OUTPUT BUFFERS        
         LC       MODE,R2           L/READ PENDING FLAG                         
         BCR,1    %+2               B/NO READ PENDING; DON'T GIVE EOT           
         BAL,R11  ECHO1             READ PENDING, GIVE EOT                      
         LB,R5    COCOC,R2          L/OUTPUT CHARACTER COUNT                    
         BEZ      BRKYC30           BEZ; NO OUTPUT EXISTED, REPORT              
*                                   .. BREAK EVENT                              
         LB,R5    MODE,R2           L/BREAK COUNT                               
         CI,R5    2                 C/BREAK COUNT W/2                           
         BAZ      COCIP01           BAZ; BREAK COUNT < 2, DON'T                 
*                                   .. REPORT BREAK EVENT                       
BRKYC30  EQU      %                                                             
         LI,R8    COCIP01           L/RETURN ADR IF IGNORING EVENT              
BRKYC40  EQU      %                                                             
         FIN                                                                    
BRKYC1   EQU      %                                                             
         DO1      2741CODE                                                      
         LI,R8    BRKYC2            L/RETURN ADR IF REPORTING EVENT             
         BAL,SR4  IPCXY1            TRIGGER BUFFER RELEASE                      
BRKYC2   EQU      %                                                             
         LW,R6    7                                                             
         B        COCIP94           BRANCH TO RECORD EVENT                      
         SPACE    3                                                             
COCIESC  EQU      %                                                             
         LB,D1    MODE,R2           SET                                         
         OR,D1    X40                ESCAPE                                     
         STB,D1   MODE,R2             BIT                                       
         B        COCIP01                                                       
         SPACE    3                                                             
*                                                                               
COCIXC   EQU      %                                                             
         DO1      2741CODE                                                      
         LI,SR1   ECHO1             SET TO GIVE EOT IF 2741                     
COCIXC10 EQU      %                                                             
*        DISABLE                                                                
         LH,R4    COCOR,R2                                                      
         BEZ      IPCXY             B/NO OUTPUT BUFFERS EXIST                   
         LI,R5    1                 RESET CNT                                   
         STB,R5   COCOC,R2                                                      
         BAL,R6   COCPUTBL          RLS OUT BUFS                                
         BNEZ     %-1                                                           
         STH,R4   COCOR,R2                                                      
         LH,R5    COCIR,R2                                                      
         BNEZ     IPCXY             B/INPUT BUFFERS EXIST                       
         BAL,SR4  ESCX2             GIVE BACK ARROW, CR/LF                      
*        ENABLE                                                                 
*                                                                               
IPCXY    EQU      %                                                             
         LI,SR4   COCIP01           SET RETURN ADDRESS FOR ESCX1                
IPCXY1   EQU      %                                                             
         BAL,SR2  CLEARLD           CLEAR LOST DATA FLAG                        
IPCXY5   EQU      %                                                             
         LH,R4    COCIR,R2                                                      
         DO       2741CODE=1                                                    
         BEZ      *SR1              RETURN IF NO INPUT BUFFERS                  
         ELSE                                                                   
         BEZ      *SR4              RETURN IF NO INPUT BUFFERS                  
         FIN                                                                    
         LH,R0    COCII,R2          SET TO RELEASE INPUT BUFFERS                
         LH,R5    EOMTIME,R2                                                    
         BNEZ     ESCX1             RELEASE BUFS IF RD-AHD IS NOT ACTIVE        
         STH,R5   COCIR,R2          READ ACTIVE, CLEAR INPUT BUF PTRS           
         STH,R5   COCII,R2                                                      
         STH,SR4  EOMTIME,R2        SET EOMTIME NON-ZERO                        
         DO       2741CODE=1                                                    
         B        *SR1                                                          
         ELSE                                                                   
         B        *SR4                                                          
         FIN                                                                    
         SPACE    3                                                             
CLEARLD  EQU      %                                                             
         LB,R6    MODE3,R2                                                      
         AND,R6   XF7               MASK OUT LOST DATA                          
         STB,R6   MODE3,R2          AND UPDATE IN MODE3                         
         B        *SR2                                                          
         SPACE    3                                                             
COCIRUB  EQU      %                                                             
         DO       #BRKSTOP                                                      
         LB,D1    MODE3,R2                                                      
         CI,D1    1                 IS STOP IN EFFECT                           
         BAZ      %+4               NO                                          
         AND,D1   XFFFE             CLEAR STOP                                  
         STB,D1   MODE3,R2                                                      
         B        COCIPGO           START IT UP                                 
         FIN      #BRKSTOP                                                      
         LC       MODE2,R2                                                      
         BCS,4    COCIP01                                                       
         LC       MODE3,R2                                                      
         BCS,4    COCIP01                                                       
         LH,R4    COCII,R2                                                      
         BNEZ     COCIP9            BRANCH IF RUBOUT IS VALID                   
         B        COCIP01                                                       
         SPACE    3                                                             
COCIPBRK EQU      %                                                             
         LI,SR2   BRKYC                                                         
         LI,R7    E:CBK                                                         
IPBRKCT  EQU      %                                                             
         LB,R5    MODE,R2                                                       
         DO       #BRKSTOP                                                      
         CI,R5    3                 ANY BREAKS YET                              
         BANZ     IPBRKCT1          YES                                         
         LB,R4    MODE3,R2                                                      
         CI,R4    1                 STOP SET YET                                
         BAZ      %+4               NO                                          
         AND,R4   XFFFE             ITS A REAL BREAK                            
         STB,R4   MODE3,R2          SO RESET STOP                               
         B        IPBRKCT1          AND CONTINUE                                
         OR,R4    X1                SET STOP                                    
         STB,R4   MODE3,R2          AND                                         
         B        COCIP01           IGNORE BREAK                                
IPBRKCT1 EQU      %                                                             
         FIN      #BRKSTOP                                                      
         AI,R5    1                                                             
         CI,R5    3                                                             
         BAZ      COCIYC            4 BRKS = CTL Y                              
         MTB,1    MODE,R2           BUMP BREAK COUNT                            
         B        *SR2                                                          
         SPACE    3                                                             
*                                                                               
COCACK   EQU      %                 ESC 'Q'                                     
         LB,R5    COCOC,R2                                                      
         BNEZ     COCIP01           DON'T ACKNOWLEGE IF OUTPUT EXISTS           
         LI,R5    X'5A'             SET TO SEND ESCLAMATION POINTS              
         BAL,SR2  COCSEND2                                                      
         BAL,SR2  COCSEND2                                                      
         B        COCIP01                                                       
         SPACE    3                                                             
*                                                                               
KILLIN   EQU      %                                                             
*        DISABLE                                                                
         LH,R0    COCII,R2                                                      
         LH,R4    COCIR,R2                                                      
KILLIN1  EQU      %                                                             
         BAL,D3   COCFIB            RELEASE LINKS                               
         LI,R6    X'8000'                                                       
         LH,R4    TL,R2                                                         
         STH,R6   TL,R2             CLEAR TAB LINK                              
         BLEZ     *R9               B/NO TAB BUFFERS                            
         BAL,R6   COCPUTBL          RELEASE TAB BUFFERS                         
         BGZ      %-1                                                           
*        ENABLE                                                                 
         B        *SR2                                                          
         PAGE                                                                   
*                                                                               
*                 VALID ESCAPE SEQ. PROCESSING                                  
*                                                                               
27ESCS   EQU      %                                                             
         DO 2741CODE=1                                                          
         DATA,1   0,X'FF',' ',8,'N','O','B','X'                                 
         FIN                                                                    
TTESCS   DATA,1   X'FF','F','L','U','(',')','T','S','R','C','Y'                 
N27ESCS  EQU      BA(%)-BA(27ESCS)-1                                            
         DATA,1   X'30','P','E','I','Q',X'D',X'15','X'                          
NTTESCS  EQU      BA(%)-BA(TTESCS)-1                                            
*                                                                               
         BOUND    4                                                             
ESCCTLV  EQU      %                                                             
         DO       2741CODE=1                                                    
         DATA,1   0,0,X'1F',X'31',X'3F',X'3B',BATTN,XATTN                       
         FIN                                                                    
         DATA,1   0,X'30',X'0C',X'34',X'35',X'36',X'37',X'38'                   
         DATA,1   X'3E',X'3A',ESCY,ESCESC,X'33'                                 
         DATA,1   X'39',5,ESCQ,X'3F',X'3B',X'32'                                
         BOUND    4                                                             
ESCTV    EQU      COCIYC-X'80'                                                  
BATTN    EQU      COCIPBRK-ESCTV    B-ATTN ON 2741 IS SAME AS 'BREAK'           
XATTN    EQU      COCIXC-ESCTV      X-ATTN ON 2741 IS SAME AS CTL-X             
ESCQ     EQU      COCACK-ESCTV                                                  
ESCY     EQU      COCIYC-ESCTV      'Y' ATTN  =  ESC 'Y'  = CTL 'Y'             
ESCESC   EQU      ESCY              ESC 'ESC'  =  CTL 'Y'                       
COCIP5B  EQU      %                                                             
         AI,SR4   ESCCTLV-27ESCS                                                
         LB,R5    *SR4,R4           NEW CHARACTER INTO R5                       
         LC       *SR4,R4                                                       
         BCS,8    ESCTV,R5          GO TO                                       
         LH,R4    COCII,R2          GET INSERTION POINT INTO R4                 
         CI,R5    X'32'                                                         
         BL       COCIP5C           BRANCH IF CHAR REQUIRES BUFFERING           
         LC       MODE,R2                                                       
         BCS,1    COCIP5D           BRANCH IF READ IS PENDING                   
         DO 2741CODE=1                                                          
COCIP5C  EQU      %                                                             
         LC       MODE2,R2                                                      
         BCR,1    COCIP9                                                        
         B        COCIP93           2741, REPLACE LAST CHAR                     
COCIP5D  EQU      %                                                             
         LC       MODE2,R2                                                      
         BCR,1    IP930             BRANCH IF NOT 2741                          
         LI,R7    X'39'                                                         
         STB,R7   COCBUF,R4         NULLIFY CHAR AT INSERT POINT                
         ELSE                                                                   
COCIP5C  EQU      COCIP9                                                        
COCIP5D  EQU      IP930                                                         
         FIN                                                                    
         B        IP930                                                         
*                                                                               
         PAGE                                                                   
         DO       2741CODE=1                                                    
*                                                                               
*                 2741 INITIAL CHAR HANDLING.                                   
*                                                                               
*                 R5  CHARACTER TO PROCESS                                      
*                 R2  LINE NO.                                                  
*                                                                               
COCIP6   EQU      %                                                             
         AND,R5   M7                                                            
         LB,SR2   LB:UN,R2                                                      
         BEZ      COCIP65           NO USER YET                                 
         BCS,8    COCIP01           IGNORE INPUT FROM DISCONNECTED LINE         
         SCS,R5   32                                                            
         BEV      COCIP54           BAD PARITY                                  
         AND,R5   M6                SCRUB                                       
         LC       MODE3,R2                                                      
         BCR,1    COCIP61           KB NOT LOCKED                               
         LB,SR2   MODE3,R2                                                      
         AI,SR2   -X'10'                                                        
         STB,SR2  MODE3,R2          UNLOCK                                      
         CI,R5    X'34'             EOA                                         
         BNE      COCIP61           CHAR IS NOT AN EOA                          
         LI,R5    X'1F'             FORCE LC                                    
COCIP61  EQU      %                                                             
         LH,R7    COCITV,R4                                                     
         AND,R4   XFE               SET LC                                      
         CI,R5    X'1F'             LC                                          
         BE       COCIP63           YES                                         
         AI,R4    1                                                             
         CI,R5    X'1C'             UC                                          
         BNE      COCIP64           NO                                          
COCIP63  STB,R4   COCTERM,R2                                                    
         B        COCIP01                                                       
*                                                                               
COCIP64  EQU      %                                                             
         CI,R5    X'3C'                                                         
         BE       COCIEOT           BRANCH IF CHAR IS ATTN                      
         CI,R5    X'2D'                                                         
         BNE      IP642             BRANCH IF CHAR NOT NEW-LINE                 
         LB,R4    MODE,R2                                                       
         OR,R4    X40               SET EOA PENDING TO IGNORE EOT               
         STB,R4   MODE,R2                                                       
IP642    EQU      %                                                             
         LH,R4    COCII,R2                                                      
         BEZ      COCIP5F           BRANCH IF NO INPUT                          
         LB,R4    COCBUF,R4         GET LAST CHARACTER IN INPUT BUFFER          
         AI,R4    -X'39'                                                        
         BNEZ     COCIP5F           BR IF CHAR IS NOT NULLED ATTN SEQ           
         MTH,-1   COCII,R2          BACK UP INSERTION POINT                     
         B        COCIP5F                                                       
*                                                                               
COCIP65  EQU      %                                                             
         CI,R5    X'7C'             EOT                                         
         BNE      COCIP66                                                       
COCIP65E EQU      %                                                             
         BAL,SR2  EOTACT            TURN LINE AROUND                            
*        ENABLE                                                                 
         LB,R4    COCTERM,R2                                                    
         BNEZ     COCIPBRK          KB ASSIGNED,ACT LIKE BRK                    
         LI,R5    X'40'                                                         
         BAL,SR2  COCSENDT          SP                                          
         LI,R5    X'5D'                                                         
         BAL,SR2  COCSENDT          BS                                          
IP681    EQU      %                                                             
         LI,SR4   COCIP01                                                       
         B        EOT1                                                          
*                                                                               
*                 USER IS LOGGING ON, DETERMINE KEYBOARD TYPE                   
COCIP66  EQU      %                                                             
         LI,R4    NOSTARS           LENGTH OF ASTERISK TABLE IN R4              
         CB,R5    STAR,R4                                                       
         BE       %+3                                                           
         BDR,R4   %-2                                                           
         B        COCIP01           NO FIND                                     
         SLS,R4   1                                                             
         LH,R5    COCITV,R4                                                     
         BNEZ     COCIP63           BRANCH IF VALID TRANSLATION TABLE           
         B        COCIP01                                                       
         SPACE    3                                                             
*                                                                               
COCIEOT  EQU      %                                                             
         LB,R7    MODE,R2           REMEMBER EOA PENDING STATUS                 
         BAL,SR2  EOTACT            TURN LINE AROUND                            
*        ENABLE                                                                 
         CI,R7    X'40'                                                         
         BANZ     COCIP01           IGNORE EOT FOLLOWING NEW-LINE               
         BAL,SR2  IPBRKCT           INC BRK CT & GIVE CTL Y IF 4                
         LH,R4    COCII,R2                                                      
*                 DETERMINE THE CURRENT BREAK SET IN EFFECT                     
         LB,R7    MODE2,R2                                                      
         CI,R7    2                                                             
         BAZ      IPEOT             BRANCH IF BREAK SET .NE. 2                  
         LI,R5    4                 SET EBCDIC EOT IN R5                        
         BAL,D4   CCFLG811          BITS 8-11 OF UH:FLG INTO COND CODES         
         BCR,12   COCIP9            EOT IF TEL OR DELTA NOT IN CONTROL          
IPEOT    EQU      %                                                             
         LB,R6    COCBUF,R4                                                     
         LC       MODE,R2                                                       
         BCS,1    COCIP59           READ PENDING,TREAT ATTN AS ESC SEQ          
         B        COCIP01                                                       
*                                                                               
*                                                                               
EOTACT   EQU      %                                                             
*        DISABLE                                                                
         LB,R5    MODE,R2                                                       
         OR,R5    X40               SET EOA PENDING BIT                         
         STB,R5   MODE,R2                                                       
         LB,R5    MODE3,R2                                                      
         OR,R5    X10                                                           
         STB,R5   MODE3,R2          LOCK KB                                     
         LB,R5    COCTERM,R2                                                    
         AND,R5   XFE               SET TERM TO LOWER CASE                      
         STB,R5   COCTERM,R2                                                    
2741DEL  EQU      %                                                             
         MTB,1    COCOC,R2          BUMP CNT.                                   
         BNEZ     %+2                                                           
         MTB,-1   COCOC,R2          DEC. COUNT.                                 
         LI,R5    X'7F'             SET 2741 'DEL' CHAR TO START OUTPUT         
         B        SENDXMIT          AND SEND IT                                 
         FIN                                                                    
         TITLE    'C H A NG E  M O D E  A T  T E R M I N A L'                   
************************************************************************        
*                                                                               
*                 ROUTINE TO SET, RESET OR TOGGLE THE APPROPRIATE MODE          
*                                                                               
*   LINKAGE: BAL,SR2 COCCM                                                      
*                                                                               
*        IN: R1 = BIT POSITION TO BE CHANGED/0,1,2,.. MEANS BIT 7,6,5,..        
*            R2 = LINE NUMBER OF ORIGINATING MESSAGE                            
*            R5 = EBCDIC CHARACTER                                              
*           SR3 = ADDRESS OF TRANSLATION TABLE                                  
*                                                                               
*  DESTROYS: R1,D3,D4                                                           
*                                                                               
************************************************************************        
*                                                                               
COCCM    EQU      %                                                             
         AND,R1   M3                GET BIT POSITION TO BE CHANGED              
         LI,D4    1                                                             
         SLS,D4   *R1               SHIFT MASK TO BIT POSITION                  
         LB,R1    TOGTAB2-12,R5                                                 
         AND,R1   M2                GET MODE IDENTIFIER                         
         LH,R1    MODENO,R1         ADDR OF MODE BEING CHANGED                  
*        DISABLE                                                                
         LB,D3    *R1,R2            GET CURRENT DATA IN MODE BYTE               
         LC       TOGTAB2-12,R5                                                 
         BCS,8    CM2               BRANCH IF MODE IS TO BE TOGGLED             
         OR,D3    D4                                                            
         BCS,4    CM3               BRANCH IF MODE IS TO BE SET                 
CM2      EOR,D3   D4                TOGGLE BIT                                  
CM3      STB,D3   *R1,R2            UPDATE MODE BYTE                            
         B        *R9               RETURN                                      
MODENO   DATA,2   MODE,MODE2,MODE3,MODE4,                                       
TOGTAB1  EQU      WA(%)                                                         
         DATA,1   0,'P','U','(',')','T','S','E','C','O',X'11',X'13'             
TOGTAB2  EQU      WA(%)                                                         
         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'                           
         BOUND    4                                                             
         TITLE    'E C H 0  I N P U T  R O U T I N E S'                         
************************************************************************        
*    USES ALL REGISTERS                                                         
*                                                                               
*   LINKAGE:  BAL,SR4 COCECHO                                                   
*                                                                               
*        IN:  R0 = HEAD OF INPUT BUFFER CHAIN                                   
*             R2 = LINE NUMBER OF ORIGINATING MESSAGE                           
*             R4 = POINTER TO CURRENT POSITION IN BUFFER                        
*             R5 = CHARACTER TO BE PROCESSED                                    
*            SR3 = TRANSLATE TABLE ADDRESS                                      
*                                                                               
*    RETURN:  NORMAL IS TO BAL + 1. RETURN TO BAL + 2 IF ACTIVATION RCVD        
*                                                                               
*                                                                               
************************************************************************        
COCECHO  EQU      %                                                             
*                 OBTAIN BSEPOS ADDRESS                                         
         ANLZ,R7  MUHT1             INITIALIZE R7 WITH HA(TL)                   
         AI,R7    -HA(COCBUF)       AND BIAS IT FROM COCBUF                     
         B        %+2                                                           
ECHO0    EQU      %                                                             
         SCD,R6   31                GET HA(LINKAGE) INTO R7                     
         LH,R6    COCBUF,R7         NEXT LINK INTO R6                           
         AI,R6    -2                POINT TO BYTE 0 OF BUFFER                   
         BGZ      ECHO0             BRANCH IF NOT LAST TAB LINK                 
         CW,R4    R0                                                            
         BNE      ECHO0A            BRANCH IF NOT FIRST CHAR OF MESSAGE         
         LI,R6    X'8000'                                                       
         STH,R6   COCBUF,R7         SET TRSZ AND BSEPOS TO ZERO                 
ECHO0A   EQU      %                                                             
         SLS,R7   1                                                             
         AI,R7    1                 POINT R7 TO BSEPOS                          
         LC       MODE,R2                                                       
         BCS,2    ECHO6             BRANCH IF TRANSPARENT MODE                  
*                 DETERMINE CHARACTERISTICS OF INPUT CHARACTER                  
         LC       *SR3,R5                                                       
         BCR,8    ECHO8             BRANCH IF NOT SPECIAL                       
         SPACE                                                                  
         BCS,2    ECHO2             BRANCH IF NORMAL OR DELTA ACTIVATION        
         LB,R1    *SR3,R5           GET OUTPUT TRANSLATION VALUE                
         LB,R6    ECHOBYTE-X'20',R1                                             
*                 'GO TO SPECIFIC ROUTINE' IF GO TO CHARACTER SENSED            
         BCR,4    ECHOBASE,R6       GO TO SPECIFIC ROUTINE                      
         SPACE                                                                  
*                                                                               
*                 'MODE CHANGE' CHARACTER SENSED                                
         BAL,SR2  COCCM             EFFECT MODE CHANGE                          
         LB,R5    TOGTAB1-12,R5     GET EBCDIC CHARACTER TO ECHO                
         LW,SR2   SR4               RETURN ADDRESS INTO SR2                     
         CI,R5    X'13'                                                         
         BLE      COCSEND1          BRANCH IF 'XON' OR 'XOFF' CHARACTER         
         BAL,D4   ECHOESC           ECHO ESCAPE SEQUENCE                        
ECHO1    EQU      %                                                             
         DO       2741CODE=1                                                    
2741EOT  EQU      %                                                             
         LC       MODE3,R2                                                      
         BCS,1    EOT1              SEND EOT IF KEYBOARD IS LOCKED              
         LC       MODE2,R2                                                      
         BCR,1    *SR4              RETURN IF NOT 2741                          
         LC       MODE,R2                                                       
         BCR,4    *SR4              RETURN IF NO EOA PENDING                    
EOT1     EQU      %                                                             
         LI,R5    X'7C'             SET TO SEND 2741 EOT                        
         BAL,SR2  COCSENDT          SEND 2741 EOT                               
         FIN                                                                    
         B        *SR4                                                          
         SPACE    3                                                             
*                                                                               
*                                                                               
*                 VECTOR OF BIASES FROM COCECHOB TO THE 'GO TO' ROUTINES        
EB       COM,8    AF-ECHOBASE                                                   
ECHOBYTE EQU      %                                                             
         EB       ECHOFF                                                        
         EB       ECHOHT                                                        
         EB       ECHOCRLF                                                      
         EB       ECHONL                                                        
         EB       ECHOESCF                                                      
         EB       ECHOESCX                                                      
         EB       ECHORUB                                                       
         EB       ECHOESCR                                                      
         EB       ECHOESCCR                                                     
         EB       ECHOBRAC                                                      
         EB       ECHONOR                                                       
         EB       ECHOBS                                                        
         EB       ECHOESCLF                                                     
         EB       ECHO2741LF                                                    
         EB       ECHOPARITY                                                    
         DO1      17                                                            
         EB       ECTBLERR                                                      
         BOUND    4                                                             
         DO       SECTB=1                                                       
         SPACE    3                                                             
COCECHOB CSECT                                                                  
ECHOBASE EQU      %                                                             
         ELSE                                                                   
COCECHOB EQU      %                                                             
ECHOBASE EQU      COCECHOB                                                      
         FIN                                                                    
*                                                                               
*                 'NORMAL OR DELTA ACTIVATION' CHARACTER SENSED                 
ECHO2    BCS,4    ECHO3             BRANCH IF NORMAL ACTIVATION CHAR            
         B        ECHO4             DELTA ACT                                   
*                                                                               
ECHO3    BAL,D4   SETACT            SET ACTIVATION                              
*                                                                               
ECHO4    EQU      %                                                             
         CI,R5    X'40'                                                         
         BL       %+2               DON'T BUMP CPOS IF CTL CHAR                 
ECHO41   EQU      %                                                             
         MTB,1    CPOS,R2                                                       
         LC       MODE,R2                                                       
         BCR,8    ECHO43            BRANCH IF NOT ECHOPLEX                      
         BAL,SR2  COCSEND1          ECHO CHARACTER TO TERMINAL                  
ECHO43   EQU      %                                                             
         LB,R5    COCBUF,R4                                                     
         LB,R1    MODE2,R2                                                      
         CI,R1    8                                                             
         BAZ      ECHO5             BRANCH IF NOT LOWER CASE SHIFT MODE         
*                 MAP UPPER CASE CHARACTERS TO LOWER CASE                       
         DO       2741CODE=1                                                    
         CI,R1    X'10'                                                         
         BAZ      ECHO45            BRANCH IF NOT 2741                          
*                 MAP EBCDIC UPPER CASE ALPHABETIC'S TO LOWER CASE              
         CLM,R5   HILET                                                         
         BCS,9    ECHO5             BRANCH IF NOT UPPER CASE ALPHABETIC         
         AI,R5    -X'40'            MAP TO LOWER CASE                           
         B        ECHO49            BRANCH TO UPDATE BUFFER                     
         USECT    COCCODE                                                      
         FIN                                                                    
*                 MAP ASCII UPPER CASE (X'40'-X'5F') TO LOWER CASE              
ECHO45   EQU      %                                                             
         LB,R1    *SR3,R5           TRANSLATE EBCDIC BACK TO ASCII              
         LC       *SR3,R5                                                       
         BCR,8    ECHO47            BRANCH IF NOT SPECIAL                       
         BCR,6    ECHO5             BRANCH IF SPECIAL IS 'GO TO' TYPE           
         AND,R1   M6                                                            
         LB,R1    *SR3,R1           RETRANSLATE SITUTATION                      
ECHO47   EQU      %                                                             
         CI,R1    X'40'                                                         
         BAZ      ECHO5             BRANCH IF NOT AT LEAST UPPER CASE           
         OR,R1    X20               MAP TO LOWER CASE ASCII                     
         LB,R5    COCTERM,R2                                                    
         LH,R5    COCITV,R5         INPUT TRANSLATION TABLE ADDRESS             
         LB,R5    *R5,R1            TRANSLATE FROM ASCII TO EBCDIC              
ECHO49   EQU      %                                                             
         STB,R5   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER            
ECHO5    EQU      %                                                             
         LB,R1    MODE,R2                                                       
         CI,R1    4                                                             
         BAZ      ECHO6             BRANCH IF NOT IN CASE RESTRICT MODE         
         CLM,R5   LOWLET                                                        
         BCS,9    ECHO6             BRANCH IF NOT LOWER CASE ALPHABETIC         
         AI,R5    X'40'             MAP LOWER CASE EBCDIC TO UPPER CASE         
         STB,R5   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER            
ECHO6    EQU      %                                                             
         LI,D3    1                 SET INCREMENT FOR ARSZ AT ONE               
         CW,SR4   Y01                                                           
         BANZ     ECHO7             BRANCH IF ACTIVATION HAS OCCURED            
*                 ADJUST BSEPOS AND ARSZ BY INCREMENT                           
         DO       2741CODE=1                                                    
INCSIZE  LB,D4    COCBUF,R7                                                     
         BEZ      ECHO7             BRANCH IF NOT BACKSPACE EDITING             
         SW,D3    D4                                                            
         BLZ      ECHO4A            BRANCH IF STILL BACKSPACE EDITING           
         LI,D4    0                                                             
         STB,D4   COCBUF,R7         NO LONGER BACKSPACE EDITING                 
         B        ECHO7                                                         
*                                                                               
ECHO4A   LCW,D3   D3                STILL BACKSPACE EDITING,                    
         STB,D3   COCBUF,R7         UPDATE BSEPOS                               
         B        *SR4                                                          
         ELSE                                                                   
INCSIZE  B        ECHO7                                                         
         USECT    COCCODE                                                      
         FIN                                                                    
         SPACE                                                                  
*                                                                               
ECHO7    LB,D4    ARSZ,R2                                                       
         AW,D4    D3                COMPUTE NEW ARSZ                            
         CB,D4    RSZ,R2                                                        
         BL       ECHO7A                                                        
         BAL,D4   SETACT            ARSZ SATISFIES RSZ, ACTIVATION RCVD         
         LB,D4    RSZ,R2            SET NEW ARSZ = RSZ                          
ECHO7A   STB,D4   ARSZ,R2           UPDATE ARSZ                                 
         B        *SR4                                                          
*                                                                               
*                 OUTPUT TRANSLATION HAS NO SPECIAL FLAG FOR THIS CHAR          
ECHO8    EQU      %                                                             
ECHO8A   LB,D4    MODE2,R2                                                      
         AND,D4   M2                OBTAIN BREAK SET                            
         BEZ      ECHO4             BRANCH IF NO BREAK SET                      
         CI,R5    X'40'                                                         
         BE       ECHO41            BRANCH IF BLANK CHARACTER                   
         DO       2741CODE=1                                                    
         BG       ECHO9             BRANCH IF NOT A CONTROL CHARACTER           
         LC       MODE2,R2                                                      
         BCR,1    ECHO3             BRANCH TO ACTIVATE IF NOT 2741              
ECHO9    EQU      %                                                             
         ELSE                                                                   
         BL       ECHO3             BRANCH IF CHARACTER IN EITHER BREAK SET     
         FIN                                                                    
         AI,D4    -2                                                            
         BEZ      ECHO4             BRANCH IF BREAK SET 2                       
         CI,R5    X'81'                                                         
         BL       ECHO3             ACTIVATE IF CHAR. IN BREAK SET 1            
         CLM,R5   DWB1B5                                                        
         BCS,9    ECHO4             BRANCH IF NOT                               
         B        ECHO3                                                         
         SPACE    3                                                             
*                                                                               
*                 PROCESS PARITY ERROR                                          
ECHOPARITY EQU    ECHO3                                                         
         SPACE    3                                                             
*                                                                               
*                 INPUT CHARACTER IS LEFT OR RIGHT BRACKET                      
         DO1      SECTB                                                         
         USECT    COCECHOB                                                      
ECHOBRAC EQU      %                                                             
         LW,R1    R5                                                            
         LB,SR2   COCTERM,R2                                                    
         LB,R6    MODE2,R2                                                      
         CI,R6    8                                                             
         BAZ      ECHOBRC2          BRANCH IF NOT LOWER CASE SHIFT MODE         
         AI,R1    -2                MAP EBCDIC BRACKETS TO BRACES               
         B        ECHOBRC4          BRANCH TO UPDATE INPUT BUFFER               
         USECT    COCCODE                                                      
ECHOBRC2 EQU      %                                                             
         AI,SR2   -3                                                            
         BNEZ     ECHO8             BRANCH IF NOT MODEL 7015 TELETYPE           
         SLS,R1   4                                                             
         AI,R1    15                MAP EBCDIC BRACKETS TO OR & NOT             
ECHOBRC4 EQU      %                                                             
         STB,R1   COCBUF,R4         UPDATE CHARACTER IN INPUT BUFFER            
         B        ECHO8                                                         
         SPACE    2                                                             
*                 INPUT CHARACTER IS NOT OR OR                                  
ECHONOR  EQU      ECHO8                                                         
         SPACE    3                                                             
*                                                                               
ECTBLERR  EQU     %                                                             
         B        TTABERR           TRANSLATE TABLE ERROR                       
         SPACE    3                                                             
*                 PROCESS ESCAPE LINE FEED                                      
ECHOESCLF EQU     %                                                             
         BAL,D4   ECHOLF                                                        
         B        *SR4                                                          
         PAGE                                                                   
*                                                                               
*                 PROCESS ESCAPE CARRIAGE RETURN                                
ECHOESCCR EQU     %                                                             
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    ESCCR             BRANCH IF NOT 2741                          
         BAL,D4   2741ESC           ECHO 'N ATTN' ESCAPE SEQUENCE               
         FIN                                                                    
ESCCR    BAL,D4   ECHOCR            ECHO 'CR,LF'                                
         B        ECHO1                                                         
         SPACE    3                                                             
         SPACE    3                                                             
*                                                                               
*                 PROCESS ESCAPE F                                              
ECHOESCF EQU      %                                                             
         LI,R5    'F'                                                           
         BAL,D4   ECHOESC           ECHO 'ESCAPE F' SEQUENCE                    
         PAGE                                                                   
*                                                                               
*                 PROCESS CR/LF                                                 
ECHOCRLF EQU      %                                                             
         CI,R5    X'15'                                                         
         BNE      ECRLF3            BRANCH IF CHAR IS NOT A LINE FEED           
         LB,SR2   ARSZ,R2           CHARACTER IS LINE FEED                      
         BNEZ     ECRLF2            BRANCH IF ARSZ IS NON-ZERO                  
         LC       MODE2,R2                                                      
         BCS,4    ECRLF1            BRANCH IF XON                               
         LC       MODE3,R2                                                      
         BCR,4    ECRLF2            BRANCH IF NOT ESC P                         
ECRLF1   LI,R5    X'39'                                                         
         STB,R5   COCBUF,R4         PUT 'NUL'(ESC CR) INTO INBUF                
         B        *SR4              RETURN                                      
ECRLF2   BAL,D4   ECHOLF            ECHO 'LF'                                   
         B        %+2                                                           
ECRLF3   BAL,D4   ECHOCR            SEND 'CR,LF'                                
ECRLF4   BAL,D4   SETACT            SET ACTIVATION                              
         MTB,1    ARSZ,R2           BUMP ACCUMULATED RECORD SIZE                
         B        *SR4              RETURN                                      
*                                                                               
*                 PROCESS FORM FEED CHARACTER                                   
ECHOFF   EQU      ECRLF3                                                        
         DO       2741CODE=0                                                    
ECHONL   EQU      ECTBLERR                                                      
ECHOBS   EQU      ECTBLERR                                                      
ECHO2741LF EQU    ECTBLERR                                                      
         FIN                                                                    
         SPACE    3                                                             
         DO       2741CODE                                                      
ECHONL   EQU      %                                                             
         LI,R15   ECRLF4            L/RETURN ADR FOR ECHOCR1                    
         FIN                                                                    
ECHONL1  EQU      %                                                             
         LI,R9    ECHOCR1           SEND IDLES AFTER CR                         
         B        SIACR             GO TO SIACR; HE'LL GO TO ECHOCR1            
         DO       2741CODE                                                      
         PAGE                                                                   
*                                                                               
*                 PROCESS 2741 LINE FEED (INDEX KEY)                            
ECHO2741LF EQU    %                                                             
         BAL,D4   ECHOCR2           UPDATE LINE COUNT                           
         B        ECHO8             TO NORMAL CHARACTER PROCESSING              
         FIN                                                                    
         USECT    COCCODE                                                      
*                                                                               
*                 THIS ROUTINE ECHOS  LF, MAINTAINING LINE COUNT                
ECHOLF   EQU      %                                                             
         LC       MODE,R2                                                       
         BCS,8    ECHOCR            B/ECHOPLEX MODE                             
         BAL,R9   SIBCR             SEND IDLES BEFORE CR                        
         LI,R5    X'29'             L/CR CODE                                   
         LI,R9    ECHONL1           SEND CR ONLY                                
         B        COCSEND1          GO TO COCSEND1; HE'LL GO TO ECHONL1         
*                                                                               
*                 THIS ROUTINE SENDS CR/LF, MAINTAINING LINE COUNT              
ECHOCR   EQU      %                                                             
         LI,R5    X'15'             SET TO SEND 'NEW LINE'                      
         BAL,SR2  COCSEND1                                                      
ECHOCR1  EQU      %                                                             
         LI,SR2   1                                                             
         STB,SR2  CPOS,R2           RESET CARRIAGE POSITION                     
ECHOCR2  EQU      %                                                             
         B        *D4                                                           
         PAGE                                                                   
         DO       2741CODE=1                                                    
         DO1      SECTB                                                         
         USECT    COCECHOB                                                      
*                                                                               
*                 PROCESS BACKSPACE CHARACTER                                   
ECHOBS   EQU      %                                                             
         LB,SR2   CPOS,R2                                                       
         BEZ      ECRLF1            BRANCH,CARRIAGE POSITION IS ZERO            
         MTB,-1   CPOS,R2                                                       
         BEZ      ECRLF1                                                        
         LC       MODE3,R2                                                      
         BCR,2    ECHOBS1           BRANCH IF NOT OVERSTRIKE EDITING            
         MTB,1    COCBUF,R7         INCREMENT BACKSPACE EDIT POSITION           
         B        *SR4              RETURN                                      
         USECT    COCCODE                                                      
         DO       2741ARUB=1                                                    
ECHOBS1  EQU      %                                                             
         CI,R5    X'18'                                                         
         BNE      ECHO8             BRANCH IF NOT 2741 CANCEL                   
*                 2741 CANCEL (STD UC'BS'), EFFECT DESTRUCTIVE RUB-OUT          
         MTB,-1   ARSZ,R2           DECREMENT ACCUMULATED RECORD SIZE           
         B        *SR4              RETURN                                      
         ELSE                                                                   
ECHOBS1  EQU      ECHO8                                                         
         FIN                                                                    
         FIN                                                                    
         PAGE                                                                   
         DO1      SECTB                                                         
         USECT    COCECHOB                                                      
*                                                                               
*                 PROCESS RUBOUT                                                
ECHORUB  EQU      %                                                             
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    ECHORUB1          BRANCH IF NOT 2741                          
         LC       MODE3,R2                                                      
         BCR,2    ECHORUB2          BRANCH IF NOT OVERSTRIKE EDIT MODE          
         LI,R5    X'40'                                                         
         BAL,SR2  COCSEND1                                                      
         LB,SR2   CPOS,R2           SEND 1 OR 2 BLANKS AND AN 'EOT'             
         BEZ      %+3               B/CPOS = 0; THE BS DIDN'T BUMP BSEPO        
         MTB,-1   COCBUF,R7         -1 TO BSEPOS                                
         BAL,SR2  PCIB1             SEND 2ND SPACE & BUMP CPOS                  
         LI,R5    X'7C'                                                         
         BAL,SR2  COCSENDT          SEND 2741 'EOT'                             
         B        ECHO41                                                        
         USECT    COCCODE                                                      
         FIN                                                                    
ECHORUB1 LI,R5    X'B1'                                                         
         BAL,SR2  PCIB1             SEND 'BACKSLASH' & BUMP CPOS                
         MTB,-1   ARSZ,R2           DECREMENT ARSZ                              
         BC       *SR4              RETURN IF ARSZ IS NOT LESS THAN ZERO        
         DO 2741CODE=1                                                          
         B        ECHOESCX                                                      
         DO1      SECTB                                                         
         USECT    COCECHOB                                                      
ECHORUB2 MTB,-2   ARSZ,R2           DECREMENT ARSZ BY 2                         
         BC       EOT1              BRANCH IF ARSZ IS GREATER THAN ZERO         
         FIN                                                                    
         PAGE                                                                   
*                                                                               
*                 PROCESS ESCAPE X                                              
ECHOESCX EQU      %                                                             
         DO1      2741CODE                                                      
         LI,SR1   ECHO1             SET TO GIVE EOT IF 2741                     
ESCX0    EQU      %                                                             
         XW,R0    R4                 BUFFER POSITION TO R0 FOR FIB              
ESCX1    EQU      %                                                             
*        DISABLE                                                                
         BAL,D3   COCFIB            RELEASE INPUT BUFFERS                       
ESCX2    EQU      %                                                             
*        ENABLE                                                                 
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    %+3               BRANCH IF TERM NOT A 2741                   
         LI,R5    X'08'                                                         
         BAL,SR2  COCSEND1          SEND 2741 'BACKSPACE'                       
         FIN                                                                    
         LI,R5    X'6D'                                                         
         BAL,SR2  COCSEND1          SEND 'BACK ARROW'                           
         BAL,D2   ECHOCRCPI         SEND 'CR,LF' AND POSITION TO CPI            
         STB,D4   ARSZ,R2           SET ARSZ TO ZERO                            
         DO       2741CODE=1                                                    
         B        *SR1              THIS NORMALLY BRANCHES TO ECHO1             
         ELSE                                                                   
         B        *SR4              RETURN TO CALLER                            
         FIN                                                                    
         PAGE                                                                   
*                                                                               
*                 PROCESS ESCAPE R                                              
ECHOESCR EQU      %                                                             
         LI,R5    'R'                                                           
         BAL,D4   ECHOESC           ECHO 'ESC R' SEQUENCE                       
         LB,R5    ARSZ,R2                                                       
         BEZ      ECHOESCX          PERFORM ESC X IF NOTHING TO RETYPE          
         LW,R6    R2                SAVE LINE NO.                               
         LW,SR1   SR4               COCECHO RETURN ADDRESS TO SR1               
         PUSH     5,R0                                                          
         LW,R3    R4                CURRENT BUFFER POSITION INTO R3             
         LW,R4    R0                HEAD OF INPUT CHAIN INTO R4                 
         BAL,SR4  GMB               GET MONITOR BUFFER                          
         BEZ      ESCR3             BRANCH IF BUFFER IS NOT AVAILABLE           
*                                                                               
*                 MONITOR BUFFER HAS BEEN OBTAINED FOR RETYPING MESSAGE         
         LW,R2    R6                RESTORE LINE NO.                            
         SLS,D3   2                 GIVE MONITOR BUFFER ADDRESS                 
         AI,D3    -1                BYTE AND BASE RESOLUTION                    
         LB,R1    ARSZ,R2           GET SIZE OF MESSAGE                         
         CI,R1    136                                                           
         BLE      %+2                                                           
         LI,R1    136               MAX SIZE FOR RETYPED MESSAGE IS 136         
         BAL,SR2  COCMU             MOVE MESSAGE TO MONITOR BUFFER              
         AI,D3    1                                                             
         SLS,D3   -2                                                            
         BAL,D2   ECHOCRCPI         SEND 'CR,LF' AND POSITION TO CPI            
         LI,R3    0                                                             
ESCR1    EQU      %                                                             
         LB,R5    *D3,R3                                                        
         BAL,SR2  COCSEND1          SEND MESSAGE TO TERMINAL                    
         AI,R3    1                                                             
         BDR,R1   ESCR1                                                         
         DO       2741CODE=1                                                    
         LB,SR4   COCBUF,R7         BACKSPACE EDIT DISPLACEMENT INTO SR4        
         FIN                                                                    
         AI,R7    -1                                                            
         LB,D4    COCBUF,R7         TAB DISPLACEMENT (TRSZ) INTO D4             
         LI,R5    X'40'             SET TO FORWARD SPACE CARRIAGE               
         DO       2741CODE=1                                                    
         SW,D4    SR4               COMPUTE NET DISPLACEMENT TO BE MADE         
         FIN                                                                    
         AI,D4    -X'80'                                                        
         BEZ      ESCR2             BRANCH IF NO ADJUSTMENT IS REQUIRED         
         DO       2741CODE=1                                                    
         BGZ      ESCRADJ           BRANCH IF FORWARD SPACING                   
         AI,R7    1                 +1 TO TRSZ/BSEPOS PNTR; PNT TO BSEPO        
         MTB,1    COCBUF,R7         +1 TO BSEPOS; ADJUST FOR R IN R-ATTN        
         AI,R15   -1                -1 TO -(BS COUNT); EXTRA BS FOR R           
         LI,R5    X'08'             SET TO BACKSPACE CARRIAGE                   
         FIN                                                                    
ESCRADJ  EQU      %                                                             
         AW,R3    R15               +TRSZ OR BSEPOS; ADJUST CPOS                
         DO1      2741CODE                                                      
         LAW,R15  R15               MAKE SURE MOVEMENT COUNT POSITIVE           
         BAL,SR2  COCSEND1          ADJUST CARRIAGE POSITION AT TERMINAL        
         BDR,D4   COCSEND1                                                      
ESCR2    EQU      %                                                             
         LB,SR4   CPI,R2            CARRIAGE POSITION IS POSITION OF            
         AW,R3    SR4               CPI + SIZE OF RETYPE MESSAGE                
         STB,R3   CPOS,R2           UPDATE CARRIAGE POSITION                    
         BAL,SR4  RMB               RELEASE MONITOR BUFFER                      
ESCR3    EQU      %                                                             
         PULL     5,R0                                                          
         DO       2741CODE=1                                                    
         LW,SR4   SR1               RESTORE RETURN ADDRESS INTO SR4             
         B        ECHO1             BRANCH TO SEE ABOUT 2741 EOT                
         ELSE                                                                   
         B        *SR1                                                          
         FIN                                                                    
         PAGE                                                                   
*                                                                               
*                 PROCESS TAB CHARACTER                                         
ECHOHT   EQU      %                                                             
         AI,R7    -1                POINT R7 AT TRSZ                            
         LB,R5    COCBUF,R7         GET TRSZ INTO R5                            
         LH,R1    TL,R2                                                         
         BGZ      ECHOHT4           BRANCH IF TAB BUFFER EXISTS                 
ECHOHT1  LI,D3    1                 INCREMENT FOR ARSZ IS ONE                   
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    ECHOHT7-1         BRANCH IF NOT 2741                          
         LI,D2    10                INCREMENT FOR CPOS IS 10                    
         B        ECHOHT7                                                       
         ELSE                                                                   
         B        ECHOHT7-1         INCREMENT CPOS                              
         FIN                                                                    
         USECT    COCCODE                                                      
*                 TAB BUFFER EXISTS                                             
ECHOHT4  LB,D1    ARSZ,R2           ARSZ                                        
         AW,D1    R5                 + TRSZ                                     
         AI,D1    -X'80'                    (ADJUST FOR TRSZ FLAG BIT)          
         LB,D3    CPI,R2              + CPI                                     
         AW,D1    D3                    = POSITION FROM WHICH TO TAB            
*                 GET VALUE OF TAB STOP                                         
ECHOHT5  LB,D3    COCBUF,R1                                                     
         BEZ      ECHOHT1           BRANCH IF NO MORE STOPS EXIST IN BUF        
         SW,D3    D1                                                            
         BGZ      ECHOHT6           BRANCH IF VALID TAB STOP FOUND              
         AI,R1    1                 BUMP TO NEXT POSITION OF TAB BUFFER         
         CI,R1    15                                                            
         BANZ     ECHOHT5           BRANCH IF POSITION IS IN BUFFER             
         SLS,R1   -1                GIVE POINTER HALF-WORD RESOLUTION           
         LH,R1    COCBUF-4,R1       GET NEXT TAB BUFFER LINK                    
         BGZ      ECHOHT5           BRANCH IF BUFFER EXISTS                     
         B        ECHOHT1                                                       
*                 VALID TAB STOP FOUND, COMPUTE ARSZ AND CPOS INCREMENTS        
ECHOHT6  LB,D2    COCBUF,R1                                                     
         LB,R1    CPOS,R2                                                       
         SW,D2    R1                CPOS INCREMENT                              
         BGZ      ECHOHT7                                                       
         LI,D2    1                 CPOS ALWAYS MOVES AT LEAST ONE POS.         
ECHOHT7  LC       MODE2,R2                                                      
         BCS,2    ECHOHT8           BRANCH IF SPACE INSERTION MODE IS ON        
         AW,R5    D3                                                            
         AI,R5    -1                COMPUTE TRSZ                                
         CI,R5    X'100'                                                        
         BL       %+2               MAXIMUM VALUE OF TRSZ IS 127                
         LI,R5    X'FF'                                                         
         STB,R5   COCBUF,R7                                                     
         LI,D3    1                 RESET ARSZ INCREMENT TO ONE                 
ECHOHT8  AI,R7    1                 POINT R7 AT BSEPOS                          
         LW,SR1   SR4               MOVE RETURN ADDRESS TO SR1                  
         BAL,SR4  INCSIZE           BRANCH TO UPDATE ARSZ WITH INCREMENT        
         B        %+2               NORMAL RETURN                               
         AI,SR1   1                 ACTIVATION RETURN                           
         LB,SR2   COCTERM,R2                                                    
         BEZ      ECHOHT8A          BRANCH IF TTY-33                            
         AI,SR2   -3                                                            
         BEZ      ECHOHT8A          BRANCH IF 7015                              
         LC       MODE,R2                                                       
         BCR,8    ECHOHT9           BRANCH IF NON-ECHOPLEX                      
ECHOHT8A LB,R5    MODE,R2                                                       
         CI,R5    8                                                             
         BANZ     ECHOHT8B          BRANCH IF IN TAB SIMULATION MODE            
         LI,D2    1                 SET TO ECHO A SINGLE CHARACTER              
         LI,R5    X'05'                                                         
         AI,SR2   0                                                             
         BNEZ     ECHOHT8C          ECHO TAB CHAR IF NOT TTY33 OR 7015          
ECHOHT8B LW,D3    D2                                                            
         LI,R5    X'40'                                                         
ECHOHT8C BAL,SR2  COCSEND1          MOVE CARRIAGE                               
         BDR,D3   COCSEND1                                                      
         CI,R5    X'40'             C/CHAR W/BLANK                              
         BE       ECHOHT9           B/BLANK SENT                                
         BAL,R9   SIAT              SEND IDLES AFTER TAB                        
ECHOHT9  EQU      %                                                             
         LB,R1    CPOS,R2                                                       
         AW,D2    R1                                                            
         STB,D2   CPOS,R2           UPDATE CPOS                                 
         B        *SR1              RETURN                                      
         PAGE                                                                   
*                                                                               
*                 THIS ROUTINE ECHOES RESPONSE TO ESCAPE SEQUENCES              
ECHOESC  EQU      %                                                             
         LC       MODE,R2                                                       
         DO       2741CODE=1                                                    
         BCS,8    ECHOESC1          BRANCH IF ECHO-PLEX                         
         LC       MODE2,R2                                                      
         BCR,1    ECHOESC2          BRANCH IF NOT 2741                          
2741ESC  LI,R5    X'08'                                                         
         BAL,SR2  COCSEND1          SEND BACKSPACE                              
         LI,R5    X'6D'                                                         
         BAL,SR2  COCSEND1          SEND UNDERSCORE                             
         LB,SR2   COCBUF,R7                                                     
         BNEZ     *D4               RETURN IF BACKSPACE EDITING                 
         MTB,-1   ARSZ,R2           DECREMENT ARSZ                              
         B        *D4                                                           
         ELSE                                                                   
         BCR,8    ECHOESC2                                                      
         FIN                                                                    
ECHOESC1 BAL,SR2  COCSEND1          ECHO CHARACTER IN ESCAPE SEQUENCE           
ECHOESC2 LI,R5    X'B1'                                                         
         BAL,SR2  COCSEND1          SEND BACKSLASH                              
         MTB,2    CPOS,R2           INCREMENT CARRIAGE POSITION BY TWO          
         B        *D4               RETURN TO CALLER                            
         SPACE                                                                  
*                                                                               
*                 ROUTINE TO ECHO 'CR,LF' AND MOVE CARRIAGE POS TO CPI          
ECHOCRCPI EQU     %                                                             
         LI,R15   130               L/130; CPOS FOR IDLE ALGORITHM              
         STB,R15  CPOS,R2           S/CPOS; INSURE SUFFICIENT # OF IDLES        
         BAL,D4   ECHOCR            SEND 'CR,LF'                                
         LB,D4    CPI,R2                                                        
         STB,D4   CPOS,R2           UPDATE CARRIAGE POSITION                    
         LI,R5    X'40'             SET TO SEND SPACES                          
         LI,SR2   %+1                                                           
         BDR,D4   COCSEND1          POSITION CARRIAGE TO CPI                    
         B        *D2                                                           
         PAGE                                                                   
*                 THIS ROUTINE SETS RETURN FROM ECHO FOR ACTIVATION RCVD        
SETACT   EQU      %                                                             
         CW,SR4   Y01                                                           
         BANZ     *D4               RETURN IF ACTIVATION ALREADY SENSED         
         AW,SR4   X1000001          SET FOR ACTIVATION RETURN OF ECHO           
SETACT1  EQU      %                                                             
SETACT2  EQU      %                                                             
         DO       PMONOFF=1                                                     
         LW,SR2   R0                SAVE R0                                     
         BAL,R0   CURNTIM                                                       
         LW,R0    SR2               RESTORE R0                                  
         OR,R1    X1                 FORCE EOMTIME NON-ZERO                     
*        DISABLE                                                                
         STH,R1   EOMTIME,R2                                                    
         ELSE                                                                   
*        DISABLE                                                                
         STH,D4   EOMTIME,R2        MAKE EOMTIME NON-ZERO                       
         FIN                                                                    
         LB,R1    MODE,R2                                                       
*        ENABLE                                                                 
         AND,R1   EF                TURN OFF READ PENDING MODE BIT              
         STB,R1   MODE,R2                                                       
SENDXOFF LI,R1    XOFF              L/XOFF CHAR; STOP PAPER TAPE READER         
CHKPTAP  EQU      %                                                             
         LC       MODE,R2                                                       
         BCR,8    *D4               RETURN IF NOT ECHOPLEX                      
         LC       MODE2,R2                                                      
         BCS,4    CHKPTAP1          BRANCH IF MODE IS 'XON'                     
         LC       MODE3,R2                                                      
         BCR,4    *D4               RETURN IF NOT MODE 'XON' OR 'ESC P'         
CHKPTAP1 LI,R9    COCSEND2          L/ADR OF SEND ROUTINE IF CHAR IS XON        
         CI,R1    XON               C/CHAR W/XON                                
         BE       %+2               YES, PUT IN BUFF                            
         LI,SR2   COCSUF            NO-XOFF, SUF                                
         LB,R1    *SR3,R1           XLATE AND MOVE                              
         XW,R1    R5                  CHAR TO R5                                
         BAL,SR2  *SR2                                                          
         LW,R5    R1                                                            
         B        *D4                                                           
         PAGE                                                                   
*                                                                               
*                 ROUTINE TO RELEASE BUFS STARTING AT C(R4) THRU C(R0)          
COCFIB   EQU      %                                                             
         LI,R5    X'FFF0'                                                       
         AI,R4    0                                                             
         BEZ      FIB15             BRANCH IF NO BUFFERS EXIST                  
         CH,R4    COCIR,R2                                                      
         BNE      %+2               BRANCH IF NOT AT THE IR BUFFER              
         OR,R5    Y8                REMEMBER IF CHAIN STARTS WITH IR BUF        
COCFIB1  EQU      %                                                             
         CS,R4    R0                                                            
         BE       COCFIB2           RELEASE ALL COC BUFFERS STARTING            
         BAL,R6   COCPUTBL          WITH C(R4) UNTIL THE BUFFER POINTED         
         BNEZ     COCFIB1           TO BY R0 IS FOUND                           
FIB10    EQU      %                                                             
         AI,R5    0                                                             
         BLZ      LIER              ERROR IF REMOVAL POINT RELEASED             
FIB15    EQU      %                                                             
         LI,R0    0                                                             
         B        *D3               RETURN, END OF CHAIN WAS ENCOUNTERED        
*                                                                               
COCFIB2  EQU      %                                                             
         CH,R0    COCII,R2                                                      
         BNE      COCFIB3           BRANCH IF NOT AT INSERTION POINT            
         BAL,R6   COCPUTBL          RELEASE INSERTION POINT BUFFER              
         BNEZ     LIER              ERROR IF END OF CHAIN NOT REACHED           
         STH,R4   COCII,R2          ZERO THE INSERTION POINTER                  
         LI,R0    0                                                             
         AI,R5    0                                                             
         BLZ      COCFIB5           BRANCH IF REMOVAL POINT WAS RELEASED        
LIER     SCREECH  X'12'             SCREECH .12                                 
COCFIB3  EQU      %                                                             
         LW,R4    R0                                                            
         AI,R0    1                                                             
         CI,R0    15                                                            
         BANZ     COCFIB4           BRANCH IF NEW REMOVAL PT IN SAME BUF        
*                 NOT ALL BUFFERS WILL BE RELEASED-OBTAIN NEW REMOVAL PT        
*                 UPDATE REMOVAL POINTER                                        
         BAL,R6   COCPUTBL          NEXT BUFFER IN THE INPUT CHAIN              
         BEZ      FIB10             BRANCH IF END OF CHAIN DETECTED             
         LW,R0    R4                                                            
         AI,R4    -1                                                            
COCFIB4  EQU      %                                                             
         AI,R5    0                                                             
         BGEZ     *D3               RETURN IF NOT UPDATING IR                   
COCFIB5  EQU      %                                                             
         STH,R0   COCIR,R2                                                      
         B        *D3               RETURN                                      
         SPACE    3                                                             
         SPACE    3                                                             
*        THIS ROUTINE CHECKS FOR LOGON BEING ASSOCIATED                         
         DO       #TJE                                                          
CHKLOGON EQU      %                                                             
         LB,R6    LB:UN,R2                                                      
         LB,R6    DCTTJE,R6         GET FLAGS                                   
         LI,R12   TJEACT                                                        
         AND,R12  R6                IS LOGON COMPLETE ,TJEACT=1                 
         B        *D4               RETURN                                      
         FIN      #TJE                                                          
         TITLE    'O U T P U T   I N T E R R U P T   R O U T I N E'             
*                                                                          08810
*                                                                          08820
* TELETYPE OUTPUT INTERRUPT ROUTINE                                        08830
*                                                                          08840
*  ENTER INHIBITED, WITH REGISTER BLOCK 1, AND THE COC NUMBER IN R3.            
*                                                                               
COCOP    EQU      %                                                        08850
         LI,R0    LMIRTS+(2*CTLMID) USE CT STACK                                
         XW,R0    K:RTS                                                         
         STW,R0   COC:RTS           SAVE ACTIVE STACK                           
*        OUTPUT INTERRUPT ROUTINE - R3 = COC#                                   
         EXU      CO:OUTRS,R3       OUTPUT RESPONSE - FIND LINE NUMBER          
         AND,7     M6               MASK OFF EXTRA BITS                         
         LD,R4    COD:LPC,R3         R4 =  LOGICAL LINE # OF 1ST LINE IN        
*                                   COC CURRENTLY PROCESSING- R5 = LAST#        
         LW,R2    R7                                                            
         AW,R2    R4                R2 =  LOGICAL LINE TO PROCESS               
         CW,R2    R5                CHECK FOR VALID LINE                        
         BG       COCOP30           BRANCH IF INVALID LINE                      
*                                                                               
         LB,SR4   COCOC,R2                                                      
         BEZ      COCOP30           BRANCH IF INTERUPT IS EXTRANEOUS            
         DO       PMONOFF=1                                                     
         MTW,1    C:CO                                                          
         FIN                                                                    
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    COCOP10           BRANCH IF NOT 2741                          
         LB,R5    MODE,R2                                                       
         AI,R5    -X'40'                                                        
         BLZ      COCOP10           BRANCH IF EOA IS NOT PENDING                
         STB,R5   MODE,R2           RESET EOA PENDING BIT                       
         LI,R5    X'34'             SET TO XMIT EOA                             
         B        COCOP52           BRANCH TO TRANSMIT EOA                      
         FIN                                                                    
COCOP10  EQU      %                                                             
         LH,R4    COCOR,R2          GET RMVL POINT                              
         BEZ      COCOP20           LINE FINISHED  -  EXIT                      
         LB,R5    COCBUF,R4         GET CHAR                                    
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCR,1    COCOP11           BRANCH IF NOT 2741                          
         CI,R5    8                                                             
         BAZ      OP10A             NOT A 2741 CONTROL CODE                     
         CI,R5    4                                                             
         BAZ      OP10A             NOT A 2741 CONTROL CODE                     
         CI,R5    X'2D'                                                         
         BNE      COCOP11           BRANCH IF CONTROL CODE NOT A CR             
OP10A    EQU      %                                                             
         LB,R6    COCTERM,R2                                                    
         CI,R5    X'40'                                                         
         BAZ      OPLC              LC CHAR                                     
         BE       COCOP11           BRANCH IF CHAR IS A SPACE                   
         CI,R6    1                                                             
         BANZ     OP2741P           TERMINAL ALREADY UC                         
         LI,R5    X'1C'             UC SHIFT                                    
         B        OPCS              CASE SHIFT                                  
OPLC     EQU      %                                                             
         CI,R6    1                                                             
         BAZ      OP2741P           TERMINAL ALREADY LC                         
         LI,R5    X'1F'             LC SHIFT                                    
OPCS     EQU      %                                                             
         LC       MODE3,R2                                                      
         BCR,1    OP2741P           DON'T SET TERM CASE IF KB UNLOCKED          
         EOR,R6   X1                                                            
         STB,R6   COCTERM,R2        REVERSE TERMINAL CASE                       
         B        COCOP52           OUTPUT CASE SHIFT CHARACTER                 
OP2741P  EQU      %                                                             
         SCS,R5   32                                                            
         BOD      %+2                                                           
         EOR,R5   X40               SET PARITY ODD IF NOT                       
         FIN                                                                    
COCOP11  EQU      %                                                             
         MTB,-1   COCOC,R2          DECREMENT OUTPUT COUNT                      
         AI,SR4   -2                                                            
         BGZ      COCOP35           BRANCH IF MORE CHAR'S IN BUFFER             
         BEZ      COCOP40           BRANCH IF LAST CHAR IN OUTPUT BUF'S         
         SCREECH  X'13'             SCREECH .13                                 
COCOP35  EQU      %                                                             
         AI,R4    1                 BUMP REMOVAL POINT                          
         CI,R4    X'F'                                                          
         BANZ     COCOP50           BRANCH IF STILL IN SAME BUFFER              
         AI,R4    -1                BACK UP R4 TO WITHIN BUFFER                 
COCOP40  EQU      %                                                             
         BAL,R6   COCPUTBL          RELEASE, RTN LINK                           
COCOP50  EQU      %                                                             
         STH,R4   COCOR,R2                                                      
COCOP52  EQU      %                                                             
         LW,R6    R7                                                            
         SLS,R5   8                                                             
         OR,R6    R5                MERGE CHAR, LINE #                          
         EXU      CO:XDATA,R3       XMIT                                        
         B        COCOP57                                                       
COCOP54  EQU      %                                                             
         LB,R6    LB:UN,R2          DCT INDEX                                   
         LB,R6    DCT18,R6          Q INDEX                                     
         BEZ      COCOP57           NO                                          
         LC       IOQ3,R6           Q BUSY                                      
         BCR,8    COCOP57           NO                                          
         LW,R5    CO:OUT,R3         L/ADR OF INTERRUPTED PSD                    
         LD,R0    *R5               L/PSD AT TIME OF INTERRPUT                  
         STD,R0   CO:IN0            SAVE FOR ENVIRONMENT PUSH                   
         BAL,R13  COCDSABL          SET COCTIME LOCKOUT, DIS COC INT            
*                                   .. RESET INHIBITS                           
         LW,R7    R2                LINE # TO R7 FOR T:TCE                      
         LI,R6    E:COC             EVENT OUTPUT COMPLETE                       
         BAL,SR4   T:RCE                                                   09850
         LC       MODE2,R2                                                      
         BCR,8    COCOP25           BRANCH IF LINE NOT REPORTED OFF             
         DO       #TJE                                                          
         LCF      MODECPR,R2        IS IT NONTJE                                
         BCS,8    %+3               YES                                         
         LB,R6    DCTTJE,R6         CLEARED BY TEX                              
         BNEZ     COCOP25           NO                                          
         FIN      #TJE                                                          
         STB,R4   LB:UN,R2          LINE DONE                                   
         EXU      CO:RCVDO,R3       TURN RECIEVER DATA SET OFF                  
         EXU      CO:RCVON,R3       AND REINITIALIZE                            
         BAL,R4   COCMINT           INITIALIZE LINE PARAMETERS                  
COCOP25  EQU      %                                                             
*                                   REGISTERS ARE NOW DESTROYABLE               
         LB,R1    LB:UN,R2          GET DCT INDEX                               
         BEZ      %+2                                                           
         BAL,R2   SERDEV                                                        
SCHDEXIT EQU      %                                                             
         DISABLE                                                                
         BAL,R13  COCENABL          ENABLE COC INTERRUPTS                       
         LW,R0    COC:RTS                                                       
         STW,R0   K:RTS             RESTORE ACTIVE STACK                        
         LPSD,11  CO:IN0            EXIT                                        
*                                                                               
*                                                                          10100
COCOP20  EQU      %                                                             
         STB,R4   COCOC,R2          ZERO OUTPUT COUNT                           
         EXU      CO:XSTOP,R3       CLEAR SCANNER                               
         B        COCOP54                                                       
COCOP30  EQU      %                                                             
         MTW,1    COCOEC            BUMP OUTPUT ERROR COUNT                     
         STW,R2   COCOEL            RECORD INVALID LOGICAL LINE                 
         EXU      CO:XSTOP,R3       CLEAR SCANNER                               
COCOP57  EQU      %                                                             
         LW,R4    CO:OUT,R3                                                     
         LW,R0    COC:RTS                                                       
         STW,R0   K:RTS             RESTORE ACTIVE STACK                        
         LPSD,11  *R4               EXIT LEVEL                                  
         TITLE    'E N A B L E / D I S A B L E   S U B R O U T I N E S'         
********************************************************************************
*                                                                               
*  CO:INTFL VALUES/STATES                                                       
*                                                                               
*  .FF00XXXX                                                                    
*                                                                               
*  1  WE'RE IN INPUT INTERRUPT PROCESSING.                                      
*  2  COC 0'S INPUT INTERRUPT LEVEL IS ACTIVE (IT ALSO IS THE HIGHEST           
*     PRIORITY COC INTERRUPT).                                                  
*  3  ALL COC INTERRUPT LEVELS ARE ENABLED.                                     
*  4  COCTIME IS LOCKED OUT                                                     
*                                                                               
*  .0001XXXX                                                                    
*                                                                               
*  1  ONE OF THE FOLLOWING PROCESSES IS ACTIVE:                                 
*     A  OUTPUT INTERRUPT PROCESSING.                                           
*  2  ALL COC INTERRUPT LEVELS ARE DISABLED.                                    
*  3  COCTIME 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  COCTIME WILL PERFORM IT'S LOGON/LOGOFF FUNCTIONS IF CALLED.               
*                                                                               
*   IF WE AREN'T IN COCTIME, XXXX IS THE NUMBER OF TIMES THAT                   
*  COCTIME WAS BY-PASSED BECAUSE OF ACTIVE COC PROCESSING.  UPON                
*  ENTRY TO COCTIME, XXXX IS INCREMENTED.                                       
*                                                                               
********************************************************************************
         PAGE                                                                   
********************************************************************************
*                                                                               
*  RESET COCTIME LOCK-OUT FLAG TO PRMIT HANG-UP AND LINE                        
*  INITIALIZATION.  ENABLE COC INPUT AND OUTPUT INTERRUPTS.                     
*                                                                               
********************************************************************************
COCENABL EQU      %                                                             
         LI,R14   0                 L/0                                         
         STH,R14  CO:INTFL          CLEAR COCTIME FLAG                          
         LW,R14   CO:AIIL           GET INPUT INTERRUPT LEVELS                  
         LW,R15   CO:AOIL           GET OUTPUT INTERRUPT LEVELS                 
         :WD,R14  ENABLE,COA:IIG    ENABLE COC INPUT INTERRUPTS                 
         :WD,R15  ENABLE,COA:OIG    ENABLE COC OUTPUT INTERRUPTS                
         B        *R13              RETURN                                      
         SPACE    2                                                             
********************************************************************************
*                                                                               
*  SET INHIBITS.                                                                
*                                                                               
*  SET COCTIME LOCK-OUT FLAG TO PREVENT CALLS FROM CLOCK4 TO HAN-UP             
*  AND CALL-UP PROCESSING  (COCTIME).                                           
*                                                                               
*                                                                               
*  DISABLE THE COC INPUT AND OUTPUT INTERRUPT LEVELS.                           
*                                                                               
*  RESET INHIBITS.                                                              
*                                                                               
********************************************************************************
COCDSABL EQU      %                                                             
         INHIBIT                    INHIBIT                                     
         MTH,1    CO:INTFL          SET COCTIME LOCK-OUT FLAG                   
         LW,R14   CO:AIIL           GET INPUT INT LEVELS                        
         LW,R15   CO:AOIL           GET OUTPUT INT LEVELS                       
         :WD,R14  DISABLE,COA:IIG   DISABLE COC INPUT INTERRUPTS                
         :WD,R15  DISABLE,COA:OIG   DISABLE COC OUTPUT INTERRUPTS               
         RINHIBIT                   RESET INHIBITS                              
         B        *R13              RETURN                                      
         PAGE                                                                   
         SPACE    3                                                             
********************************************************************************
*                                                                               
*  ENABLE AND DISABLE COC INPUT AND OUTPUT INTERRUPTS                           
*                                                                               
*  THE PURPOSE OF THIS IS TO AVOID RING BUFFER OVER-RUNS AND TO                 
*  KEEP OUTPUT INTERRUPT PROCESSING RUNNING SMOOTHLY.                           
*                                                                               
********************************************************************************
C:ENABLE%DISABLE ;                                                              
         EQU      %                                                             
         BAL,R13  COCENABL          CLEAR T:COCHC LOCK-OUT, ENABLE COC INTS     
         BAL,R13  COCDSABL          SET T:COCHC LOCK-OUT, DISABLE COC INTS      
         B        *R12              RETURN                                      
         TITLE    'B L O C K I N G   B U F F E R   A L L O C A T O R'           
         SPACE    1                                                        10590
* INPUT/OUTPUT BUFFER BLOCK ALLOCATOR                                      10600
*  CALL:  BAL,6  COCGETB                                                        
*  EXIT WITH RELATIVE BUFFER ADDRESS IN R4                                      
* NOTE:  AVAILABLE BUFFER CHAIN IS RIGHT LINKED                                 
         SPACE    3                                                        10620
COCGETB  RES      0                                                             
*        DISABLE                                                                
         LW,4     COCHPB            HEAD                                        
         BEZ      0,R6              RETURN IF NO BUFFERS ARE AVAILABLE          
         DO1      1-COCGBUG                                                     
         BLZ      SCR                                                           
         STW,R6   COCHPB            SAVE R6                                     
         DO       COCGBUG=1                                                     
         LW,R6    R4                                                            
GETB0    EQU      %                                                             
         BLZ      SCR                                                           
         CW,R4    COCBUF,R6                                                     
         BE       SCR                                                           
         CI,R6    HRBA                                                          
         BG       SCR                                                           
         CI,R6    3                                                             
         BANZ     SCR                                                           
         RD,0     0                                                             
         BCR,1    GETB1             BRANCH IF NOT SECURITY CHECKING             
         LW,R6    COCBUF,R6                                                     
         BNEZ     GETB0                                                         
         FIN                                                                    
GETB1    EQU      %                                                             
         LW,R6    COCBUF,R4         CHAIN INTO R6                               
         XW,R6    COCHPB            RESTORE R6, SET HEAD TO CHAIN               
         MTB,1    BUFCNT,R2         BUMP BUFFER COUNT FOR THIS USER             
         SLS,R4   2                 POINT 2 INTO BUF (LINK OF BUF = 0)          
         AI,R4    2                                                             
         B        1,R6                                                          
         PAGE                                                              10900
* INPUT/OUTPUT LINE BUFFER BLOCK UPDATE ROUTINE                            10910
*        AVAILABLE BUFFERS ARE RIGHT LINKED                                     
*                                                                               
COCPUTBL RES      0                 6= RETURN , 4=BUFF                          
         CI,R4    HRBA+HRBA+HRBA+HRBA+15                                        
         BG       SCR               BUFFER ADDRESS TOO BIG                      
         CI,R4    15                                                            
         BG       PUTBL1                                                        
SCR      SCREECH  X'10'             SCREECH .10                                 
PUTBL1   EQU      %                                                             
         MTB,-1   BUFCNT,R2         DECREMENT BUFFER COUNT FOR THIS USER        
         AND,R4   XFFF0                                                         
         SLS,R4   -2                                                            
         XW,6     COCHPB            OLD CHAIN TO 6                              
         DO       COCPBUG=1                                                     
         BEZ      PUTBL3                                                        
         PUSH     R6                                                            
PUTBL0   EQU      %                                                             
         CW,R6    R4                                                            
         BE       SCR                                                           
         CI,R6    HRBA                                                          
         BG       SCR                                                           
         CI,R6    3                                                             
         BANZ     SCR                                                           
         RD,0     0                                                             
         BCR,1    PUTBL2            BRANCH IF NOT SECURITY CHECKING             
         LW,R6    COCBUF,R6                                                     
         BGZ      PUTBL0                                                        
         BLZ      SCR                                                           
PUTBL2   EQU      %                                                             
         PULL     R6                                                            
PUTBL3   EQU      %                                                             
         FIN                                                                    
************************************************************************        
*  RELEASE THE BUFFER WHOSE RELATIVE ADDRESS IS IN R4.                          
************************************************************************        
         XW,R6    COCBUF,R4         X/ADR OF FIRST BUFFER IN FREE POOL          
*                                   .. (R6) W/FLINK CONTAINED IN THE            
*                                   .. BUFFER WE'RE RELEASING (COCBUF,R4        
*                                   .. LEFT HALF)                               
         XW,R4    COCHPB            X/ADR OF BUFFER WE'RE RELEASING (R4)        
*                                   .. W/BAL ADR (COCHPB)                       
         XW,R6    R4                X/FLINK CONTAINED IN THE BUFFER WE          
*                                   .. RELEASED (R6) W/BAL ADR (R4)             
         LH,R4    R4                RJ/FLINK CONTAINED IN THE BUFFER WE         
*                                   .. JUST RELEASED                            
         B        0,R6                                                          
         TITLE    'R E A D   R O U T I N E'                                     
************************************************************************   11030
*                                                                          11040
*       USES ALL REGISTERS                                                      
*   LINKAGE:  BAL,11  COCRD                                                11060
*        IN:                                                                    
*             R0 = OPERATION CODE                                               
*            SR1 = MAXIMUM BYTE SIZE OF MESSAGE                            11080
*            SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE           
*             R2 = LINE NUMBER OF ORIGINATING MESSAGE                           
*                                                                          11110
************************************************************************   11120
COCRD    EQU      %                                                        11130
         DO       PMONOFF=1                                                     
         BAL,4    READREQ           RECORD PERFORMANCE DATA                     
         FIN                                                                    
         PUSH     SR4               SAVE RETURN                                 
         STB,SR1  RSZ,R2            SAVE REQUESTED MESSAGE SIZE                 
         LI,R3    X'8000'                                                       
         STH,R3   TL,R2             INITIALIZE TAB LINK                         
*                 INITIALIZE MODE AS TO TRANSPARENT OR NON-TRANSPARENT          
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCS,1    COCRD20           BRANCH IF 2741                              
         FIN                                                                    
         SPACE                                                                  
*                                   ADD NEXT INSTR LATER                        
*                                                                               
         CI,R0    FCRLN             IS IT TRANSPARENT                           
         BNE      %+3               NO                                          
         LI,R0    X'20'             SET UP TO TOGGLE                            
         B        %+2                                                           
         LI,R0    0                 SET UP TO TOGGLE                            
         LI,R1    X'20'             MASK                                        
*        DISABLE                                                                
         LB,D4    MODE,R2                                                       
         CS,R0    D4                                                            
         BE       COCRD20           BRANCH IF MODE DOES NOT CHANGE              
         SPACE                                                                  
*                 CHANGE FROM TRANSPARENT TO NON-TRANS. (OR VICE-VERSA)         
         EOR,D4   R1                FLIP TRANSPARENT MODE BIT                   
         STB,D4   MODE,R2                                                       
         BAL,SR2  KILLIN            RELEASE ALL INPUT BUFFERS                   
*                 SEND PROMPT IF REQUIRED                                       
COCRD20  EQU      %                                                             
*        ENABLE                                                                 
         LB,R5    LB:UN,R2                                                      
         LB,R5    DCT6,R5                                                       
         LB,R0    IOQ4,R5           GET FUNCTION CODE                           
         CI,R0    FCRLN             IS IT TRANSPARENT                           
         BE       COCRD30           YES, DONT PROMPT                            
         LW,R5    IOQ12,R5                                                      
         LB,R5    R5                GET PROMPT CHARACTER                        
         BEZ      COCRD30           BRANCH IF NO PROMPT                         
         BAL,SR2  COCPCIB                                                       
*                 TAB BUFFER INITIALIZATION                                     
COCRD30  EQU      %                                                             
         LB,R1    LB:UN,R2                                                      
         LB,R1    DCT6,R1                                                       
         LW,R1    IOQ12,R1                                                      
         AND,R1   M8                GET JOB ID                                  
         BEZ      COCRD38           NONE                                        
         LW,R1    SJI1,R1           JCB ADDRESS                                 
         LW,R1    JCBTABS,R1        ANY TABS                                    
         BEZ      COCRD38           NO                                          
         LB,D3    *R1                                                           
         AI,R1    3                 SET UP FOR 12 TABS                          
         BEZ      COCRD38           BRANCH IF NONE                              
         LC       MODE,R2                                                       
         BCS,2    COCRD38           BRANCH IF IN TRANSPARENT TEXT MODE          
         ANLZ,R5  MUHT1             INITIALIZE R5 WITH TL AS A                  
         AI,R5    8-HA(COCBUF)      HALF-WORD DISPLACEMENT FROM COCBUF+4        
         LI,SR1   0                                                             
         LI,R7    -12               SET TO MOVE 12 TAB STOPS                    
         LC       MODE3,R2                                                      
         BCR,8    COCRD32           BRANCH IF NOT TABBING RELATIVE              
         LB,SR1   CPOS,R2                                                       
         AI,SR1   -1                                                            
         B        COCRD32                                                       
*                                                                               
COCRD36  EQU      %                                                             
         BANZ     COCRD34                                                       
         BDR,R4   COCRD35           DECRE R4.                                   
*                 PREPARE TO MOVE NEXT TAB STOP INTO TAB BUFFER                 
COCRD31  EQU      %                                                             
         AI,R4    1                 INCREMENT BUFFER POSISTION                  
         CI,R4    15                                                            
         LB,D3    *R1,R7            GET NEXT TAB STOP                           
         BEZ      COCRD36                                                       
         BANZ     COCRD33           BRANCH IF ROOM IN BUFFER FOR TAB STP        
*                 OBTAIN TAB BUFFER IN ORDER TO STORE THIS TAB STOP             
         SCD,R4   31                                                            
COCRD32  EQU      %                                                             
         BAL,R6   COCGETB           GET A BUFFER                                
         B        COCRD38           NO BUFFERS, NO TABS                         
         STH,R4   COCBUF-4,R5       LINK NEW BUFFER TO TAB BUFFER CHAIN         
*                                                                               
COCRD33  EQU      %                                                             
         AW,D3    SR1               APPLY RELATIVE TAB ADJUSTMENT               
         STB,D3   COCBUF,R4         AND STORE INTO BUFFER                       
         BIR,R7   COCRD31                                                       
         AI,R4    1                                                             
*                 TAB STOPS HAVE BEEN MOVED, FLAG END OF TABS WITH ZERO         
COCRD34  EQU      %                                                             
         STB,R3   COCBUF,R4                                                     
COCRD35  EQU      %                                                             
*        ENABLE                                                                 
         SCD,R4   28                                                            
         AI,R5    1                                                             
         SLS,R5   3                                                             
         STH,R3   COCBUF-4,R5       LINKAGE POSITION OF LAST TAB BUFFER         
         SPACE                                                                  
*                 INITIALIZE CARRIAGE POSITION AT START OF READ (CPI)           
COCRD38  EQU      %                                                             
         LB,D4    CPOS,R2                                                       
         STB,D4   CPI,R2                                                        
         STB,R3   ARSZ,R2           INITIALIZE ARSZ TO ZERO                     
         LH,R3    TL,R2             SAVE TAB LINK IN R3 FOR ACTIVATION          
         SPACE                                                                  
         DO 2741CODE=1                                                          
*                 UNLOCK 2741 KEYBOARD                                          
         BAL,SR4  2741EOT           SEND EOT TO UNLOCK 2741 KEYBOARD            
         FIN                                                                    
         SPACE                                                                  
*                 ECHO ALL CHARACTERS READ AHEAD FOR THIS RECORD                
COCRD40  EQU      %                                                             
         AND,R3   M16                                                           
*        DISABLE                                                                
         LH,R0    COCIR,R2          SET HEAD OF BUFFER POINTER FOR ECHO         
         LH,R4    COCIR,R2          INITIALIZE BUFFER POSITION FOR ECHO         
         BEZ      COCRD70           BRANCH IF NO DATA READ AHEAD                
COCRD45  EQU      %                                                             
         LI,R5    0                                                             
         STH,R5   EOMTIME,R2         EOMTIME=0 MEANS READER USING ECHO          
         LB,R5    COCBUF,R4         GET EBCDIC CHARACTER FROM BUFFER            
*        ENABLE                                                                 
         BAL,SR4  COCECHO           ECHO CHARACTER                              
         B        %+2                                                           
         OR,R3    Y8                SET TO INDICATE ACTIVATION OCCURANCE        
*        DISABLE                                                                
         CH,R0    COCIR,R2                                                      
         BE       COCRD60           BRANCH IF NO CTL-X OR CTL-Y OCCURED         
         LI,R0    0                 SET TO RELEASE READER INPUT CHAIN           
         DO       2741CODE=1                                                    
         BAL,SR1  ESCX0             RELEASE CHAIN & SEND LINE DELETE SEQ        
         ELSE                                                                   
         BAL,SR4  ESCX0             RELEASE CHAIN & SEND LINE DELETE SEQ        
         FIN                                                                    
*                                                                               
         B        COCRD40           START OVER                                  
         PAGE                                                                   
*                 ACTIVATION CHARACTER HAS BEEN RECEIVED                        
COCRD50  EQU      %                                                             
         LW,R3    R4                ACTIVATION POINT                            
         LI,R6    E:CIC             EVENT INPUT COMPLETE                        
         LW,R7    R2                LINE TO R7                                  
         BAL,SR4  T:RCE             REPORT COC EVENT                            
COCRD50E EQU      %                                                             
         B        PULLSR4           PULL SR4 & RETURN TO CALLER                 
         SPACE    3                                                             
         PAGE                                                                   
COCRD60  EQU      %                                                             
         AI,R3    0                                                             
         BLZ      COCRD50           BRANCH IF ACTIVATION OCCURED                
         CH,R4    COCII,R2                                                      
         BE       COCRD70           BRANCH IF NO MORE CHARS TO READ AHD.        
         AI,R4    1                 BUMP TO NEXT CHARACTER IN BUFFER            
         CI,R4    15                                                            
         BANZ     COCRD45           BRANCH IF STILL IN SAME BUFFER              
         SLS,R4   -1                                                            
         LH,R4    COCBUF-4,R4       LINK TO NEXT CHARACTER                      
         BNEZ     COCRD45           BRANCH IF LINK EXISTS                       
         SPACE    3                                                             
************************************************************************        
*  IF TERMINAL IS IN A PAPER TAPE MODE, TRANSMIT AN XON CHARACTER               
*  TO START THE READER.                                                         
************************************************************************        
COCRD70  EQU      %                                                             
         LI,R1    XON               L/XON CHARACTER                             
         BAL,R15  CHKPTAP           BAL/SEND XON IF IN PAPER TAPE MODE          
********************************************************************************
*                                                                               
*  ALL CURRENTLY COMPLETE INPUT RECORDS HAVE BEEN READ (GIVEN                   
*  TO USER).  REG, REPORTING COC READ EVENT.  WE COME BACK WHEN                 
*  THE READ IS SATISFIED.                                                       
*                                                                               
*  INITIALIZE TIMEOUT FOR READ.  THE SYSTEM LIMIT IS IN 1.2                     
*  SECOND INTERVALS.                                                            
*                                                                               
********************************************************************************
         LW,D3    SL:OITO           INITIALIZE D3 WITH TIMEOUT FOR READ         
         DO       #TJE                                                          
         LCF      MODECPR,R2        NONTJE                                      
         BCS,8    COCRD71           YES                                         
         BAL,D4   CHKLOGON          CHECK IF LOGON IS ASSOCIATED                
         BNE      %+2                                                           
         LW,D3    SL:OLTO           RESET D3 TO TIMEOUT FOR LOGON               
COCRD71  EQU      %                                                             
         FIN      #TJE                                                          
         STH,D3   EOMTIME,R2                                                    
         LC       MODE2,R2                                                      
         BCS,8    COCRD50           BRANCH IF LINE REPORTED OFF                 
         LB,R6    MODE,R2           SET READ PENDING FLAG                       
         AI,R6    X'10'                                                         
         STB,R6   MODE,R2           UPDATE MODE WITH READ PENDING BIT SET       
         B        COCRD50E                                                      
         SPACE    3                                                             
         TITLE    'M O V E  M E S S A G E  T O  R E A D E R'                    
************************************************************************        
*                                                                               
*                 MOVES A MESSAGE IN THE COC BUFFER TO CALLER'S BUFFER          
*                                                                               
*   LINKAGE: BAL,SR2 COCMU                                                      
*                                                                               
*        IN: R1 = SIZE OF MESSAGE TO BE MOVED                                   
*            R2 = LINE NUMBER OF ORIGINATING MESSAGE                            
*            R3 = POINTER TO END OF MESSAGE IN THE COC BUFFER                   
*            R4 = POINTER TO START OF MESSAGE IN THE COC BUFFER                 
*            SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE           
*            D3 = BYTE ADDRESS-1 OF CALLER'S BUFFER                             
*                                                                               
*    RETURN: R4 = POINTER TO END OF MESSAGE IN THE COC BUFFER                   
*            R5 = : BYTE 0 = PSEUDO 'TYC', BYTE 3 = LAST CHARACTER MOVED        
*                                                                               
*  DESTROYS: R6,SR4,D1,D2, AND D4                                               
*                                                                               
************************************************************************        
         SPACE    3                                                             
*                                                                               
*                                                                               
MOVECHAR AI,D1    1                 INCREMENT POSITION OF USER BUFFER           
         DO       2741CODE=1                                                    
         CB,D1    D1                COMPARE WITH HIGHEST POSITION MOVED         
         BG       MOVEC1            BRANCH IF HIGHER POSITION BEING MOVED       
         CI,R5    X'40'             BACK-SPACE EDITING MODE IS IN EFFECT        
         BNE      MOVEC2            BRANCH ON NON-BLANK CHARACTERS              
         B        *SR4              RETURN IF CHARACTER IS BLANK                
         FIN                                                                    
MOVEC1   STB,D1   D1                UPDATE HIGHEST POSITION MOVED               
         CS,D1    R1                                                            
         BG       *SR4              RETURN IF ARSZ HAS BEEN EXCEEDED            
MOVEC2   EQU      %                                                             
         LI,R6    1                                                             
         LH,R6    D1,R6             PUT CURRENT POSITION INTO R6                
         AW,R6    D3                COMPUTE BYTE LOCATION IN USER BUFFER        
         STB,R5   0,R6              MOVE CHARACTER TO USER'S BUFFER             
         B        *SR4              RETURN                                      
         SPACE                                                                  
*                 OUTPUT TRANSLATION TABLE YIELDS SPECIAL FLAG                  
MUSPEC   EQU      %                                                             
         BCS,4    MU4               BRANCH TO IGNORE MODE CHANGE CHAR.          
*                                                                               
         LB,R6    *SR3,R5           GET OUTPUT TRANSLATION VALUE                
         LB,R6    MUBTBL-X'20',R6                                               
         B        MUBYTE,R6         GO TO SPECIAL HANDLING ROUTINE              
MB       COM,8    AF-MUBYTE                                                     
MUBTBL   EQU      %                                                             
         MB       MUFF                                                          
         MB       MUHT                                                          
         MB       MUCRLFNL                                                      
         MB       MUCRLFNL                                                      
         MB       MUESCF                                                        
         MB       MUESCX                                                        
         MB       MURUB                                                         
         MB       MUESCR                                                        
         MB       MUESCCR                                                       
         MB       MUBRAC                                                        
         MB       MUNOTOR                                                       
         MB       MUBS                                                          
         MB       MUESCLF                                                       
         MB       MU2741LF                                                      
         MB       MUPARITY                                                      
         DO1      17                                                            
         MB       MUTBLERR                                                      
         BOUND    4                                                             
         SPACE    3                                                             
*                                                                               
         PAGE                                                                   
*                                                                               
*                 ENTRY POINT                                                   
*                                                                               
COCMU    EQU      %                                                             
         LD,D1    DM8               INITIALIZE UBUF POSITION AND MASK           
MU1      LB,R5    COCBUF,R4         GET NEXT CHARACTER FROM COC BUFFER          
         LC       MODE,R2                                                       
         BCS,2    MU3               BRANCH IF TRANSPARENT TEXT                  
         LC       *SR3,R5                                                       
         BCR,8    MU3               BRANCH IF NOT SPECIAL                       
         BCR,2    MUSPEC            BRANCH IF NOT ACTIVATION CHARACTER          
MU3      BAL,SR4  MOVECHAR          MOVE IT TO CALLER'S BUFFER                  
MU4      EQU      %                                                             
         CW,R3    R4                                                            
         BE       *SR2              RETURN IF END OF MESSAGE                    
         AI,R4    1                                                             
         CI,R4    X'F'                                                          
         BANZ     MU1               UPDATE POINTER TO COC BUFFER                
         SLS,R4   -1                                                            
         LH,R4    COCBUF-4,R4                                                   
         B        MU1                                                           
         SPACE    3                                                             
*        TTY LEFT OR RIGHT BRACKET CHARACTER                                    
MUBRAC   EQU      MU3                                                           
*                 TTY NOT OR OR CHARACTER                                       
MUNOTOR  EQU      MU3                                                           
*                                                                               
MUESCF   LW,R5    Y04               ESC F . . . TYC=6                           
*                                                                               
MUPARITY AW,R5    Y01               PARITY ERROR . . . TYC=2                    
*                                                                               
MUFF     AW,R5    Y01               FORM FEED . . . TYC(FOR RD)=1               
*                                                                               
MUCRLFNL B        *SR2              RETURN                                      
         PAGE                                                                   
         PAGE                                                                   
*                                                                               
*                 TAB CHARACTER                                                 
MUHT     EQU      %                                                             
         LC       MODE2,R2          CHECK FOR SPACE INSERTION MODE ON           
         BCR,2    MU3               BRANCH TO NORMAL PROCESS IF NOT ON          
MUHT1    LH,R6    TL,R2             CHECK FOR A TAB BUFFER                      
         BLEZ     MUHT4             BRANCH TO MOVE SINGLE BLANK IF NOT          
         INT,D4   D1                                                            
         LB,R5    CPI,R2            COMPUTE CURRENT CARRIAGE POSITION           
         AW,R5    D4                                                            
MUHT3    LB,D4    COCBUF,R6         GET VALUE OF TAB STOP                       
         BEZ      MUHT4             BRANCH TO MOVE SINGLE BLANK IF ZERO         
         CW,R5    D4                                                            
         BL       MUHT5             BRANCH IF VALID TAB STOP IS FOUND           
         AI,R6    1                                                             
         CI,R6    15                                                            
         BANZ     MUHT3             GET NEXT TAB STOP                           
         SLS,R6   -1                                                            
         LH,R6    COCBUF-4,R6       LINK TO NEXT BUFFER                         
         BGZ      MUHT3                                                         
MUHT4    LI,R5    X'40'             SET TO MOVE A BLANK TO USER                 
         B        MU3                                                           
*                 VALID TAB STOP FOUND                                          
MUHT5    SW,D4    R5                COMPUTE NUMBER OF BLANKS TO MOVE            
         LI,R5    X'40'             SET FOR INSERTING BLANKS                    
         BAL,SR4  MOVECHAR                                                      
         BDR,D4   MOVECHAR          MOVE THE CORRECT NUMBER OF BLANKS           
         B        MU4                                                           
MUBYTE   EQU      MU3               BASE ADDR OF SPECIAL MOVE HANDLERS          
MUTBLERR B        WRTBLERR          TRANSLATE TABLE ERROR                       
*                                                                               
MUESCX   EQU      MUTBLERR          ERROR IF ESC X CHARACTER                    
MUESCR   EQU      MU4               ESC 'R'  . . .  IGNORE                      
MUESCCR  EQU      MU4               ESC 'CR'  . . .  IGNORE                     
MUESCLF  EQU      MU4               ESC 'LF'  . . .  IGNORE                     
         DO       2741CODE=1                                                    
MU2741LF EQU      MU3               2741 'LF', HANDLE AS NORMAL CHAR.           
         ELSE                                                                   
MU2741LF EQU      MUTBLERR          ERROR IF 2741 LINE FEED (INDEX KEY)         
         FIN                                                                    
         DO       2741CODE=1                                                    
*                                                                               
*                 BACKSPACE CHARACTER                                           
MUBS     LC       MODE3,R2          CHECK OVERSTRIKE EDIT MODE FLAG             
         BCR,2    MUBS2             BRANCH IF OFF                               
*                 OVER-STRIKE EDITING MODE IS ON                                
         CB,D1    D2                CHECK FOR USER BUFFER POSITION = 0          
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS IS ZERO        
         AI,D1    -1                DECREMENT USER BUFFER POSITION              
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS           
         DO       2741ARUB=1                                                    
MUBS2    EQU      %                                                             
         CI,R5    X'18'                                                         
         BNE      MU3               BRANCH IF NOT 2741 CANCEL (UC'BS')          
         ELSE                                                                   
MUBS2    EQU      MU3                                                           
         FIN                                                                    
*                                                                               
*                 RUB-OUT CHARACTER                                             
MURUB    LC       MODE3,R2          CHECK OVER-STRIKE EDIT MODE FLAG            
         BCS,2    MURUB1            BRANCH IF ON                                
         ELSE                                                                   
MUBS     EQU      MUTBLERR                                                      
MURUB    EQU      %                                                             
         FIN                                                                    
         CB,D1    D2                CHECK FOR USER BUFFER POSITION = 0          
         BEZ      MU4               BRANCH TO IGNORE CHAR IF POS = ZERO         
         SW,D1    X1000001          DECREMENT BUFFER POSITIONING INFO           
         LI,R5    X'40'             BLANK CHARACTER                             
         BAL,SR4  MOVECHAR          MOVE IT                                     
         SW,D1    X1000001          AND REDECREMENT                             
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS           
         DO       2741CODE=1                                                    
MURUB1   AI,D1    1                 OVER-STRIKE EDITING, BUMP UBUF POS          
         LI,R5    X'40'             MOVE BLANK TO CALLER'S BUFFER               
         BAL,SR4  MOVEC2                                                        
         B        MU4               BRANCH TO GET NEXT COC BUFFER POS           
         FIN                                                                    
*                                                                          11740
*                                                                          11750
*                                                                          11760
         TITLE    'W R I T E   R O U T I N E'                                   
************************************************************************   11780
*                                                                          11790
*   USES ALL REGISTERS                                                          
*                                                                               
*   LINKAGE:  BAL,11  COCWR                                                11810
*          IN: R2 = LINE NUMBER                                                 
*              R7 = BYTE ADDRESS OF USER BUFFER - ONE                           
*             SR1 = MAXIMUM BYTE SIZE OF MESSAGE                                
*             SR3 = OUTPUT TRANSLATION TABLE ASSOCIATED WITH THIS LINE          
*                                                                               
************************************************************************   11820
COCWR    EQU      %                                                        11830
         DO       PMONOFF=1                                                     
         MTW,1    C:CTW             BUMP COUNT OF TERMINAL WRITES               
         FIN                                                                    
         LW,R0    SR1                                                           
         PUSH     SR4               SAVE RETURN ADDRESS                         
COCWR1   EQU      %                                                             
COCWR2   EQU      %                                                             
COCWR4   EQU      %                                                             
         AW,R7    R0                POINT R7 AT END OF USER'S BUFFER            
         LB,R4    LB:UN,R2          GET DCT INDEX                               
         LB,R4    DCT18,R4          GET IOQ INDEX                               
         LB,R4    IOQ4,R4           GET FUNCTION                                
         CI,R4    FCWLN             IS IT TRANSPARENT                           
         BE       COCWR8            YES                                         
         CI,R4    FCWKP             DRC                                         
         BE       COCWR8            YES                                         
COCWR5   LB,SR2   0,R7                                                          
         BEZ      %+3               SKIP BLANKS OR ZERO                         
         AI,SR2   -X'40'                                                        
         BNEZ     COCWR8            BRANCH ON NON-BLANK CHARACTER               
         AI,R7    -1                ADJUST COUNTS TO REFLECT TRAILING           
         BDR,R0   COCWR5            BLANKS THAT WILL NOT BE TRANSMITTED         
         AI,R7    1                 BUFFER IS ALL BLANKS, SEND 1                
         AI,R0    1                                                             
*                                                                               
COCWR8   EQU      %                                                             
         SW,R7    R0                REPOSITION R7 TO BA(UBUF)-1                 
         LW,SR1   R0                UPDATE ARS                                  
COCWR8A  EQU      %                                                             
         AI,R7    1                 POINT R7 TO 1ST POS OF USER'S BUF           
         CI,R4    FCWLN             IS IT TRANSPARENT                           
         BNE      COCWR30           NO                                          
         LB,R5    0,R7              GET NEXT CHARACTER                          
         BAL,SR2  COCSENDT          SEND                                        
         BDR,R0   COCWR8A           LOOP                                        
         B        PULLSR4           GO EXIT                                     
COCWR30  EQU      %                                                             
COCWR38  EQU      %                                                             
*                 PROCESS CHAR'S FROM USER BUFFER INTO OUTPUT BUFFERS           
COCWR40  EQU      %                                                             
         LB,R5    0,R7                                                          
         BNEZ     %+2               IS IT NUL                                   
         LI,R5    RUBOUT            YES, SEND RUBOUT                            
         LI,SR2   COCWR70                                                       
         LC       *SR3,R5                                                       
         BCR,8    COCWR95           B/NOT SPEC CHAR                             
         BCS,6    COCPCIB                                                       
         LB,R4    *SR3,R5                                                       
         LB,R4    WRBTBL-X'20',R4                                               
         B        WRBYT,R4                                                      
*                                                                               
*                                                                               
WRBTBL   EQU      %                                                             
WB       COM,8    AF-WRBYT                                                      
         WB       COCWRFF           FF                                          
         WB       COCWRHT           HT                                          
         WB       COCWRNL           CR,LF                                       
         WB       COCWRNL           NL                                          
         DO1      5                                                             
         WB       COCWR70           ESCF,XC,RUB,ESCR,ESCCR                      
         WB       COCPCIB           BRACKETS                                    
         WB       COCPCIB           NOT,OR                                      
         WB       COCWRBS           BS                                          
         WB       COCWR70           ESCLF                                       
         WB       COCWRNDX          2741 INDEX                                  
         WB       COCPCIB           PARITY ERROR                                
         DO1      17                                                            
         WB       WRTBLERR          TRANSLATE TABLE ERROR                       
         BOUND    4                                                             
WRBYT    EQU      %                                                             
COCWRHT  EQU      %                                                             
         LI,R5    X'40'                                                         
         BAL,SR2  COCPCIB           SEND BLANKS                                 
         B        COCWR70                                                       
*                                                                               
SENDBYT  EQU      %                                                             
WRTBLERR EQU      %                                                             
SETBLERR EQU      %                                                             
TTABERR  EQU      SETBLERR                                                      
         SCREECH  X'11'             SCREECH .11                                 
COCNL    EQU      %                                                             
         LI,R5    X'15'             SET TO SEND 'NEW LINE'                      
COCWRNL  EQU      %                                                             
         LI,SR4   WRNLA             SET RETURN ADDRESS FOR SEND                 
WRNL     EQU      %                                                             
         XW,SR2   SR4               SET RETURN ADDRESS'S                        
         B        COCSEND1                                                      
WRNLA    EQU      %                                                             
         LI,SR2   1                                                             
         STB,SR2  CPOS,R2           SET CARRIAGE POSITION TO 1                  
WRNLB    EQU      %                                                             
         B        *SR4                                                          
COCWRNDX EQU      %                                                             
         LI,SR4   WRNLB             SET RETURN ADDRESS FOR SEND                 
         B        WRNL                                                          
COCWRBS  EQU      %                                                             
         LB,R4    CPOS,R2                                                       
         AI,R4    -1                                                            
         BLEZ     COCWR70           BRANCH TO IGNORE BACKSPACE                  
         MTB,-1   CPOS,R2           DECREMENT CARRIAGE POSITION                 
         B        COCSEND1                                                      
*                                                                               
COCWRFF  EQU      %                                                             
COCWR70  LB,R5    0,R7                                                          
         AI,R7    1                 INCREMENT BYTE POINTER                      
*                                   .. LOCK-OUT, DISABLE COC INTS, SET          
*                                   .. COCTIME LOCK-OUT FLAG                    
COCWR74  EQU      %                                                             
         BDR,R0   COCWR40           GET NEXT (IF ANY)                           
COCWR80  EQU      %                                                             
         LI,SR2   COCWR81           SET RETURN ADDR FOR COCNL                   
         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                                                           
         LB,R7    LB:UN,R2                                                      
         LB,R7    DCT18,R7          OUTPUT QUEUE                                
         LB,R7    IOQ4,R7           FUNCTION                                    
         CI,R7    FCWKP             WITH DRC                                    
         BNE      COCNL             BRANCH IF NOT SPACE SUPPRESSION             
COCWR81  EQU      %                                                             
COCWR801 EQU      %                                                             
         LB,R4    COCOC,R2          ANY ACTION ON LINE                          
         BNEZ     PULLSR4           YES                                         
         LI,R5    RUBOUT            CREATE SOME                                 
         BAL,SR2  COCSEND2          BY SENDING RUBOUT                           
PULLSR4  EQU      %                                                             
         PULL     SR4               PULL RETURN                                 
         B        *SR4              RETURN                                      
NOCR     EQU      %                                                             
         DATA     X'1620150D'         SYNC , SPC LF,   LF  ,   CR               
LNOCR    EQU      %                                                             
NNOCR    EQU      BA(%)-BA(NOCR)                                                
         BOUND    4                                                             
COCWR95  EQU      %                                                             
         CI,R0    1                 C/(REMAINING CHAR CNT + 1) W/1              
         BNE      COCPCIB           BNE; NOT LAST CHAR                          
         CI,R5    SYN               C/LAST CHAR W/SYN                           
         BE       COCWR81           BE; DON'T BUFFER OR XMIT; IGNORE            
         TITLE    ' PLACE CHAR. IN BUFFER ROUTINE '                             
*        CALL     BAL,SR2 COCSEND1,COCSENDT  FOR SEND, NO CHECK.                
*        CALL     BAL,SR2 COCPCIB   FOR LINEATION AND PAGINATION CHECKS.        
*                                                                               
*        INPUT:                                                                 
*                 R2 = LOGICAL LINE NUMBER                                      
*                 R5 = CHAR TO STORE                                            
*                 SR3 = XLATE TBL, BYTE 0=1 FOR CHECKING O/P BLOCK LIMITS       
*        USES:    REGISTER R6                                                   
*                                                                               
*        MAY BE USED RECURSIVELY.                                               
*                                                                               
COCPCIB  EQU      %                                                             
         CI,R5    X'40'                                                         
         BL       COCSEND1          DON'T POSITION CTL CHARACTERS               
         LB,R6    COLUMNS           PLATEN SIZE                                 
         CI,R6    12                DONT BUST LINES < 12                        
         BL       PCIB1                                                         
         CB,R6    CPOS,R2           OR IF CPOS < JB:PCW                         
         BGE      PCIB1                                                         
*                                   MUST BREAK UP LINE - SEE ABOUT PAGE         
         PUSH     7,R5              SAVE CHARACTER AND LINKAGES                 
         BAL,SR2  COCNL                                                         
         PULL     7,R5              RESTORE                                     
PCIB1    MTB,1    CPOS,R2           RESET CPOS                                  
*                                                                               
*                                                                               
COCSEND1 EQU      %                 NORMAL ENTRY TO BUFFER CHAR(AND TRANSLATE)  
         LC       MODE3,R2          DO NOT SEND IF                              
         BCS,4    *SR2                  ESCP + (XON.ESCE NOT)                   
         LC       MODE2,R2                                                      
         BCR,4    %+3                                                           
         LC       MODE,R2                                                       
         BCR,8    *SR2                                                          
*                                                                               
COCSEND2 EQU      %                 ALT ENTRY TO BUFFER CHAR(AND TRANSLATE)     
COCSENDX EQU      %                                                             
         PUSH     6,R4              PRESERVE REGISTERS                          
*                                                                               
SENDXL   EQU      %                                                             
         LW,R6    R5                                                            
         LB,R5    *SR3,R5                                                       
         CI,R5    X'80'                                                         
         BAZ      SENDNORM          NO SPECIAL CHAR                             
         CI,R5    X'20'                                                         
         BAZ      %+3                                                           
         AND,R5   M6                RETRANSLATE SITUATION                       
         B        SENDXL                                                        
         LB,R4    SENDTAB-X'20',R5  OFFSET TO GO ROUTINE                        
         CI,R5    X'40'                                                         
         BAZ      SENDBYT,R4        USED IF NOT TOGGLE                          
SENDXIT  EQU      %                                                             
         PULL     6,R4              RESTORE                                     
         B        *SR2                                                          
*                                                                               
*                                                                               
SENDTAB  EQU      %                                                             
SB       COM,8    AF-SENDBYT                                                    
         SB       SENDNOP           FF                                          
         SB       SENDHT            HT                                          
         SB       SENDCR            CR,LF                                       
         SB       SENDNL            NL                                          
         DO1      5                                                             
         SB       SENDNOP           ESCF,XC,RUB,ESCR,ESCCR                      
         SB       SENDBRAC          BRACKETS                                    
         SB       SENOTOR           NOT,OR                                      
         SB       SENDBS            BS                                          
         SB       SENDXIT           ESCLF                                       
         SB       SENDNDX           2741 INDEX                                  
         SB       SENDPER           PARITY ERROR                                
         DO1      17                                                            
         SB       SETBLERR                                                      
         BOUND    4                                                             
*                                                                               
*                                                                               
*                                                                               
*                                                                               
SENDCR   EQU      %                                                             
SENDNL   EQU      %                                                             
         BAL,R9   SIBCR             SEND IDLES BEFORE CARRIAGE RETURN           
         LI,R5    X'29'             L/CR CODE                                   
         BAL,R9   COCSEND2          SEND CR                                     
         DO       2741CODE=1                                                    
         LC       MODE2,R2                                                      
         BCS,1    SIACR1            SEND IDLES AFTER CR CHAR                    
         FIN                                                                    
SENDNDX  EQU      %                                                             
         LI,R5    X'2E'             L/LINE FEED CODE                            
         BAL,R9   COCSEND2          SEND LF                                     
         CI,R6    X'20'                                                         
         BE       SEND1I1           SEND 1 IDLE IF LINE FEED ONLY               
         B        SIACR1            SEND IDLES AFTER CARRIAGE RETURN            
SENDNOP  B        SENDXIT                                                       
SENDHT   LI,R5    X'40'                                                         
         LB,SR2   COCTERM,R2                                                    
         BEZ      SENDXL            BRANCH IF MODEL 33 TELETYPE                 
         AI,SR2   -3                                                            
         BEZ      SENDXL            BRANCH IF MODEL 7015 TELETYPE               
         AI,R5    1                 FOR CHANGING '81' TO '2D'                   
SENDPER  EQU      %                                                             
         AI,R5    X'4C'             FOR CHANGING '8E' TO '7A'                   
SENDBS   EQU      %                                                             
         AI,R5    -X'60'            FOR CHANGING '8B' TO '2B'                   
         B        SENDXL                                                        
SENDBRAC EQU      %                                                             
         AI,R6    8                 CHANGE 'B4','B5' TO 'BC','BD'               
SENBR1   EQU      %                                                             
         LW,R5    R6                                                            
         B        SENDXL            RETRANSLATE                                 
*                                                                               
SENOTOR  EQU      %                                                             
         AI,R6    X'60'             CHANGE '4F','5F' TO 'AF','BF'               
         LB,SR2   COCTERM,R2                                                    
         AI,SR2   -3                                                            
         BNEZ     SENBR1            BRANCH IF NOT 7015 TELETYPE                 
         SLS,R6   -4                                                            
         AI,R6    X'B2'             CHANGE '4F','5F' TO 'BC','BD'               
         B        SENBR1                                                        
*                                                                               
*                                                                               
*                                                                               
SENDNORM EQU      %                                                             
         DO 2741CODE=1                                                          
         LC       MODE2,R2          CHECK 2741                                  
         BCS,1    SENDCMN           BRANCH IF 2741                              
         FIN                                                                    
         SCS,R5   32                                                            
         BEV      %+2                                                           
         AI,R5    X'80'             MAKE PARITY EVEN                            
SENDCMN  EQU      %                                                             
         LI,R6    SENDNXTI          SET RETURN ADDRESS FOR SENCKOC              
         SPACE    2                                                             
SENCKOC  EQU      %                                                             
*        DISABLE                                                                
         LB,R4    COCOC,R2                                                      
         BEZ      SENCKLOK          BRANCH IF NO ACTION ON LINE                 
         CI,R4    255                                                           
         BNE      CKOC2             BR IF OUTPUT COUNT IS NOT AT MAXIMUM        
CKOC1    EQU      %                                                             
         B        SENDBLK2                                                      
CKOC2    EQU      %                                                             
         LH,R4    COCOR,R2                                                      
         BNEZ     0,R6              RETURN IF OUTPUT CHAIN EXISTS               
*                 INITIATE AN OUTPUT BUFFER CHAIN FOR THIS USER                 
SENDGFB  EQU      %                                                             
         BAL,R6   COCGETB           GET A BUFFER                                
         B        SENDBLK1          BRANCH IF NO BUFFERS ARE AVAILABLE          
         STH,R4   COCOR,R2          SET REMOVAL POINT                           
         B        SENDSIP           BRANCH TO SET INSERT POINT                  
*                 OBTAIN INSERT POINT FOR OUTPUT CHARACTER                      
SENDNXTI EQU      %                                                             
         LH,R4    COCOI,R2                                                      
         AI,R4    1                 BUMP INSERT POINT                           
         CI,R4    X'F'              SEE IF BUF FULL                             
         BANZ     SENDSIP           BRANCH IF ROOM IN BUFFER                    
*                 CURRENT OUTPUT BUFFER IS FULL, GET ANOTHER                    
         PUSH     R4                SAVE OLD BUFFER ADDRESS                     
         BAL,R6   COCGETB           GET A BUFFER                                
         B        SENDBLOK          BLOCK USER IF NONE ARE AVAILABLE            
         PULL     R6                                                            
         SLS,R6   -1                BACK TO BUF                                 
         STH,R4   COCBUF-4,R6       SET LINK                                    
*                 UPDATE INSERT POINT AND PUT CHAR IN BUFFER                    
SENDSIP  STH,R4   COCOI,R2          SET INSERT POINT                            
         STB,R5   COCBUF,R4         PUT BYTE IN LINE BUF                        
SENDINC  MTB,1    COCOC,R2          INC COUNT                                   
         B        SENDXIT                                                       
*                 BUFFER IS UNAVAILABLE, REG IF USER CAN BE BLOCKED             
SENDBLOK EQU      %                                                             
         PULL     R4                                                            
SENDBLK1 EQU      %                                                             
SENDBLK2 EQU      %                                                             
         B        SENDXIT           BRANCH                                      
*                                                                               
*                 CHECK 2741 TERMINALS FOR LOCKED KEYBOARDS                     
SENCKLOK EQU      %                                                             
         DO 2741CODE=1                                                          
         LC       MODE2,R2                                                      
         BCR,1    SENDIT            TTY OK                                      
         BCS,8    %+3               2741 - BRANCH IF LINE REPORTED OFF          
         LC       MODE3,R2                                                      
         BCR,1    SENDGFB           2741 - BUF CHAR IF KB NOT LOCKED.           
         LW,R7    R5                                                            
         BAL,SR2  2741DEL           TRANSMIT A 2741 DELETE                      
         LW,R5    R7                                                            
         B        SENDGFB           BUFFER FIRST CHAR                           
         FIN                                                                    
SENDIT   LI,SR2   SENDINC           SET RETURN ADDRESS FOR XMIT                 
*                 TRANSMIT CHARACTER TO TERMINAL                                
SENDXMIT EQU      %                                                             
         LW,R6    R5                                                            
         SLS,R6   8                 CHARACTER ALIGNED IN R6                     
         LI,R4    -1                                                            
         AI,R4    1                 STEP TO NEXT 7611                           
         CLM,R2   COD:LPC,R4                                                    
         BCS,9    %-2               NOT HERE, TRY NEXT                          
         LD,R5    COD:LPC,R4        LOG LIMS FOR 7611                           
         AW,R6    R2                                                            
         SW,R6    R5                CONVERT LINE # TO PHYS                      
         EXU      CO:XDATA,R4       GO                                          
         B        *SR2                                                          
         TITLE    'T I M I N G   A L G O R I T H M S'                           
SIBCR    EQU      %                 SEND IDLES BEFORE CARRIAGE RETURN           
         PUSH     6,R4                                                          
SIBCR1   EQU      %                                                             
         LI,R6    IDBCR                                                         
         B        IDLE1                                                         
*                                                                               
SIACR    EQU      %                 SEND IDLES AFTER CR                         
         PUSH     6,R4                                                          
SIACR1   EQU      %                                                             
         LI,R6    IDACR                                                         
         B        IDLE1                                                         
*                                                                               
SIAT     EQU      %                 SEND IDLES AFTER TAB                        
         PUSH     6,R4                                                          
         LI,R6    IDAT                                                          
*                                                                               
IDLE1    EQU      %                                                             
         LC       MODE3,R2                                                      
         BCS,4    SENDXIT           B/HALF DUPLEX PAPER TAPE                    
         LC       MODE2,R2                                                      
         BCR,4    %+3               B/NOT FULL DUPLEX PAPER TAPE MODE           
         LC       MODE,R2                                                       
         BCR,8    SENDXIT           B/ECHOPLEX OFF                              
         LB,R4    MODE4,R2          L/MODE4; ALGORITHM #, LINE SPEED            
         SLD,R4   -3                SHIFT SPEED FROM R4 INTO R5                 
         SLS,R5   -29               RJ/SPEED                                    
         AND,R4   M3                MASK ALGORITHM #                            
IDLE20   EQU      %                                                             
         LB,R7    *R6,R4            ALGORITHM DISPLACEMENT FROM SENDIDLE        
         B        SENDIDLE,R7       B/APPROPOS IDLE ROUTINE                     
         PAGE                                                                   
*                                                                               
ID       COM,8    AF-SENDIDLE                                                   
*                                                                               
********************************************************************************
*                                                                               
*  FOLLOWING ENTRIES SEND IDLE BEFORE CR                                        
*                                                                               
********************************************************************************
         BOUND    4                                                             
IDBCR    EQU      %                                                             
         ID       IDLXIT            ALGORITHM 0 - BEFORE CARRIAGE RETURN        
         ID       IDLXIT            ALGORITHM 1 - BEFORE CARRIAGE RETURN        
         ID       IDLXIT            ALGORITHM 2 - BEFORE CARRIAGE RETURN        
         ID       ID3BC             ALGORITHM 3 - BEFORE CARRIAGE RETURN        
         ID       ID4BC             ALGORITHM 4 - BEFORE CARRIAGE RETURN        
         ID       IDLXIT            ALGORITHM 5 - BEFORE CARRIAGE RETURN        
         ID       IDLXIT            ALGORITHM 6 - BEFORE CARRIAGE RETURN        
         ID       IDLXIT            ALGORITHM 7 - BEFORE CARRIAGE RETURN        
         BOUND    4                                                             
********************************************************************************
*                                                                               
*  FOLLOWING ENTRIES SEND IDLE AFTER CR                                         
*                                                                               
********************************************************************************
IDACR    EQU      %                                                             
         ID       IDLXIT            ALGORITHM 0 - AFTER CARRIAGE RETURN         
         ID       ID1AC             ALGORITHM 1 - AFTER CARRIAGE RETURN         
         ID       ID2AC             ALGORITHM 2 - AFTER CARRIAGE RETURN         
         ID       IDLXIT            ALGORITHM 3 - AFTER CARRIAGE RETURN         
         ID       ID4AC             ALGORITHM 4 - AFTER CARRIAGE RETURN         
         ID       ID5AC             ALGORITHM 5 - AFTER CARRIAGE RETURN         
         ID       IDLXIT            ALGORITHM 6 - AFTER CARRIAGE RETURN         
         ID       IDLXIT            ALGORITHM 7 - AFTER CARRIAGE RETURN         
         BOUND    4                                                             
         PAGE                                                                   
********************************************************************************
*                                                                               
*  FOLLOWING ENTRIES SEND IDLE AFTER TAB                                        
*                                                                               
********************************************************************************
IDAT     EQU      %                                                             
         ID       IDLXIT            ALGORITHM 0 - AFTER TAB CHARACTER           
         ID       ID1AT             ALGORITHM 1 - AFTER TAB CHARACTER           
         ID       ID2AT             ALGORITHM 2 - AFTER TAB CHARACTER           
         ID       ID3AT             ALGORITHM 3 - AFTER TAB CHARACTER           
         ID       ID4AT             ALGORITHM 4 - AFTER TAB CHARACTER           
         ID       ID5AT             ALGORITHM 5 - AFTER TAB CHARACTER           
         ID       IDLXIT            ALGORITHM 6 - AFTER TAB CHARACTER           
         ID       IDLXIT            ALGORITHM 7 - AFTER TAB CHARACTER           
         BOUND    4                                                             
         PAGE                                                                   
SENDIDLE EQU      %                                                             
*                                                                               
SEND1I   EQU      %                 SEND ONE IDLE                               
         PUSH     6,R4                                                          
SEND1I1  EQU      %                                                             
         LI,R4    1                 SET # OF IDLES TO 1                         
         B        IDLE3                                                         
*                                                                               
ID2AC    EQU      %                                                             
ID4AC    EQU      %                                                             
         LB,R4    IDV1,R5           # OF IDLES TO SEND                          
         B        IDLE2                                                         
*                                                                               
ID5AC    EQU      %                                                             
         LB,R4    CPOS,R2           L/CARRIAGE POSITION                         
ID5AC1   AI,R4    15                +15 TO MOVEMENT IN COLUMNS                  
         DH,R4    IDV4,R5           DIVIDE; IF 2741 (ALGO 1), IDLES =           
*                                   .. COLUMNS / 10 ROUNDED UP + 1              
         B        IDLE2             B; SEND IDLES IF # > 0                      
*                                                                               
ID3BC    EQU      %                                                             
ID4BC    EQU      %                                                             
         LB,R4    IDV2,R5           L/MINIMUM # OF CHARACTERS                   
         LB,R5    CPOS,R2           L/CARRIAGE POSITION                         
         SW,R4    R5                # IDLES = MIN - CPOS                        
IDLE2    EQU      %                                                             
         BLEZ     SENDXIT           EXIT IF # IDLES NOT > 0                     
IDLE3    EQU      %                                                             
         LI,R5    RUBOUT            L/RUBOUT CHAR; USE FOR TIMING               
         DO       2741CODE                                                      
         LC       MODE2,R2          CHECK FOR 2741                              
         BCR,1    %+2               B/NOT 2741                                  
         LI,R5    SYN               L/SYN CHAR; 2741 TIMING CHAR                
         FIN                                                                    
         BAL,R9   COCSEND2          SEND IDLES                                  
         BDR,R4   COCSEND2                                                      
IDLXIT   EQU      %                                                             
         B        SENDXIT                                                       
*                                                                               
ID5AT    EQU      %                                                             
         LW,R4    R13                                                           
         B        ID5AC1                                                        
*                                                                               
ID2AT    EQU      %                                                             
ID3AT    EQU      %                                                             
ID4AT    EQU      %                                                             
         LB,R4    IDV3,R5                                                       
         B        IDLE2                                                         
ID1AT    EQU      %                                                             
ID1AC    EQU      %                                                             
         LI,R5    HA(Y000A)-HA(IDV4)    L/FUDGE FACTOR TO GET US                
*                                   .. FROM IDV4 TO A LITERAL 10                
         LI,R4    5                 L/5; USE AS ALGORITHM NUMBER                
         B        IDLE20            CONTINUE AS ALGO 5                          
         SPACE    1                                                             
********************************************************************************
*                                                                               
*  THIS TABLE CONTAINS THE NUMBER OF IDLES TO SEND FOLLOWING CR.                
*  THE TABLE IS INDEXED BY RATE.                                                
*                                                                               
*  IT IS USED BY IDLE ALGORITHMS 2 AND 4.                                       
*                                                                               
********************************************************************************
IDV1     EQU      %                                                             
         DATA,1   1,4,8,12                                                      
         DATA,1   16,16,16,16                                                   
         BOUND    4                                                             
         PAGE                                                                   
********************************************************************************
*                                                                               
*  THIS TABLE CONTAINS THE MINIMUM NUMBER OF CHARACTERS THAT MUST BE            
*  SENT PRIOR TO A CR.  THEREFORE, THE NUMBER OF IDLES TO SEND BEFORE           
*  A CR IS CPOS-IDV2(RATE).                                                     
*                                                                               
*  THIS TABLE IS USED BY IDLE ALGORITHMS 3 AND 4.                               
*                                                                               
********************************************************************************
IDV2     EQU      %                                                             
         DATA,1   7,10,20,40                                                    
         DATA,1   40,40,40,40                                                   
         BOUND    4                                                             
************************************************************************        
*                                                                               
*  THIS TABLE CONTAINS THE NUMBER OF IDLES TO SEND FOLLOWING A TAB.             
*  THE TABLE IS INDEXED BY RATE.                                                
*                                                                               
*  USED BY ALGORITHMS 2, 3, AND 4.                                              
*                                                                               
************************************************************************        
IDV3     EQU      %                                                             
         DATA,1   1,1,2,4                                                       
         DATA,1   8,8,8,8                                                       
         BOUND    4                                                             
         PAGE                                                                   
************************************************************************        
*                                                                               
*  THIS TABLE CONTAINS ENTRIES THAT ARE DIVIDED INTO A COMPUTED                 
*  DISPLACEMENT AS FOLLOWS:                                                     
*                                                                               
*     # IDLES = (MOVEMENT IN COLUMNS + 15) / IDV4(RATE)                         
*                                                                               
*  THIS TABLE IS USED BY IDLE ALGORITHM 5.                                      
*                                                                               
************************************************************************        
IDV4     EQU      %                                                             
         DATA,2   60,50,18,15                                                   
         DATA,2   3,3,3,3                                                       
         BOUND    4                                                             
         TITLE    'PLACE CHAR. IN BUFFER ROUTINE'                               
*                                                                               
*                 SENDS CHARACTER TRANSPARENT (WITH NO TRANSLATION)             
COCSENDT EQU      %                                                             
         PUSH     6,R4              PRESERVE REGISTERS                          
         B        SENDCMN                                                       
*                                                                               
*                 SENDS CHARACTER IN R5 TO TERM IN FRONT OF QUEUED OUTPUT       
*                 IF POSSIBLE.                                                  
COCSUF   EQU      %                                                             
         PUSH     6,R4                                                          
         SCS,R5   32                SHIFT; CHECK PARITY                         
         BEV      %+2               B/EVEN; OK                                  
         AI,R5    X'80'             ODD, SET .80 BIT, MAKE EVEN                 
         BAL,R6   SENCKOC           CHECK OUTPUT COUNT, ETC.                    
         AI,R4    -1                BACK-UP BUFFER                              
         CI,R4    X'E'                                                          
         BANZ     COCSUF1           BRANCH IF BUF POS IS VALID                  
         BAL,R6   COCGETB           GET A BUFFER                                
         B        CKOC1             BRANCH IF NONE ARE AVAILABLE                
         AI,R4    -2                POS TO FRONT OF BUFFER OBTAINED             
         LH,R6    COCOR,R2                                                      
         SLS,R4   -1                                                            
         STH,R6   COCBUF,R4         LINK BUFFER TO FRONT OF CHAIN               
         SLS,R4   1                                                             
         AI,R4    15                POINT R4 TO LAST POS OF BUF OBTAINED        
COCSUF1  EQU      %                                                             
         STH,R4   COCOR,R2          UPDATE REMOVAL POINT                        
         B        SENDSIP+1         BRANCH TO INSERT CHAR IN BUF                
         TITLE    'P A G E   H E A D I N G   R O U T I N E'                     
         TITLE    ' COMMON CODE FOR READ AND WRITE '                            
         TITLE    'A U T O H A N G U P - - C A L L U P  R O U T I N E'          
*                                                                               
*                 CALLED FROM CLOCK4 EVERY 5 SECONDS                            
*                                                                               
*        CALL:      BAL,R8   COCTIME                                            
*                                                                               
COCTIME  EQU      %                                                             
         MTW,1    CO:INTFL          INCR COCTIME BY-PASS COUNT                  
         LH,R3    CO:INTFL          L/LH OF CO:INTFL                            
         BNEZ     *R8               BNEZ; WE'VE INTERRUPTED COC PROCESSING      
         PUSH     R8                SAVE BAL REGISTER                           
         LI,R5    LCOC              INITIALIZE REG 5 TO LAST 7611 NUMBER        
COCHC0   EQU      %                                                             
         LH,R7    COH:DN,R5         L/DEVICE ADR FOR THIS COC                   
         TIO,0    0,R7              TIO COC; SEE IF THIS COC IS RUNNING         
         BCS,8    COCHC9            B/ADR NOT RECOGNIZED; COC NOT OPERAT        
         BCR,4    COCHC9            B/SIO POSSIBLE; COC NOT RUNNING             
         LD,SR1   COD:HWL,R5        GET HARDWIRE BITS IN SR1&SR2                
         LD,R6    COD:LPC,R5        RANGE OF LOGICAL LINES ON 7611              
         SW,R6    R7                                                            
         LCW,SR3  R6                LAST PHYSICAL LINE INTO SR3                 
         LI,R6    X'301'            SET UP SCD                                  
         AW,R6    SR3               AND                                         
         SCD,SR1  *R6               ALIGN                                       
COCHC1   EQU      %                                                             
         SCD,SR1  -1                BIT 0 OF SR1 IS HDWIRE BIT FOR TERM         
         LI,SR4   2                                                             
         LW,R2    R7                L/LINE # FOR 2741DEL, CHKLOGON, COCM        
COCHC2   EQU      %                                                             
         EXU      CO:STAT,R5        SENSE RECEIVER STATUS                       
         BCS,1    COCHC5            BRANCH IF RECEIVER IS ON                    
         BDR,SR4  COCHC2                                                        
         LB,R6    LB:UN,R7          USER NUMBER                                 
         BEZ      COCHC8            BRANCH IF NO USER ON THIS LINE              
         LC       MODE2,R7                                                      
         BCS,8    COCHC81           LINE IS OFF.                                
         DO 2741CODE=1                                                          
         BCR,1    COCHC26                                                       
         STB,SR4  COCTERM,R7        DISABLE AUTO LOGON                          
         FIN                                                                    
COCHC26  EQU      %                                                             
         LB,R11   MODE2,R7                                                      
         OR,R11   X80                                                           
         STB,R11  MODE2,R7          SET OFF BIT                                 
         LI,R6    E:OFF             SET TO REPORT 'OFF' EVENT                   
COCHC28  EQU      %                                                             
         BAL,SR4  T:RCE             REPORT EVENT                                
COCHC8   EQU      %                                                             
         AI,R7    -1                NEXT LOGICAL LINE                           
         AI,SR3   -1                NEXT PHYSICAL LINE                          
         BGEZ     COCHC1            CONTINUE FOR ALL LINES ON THIS COC          
COCHC9   EQU      %                                                             
         AI,R5    -1                DECREMENT 7611 NUMBER                       
         BGEZ     COCHC0            BRANCH AFTER ALL 7611'S PROCESSED           
*                                                                               
*                                   .. RETURN WITH INHIBITS OFF                 
HCXIT    EQU      %                                                             
         LI,R8    0                 L/0                                         
         STW,R8   CO:INTFL          RESET COCTIME LOCK-OUT FLAG                 
         PULL     R8                PULL RETURN ADR                             
         B        *SR1                                                          
*                                                                               
COCHC81  EQU      %                                                             
         DO       2741CODE=1                                                    
         LC       MODE2,R7                                                      
         BCR,1    COCHC8            B/NOT 2741                                  
         BCR,8    COCHC65           B/NOT REPORTED OFF                          
         LH,SR4   COCOR,R7          BUFFS EXIST??                               
         BEZ      COCHC8                                                        
         PUSH     SR2                                                           
         PUSH     R5                PUSH R5                                     
         BAL,SR2  2741DEL           START OUTPUT.                               
         PULL     R5                PULL R5                                     
         PULL     SR2                                                           
         FIN                                                                    
         B        COCHC8                                                        
*                                                                               
COCHC5   EQU      %                                                             
         LW,SR1   SR1               HARDWIRE BIT TO CC4                         
         BCS,1    COCHC81           B/ IF HARDWIRED                             
         LB,R6    LB:UN,R7                                                      
         BEZ      COCHC5A                                                       
         DO       #TJE                                                          
         LCF      MODECPR,R7        NONTJE                                      
         BCS,8    COCHC7                                                        
         LB,R6    DCTTJE,R6                                                     
         BNEZ     COCHC7            BRANCH IF USER EXISTS FOR THIS LINE         
         ELSE     #TJE                                                          
         B        COCHC7                                                        
         FIN      #TJE                                                          
COCHC5A  EQU      %                                                             
         DO       2741CODE=1                                                    
         LC       MODE2,R7          CHECK FOR 2741 TERMINAL                     
         BCR,1    COCHC6            BRANCH IF NOT 2741                          
         LB,R6    COCTERM,R7        CHECK IF KEYBOARD STILL INITIALIZED         
         BEZ      COCHC8            DO NOT LOGON IF KEYBOARD TYPE = 0.          
         LC       MODE3,R7                                                      
         BCR,1    COCHC8            LOGON UNDERWAY IF KEYBOARD UNLOCKED         
         FIN                                                                    
         LC       MODE2,R7                                                      
COCHC6   EQU      %                                                             
         BCS,8    COCHC8            BRANCH IF LOGGING OFF                       
COCHC62  EQU      %                                                             
         BAL,R4   COCMINT           INITIALIZE MODE CONTROL BITS                
         LI,R6    E:CBK             SET TO REPORT BREAK (STARTS TEX)            
         B        COCHC28           BRANCH TO REPORT EVENT                      
         DO       2741CODE                                                      
         PAGE                                                                   
********************************************************************************
*                                                                               
*  2741 LINE AND HARDWIRED                                                      
*  LINE IS NOT FLAGGED AS OFF.                                                  
*                                                                               
*  IF LOGON IS ASSOCIATED, EXECUTE THE TIME-OUT ROUTINE IN CASE                 
*  THE USER DIDN'T HIT THE '*' KEY WHEN IDENTIFYING HIS CHARACTER               
*  SET, OR WANTS TO CHANGE CHARACTER SETS.  THIS WAY THE LINE WILL              
*  TIME OUT AND COCTERM WILL BE RESET, ALLOWING THE USER                        
*  TO RE-IDENTIFY.                                                              
*                                                                               
********************************************************************************
COCHC65  EQU      %                                                             
         BAL,R15  CHKLOGON          SEE IF LOGON ASSOCIATED                     
         BNE      COCHC8            B/NOT LOGON; DON'T TIME OUT                 
         FIN                                                                    
*                                                                               
*                 TIME OUT USERS HAVING READS PENDING                           
COCHC7   EQU      %                                                             
         LC       MODE,R7                                                       
         BCR,1    COCHC8            BRANCH IF NO READ IS PENDING                
         INT,R3   CO:INTFL          L/COCTIME BY-PASS COUNT + 1                 
         MTH,-1   EOMTIME,R7        DECREMENT TIMER                             
         BEZ      COCHC7C           BEZ; READ HAS TIMED OUT                     
         BDR,R3   %-2               BDR IF COCTIME WAS BY-PASSED                
         B        COCHC8            B; USER HAS TIME LEFT                       
COCHC7C  MTH,-1   EOMTIME,R7        MAKE EOMTIME NON-ZERO; OTHERWISE,           
*                                   .. BUFFER POINTERS MAY BE RESET             
*                                   .. WITHOUT RELEASING BUFFERS                
         LI,R3    OC                GET OC INDEX                                
         LB,R15   LB:UN,R7          GET LINE INDEX                              
         CB,R15   OPLBS2,R3         IS LINE OC                                  
         BE       COCHC8            DON'T TIME OUT                              
         B        COCHC26           B; REPORT E:OFF EVENT                       
         PAGE                                                                   
         PAGE                                                                   
*                                                                               
*        INITIALIZE LINE MODE CONTROL BITS BEFORE NEW USER IS LOGGED ON.        
*        THIS ROUTINE IS ENTERED FROM COCIP IF A BREAK IS RECEIVED ON A         
*        LINE WITH NO USER NUMBER ASSIGNED AND FROM COCHC IF A LINE IS          
*        READY AND NO USER NUMBER IS ASSIGNED.                                  
*                                                                               
*        R4 = RETURN REG                                                        
*                                                                               
COCMINT  EQU      %                 INITIALIZE MODE CONTROL BITS                
         LI,R6    X'2088'           MODE BITS                                   
         STH,R6   EOMTIME,R2        RESET EOMTIME NONZERO.                      
         DO 2741CODE=1                                                          
         LC       MODE2,R2                                                      
         BCR,1    MINT1             BRANCH IF TERM NOT A 2741                   
         LI,R6    X'1440'           MODE BITS FOR 2741                          
         LC       MODE,R2                                                       
         BCS,4    MINT1             BRANCH IF EOA IS PENDING                    
         LI,R6    X'1400'           RESET EOA BIT                               
         FIN                                                                    
MINT1    EQU      %                                                             
         STB,R6   MODE,R2                                                       
         SLS,R6   -8                                                            
         STB,R6   MODE2,R2                                                      
         AND,R6   X10               SET 2741 KEYBOARD LOCKED                    
         OR,R6    X80               SET TAB RELATIVE                            
         STB,R6   MODE3,R2                                                      
         B        0,R4                                                          
         TITLE    'C O C   I N I T I A L I Z A T I O N'                         
********************************************************************************
*                                                                               
*  COC INITIALIZATION - START/RESTART THE COC HARDWARE                          
*                                                                               
*  THIS ROUTINE IS CALLED FROM IPLMM TO DO THE FOLLOWING:                       
*                                                                               
*  RE-INITIALIZE THE RING BUFFER POINTER IN CASE OF POWER FAIL-SAFE.            
*                                                                               
*  EXECUTE AN SIO TO THE COC HARDWARE.  IF UNSTARTABLE, AN ERROR                
*     MESSAGE IS GIVEN ON THE OC, AND INITIALIZATION SKIPS TO                   
*     THE NEXT COC.                                                             
*                                                                               
*  IF THE RCVRCHK ASSEMBLY FLAG IS ON, ALL COC RECEIVERS ARE CHECKED            
*     TO MAKE SURE THAT THE RECEIVER IS INSTALLED.  IF THE RECEIVER             
*     INTERFACES TO A DATA SET, THE DATA SET IS CHECKED TO MAKE SURE            
*     THAT IT IS ON (DATA SET READY TRUE).  IF NOT, AN ERROR MESSAGE            
*     IS PRINTED ON THE OC, AND WE SKIP TO THE NEXT LINE.                       
*                                                                               
*  TURN THE RECEIVER ON.                                                        
*                                                                               
*  TRANSMIT A NULL CHARACTER.  THIS IS TO RESTART OUTPUT INTERRUPT              
*     PROCESSING IN CASE OF A POWER FAIL-SAFE.                                  
*                                                                               
*  ARM AND ENABLE THE COC INTERRUPTS.  IF THIS IS A POWER FAIL-SAFE,            
*     WE MAY HAVE HAD THE COC INTERRUPTS DISABLED, IN WHICH CASE                
*     WE AGAIN DISABLE THE COC INTERRUPTS.                                      
*                                                                               
*  INPUT:                                                                       
*     R11         RETURN ADDRESS                                                
*                                                                               
*  ENTRY POINTS:                                                                
*     AT COCINIT                                                                
*                                                                               
*  EXIT POINTS:                                                                 
*     AT INIT350 (WITH A BRANCH *R11)                                           
*                                                                               
*  REGISTERS DESTROYED:                                                         
*     ASSUME THAT ALL REGISTERS ARE DESTROYED                                   
*                                                                               
********************************************************************************
COCINIT  EQU      %                                                             
         LI,R3    0                 L/0; COC NUMBER                             
INIT050  EQU      %                                                             
         LCH,R0   COH:RBS,R3        L/COMPLEMENT OF RING BUFFER SIZE            
         STW,R0   CO:LST,R3         S/RING BUFFER POINTER                       
         LI,R0    DA(CO:CMND)       L/ DA OF CMD DBLWD                          
         AW,R0    R3                                                            
         AW,R0    R3                POSITION TO PROPER ENTRY                    
         LH,R5    COH:DN,R3         L/COC ADR FOR THIS COC                      
         HIO,R0   *R5               MOVE HIO TO ALARM********                   
         SIO,R0   *R5               START COC                                   
         BCR,12   INIT100           B/SIO CC'S OK                               
********************************************************************************
*  SIO FAILURE ON THIS COC HAS OCCURED.                                         
*  GIVE THE OPERATOR A MESSAGE OF THE FOLLOWING FORM:                           
*                                                                               
*      LNXXX  SIO FAILURE                                                       
*                                                                               
*  GO ON TO NEXT COC                                                            
********************************************************************************
         PUSH     R3                SAVE R3                                     
         LD,R1    COD:LPC,R3        CALCULATE                                   
         AH,R1    DCT1              LOWEST DCT INDEX                            
         AI,R1    1                 ADD EXTRA ONE                               
         LI,R3    0                 PRIORITY                                    
         LI,R13   MSG4B             FAILURE MSG                                 
         BAL,R5   MSGOUT            BAL/WRITE MESSAGE ON OC                     
         PULL     R3                PULL R3                                     
         B        INIT300           SKIP TO NEXT COC                            
         PAGE                                                                   
INIT100  EQU      %                                                             
         LI,R7    0                 L/0; PHYSICAL LINE #                        
INIT150  EQU      %                                                             
         DO       RCVRCHK                                                       
***********************************************************************         
*  CHECK RECEIVERS TO MAKE SURE THAT THE RECEIVER IS INSTALLED AND              
*  EITHER HARDWIRED OR DATA SET READY IS TRUE.                                  
***********************************************************************         
         LW,R10   R7                L/RECEIVER NUMBER                           
         EXU      CO:STAT,R3        SENSE RECEIVER L STATUS                     
         BCS,C3C4 INIT200           B/RECEIVER INSTALLED AND EITHER             
*                                   .. HARDWIRED OR DATA SET READY              
         STB,R7   R5                LEFT JUSTIFY RCVR # IN R5                   
         LI,R1    BA(COCM2)+25      L/BA OF RCVR # IN MESSAGE                   
         LI,R2    2                 L/# OF CHARS TO CONVERT                     
         BAL,R6   HEXCON            BAL/MAKE RCVR # EBCDIC, PUT IN MESSAGE      
         LI,R1    BA(COCM2)+14      L/BA OF COC # IN MESSAGE                    
         LW,R4    R3                L/COC #                                     
         BAL,R6   HEXCON10          BAL/MAKE COC # EBCDIC, PUT IN MESSAGE       
         LI,R13   COCM2             L/ADR OF MESSAGE                            
         PUSH     R3                PUSH R3                                     
         LI,R1    0                 L/DCTX OF 0; DON'T PRECEED MESSAGE          
*                                   .. WITH DEVICE NAME                         
         LI,R3    Y00FE+1-BA(IOQ14) L/DUMMY IOQX; POINT IOQ14 TO .FE,           
*                                   .. USE .FE AS PRIO FOR MESSAGE              
         BAL,R5   MSGOUT            BAL/WRITE MESSAGE ON OC                     
         PULL     R3                PULL R3                                     
INIT200  EQU      %                                                             
         FIN                                                                    
***********************************************************************         
*  TURN RECEIVER ON, TRANSMIT NULL CHARACTER                                    
***********************************************************************         
         EXU      CO:RCVON,R3       TURN RECEIVER L ON                          
         LW,R6    R7                L/LINE #                                    
         EXU      CO:XDATA,R3       TRANSMIT NULL TO RESTART OUTPUT             
         AI,R7    1                 +1 TO LINE #                                
         LD,R4    COD:LPC,R3        L/LIMITS OF LOGICAL LINES FOR COC           
         SW,R5    R4                LAST PHYSICAL LINE = LAST LOGICAL -         
*                                   .. FIRST LOGICAL LINE #                     
         CW,R7    R5                C/CURRENT LINE # W/LAST LINE #              
         BLE      INIT150           BLE; CHECK NEXT LINE                        
***********************************************************************         
*  ALL LINES ON THIS COC HAVE BEEN SET UP.                                      
***********************************************************************         
INIT300  EQU      %                                                             
         AI,R3    1                 +1 TO COC #                                 
         CI,R3    LCOC              C/COC # W/LAST COC #                        
         BLE      INIT050           BLE; CHECK NEXT COC                         
************************************************************************        
*  ARM AND ENABLE/DISABLE THE COC INTERRUPTS                                    
************************************************************************        
         LW,R4    CO:AIIL           GET INPUT INT LEVELS                        
         LW,R5    CO:AOIL           GET OUTPUT INT LEVELS                       
         :WD,R4   ARM%DISABLE,COA:IIG    ARM & DISABLE INPUT INTERRUPTS         
         :WD,R5   ARM%DISABLE,COA:OIG    ARM & DISABLE OUTPUT INTERRUPTS        
         BAL,R13  COCENABL          ENABLE COC'S                                
*                                   .. COC INPUT AND OUTPUT INTERRUPTS          
INIT350  B        *R11              EXIT                                        
         PAGE                                                                   
         TITLE    'A S C I I   = = = >   E B C D I C   T A B L E'               
*                                                                       KD000020
*                                                                               
*        TTY AND K/D  INPUT TRANSLATE TABLE --ASCII TO EBCDIC                   
*                                                                               
*                                                                               
TTYIN    EQU      %                                                             
*                 EBCDIC EQUIVAVENT OF ..... ASCII CHARACTERS                   
*    0                                                                          
*                                                                               
*                                                                               
  DATA,8 X'0001020304090607'    NUL,  SOH,  STX,  ETX,  EOT,  ENQ,  ACK,  BEL   
  DATA,8 X'0805150B0C0D0E0F'     BS,   HT, NL(LF), VT,   FF,   CR,   SO,   SI   
*    1                                                                          
  DATA,8 X'103C123D140A1617'   DLE,DC1(XON),DC2,DC3(XOFF),DC4, NAK, SYN,  ETB   
  DATA,8 X'32191A301C1D1E1F'  CAN(CTL-X),EM(CTL-Y),SUB,ESC,FS, GS,  RS ,  US    
*    2                                                                          
  DATA,8 X'405A7F7B5B6C507D'  BLANK,EXCL MK,QUOT MK, #,   %,    %,    &,    '   
  DATA,8 X'4D5D5C4E6B604B61'      (,    ),   *,    +,    ,,    -,    .,    /    
*    3                                                                          
  DATA,8 X'F0F1F2F3F4F5F6F7'      0,    1,    2,    3,    4,    5,    6,    7   
  DATA,8 X'F8F97A5E4C7E6E6F'      8,    9,    :,    ;,    <,    =,    >,QUEST MK
         PAGE                                                                   
*    4                                                                          
  DATA,8 X'7CC1C2C3C4C5C6C7'      @,    A,    B,    C,    D,    E,    F,    G   
  DATA,8 X'C8C9D1D2D3D4D5D6'      H,    I,    J,    K,    L,    M,    N,    O   
*                                                                               
*    5                                                                          
  DATA,8 X'D7D8D9E2E3E4E5E6'      P,    Q,    R,    S,    T,    U,    V,    W   
  DATA,8 X'E7E8E9B4B1B56A6D'      X,    Y,    Z,(BRAC, BK/ ,BRAC),ARROW,UNLINE  
* FOR TTY'S OTHER THAN 7015, ASCII '5B' & '5D'(LEFT & RIGHT BRACKETS)           
* ARE TRANSLATED RESPECTIVELY INTO - 'B4' & 'B5'                                
* FOR 7015'S, ASCII '5B' & '5D' (OR & NOT)                                      
* ARE TRANSLATED RESPECTIVELY INTO '4F' & '5F'                                  
*    6                                                                          
  DATA,8 X'4A81828384858687'   CENTS,LC'A',LC'B',LC'C',LC'D',LC'E',LC'F',LC'G'  
  DATA,8 X'8889919293949596'   LC'H',LC'I',LC'J',LC'K',LC'L',LC'M',LC'N',LC'O'  
*    7                                                                          
  DATA,8 X'979899A2A3A4A5A6'   LC'P',LC'Q',LC'R',LC'S',LC'T',LC'U',LC'V',LC'W'  
  DATA,8 X'A7A8A9B24FB35FFF'   LC'X',LC'Y',LC'Z',BRACE(, OR,BRACE), NOT, RUB    
         SPACE    5                                                             
ALTMODES DATA     X'311B1B80'       ACTIVE RUB, ALT-ESC, ALT-ESC, RUBOUT        
         TITLE    'E B C D I C   = = = >   A S C I I   T A B L E'               
*                                                                               
*        TTY AND K/D  OUTPUT TRANSLATE TABLE -- EBCDIC TO ASCII                 
*                                                                               
TTYOUT   EQU      %                                                             
*   00                                                                          
  DATA,8  X'00010203EA810607'   NUL,  SOH,  STX,  ETX, +EOT,  *HT,  ACQ,  BEL   
  DATA,8 X'0805150B80820E0F'     BS,  ENQ,  NAK,   VT,  *FF,  *CR,   SO,   SI   
*   01                                                                          
  DATA,8  X'1011121314821617'   DLE,  XON,  DC2, XOFF,  DC4,*NL(LF),SYN,  ETB   
  DATA,8  X'18E58E1BE1E2E3E4'   CAN,  +EM, *SUB, *ESC,  +FS,  +GS,  +RS,  +US   
*   02                                                                          
  DATA,8  X'8D1C1D1E1F192F5E'   *LF,   FS,   GS,   RS,   US,   EM,    /,ARROW   
  DATA,8  X'3D0D040829090A23'    = ,   CR,  EOT,   BS,    ),   HT,   LF,  SUB   
*    3                                                                          
  DATA,8  X'848685D6D2C3CBD3'  ESC*F,*RUB,ESC*X,ESC&P,ESC&U,ESC&(,ESC&),ESC&T   
  DATA,8 X'D5D7D78CCEC68788'   ESC&S,ESC&E,ESC&C,ESC*LF,*XON,*XOFF,ESC*R,ESC*CR

*    4                                                                          
  DATA,8  X'2023232323232323'  BLANK, SUB , SUB , SUB , SUB , SUB , SUB , SUB   
  DATA,8  X'2323602E3C282B8A'   SUB , SUB ,CENTS,   . ,   < ,   ( ,   + , *OR   
*    5                                                                          
  DATA,8  X'2623232323232323'     &,  SUB , SUB , SUB , SUB , SUB , SUB , SUB   
  DATA,8  X'232321242AAC3B8A'   SUB, SUB ,EXCL.,   % ,   * ,  +) ,   ; , NOT    
*    6                                                                          
  DATA,8  X'2DA6232323232323'     -,   +/,  SUB , SUB , SUB , SUB , SUB , SUB   
  DATA,8  X'2323A72C255F3E3F'   SUB , SUB ,+UP-ARROW, ,,  %,BK-ARROW, >,QUEST MK
*    7                                                                          
  DATA,8  X'2323232323232323'   SUB , SUB , SUB , SUB , SUB , SUB , SUB , SUB   
  DATA,8  X'23233A234027A822'   SUB , SUB ,   :,    #,    @,    ',   +=,'       
*    8                                                                          
  DATA,8  X'2361626364656667'   SUB ,LC'A',LC'B',LC'C',LC'D',LC'E',LC'F',LC'G'  
  DATA,8  X'6869232323232323'  LC'H',LC'I', SUB , SUB , SUB , SUB , SUB , SUB   
*    9                                                                          
  DATA,8  X'236A6B6C6D6E6F70'   SUB ,LC'J',LC'K',LC'L',LC'M',LC'N',LC'O',LC'P'  
  DATA,8  X'7172232323232323'  LC'Q',LC'R', SUB , SUB , SUB , SUB , SUB , SUB   
*    A                                                                          
  DATA,8  X'2323737475767778'   SUB , SUB ,LC'S',LC'T',LC'U',LC'V',LC'W',LC'X'  
  DATA,8  X'797A23232323237C'  LC'Y',LC'Z', SUB , SUB , SUB , SUB , SUB , OR    
*    B                                                                          
  DATA,8  X'235C7B7D89892323'   SUB ,BK'/',(BRAC,BRAC),*(BRK,*BRK), SUB , SUB   
  DATA,8  X'232323235B5DEF7E'   SUB , SUB , SUB , SUB ,(BRAK,BRAK),+DATA, NOT   
*    C                                                                          
  DATA,8  X'2041424344454647'  SPACE,   A,    B,    C,    D,    E,    F,    G   
  DATA,8  X'4849232323232323'     H,    I,  SUB , SUB , SUB , SUB , SUB , SUB   
*    D                                                                          
  DATA,8  X'234A4B4C4D4E4F50'   SUB ,   J,    K,    L,    M,    N,    O,    P   
  DATA,8  X'5152232323232323'     Q,    R,  SUB , SUB , SUB , SUB , SUB , SUB   
*    E                                                                          
  DATA,8  X'2D23535455565758'    -  , SUB,    S,    T,    U,    V,    W,    X   
  DATA,8  X'595A232323232323'     Y,    Z,  SUB , SUB , SUB , SUB , SUB , SUB   
*    F                                                                          
  DATA,8  X'3031323334353637'     0,    1,    2,    3,    4,    5,    6,    7   
  DATA,8  X'383923232323237F'     8,    9,  SUB , SUB , SUB , SUB , SUB , DEL   
*                                                                               
*                                                                               
*                                                                               
* THE SYMBOL *, +, AND &, WHICH PRECEED OR ARE IMBEDDED IN COMMENTARY SYMBOLS   
* INDICATE CATAGORIES OF CHARACTERS WHICH REQUIRE SPECIAL HANDLING.             
*  THE SPECIAL CATAGORIES ARE:                                                  
*                                                                               
*          *   . . .   UNIQUE ACTION IS GENERALLY REQUIRED.                     
*                                                                               
*          +   . . .   THE CHARACTER WILL NORMALLY ACTIVATE, OR                 
*                      IT IS A DELTA ACTIVATION CHARACTER.                      
*                                                                               
*          &   . . .   CHANGE APPROPRIATE MODE IN LINE TABLE.                   
*                                                                               
*                                                                               
*                                                                               
* END OF K/D OUTPUT TRANSLATE TABLE                                     KD000950
*                                                                       KD000960
SPACE    EQU      BA(TTYIN)+X'20'                                               
SLASH    EQU      BA(TTYIN)+X'2F'                                               
COLON    EQU      BA(TTYIN)+X'3A'                                               
         TITLE    'E V E N T   R E P O R T I N G'                               
         PAGE                                                                   
************************************************************************        
*                 T:RCE                                                *        
*        SUBROUTINE CALLED TO REPORT EVENTS                            *        
*        WHICH MAY AFFECT USER  STATUS                                 *        
*                                                                      *        
*        ENTRY                                                         *        
*                 SR4=LINK                                             *        
*                 R3=ACTIVATION POINT                                           
*                 R6=EVENT HANDLER ADDRESS                             *        
*                 R7=LINE NUMBER                                       *        
*                                                                      *        
*        ALL REGS  PRESERVED                                           *        
*        STACK  USED                                                   *        
************************************************************************        
*                                                                               
T:RCE    EQU      %                 ENTRY  BAL,R2 T:RCE                         
         PUSH     0,R0              SAVE ALL REGS                               
         B        0,R6              GO HANDLE EVENT                             
T:RCEX   PULL     0,R0              RESTORE REGS                                
         B        *SR4              RETURN                                      
*                                                                               
T:RCECR  CRASH    'COC T:RCE'                                                   
*                                                                               
*                                                                               
************************************************************************        
*        EVENT    BREAK RECIEVED                                                
*                                                                               
E:CBK    EQU      %                                                             
         DO       #TJE                                                          
         LCF      MODECPR,R7        NONTJE                                      
         BCS,8    E:CECA            YES                                         
         LB,R5    LB:UN,R7          GET DCT INDEX                               
         BEZ      E:CBK3            NO USER                                     
         LB,R8    DCTTJE,R5         GET FLAGS                                   
*                                                                               
         CI,R8    TJEACT            ACTIVE                                      
         BAZ      E:CBK2            NO                                          
         LD,R10   DCT16,R5          GET DEVICE NAME                             
         SLD,R10  24                GET RID OF !!NL                             
         AW,R11   X404040           SPACE FILL                                  
         LB,R2    SJI3              # OF SJI ENTRIES                            
         CD,R10   SJI2,R2           THIS JOB                                    
         BE       E:CBK1            YES                                         
         BDR,R2   %-2                                                           
         B        T:RCEX            NOT CONTROL                                 
*                                                                               
E:CBK1   PUSH     3,R5                                                          
         CI,R6    E:CEC             IS THIS A CONTROL EVENT                     
         BE       E:CBK1A           YES                                         
         LI,R7    OC                GET OC INDEX                                
         CB,R5    OPLBS2,R7         IS LINE OC                                  
         BNE      E:CBK1A           NO                                          
         LI,R7    BIT27                                                         
         WD,R7    X'1700'           TRIGGER CP INT                              
         B        E:CEC2                                                        
*                                                                               
E:CBK1A  RES      0                                                             
         LW,R7    SJI1,R2           GET JCB ADDRESS                             
         XW,R6    R2                SJI INDEX                                   
         CI,R2    E:CEC             CONTROL EVENT                               
         BE       E:CEC1            YES                                         
         BAL,R8   BRKSUB            GO HANDLE BRK                               
         B        E:CEC2                                                        
*                                                                               
E:CBK2   CI,R8    0                 ANYTHING HAPPENING                          
         BNE      T:RCEX            YES,RETURN                                  
*                                                                               
E:CBK3   LW,R0    TJE:NUM           MAX ALLOWED USERS                           
         CW,R0    TJE:NOW           PRESENT SUPPLY                              
         BLE      T:RCEX            NO MORE ALLOWED                             
*                                                                               
         LH,R5    DCT1              CALCULATE                                   
         AW,R5    R7                DCT INDEX                                   
         AI,R5    1                 COC STARTS AT ZERO                          
         STB,R5   LB:UN,R7          MARK ACTIVE USER                            
         LI,R0    TJEON                                                         
         STB,R0   DCTTJE,R5         SET LOGON INDICATOR                         
E:ALL    LI,R4    TEXTID            GET TERMINAL EXECS STI INDEX                
         LW,R1    XSTISTRT          GET START BIT                               
         STS,R1   STIPRIO,R4        SET IT                                      
         BAL,R8   TMTRIG            TRIGGER TEX                                 
         B        T:RCEX            RETURN                                      
         ELSE     #TJE                                                          
         B        E:CECA                                                        
         FIN      #TJE                                                          
************************************************************************        
*        EVENT    CONTROL RECIEVED                                              
*                                                                               
E:CEC    EQU      %                                                             
         DO       #TJE                                                          
         B        E:CBK             HANDLING IS SIMILAR TO BREAK                
*                                   WHICH EVENTUALLY COMES BACK                 
*                                   TO HERE IF REPORT IS NEEDED                 
E:CEC1   BAL,R8   CTLSUB            CALL CONTROL REPORTER                       
*                                                                               
E:CEC2   PULL     3,R5                                                          
         FIN      #TJE                                                          
E:CECA   EQU      %                                                             
         LB,R4    DCT6,R5           ANY INPUT REQUESTS                          
         BNEZ     E:CEC3            YES                                         
         LH,R0    COCII,R7          ANY TYPE AHEAD                              
         BEZ      T:RCEX            NO,RETURN                                   
*                                                                               
E:CEC3   PUSH     3,R5                                                          
         XW,R2    R7                                                            
         BAL,SR2  KILLIN            REMOVE ALL INPUT AND TABS                   
         LI,SR4   0                                                             
         LB,R6    COCTERM,R2        DET TERM TYPE                               
         LH,SR3   COCOTV,R6         GET TRANSLATION                             
         BAL,D4   SETACT            SET ACTIVATION RECIEVED                     
         BAL,SR2  CLEARLD                                                       
         PULL     3,R5                                                          
         LB,R4    DCT6,R5           ANY INPUT                                   
         BEZ      T:RCEX            NO, RETURN                                  
*                                                                               
         LC       IOQ3,R4           Q BUSY                                      
         BCR,8    T:RCEX            NO                                          
         LI,R12   1                 TYC NORMAL                                  
         LI,R11   0                 RBC                                         
         LW,R1    R5                DCT INDEX                                   
         BAL,R5   COCPSTIN          GO POST INPUT                               
         DISABLE                                                                
         B        T:RCEX            RETURN                                      
************************************************************************        
*        EVENT    INPUT COMPLETE                                                
*                                                                               
E:CIC    EQU      %                                                             
         LW,R2    R7                CARRY INDEX IN BOTH                         
         LB,R5    LB:UN,R7          GET DCT INDEX                               
         BEZ      T:RCECR           CRASH                                       
         LB,R4    DCT6,R5           QUEUE INDEX                                 
         BEZ      T:RCECR           CRASH                                       
         LW,D3    IOQ8,R4           BYTE ADDRESS OF BUFFER                      
         AI,D3    -1                OFFSET FOR BUFFER ADR                       
         PUSH     4,R4                                                          
         LI,R0    0                 SET DEFAULT REMOVAL POINT                   
         LB,R1    ARSZ,R7           IS ARSZ ZERO                                
         BEZ      E:CIC1                                                        
         LH,R4    COCIR,R7          GET REMOVAL POINT                           
         LW,R0    R4                SAVE REMOVAL POINTR                         
         BAL,SR2  COCMU             MOVE IT TO USERS BUFFER                     
*                                                                               
*                                                                               
*                                                                               
         LW,D4    R5                PUT TYC IN D4                               
         CB,D4    YBE               LOST DATA CHARACTER                         
         BNE      E:CIC2            NO                                          
*                                                                               
E:CIC1   LH,R4    COCII,R7          REMOVE ALL INPUT                            
         BAL,SR2  CLEARLD           CLEAR LOST DATA                             
         LW,D4    Y02               TYC                                         
*                                                                               
E:CIC2   XW,R0    R4                SET UP TO RELEASE                           
         BAL,SR2  KILLIN1           RELEASE THE BUFFERS                         
         PULL     4,R4                                                          
         LB,R12   D4                TYC TO R12                                  
         CI,R12   0                 ANY                                         
         BNE      %+2               YES                                         
         LI,R12   1                 SET TO NORMAL                               
         LI,R11   0                 RBC                                         
         LW,R1    R5                DCT INDEX                                   
         BAL,R5   COCPSTIN          GO POST INPUT                               
         DISABLE                                                                
         B        T:RCEX            RETURN                                      
************************************************************************        
*        EVENT    OUTPUT COMPLETE                                               
*                                                                               
E:COC    EQU      %                                                             
         LB,R5    LB:UN,R7          DCT INDEX                                   
         BEZ      T:RCECR                                                       
         LB,R4    DCT18,R5          GET IOQ ENTRY                               
         BEZ      T:RCEX            NO OUTPUT                                   
         LC       IOQ3,R4           Q BUSY                                      
         BCR,8    T:RCEX            NO                                          
         LI,R12   1                 TYC                                         
         LI,R11   0                 RBC                                         
         LW,R1    R5                DCT INDEX                                   
         BAL,R5   COCPSTOT          POST OUTPUT                                 
         DISABLE                                                                
         B        T:RCEX            RETURN                                      
************************************************************************        
*        EVENT    COC OFF                                                       
*                                                                               
E:OFF    EQU      %                                                             
         DO       #TJE                                                          
         LCF      MODECPR,R7        NONTJE                                      
         BCS,8    T:RCEX            YES                                         
         LB,R5    LB:UN,R7          DCT INDEX                                   
         BEZ      T:RCECR                                                       
         LB,R0    DCTTJE,R5         GET FLAGS                                   
         BEZ      T:RCEX            DONT LOG OFF IF OFF                         
         CI,R0    TJEOFF            ALREADY                                     
         BANZ     T:RCEX            YES                                         
         AI,R0    TJEOFF                                                        
         STB,R0   DCTTJE,R5         SET OFF                                     
         LI,R4    TEXTID                                                        
         LW,R1    XSTISTRT          GET START BIT                               
         STS,R1   STIPRIO,R4        SET IT FOR TEX                              
         BAL,R8   TMTRIG            START TEX'S DISPATCHER                      
         B        E:CECA            POST ANY CURRENT INPUT                      
         ELSE     #TJE                                                          
         B        T:RCEX                                                        
         FIN      #TJE                                                          
         TITLE    'I / O   S Y S T E M    I N T E R F A C E'                    
************************************************************************        
*                 B  COCIO          FROM QUEUE                                  
*                                                                               
*                 R3=Q INDEX                                                    
*                 R7=DCT INDEX                                                  
*                 R13=PRIORITY                                                  
*                                                                               
*                 B  %CALLSD        WHEN QUEUED                                 
*                                                                               
COCIO    EQU      %                                                             
A:COCIO  EQU      COCIO                                                         
         LB,R1    DCT14,R7          GET LINE NUMBER                             
         LB,R2    LB:UN,R1          INTERNAL INITIATION                         
         BNEZ     COCQ1             NO                                          
         STB,R7   LB:UN,R1          MAKE IT USABLE                              
COCQ1    EQU      %                                                             
         LB,R4    IOQ4,R3           GET FUNCTION                                
         CI,R4    FCRKPWE           READ                                        
         BE       COCQR             YES                                         
         CI,R4    FCRKPWOE          READ                                        
         BE       COCQR             YES                                         
         CI,R4    FCRLN             READ                                        
         BE       COCQR             YES                                         
         LI,R2    BA(DCT18)-BA(IOQ2)                                            
         B        COCQL                                                         
COCQR    LI,R2    BA(DCT6)-BA(IOQ2)                                             
COCQL    AW,R2    R7                                                            
COCQL1   LB,R1    IOQ2,R2           GET NEXT Q                                  
         BEZ      COCQL2            END                                         
         LC       IOQ3,R1           BUSY                                        
         BCS,8    COCQL1A           YES                                         
         CB,R13   IOQ14,R1          SHOULD WE Q HERE                            
         BL       COCQL2            YES                                         
COCQL1A  LW,R2    R1                NO                                          
         B        COCQL1            CONTINUE SCAN                               
COCQL2   STB,R1   IOQ2,R3           STORE FORWARD LINK                          
         STB,R3   IOQ2,R2           STORE PRESENT LINK                          
         ENABLE                                                                 
         B        %CALLSD           RETURN TO QUEUE                             
         PAGE                                                                   
************************************************************************        
*                 B  COCRIP         FROM RIPOFF                                 
*                                                                               
*                 R3= Q INDEX                                                   
*                 R1=DCTINDEX                                                   
*                 B  RIPTOFF        WHEN POSTED                                 
*                                                                               
COCRIP   EQU      %                                                             
         LB,R4    DCT18,R1          GET OUTPUT CHAIN                            
         BEZ      COCRIPR           NOT WRITE                                   
COCRIP1  CW,R4    R3                THIS IT                                     
         BE       COCRIP2           FOUND IT                                    
         LB,R4    IOQ2,R4                                                       
         BEZ      COCRIPR           NOT WRITE                                   
         B        COCRIP1           AGAIN                                       
COCRIP2  EQU      %                 SET UP FOR POST                             
         LI,R12   IOABORT           ABORT TYC                                   
         LI,R11   0                 RBC                                         
         BAL,R5   COCPSTOT          POST IT                                     
         B        COCRIPX           EXIT                                        
*                                                                               
COCRIPR  LB,R4    DCT6,R1           GET  INPUT CHAIN                            
         BEZ      COCRIPX           NOPE                                        
         CW,R4    R3                THIS IT                                     
COCRIP3  BE       COCRIP4           FOUND IT                                    
         LB,R4    IOQ2,R4                                                       
         BEZ      COCRIPX           NOPE                                        
         B        COCRIP3           AGAIN                                       
COCRIP4  LC       IOQ3,R4           BUSY                                        
         BCR,8    COCRIP5           NO                                          
         PUSH     4,R1                                                          
         LW,R2    R1                CLACULATE LINE NUMBER                       
         SH,R2    DCT1                                                          
         AI,R2    -1                                                            
         BAL,SR2  KILLIN            RELEASE ALL INPUT BUFFERS                   
         LI,SR4   0                                                             
         BAL,D4   SETACT            SET ACTIVATION RECIEVED                     
         BAL,SR2  CLEARLD           CLEAR LOST DATA                             
         PULL     4,R1                                                          
*                                                                               
COCRIP5  EQU      %                 SET UP TO POST                              
         LI,R12   IOABORT           TYC ABORT                                   
         LH,R11   IOQ9,R4           RBC                                         
         BAL,R5   COCPSTIN          GO POST IT                                  
COCRIPX  ENABLE                                                                 
         B        RIPTOFF           EXIT, CALL SERDEV****CHECK                  
         PAGE                                                                   
************************************************************************        
*                 B COCSRDV         FROM  SERDEV                                
*                                                                               
*                 R2=LINK                                                       
*                 R1 = DCT INDEX                                                
*                                                                               
*                 B  *R2            RETURN AS SERDEV                            
*                                                                               
COCSRDV  EQU      %                                                             
         PUSH     R2                SAVE RETURN                                 
         DO       #BRKSTOP                                                      
         LB,R2    DCT14,R1          LINE NUMBER                                 
         LB,R2    MODE3,R2                                                      
         CI,R2    1                 STOP SET                                    
         BANZ     COCSDX            YES                                         
         FIN      #BRKSTOP                                                      
         AND,R1   M7                MASK OUT DCT INDEX                          
         DISABLE                                                                
         LB,R4    DCT18,R1          OUTPUT Q                                    
         BEZ      COCSDR            NONE                                        
         LC       IOQ3,R4           BUSY                                        
         BCS,8    COCSDR            YES                                         
         PUSH     R1                                                            
         BAL,R8   COCWRQ            GO START WRITE                              
         PULL     R1                                                            
*                                                                               
COCSDR   ENABLE                                                                 
         DISABLE                                                                
         LB,R4    DCT6,R1           INPUT Q                                     
         BEZ      COCSDX            NONE                                        
         LC       IOQ3,R4           BUSY                                        
         BCS,8    COCSDX            YES                                         
         BAL,R8   COCRDQ            GO START READ                               
         ENABLE                                                                 
COCSDX   PULL     R2                RESTORE RETURN                              
         B        0,R2              RETURN                                      
         PAGE                                                                   
************************************************************************        
*                 BAL,R8  COCRDQ,COCWR                                          
*                                                                               
*                 R4=Q INDEX                                                    
*                 R1=DCT INDEX                                                  
*                                                                               
*                                   THIS ROUTINES SETS UP THE                   
*                                   INTERFACE WITH COCRD,WR                     
*                                                                               
COCRDQ   EQU      %                                                             
*                                                                               
*        SPACE FILL USER BUFFER                                                 
         LW,R2    IOQ8,R4           BYTE ADDRESS OF BUFFER                      
         AH,R2    IOQ9,R4           BYTE COUNT                                  
         AI,R2    -1                                                            
         LH,R6    IOQ9,R4                                                       
         LI,R0    X'40'                                                         
         STB,R0   0,R2              SPACE FILL                                  
         AI,R2    -1                                                            
         BDR,R6   %-2                                                           
*                                                                               
*                                                                               
         LI,SR4   COCRD             READ                                        
         B        %+2                                                           
COCWRQ   LI,SR4   COCWR             WRITE                                       
         PUSH     R8                SAVE RETURN                                 
         LB,R0    IOQ3,R4                                                       
         OR,R0    X80                                                           
         STB,R0   IOQ3,R4           SET Q BUSY                                  
         LH,SR1   IOQ9,R4           BYTE COUNT                                  
         LB,R0    IOQ4,R4           FUNCTION CODE                               
         LB,R2    DCT14,R1          GET LINE NUMBER                             
         LB,R6    COCTERM,R2                                                    
         LH,SR3   COCOTV,R6         TRANSLATION TABLE                           
         LW,R7    IOQ8,R4           BYTE ADDRESS OF BUFFER                      
         AI,R7    -1                OFFSET                                      
         BAL,SR4  *SR4              GO READ OR WRITE                            
         PULL     R8                RESTORE RETURN                              
         B        *R8               RETURN                                      
         PAGE                                                                   
************************************************************************        
*                 BAL,R5 COCPSTIN, COCPSTOT                                     
*                                                                               
*        R4=QUEUE                   *ROUTINE POST THE QUEUE                     
*        R1=DCT   INDEX             *ENTRY COMPLETE                             
*                                   *BY GOING TO RC50                           
*        R11=RBC                                                                
*        R12=TYC                                                                
*                                                                               
*                                                                               
COCPSTIN LI,R2    BA(DCT6)-BA(IOQ2)                                             
         B        %+2                                                           
COCPSTOT LI,R2    BA(DCT18)-BA(IOQ2)                                            
         AW,R2    R1                ADD DCT OFFSET                              
         PUSH     9,R13             SAVE REGS FOR REQCOM                        
         DISABLE                                                                
COCPST1  LB,R3    IOQ2,R2           GET NEXT Q                                  
         BEZ      T:RCECR                                                       
         CW,R3    R4                THIS IT                                     
         BE       COCPST2           YES                                         
         LW,R2    R3                FORWARD CHAINED ONLY                        
         B        COCPST1                                                       
*                                                                               
COCPST2  LB,R0    IOQ2,R3                                                       
         STB,R0   IOQ2,R2           DELINK IT                                   
         LB,R0    IOQ2                                                          
         STB,R0   IOQ2,R3           FREE CHAIN                                  
         STB,R3   IOQ2                                                          
         LB,R0    IOQ14,R3                                                      
         CI,R0    KFF               BACKGROUND                                  
         BNE      %+2               NO                                          
         MTB,-1   IOQ3              BACKGROUND I/O COUNT                        
*                                                                               
         LW,R13   R11               RBC                                         
         LD,R10   IOQ13,R3          END ACTION                                  
         LW,R15   IOQ8,R3           BUFFER ADR                                  
         LW,R2    IOQECB,R3         ECB ID                                      
         LB,R7    IOQ7,R3           DCT                                         
         LI,R6    0                                                             
         STW,R6   IOQECB,R3         CLEAR  ECB                                  
         STB,R6   IOQ7,R3           CLEAR  DCT                                  
         STB,R6   IOQ3,R3           RESET BUSY                                  
         B        RC50                                                          
         PAGE                                                                   
************************************************************************        
*                 BAL,SR4           GMB                                         
*                                                                               
*                 D3=ADDRESS OF BUFFER AT RETURN                                
*                 CC REFLECT ZERO IF NONE                                       
*                 REGISTERS SAVED                                               
*                 STACK USED                                                    
*                                                                               
GMB      EQU      %                                                             
         PUSH     R0                                                            
         PUSH     5,R7                                                          
         LI,R7    140               LARGEST PRINT LINE                          
         BAL,R8   GETTEMPI          GET THE SPACE                               
         LI,R7    0                 NONE AVAILABLE                              
         AND,R7   M17                                                           
         LW,D3    R7                USER EXPECTS IN D3                          
         PULL     5,R7                                                          
         PULL     R0                                                            
         LW,D3    D3                SET CC                                      
         B        *SR4              RETURN                                      
*                                                                               
*                                                                               
************************************************************************        
*                 BAL,SR4           RMB                                         
*                                                                               
*                 D3=ADDRESS OF BUFFER                                          
*                 REGISTERS SAVED                                               
*                 STACK USED                                                    
*                                                                               
RMB      EQU      %                                                             
         PUSH     R0                                                            
         PUSH     5,R7                                                          
         LW,R7    D3                ADDRESS OF BUFFER                           
         LI,R0    140               SIZE OF SPACE                               
         STB,R0   R7                SET UP CALL                                 
         BAL,R8   RELTEMPI          RELEASE THE SPACE                           
         PULL     5,R7                                                          
         PULL     R0                                                            
         B        *SR4              RETURN                                      
*                                                                               
*                                                                               
END      EQU      %                                                             
COCASMFL EQU      (;                                                            
                  MINICOC**8+;                                                  
                  RCVRCHK**7+;                                                  
                  2741CODE**5+;                                                 
                  PMONOFF**4+;                                                  
                  COCGBUG**3+;                                                  
                  COCPBUG**2+;                                                  
                  SECTB**1+;                                                    
                  2741ARUB;                                                     
                  )**16+END-COC                                                 
         FIN      #LN                                                           
         END                                                                    
