         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DO       #LN                                                           
         DEF      A:CMCIO,CMCINT,CMCPRE,COCIO                                   
         DEF      COCRIP,COCTIME,COCSRDV                                        
         DEF      COCINIT,COCOP,COCIP                                           
OLAYFLAG EQU      'CMCI'                                                        
         SYSTEM   CPRMON                                                        
COA:IG   EQU      COA:IIG                                                       
         OPEN     SETUP                                                         
         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                                                                   
*                                                                               
I        DO      10                                                             
J        SET     I*CMCBSIZE                                                     
         GOTO,J>=CMSIZE  #PB                                                    
         FIN     I                                                              
#PB      SET     J/14+1                                                         
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     #PB                MUST HAVE SPACE FOR 200 BYTES              
SL:OITO  DATA     360*5              READ TIME-OUT (30 MINUTES)                 
SL:OLTO  DATA     36*5               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           
HW       EQU      1                 HARD WIRED LINE BIT OF MODE6                
HLT      EQU      1                 MODE6 HALT BIT                              
 TITLE 'C M C U   -   A I O   I N T E R R U P T   H A N D L E R'                
**********************************************************************          
*F*  NAME:    CMC:IO:INT                                                        
*F*  PURPOSE: HANDLE CMC AIO INTERRUPTS                                         
*F*  DESCRIPTION: HANDLES AIO STATUS AND PERFORMS TABLE UPDATES                 
*F*               ACCORDINGLY.  WILL TRIGGER CMC EXTERNAL TASK                  
*F*               LEVEL INTERUPT IF WORK THERE IS NEEDED.                       
**********************************************************************          
*                                                                               
CMC:IO:INT EQU    %                                                             
CMCINT   EQU      CMC:IO:INT                                                    
         LI,R3    LCOC              # OF CMC'S IN SYSTEM                        
I:FNDCHN CH,R2    COH:DN,R3         LOOKUP THE ADDRESS                          
         BE       I:GOTIT                                                       
         AI,R3    -1                                                            
         BGEZ     I:FNDCHN                                                      
*                                                                               
*  SCREECH 10-01   AIO HANDLER FED CMC:IO:INT A BAD CMC ADDRESS                 
*                                                                               
         SCREECH  X'10',1                                                       
*                                                                               
I:GOTIT  LB,R2    R1                GET CMC AIO BYTE                            
         CI,R2    X'08'             IS IT A CHANNEL END?                        
         BANZ     %+3               NO                                          
         LI,R9    X'80'             YES...SO                                    
         STB,R9   CM:BSY,R3         SET CHANNEL INT IS IN                       
         AND,R2   =X'F'             AIO CODE TO R2***                           
         LB,R5    R1                                                            
         SLS,R5   -4                                                            
         AND,R5   =X'7'             R5=REL LINE NUMBER IN CMC                   
         SLS,R3   +3                                                            
         OR,R5    R3                ADD IN CMC NUMBER                           
         SLS,R3   -3                                                            
         LB,R13   CM:LNBSY,R5       GET LINE STATUS BYTE                        
         EXU      GETBIT,R2         GET BIT TO SET IN R10                       
SETR13   EQU      %                                                             
         STB,R13  CM:LNBSY,R5       SET FLAG                                    
         CI,2     8                 CHECK THE FUNCTION CODE                     
         BGE      CHKTRIG           CHECK NEED FOR TRIGGER                      
*                                                                               
*  ON CHANNEL END, TRIGGER ONLY IF MORE WORK FOR CMC TO DO                      
*                                                                               
         MTW,0    CM:SUBOP,3        IS THERE ANY SUBOPERATION??                 
         BNEZ     TRIGGER                                                       
         MTW,0    CM:TRIGGER,3                                                  
         BNEZ     TRIGGER                                                       
         LI,2     0                                                             
         STB,2    CM:BSY,3          SHOW CHANNEL IS FREE                        
         B        *R14                                                          
CHKTRIG  EQU      %                 CHECK NEED FOR NON CHANNEL END INT          
         CI,2     11                SEE IF COUNT DOWN                           
         BNE      %+4                                                           
         LB,2     COCOC,5           SEE IF ANY MORE FOR THE LINE                
         BEZ      *R14                                                          
         B        CHKTRGER                                                      
         CI,2     12                                                            
         BG       CHKTRGER                                                      
         MTW,1    CM:TRIGGER,3      SHOW WORK TO DO                             
CHKTRGER EQU      %                                                             
         MTB,0    CM:BSY,3                                                      
         BNEZ     *R14                                                          
TRIGGER  EQU      %                                                             
         MTW,1    CM:INTIN          SHOW INTERRUPT HAS BEEN DONE                
         LW,R5    CO:IIL            GET EXT INT LEVEL                           
         WD,R5    X'1700'+COA:IG    TRIGGER IT                                  
         B        *R14              RETURN TO AIO HANDLER                       
*                                                                               
GETBIT   RES      0                                                             
         NOP                        CHANNEL END ONLY                            
         B        BUFERR            BUFFER ERROR                                
         B        SETMORE           SET NEED TO REED                            
         B        CMDERR            COMMAND ERROR                               
         NOP                        IGNORE DATA ERRORS FOR NOW                  
         B        BADORD            INVALID ORDER CODE                          
         B        SETMORE           SET NEED TO REED                            
         NOP                        TDV ABORT                                   
         B        CONNECT           LINE ATTACHED                               
         OR,R13   =X'10'            LINE DISCONNECT                             
         OR,R13   =X'40'            LINE BREAK                                  
         AND,R13  =X'FE'            RESET BUFFER FULL                           
         OR,R13   =X'80'            NEED TO READ                                
         AND,R13  =X'FE'            LINE ON OTHER PORT--DON'T HANG UP           
         OR,R13   =X'08'            LINE MARKED DOWN                            
         SCREECH  X'10',X'F'        FIRMWARE FAULT                              
*                                                                               
SETMORE  EQU      %                 FLAG MORE WORK TO DO FOR CMC                
         OR,13    =X'80'                                                        
         MTW,1    CM:TRIGGER,3                                                  
         B        SETR13            AND GO FINISH LIKE EXECUTE                  
CONNECT  EQU      %                 LINE HAS CONNECTED                          
         OR,13    =X'20'            SET THE BIT STILL                           
         LB,6     CM:STAT,5         AND HERE ALSO                               
         OR,6     =X'80'                                                        
         STB,6    CM:STAT,5                                                     
         B        SETR13                                                        
BUFERR   EQU      %                 HANDLE THE BUFFER ERROR                     
         LI,9     ECHOERR           MAKE WRITE RETRY A SUB OPERATION            
         STW,9    CM:SUBOP,3                                                    
         OR,13    =X'01'            SET WAIT FOR EMPTY INTERRUPT                
         B        SETR13            AND GO TRIGGER                              
CMDERR   SCREECH  X'10',3           COMMAND FORMAT ERR                          
BADORD   SCREECH  X'10',4           BAD ORDER CODE                              
*                                                                               
*                                                                               
 TITLE 'C M C U   -   E X T E R N A L   I N T   P R O C E S S O R'              
*                                                                               
COCIP    MTB,-1   CO:INTFL          INHIBIT T:COCHC                             
         MTW,1    CM:INTS           NOTCH COUNT OF INTERRUPTS                   
         LI,5     0                                                             
         XW,5     CM:INTIN          SEE IF WORK TO DO                           
         BEZ      CMCEXITA          IF ZERO, THEN A FALSE INTERRUPT             
         LI,R0    LMIRTS+(2*CTLMID) USE CT STACK                                
         XW,R0    K:RTS                                                         
         STW,R0   COC:RTS           SAVE ACTIVE STACK                           
*                                                                               
*  CHECK FOR ANY SUB OPERATIONS FOR ALL CMCS                                    
*                                                                               
RESCH    EQU      %                                                             
         LI,3     LCOC              INDEX TO LOOP ON                            
RESCH1   EQU      %                                                             
         LC       CM:BSY,3          ANY WORK ON THIS CMC??                      
         BCS,8    RESCH2                                                        
RESCH11  EQU      %                                                             
         AI,3     -1                                                            
         BGEZ     RESCH1                                                        
         B        RESCH3                                                        
*                                                                               
*  CHANNEL END FLAGGED, CLEAR CM:BSY AND DO ANY POST-OP                         
*                                                                               
RESCH2   EQU      %                                                             
         LI,5     0                                                             
         STB,5    CM:BSY,3                                                      
         XW,5     CM:SUBOP,3                                                    
         BEZ      RESCH11           IF ZERO, THEN NO SUB OP                     
         LB,2     CM:LINE,3         LOAD LINE FOR SUB-OP                        
         B        0,5               AND GO DO THE SUBOP                         
*                                                                               
*  SCHEDULE WORK FOR EACH CMC NOW                                               
*                                                                               
RESCH3   EQU      %                                                             
         MTW,1    CM:SCHED          NOTCH COUNT OF SCHEDULES                    
         LI,3     LCOC              LOAD NUMBER OF CMC'S                        
RESCH4   EQU      %                                                             
         MTW,0    CM:TRIGGER,3      ANY WORK TO DO HERE??                       
         BNEZ     RESCH6            IF NON ZERO, THEN YES!!                     
RESCH5   EQU      %                                                             
         AI,3     -1                                                            
         BGEZ     RESCH4            CONTINUE                                    
         B        IOSFIN            SEE IF WE SHOULD EXIT                       
RESCH6   EQU      %                                                             
         LW,2     3                                                             
         SLS,2    3                 COMPUTE HIGH LINE ADDRESS                   
         AI,2     7                                                             
         LB,5     CM:BSY,3          SEE IF CMC IS BUSY                          
         BNEZ     CHKBRKS           IF SO, LOOK FOR BREAKS ONLY                 
         STW,5    CM:PWORK          SET PENDING WORK FLAG TO NO                 
         INHIBIT                    NO INTERRUPTS NOW PLEASE                    
RESCH7   EQU      %                                                             
         LC       CM:LNBSY,2        ANY WORK TO DO                              
         BCS,15   IOSCH1                                                        
         LB,5     COCOC,2                                                       
         BNEZ     WRTLINE           GO HANDLE THE WRITE                         
IOSCH    EQU      %                                                             
         AI,2     -1                                                            
         CLM,2    COD:LPC,3                                                     
         BIL      RESCH7                                                        
         LW,5     CM:PWORK          SEE IF ANY WORK FOR US PENDING              
         BNEZ     RESCH5            IF SO, DON'T CLEAR COUNTER                  
         STW,5    CM:TRIGGER,3                                                  
         RINHIBIT                                                               
         B        RESCH5                                                        
*                                                                               
*  CMC IS CURRENTLY BUSY--LOOK FOR BREAKS ONLY                                  
*                                                                               
CHKBRKS  EQU      %                                                             
         LC       CM:LNBSY,2                                                    
         BCS,4    GOTABRK                                                       
         AI,2     -1                                                            
         CLM,2    COD:LPC,3                                                     
         BIL      CHKBRKS                                                       
         B        RESCH5                                                        
GOTABRK  EQU      %                                                             
         LI,11    CHKBRKS+2                                                     
         PUSH     R11                                                           
         B        LOGBRK0           AND GO HANDLE IT                            
*                                                                               
*  CHECK WHICH WORK TO DO FOR THE LINE                                          
*                                                                               
IOSCH1   EQU      %                                                             
         BCS,8    RDLIN             NEEDS A READ                                
         BCS,4    LOGBRK            GOT A BREAK                                 
         BCS,2    IOSCH2            GOT WORK TO DO IN CM:STAT                   
         B        LOGDCON           GOT A LINE DISCONNECT                       
*                                                                               
*  WORK TO DO IN CM:STAT TABLE                                                  
*                                                                               
*    BIT 0 - LINE CONNECTED BIT                                                 
*    BIT 1 - INPUT OR OUTPUT TO BE CANCELLED                                    
*    BIT 2 - XON / XOFF TO BE ALTERED                                           
*    BIT 3 - UNUSED                                                             
*    BIT 4 - SET XON/XOFF                                                       
*    BIT 5 - SET XON/XOFF                                                       
*    BIT 6 - CANCEL INPUT                                                       
*    BIT 7 - CANCEL OUTPUT                                                      
*                                                                               
IOSCH2   EQU      %                                                             
         LC       CM:STAT,2                                                     
         BCS,8    LOGCON                                                        
         BCS,2    XONOFF                                                        
         BCS,4    IOCANCEL                                                      
         INHIBIT                    RESET TABLE                                 
         LB,5     CM:LNBSY,2                                                    
         AND,5    =X'DF'                                                        
         STB,5    CM:LNBSY,2                                                    
         RINHIBIT                                                               
         B        SETPWORK                                                      
*                                                                               
*  WE NEED TO TURN XON/XOFF EITHER ON OR OFF                                    
*                                                                               
XONOFF   EQU      %                                                             
         BCS,13   XONOFF0                                                       
         INHIBIT                                                                
         LB,6     CM:LNBSY,2        UPDATE THIS CELL AS NEEDED                  
         AND,6    =X'DF'                                                        
         STB,6    CM:LNBSY,2                                                    
         B        XONOFF0+1                                                     
XONOFF0  EQU      %                                                             
         INHIBIT                                                                
         LB,6     CM:STAT,2                                                     
         LB,5     CM:STAT,2         SAVE R6 FOR LATER, USE R5 NOW               
         AND,5    =X'D1'                                                        
         STB,5    CM:STAT,2                                                     
         RINHIBIT                                                               
         MTW,-1   CM:TRIGGER,3      DECREMENT WORK COUNTER                      
         AND,6    =X'F'             MASK TO BITS TO DO                          
         SLS,6    4                                                             
         LW,10    CM:BUF,3          LOAD ADDRESS OF CMC BUFFER                  
         STW,6    *10               AND PUT IT THERE                            
         B        SETUPCOM          AND GO FINISH SET BUILDING                  
*                                                                               
*  WE NEED TO CANCEL INPUT OR OUTPUT--DO IT                                     
*                                                                               
IOCANCEL EQU      %                                                             
         BCS,11   IOCANCEL0         IF OTHERS SET, DON'T RESET                  
         INHIBIT                                                                
         LB,6     CM:LNBSY,2                                                    
         AND,6    =X'DF'                                                        
         STB,6    CM:LNBSY,2                                                    
         B        IOCANCEL0+1                                                   
IOCANCEL0 EQU     %                                                             
         INHIBIT                                                                
         LB,6     CM:STAT,2         SAVE IT                                     
         LB,5     CM:STAT,2                                                     
         AND,5    =X'BC'                                                        
         STB,5    CM:STAT,2                                                     
         MTW,-1   CM:TRIGGER,3      DECREMENT WORK COUNTER                      
         RINHIBIT                                                               
         AND,6    =X'3'             MASK TO BITS ONLY                           
         BEZ      SETPWORK          NOTHING TO DO--XONOFF DID IT ALL            
         SLS,6    4                                                             
         LW,10    CM:BUF,3          LOAD CMC BUFFER ADDRESS                     
         STW,6    *10               AND STORE IN WHAT TO DO                     
         B        SETUPCOM          GO TO COMMON HANDLER                        
*                                                                               
*  WE ARE TO WRITE TO A LINE--SEE IF WE CAN!!                                   
*                                                                               
WRTLINE  EQU      %                                                             
         RINHIBIT                   ALLOW INTERRUPTS                            
         LB,R10   CM:LNBSY,R2       GET USER'S FLAGS                            
         CI,R10   X'03'             IS WRITE OK?                                
         BANZ     CHKWORK           NO, BLOCKED ON CMC BUFFERS                  
         LC       MODE6,R2          IS ESC-H ON?                                
         BCS,HLT     CHKWORK        YES, DON'T DO OUTPUT                        
         LI,R1    0                 ZERO CHAR COUNT                             
WRT01    PUSH     R1                SAVE COUNT                                  
         BAL,R11  COCOP             GET A CHARACTER FROM BUFFER                 
         B        WRT02A            NONE LEFT                                   
         PULL     R1                                                            
         LW,R10   CM:BUF,R3         POINT TO BUFFER                             
         STB,R5   *R10,R1           PUT THIS BYTE IN                            
         AI,R1    +1                COUNT IT                                    
         CW,1     CM:SIZE           SEE IF UP TO BUFFER SIZE YET                
         BL       WRT01             GET ALL WE CAN                              
         MTB,0    COCOC,R2           IF NO MORE OUTPUT                          
         BEZ      WRT02B             SET FOR CLEANUP                            
         B        WRT02             AVOID PULL R1                               
WRT02A   PULL     R1                 RESTORE COUNT                              
WRT02B   LI,R0    COCOP54            SET TO CLEANUP QUEUE ETC                   
         STW,R0   CM:SUBOP,3                                                    
WRT02    CI,R1    0                                                             
         BE       RESCH6            DON'T KNOW WHAT HAPPENED!                   
         LCW,10   1                 LOAD NEGATIVE OF COUNT                      
         AWM,10   CM:TRIGGER,3                                                  
         LW,R10   CM:CDW                                                        
         AW,R10   R3                                                            
         AW,R10   R3                POINT R10 TO CDW                            
         LW,R5    R2                GET LINE NUMBER                             
         AND,R5   =7                AS CMC OFFSET                               
         SLS,R5   +4                POSITION IT                                 
         CW,1     CM:ETHRSH         SEE IF TO ECHO OR WRITE                     
         BLE      WRT021            IF LESS OR EQUAL, GO ECHO IT                
         AI,R5    X'01'             FORM WRITE LINE X ORDER                     
         AWM,1    CM:WCHAR          NOTCH COUNT OF WRITE CHARACTERS             
         MTW,1    CM:RITES          NOTCH COUNT OF WRITE OPERATIONS             
         B        WRT03                                                         
WRT021   EQU      %                                                             
         AWM,1    CM:ECHAR          NOTCH COUNT OF ECHO CHARACTERS              
         AI,5     X'05'             SET ECHO ORDER                              
         MTW,1    CM:ECHOES         AND NOTCH COUNT OF ECHOES WE DO             
WRT03    EQU      %                                                             
         STB,R5   *R10              PUT IN CDW                                  
         AI,R10   +1                                                            
         STW,R1   *R10              PUT IN BYTE COUNT                           
         LI,R0    X'16'                                                         
         STB,R0   *R10              AND FLAGS                                   
         LW,R0    R10                                                           
         SLS,R0   -1                FORM DA(CM:CDW(CMC))                        
         CI,5     X'04'             SEE IF WE ARE USING ECHO                    
         BANZ     CMC:SIO                                                       
WRT04    EQU      %                                                             
         INHIBIT                                                                
         LB,R5    CM:LNBSY,R2       GET STATUS                                  
         OR,R5    =1                SET WAIT FOR EMPTY INT                      
         STB,R5   CM:LNBSY,R2                                                   
         RINHIBIT                                                               
         B        CMC:SIO           DO THE SIO                                  
*                                                                               
*  CHECK NEED TO GO TO NEXT CMC IF ONLY WORK IS FOR THIS LINE                   
*                                                                               
CHKWORK  EQU      %                                                             
         CW,5     CM:TRIGGER,3      ARE ALL TRIGGERS FOR THIS LINE              
         BE       RESCH5            IF SO, GO TO NEXT CMC                       
*                                   IF NOT, FALL TO SETPWORK                    
*                                                                               
*  SET PENDING WORK FLAG SO WE WON'T CLEAR CM:TRIGGER FOR CMC                   
*                                                                               
SETPWORK EQU      %                                                             
         MTW,1    CM:PWORK                                                      
         B        IOSCH                                                         
*                                                                               
*  HANDLE ECHO OVERFLOW SUB OPERATION                                           
*                                                                               
ECHOERR  EQU      %                                                             
         MTW,1    CM:ECHOERR        NOTCH COUNT OF ECHO ERRORS                  
         LW,0     CM:CDW                                                        
         AW,0     3                                                             
         AW,0     3                 BUILD THE COMMAND DOUBLEWORD ADDR           
         LB,1     *R0               LOAD OP CODE TO CHECK ORDER                 
         CI,1     X'01'                                                         
         BAZ      RESCH11           EMPTY READ IF AND IS ZERO                   
         AI,R0    1                 NOTCH TO BYTE COUNT WORD LOCATION           
         LW,R1    *R0                                                           
         AND,R1   =X'FF'                                                        
         AI,R1    -1                                                            
         LW,10    CM:BUF,R3         LOAD ADDRESS OF BUFFER                      
ECHOERR1 EQU      %                                                             
         LB,R5    *R10,R1           GET BACK THE DATA IN REVERSE ORDER          
         BAL,11   RESTUFF                                                       
         AI,R1    -1                                                            
         BGEZ     ECHOERR1                                                      
         B        RESCH11                                                       
*                                                                               
*  ROUTINE TO RE-STUFF DATA INTO FRONT OF COCBUF LINKED LIST                    
*                                                                               
RESTUFF  EQU      %                                                             
         PUSH     (R4,R6)                                                       
         LH,R4    COCOR,R2                                                      
         BNEZ     RESTUF1           ANY BUFS NOW, IF SO, GO PUT BACK            
         BAL,R6   COCGETB           GO GET A BUFFER                             
         B        RESTUFX           IF NONE, DATA IS LOST                       
         STH,R4   COCOI,R2          SET INSERTION POINT                         
         B        RESTUF2                                                       
*                                                                               
RESTUF1  EQU      %                 BACK UP 1 CHARACTER                         
         AI,R4    -1                                                            
         CI,R4    X'E'              DID WE GO TO FRONT OF BUFFER                
         BANZ     RESTUF2                                                       
         BAL,R6   COCGETB           YES NEED ANOTHER BUFFER                     
         B        RESTUFX           CAN'T GET ONE--DATA IS LOST                 
         AI,R4    -2                                                            
         LH,R6    COCOR,R2                                                      
         SLS,R4   -1                                                            
         STH,R6   COCBUF,R4                                                     
         SLS,R4   1                                                             
         AI,R4    15                                                            
RESTUF2  EQU      %                                                             
         STH,R4   COCOR,R2                                                      
         STB,R5   COCBUF,R4                                                     
         MTB,1    COCOC,R2                                                      
         MTW,1    CM:TRIGGER,3                                                  
RESTUFX  EQU      %                                                             
         PULL     (R4,R6)                                                       
         B        *R11              RETURN                                      
*                                                                               
*  READ FROM LINE                                                               
*                                                                               
RDLIN    EQU      %                                                             
         RINHIBIT                   ALLOW INTERRUPTS                            
         MTW,-1   CM:TRIGGER,3      DECREMENT COUNTER                           
         LW,R10   CM:CDW                                                        
         AW,R10   R3                                                            
         AW,R10   R3                POINT TO CMD DBLWD                          
         LW,R5    R2                                                            
         AND,R5   =7                LINE WITHIN CMC                             
         SLS,R5   +4                                                            
         AI,R5    X'02'             FORM READ LINE X ORDER                      
         STB,R5   *R10              PUT IN READ ORDER                           
         AI,R10   +1                POINT TO BYTE COUNT                         
         LW,5     CM:SIZE           LOAD CURRENT BUFFER SIZE                    
         OR,5     =X'16000000'                                                  
         STW,R5   *R10                                                          
         LI,R5    RDLIN1            GET POST-OP                                 
         STW,R5   CM:SUBOP,R3       SET AS FOLLOW-ON                            
         LW,R0    R10                                                           
         SLS,R0   -1                DA(CM:CDW(CMC))                             
         INHIBIT                                                                
         LB,R5    CM:LNBSY,R2       GET STATUS                                  
         AND,R5   =X'7F'            RESET READ REQUIRED BIT                     
         STB,R5   CM:LNBSY,R2                                                   
         RINHIBIT                                                               
         B        CMC:SIO           DO THE SIO                                  
*                                                                               
RDLIN1   LH,R5    COH:DN,R3         GET I/O ADR OF CMC                          
         TIO,R8   0,R5              GET BYTES REMAINING                         
         AND,R9   =X'FFFF'          IN R8                                       
         LW,7     8                 GET BYTES ASKED FOR                         
         SLS,7    1                                                             
         AI,7     1                                                             
         LW,7     0,7               LOAD THE SECOND WORD OF DOUBLEWORD          
         AND,7    =X'FFFF'          MASK THE BYTE COUNT                         
         SW,R7    R9                R7=BYTES READ                               
         BEZ      RESCH11           NONE CAME IN!!!                             
         MTW,1    CM:READS          NOTCH COUNT OF READS                        
         AWM,7    CM:RCHAR          AND COUNT THE NUMBER OF CHARACTERS          
         LW,R6    CM:BUF,R3         POINT R6 TO BUFFER                          
         LI,R4    0                 FETCH INDEX                                 
*                                                                               
*  R4 = FETCH INDEX                                                             
*  R6 = BUFFER POINTER                                                          
*  R7 = COUNT                                                                   
*                                                                               
RDLIN2   LB,R5    *R6,R4            GET CHARACTER                               
         PUSH     (R4,R7)           SAVE WORK REGS                              
         BAL,R11  COCIP512          PUT IN COCBUFS (MAYBE ECHO)                 
         PULL     (R4,R7)           RESTORE OUR REGS                            
         AI,R4    +1                BUMP FETCH                                  
         BDR,R7   RDLIN2            LOAD THEM ALL IN                            
         B        RESCH11           READ IS FINISHED                            
*                                                                               
*  LOG BREAK TO LINE                                                            
*                                                                               
LOGBRK   EQU      %                                                             
         LI,R11   SETPWORK                                                      
         PUSH     R11                                                           
LOGBRK0  EQU      %                                                             
         INHIBIT                                                                
         LB,R5    CM:LNBSY,R2       GET STATUS                                  
         AND,R5   =X'BF'            REMOVE BREAK BIT                            
         STB,R5   CM:LNBSY,R2                                                   
         RINHIBIT                                                               
         MTW,-1   CM:TRIGGER,3      DECREMENT WORK COUNT                        
LOGBRK1  LB,R4    COCTERM,R2                                                    
         LH,R10   COCOTV,R4         GET XLATE TABLE                             
         B        COCIPBRK          LOG A BREAK EVENT                           
*                                                                               
*  LOG LINE CONNECTED                                                           
*                                                                               
LOGCON   EQU      %                                                             
         BCS,7    LOGCON0           IF OTHER BITS SET, DON'T RESET              
         INHIBIT                                                                
         LB,R5    CM:LNBSY,R2       GET STATUS                                  
         AND,R5   =X'D0'            REMOVE CONNECT/FLAG BITS                    
         STB,R5   CM:LNBSY,R2                                                   
         B        LOGCON0+1         SKIP NEXT INHIBIT                           
LOGCON0  EQU      %                                                             
         INHIBIT                                                                
         LB,5     CM:STAT,2         GET BITS                                    
         AND,5    =X'7F'            RESET BY BIT                                
         STB,5    CM:STAT,2                                                     
         RINHIBIT                   ALLOW INTS                                  
         LB,5     MODE4INIT,2       SEE IF THIS LINE IS AUTOBAUDED              
         BNEZ     LOGBRK             IF NOT HANDLE LIKE BREAK                   
         MTW,-1   CM:TRIGGER,3      DECREMENT WORK COUNT                        
         LW,5     2                                                             
         AND,5    =7                BUILD SENSE ORDER                           
         SLS,5    4                                                             
         AI,5     4                                                             
         LW,R10   CM:CDW            BUILD COMMAND ADDRESS                       
         AW,10    3                                                             
         AW,10    3                                                             
         STB,5    *10               SET ORDER CODE                              
         AI,10    1                                                             
         LW,5     =X'16000005'      NEED A BYTE COUNT OF FIVE                   
         STW,5    *10                                                           
         LI,5     LOGCON1           SET SUB OPERATION HANDLER                   
         STW,5    CM:SUBOP,3                                                    
         LW,0     10                                                            
         SLS,0    -1                                                            
         B        CMC:SIO           AND GO ISSUE THE SIO                        
*                                                                               
*  SUB OPERATION HANDLER AFTER SENSE ORDER FOR SETTING BAUD RATE                
*                                                                               
LOGCON1  EQU      %                                                             
         LW,6     CM:BUF,3          LOAD ADDRESS OF BUFFER                      
         LW,5     1,6               LOAD THE STATUS WORD                        
         SLS,5    -24                                                           
         AND,5    =X'F'             MASK TO WHAT WE WANT                        
         LB,4     BAUDTBLE,5        LOAD CONVERTED VALUE FOR TCP-V              
         AI,4     X'28'                                                         
         STB,4    MODE4,2                                                       
         INHIBIT                    DISABLE INTERRUPTS                          
         LB,5     CM:LNBSY,2                                                    
         OR,5     =X'40'            SHOW A BREAK IS PENDING                     
         STB,5    CM:LNBSY,2                                                    
         RINHIBIT                   ALLOW INTERRUPTS                            
         MTW,1    CM:TRIGGER,3      SHOW WORK TO BE DONE HERE                   
         B        RESCH11           AND CONTINUE                                
*                                                                               
BAUDTBLE DATA,1   0,0,0,1,1,1,2,3,4,4,5,5,6,7,7,7                               
         BOUND    4                                                             
*  LOG LINE DISCONNECTED                                                        
*                                                                               
LOGDCON  INHIBIT                                                                
         LB,R5    CM:LNBSY,R2       GET STATUS                                  
         AND,R5   =X'EF'            REMOVE DISCONNECT BIT                       
         STB,R5   CM:LNBSY,R2                                                   
         MTW,-1   CM:TRIGGER,3      DECREMENT WORK COUNTER                      
         LB,6     LB:UN,R2          SEE IF ANY USER ASSOCIATED                  
         BEZ      LOGDCON1          IF NOT, THEN NO EVENT!!                     
         LW,R7    R2                 PUT INDEX IN R7 FOR T:RCE                  
         LI,R6    E:OFF             LOG 'OFF' EVENT                             
         BAL,R11  T:RCE             REPORT EVENT                                
LOGDCON1 EQU      %                                                             
         RINHIBIT                   ALLOW INTERRUPTS AGAIN                      
         LB,10    MODE6,2           SEE IF HARDWIRE LINE                        
         CI,10    X'01'             IF SO, NO NEED TO HANG UP                   
         BANZ     SETPWORK          AND RETURN VIA SETPWORK                     
         LW,R10   CM:BUF,R3         POINT TO DATA BUF                           
         LW,R5    =X'00200000'      SEND HANG UP ORDER                          
         STW,R5   *R10                                                          
*                                                                               
*  COMMON CODE FOR BUILDING SETUP ORDER                                         
*                                                                               
SETUPCOM EQU      %                                                             
         LW,R10   CM:CDW                                                        
         AW,R10   R3                                                            
         AW,R10   R3                POINT TO CDW                                
         LW,R5    R2                                                            
         AND,R5   =7                                                            
         SLS,R5   +4                LINE WITHIN CMC                             
         AI,R5    X'03'             MAKE SETUP LINE X ORDER                     
         STB,R5   *R10              PUT IN CDW                                  
         AI,R10   +1                                                            
         LW,R5    =X'16000004'      BC = 4                                      
         STW,R5   *R10                                                          
         LW,R0    R10                                                           
         SLS,R0   -1                SIM: LI,R0  DA(CM:CDW(LN))                  
*                                                                               
*  SEND AN SIO TO A CMC                                                         
*                                                                               
CMC:SIO  STB,R2   CM:LINE,R3        LINE # DOING THE I/O                        
         LI,R4    X'01'             MARK LINE BUSY                              
         STB,R4   CM:BSY,R3                                                     
         LI,R4    +3                SET CMC TIMEOUT                             
         STB,R4   CM:TOCNT,R3                                                   
         LH,R5    COH:DN,R3         GET I/O ADR OF HIS CMC                      
         LI,6     20                ATTEMP THE SIO UP TO TWENTY TIMES           
         SIO,R0   0,R5              DO THE SIO                                  
         BCR,12   RESCH5            DONE HERE                                   
*                                                                               
*  CMC REFUSED THE SIO!! RETRY UP TO TWENTY TIMES AND THEN IGNORE               
*                                                                               
         LI,1     X'FFF'                                                        
         BDR,1    %                                                             
         BDR,6    %-4                                                           
         MTW,1    CM:SIOFAILS       NOTCH COUNT OF FAILURES                     
         STB,6    CM:BSY,3          RESET FLAG                                  
         STB,6    CM:LNBSY,2        RESET LINE FLAGS ALSO                       
         B        RESCH5            AND  ONTO THE NEXT CMC                      
*                                                                               
*                                                                               
*   DONE WITH A TRIP THROUGH, SEE IF ANY WORK LEFT                              
*                                                                               
IOSFIN   LI,R5    0                                                             
         INHIBIT                    *** INHIBIT INTERRUPTS ***                  
         XW,5     CM:INTIN          SEE IF ANY INTERRUPT OCCURRED               
         BNEZ     IO:REDO                                                       
*                                                                               
*  NOTHING TO DO, BAIL OUT                                                      
*                                                                               
CMCEXIT  EQU      %                                                             
         LW,R4    COC:RTS                                                       
         STW,R4   K:RTS             RESTORE ACTIVE STACK                        
CMCEXITA EQU      %                                                             
         LW,R4    CO:IIL                                                        
         :WD,R4   ARM%ENABLE,COA:IG ARM AND ENABLE CMC INTERRUPT                
         LI,R4    0                 CLEAR TIMEOUT FLAG                          
         STB,R4   CO:INTFL                                                      
         LPSD,8   CO:IN0                                                        
IO:REDO  RINHIBIT                                                               
         B        RESCH             PICK UP INTS                                
 TITLE 'C M C U   -   P U T   C H A R   I N   C O C B U F'                      
         PAGE                                                                   
*                                                                               
*                 SUBROUTINE TO 1 CHARACTER IN                                  
*                 NORMAL CHAR PROCESSING - 2=LINE, 5= CHAR                      
*                                                                               
COCIP512 EQU      %                                                             
         DO       PMONOFF=1                                                     
         MTW,1    C:CI              BUMP COUNT OF CHARACTERS INPUT              
         FIN                                                                    
         PUSH     R11              SAVE LINK REGISTER                           
         LB,R4    COCTERM,R2                                                    
         LH,R10   COCOTV,R4                                                     
         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                                                             
*                                                                               
*  EXIT CHARACTER IN PROCESSING                                                 
*                                                                               
COCIP01  PULL     R11                                                           
         B        *R11                                                          
*                                                                               
         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       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      %                                                             
         INHIBIT                                                                
         LB,4     CM:LNBSY,2        LOAD THIS TABLE VALUE                       
         OR,4     =X'20'            SET BIT FOR WORK TO DO IN CM:STAT           
         STB,4    CM:LNBSY,2                                                    
         LB,4     CM:STAT,2         SET WHAT WORK TO DO                         
         OR,4     =X'42'            CANCEL INPUT ORDER                          
         STB,4    CM:STAT,2                                                     
         RINHIBIT                   ALLOW INTERRUPTS                            
         LW,4     2                                                             
         SLS,4    -3                                                            
         MTW,1    CM:TRIGGER,4      SHOW WORK FOR THIS CMC TO DO                
         MTB,0    CM:BSY,4          SEE IF ALLREADY ACTIVE                      
         BNEZ     KILLIN0                                                       
         MTW,1    CM:INTIN          SHOW INTERRUPT IN                           
         MTW,1    CM:RINT           SHOW INTERRUPT IS FROM ROOT                 
         LW,4     CO:IIL            GET INTERRUPT LEVEL BITS                    
         WD,4     X'1700'+COA:IG    AND FIRE IT                                 
KILLIN0  EQU      %                                                             
         LH,R0    COCII,R2                                                      
         LH,R4    COCIR,R2                                                      
KILLIN1  EQU      %                                                             
         BAL,D3   COCFIB            RELEASE LINKS                               
         LI,R6    X'8000'                                                       
         LH,R4    TL,R2                                                         
         STH,R6   TL,R2             CLEAR TAB LINK                              
         BLEZ     *R9               B/NO TAB BUFFERS                            
         BAL,R6   COCPUTBL          RELEASE TAB BUFFERS                         
         BGZ      %-1                                                           
*        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'08'              SEND BACKSPACE                             
         BAL,SR2  COCSEND1                                                      
         LI,R5    X'40'              SEND BLANK                                 
         BAL,SR2  COCSEND1                                                      
         LI,R5    X'08'              SEND ONE MORE BACKSPACE                    
         BAL,SR2  COCSEND1                                                      
         MTB,-1   CPOS,R2            ADJUST CURRENT POSITION                    
         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
         PUSH     R11              SAVE RETURN LINK                             
*                                                                               
         LB,SR4   COCOC,R2                                                      
         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                      
         PULL     R5                                                            
         AI,R5    +1               BUMP RETURN IF CHAR IS AVAIL                 
         PUSH     R5                                                            
         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   -1                                                            
         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      %                                                             
         B        COCOP57                                                       
COCOP54  EQU      %                                                             
         LB,R6    LB:UN,R2          DCT INDEX                                   
         LB,R6    DCT18,R6          Q INDEX                                     
         BEZ      RESCH11          NO                                           
         LC       IOQ3,R6           Q BUSY                                      
         BCR,8    RESCH11          NO                                           
         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                                   
*              DELETE DATA SET OFF/ON REINITIALIZATION                          
         BAL,R4   COCMINT           INITIALIZE LINE PARAMETERS                  
COCOP25  EQU      %                                                             
*                                   REGISTERS ARE NOW DESTROYABLE               
         LB,R1    LB:UN,R2          GET DCT INDEX                               
         BEZ      %+4                                                           
         PUSH     0,R0                                                          
         BAL,R2   SERDEV                                                        
         PULL     0,R0                                                          
SCHDEXIT EQU      %                                                             
         DISABLE                                                                
         BAL,R13  COCENABL          ENABLE COC INTERRUPTS                       
         B        RESCH11                                                       
*                                                                               
*                                                                          10100
COCOP20  EQU      %                                                             
         STB,R4   COCOC,R2          ZERO OUTPUT COUNT                           
         B        COCOP57                                                       
COCOP30  EQU      %                                                             
         MTW,1    COCOEC            BUMP OUTPUT ERROR COUNT                     
         STW,R2   COCOEL            RECORD INVALID LOGICAL LINE                 
COCOP57  EQU      %                                                             
         PULL     R11              GET RETURN                                   
         B        *R11             EXIT                                         
*                                                                               
         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:IIL            GET CMC INTERRUPT LEVEL                     
         :WD,R14  ENABLE,COA:IIG    ENABLE COC INPUT 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:IIL            GET CMC INTERRUPT LEVEL                     
         :WD,R14  DISABLE,COA:IIG   DISABLE COC INPUT 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                                                             
         INHIBIT                                                                
         LW,4     COCHPB            HEAD                                        
         BEZ      GETB2              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                                                             
         AI,R6    1                                                             
GETB2    EQU      %                                                             
         RINHIBIT                                                               
         B        0,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      %                                                             
         INHIBIT                                                                
         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                            
         RINHIBIT                                                               
         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)         
         LW,R3    R0                                                            
         LI,9     X'24'             ASSUME WE ARE TO TURN XON OFF               
         CI,3     X'20'                                                         
         BANZ     %+2                                                           
         LI,9     X'2C'             IT IS NON TRANS--TURN XON ON                
         INHIBIT                    SET UP TO SHOW CMC WORK TO DO               
         LB,3     CM:LNBSY,2                                                    
         OR,3     =X'20'            SHOW WORK TO DO                             
         STB,3    CM:LNBSY,2                                                    
         LB,3     CM:STAT,2                                                     
         OR,3     9                 SHOW WHAT WORK TO DO                        
         STB,3    CM:STAT,2                                                     
         RINHIBIT                   ALLOW INTERRUPTS                            
         LW,3     2                 LOAD LINE NUMBER                            
         SLS,3    -3                CONVERT TO CMC INDEX                        
         MTW,1    CM:TRIGGER,3      SHOW WHAT WORK TO DO                        
         MTB,0    CM:BSY,3          SEE IF CURRENTLY ACTIVE                     
         BNEZ     COCRD15           IF SO, DON'T TRIGGER IT                     
         MTW,1    CM:RINT           SHOW ROOT INTERUPT FIRED                    
         MTW,1    CM:INTIN          SHOW INTERRUPT IS IN                        
         LW,3     CO:IIL            LOAD INTERRUPT LEVEL BITS                   
         WD,3     X'1700'+COA:IG    AND TRIGGER IT                              
COCRD15  EQU      %                                                             
         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                                                          
         LB,R6    LB:UN,R2           GET DCT INDEX                              
         LB,R6    DCT6,R6            GET IOQ INDEX                              
         LW,R6    IOQECB,R6          GET ECB ADDRESS                            
         LW,R6    6,R6               GET TIMEOUT VALUE                          
         CW,R6    Y4                 IS IT SPECIAL TIMEOUT                      
         BAZ      %+3                NO, BRANCH                                 
         LW,D3    R6                 MOVE TO D3                                 
         AND,D3   M16                REMOVE SPECIAL FLAG                        
         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       
*                                                                               
*   FLUSH ANY PENDING OUTPUT FOR CMC CHANNEL                                    
*                                                                               
         LB,R6    COCOC,R2          ANY OUTPUT PENDING?                         
         BEZ      COCRD50E          NO, ALL IS WELL                             
         LW,6     2                                                             
         SLS,6    -3                                                            
         MTB,0    CM:BSY,6                                                      
         BNEZ     COCRD50E          IF NOT ZERO, CMC WILL RUN                   
         MTW,1    CM:TRIGGER,6      SHOW WORK TO DO                             
         MTW,1    CM:RINT           COUNT ROOT INTERRUPTS SENT OUT              
         MTW,1    CM:INTIN          SHOW WE TRIGGERED THE INTERRUPT             
         LW,R6    CO:IIL            NO, GET EXT INT BITS                        
         WD,R6    X'1700'+COA:IG    **** TRIGGER CMC EXT INT ***                
         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      %                                                             
         LB,5     COCOC,2           CHECK OUR OUTPUT COUNT                      
         CW,5     CM:LTHRSH         SEE IF AT LOCKOUT THRESHOLD                 
         BG       COCWR11                                                       
         INHIBIT                    IF UNDER LIMIT, THEN LOCK                   
         LB,5     CM:LNBSY,2                                                    
         OR,5     =X'02'            LOCK IT                                     
         STB,5    CM:LNBSY,2                                                    
         RINHIBIT                    ALLOW                                      
COCWR11  EQU      %                 CONTINUE                                    
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        COCWR801           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 PUSH     R5                                                            
         INHIBIT                    RESET LOCK OUT FLAG                         
         LB,5     CM:LNBSY,2                                                    
         AND,5    =X'FD'                                                        
         STB,5    CM:LNBSY,2                                                    
         RINHIBIT                                                               
         LW,5     2                                                             
         SLS,5    -3                                                            
         MTB,0    CM:BSY,5                                                      
         BNEZ     COCWR802                                                      
         MTW,1    CM:RINT           COUNT ROOT INTERRUPTS SENT OUT              
         MTW,1    CM:INTIN          SHOW WE TRIGGERED THE INTERRUPT             
         LW,R5    CO:IIL            NO, GET EXT IN BITS                         
         WD,R5    X'1700'+COA:IG    **** TRIGGER CMC EXT INT ***                
COCWR802 EQU      %                                                             
         PULL     R5                                                            
         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                                                      
         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                                   
         LW,4     2                 NOTCH COUNT FOR CMC                         
         SLS,4    -3                                                            
         MTW,1    CM:TRIGGER,4                                                  
         B        SENDXIT                                                       
*                 BUFFER IS UNAVAILABLE, REG IF USER CAN BE BLOCKED             
SENDBLOK EQU      %                                                             
         PULL     R4                                                            
SENDBLK1 EQU      %                                                             
SENDBLK2 EQU      %                                                             
         B        SENDXIT           BRANCH                                      
*                                                                               
         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    IDLXIT            B/HALF DUPLEX PAPER TAPE                    
         LC       MODE2,R2                                                      
         BCR,4    %+3               B/NOT FULL DUPLEX PAPER TAPE MODE           
         LC       MODE,R2                                                       
         BCR,8    IDLXIT            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    SYN               L/SYN CHAR; 2741 TIMING CHAR                
         BAL,R9   COCSEND2          SEND IDLES                                  
         BDR,R4   COCSEND2                                                      
IDLXIT   EQU      %                                                             
         LW,4     2                                                             
         SLS,4    -3                                                            
         MTB,0    CM:BSY,4          SEE IF ANY CMC'S ARE BUSY                   
         BNEZ     SENDXIT                                                       
         MTW,1    CM:RINT           COUNT ROOT INTERRUPTS SENT OUT              
         MTW,1    CM:INTIN          SHOW WE TRIGGERED THE INTERRUPT             
         LW,R4    CO:IIL            YES, GET EXT INT BITS                       
         WD,R4    X'1700'+COA:IG    **** TRIGGER CMC EXT INT ***                
         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        
         LD,SR1   COD:HWL,R5        GET HARDWIRE BITS IN SR1&SR2                
         LB,R6    CM:BSY,R5         IS THIS CMC ACTIVE?                         
         CI,R6    X'01'                                                         
         BNEZ     CMCNTO            NO, DON'T TIME IT OUT                       
         LW,R6    C:TINC            IF IN CATCH-UP CLOCK MODE                   
         AI,R6    +600              AND WAY BEHIND                              
         BLZ      CMCNTO            DON'T CHECK TIMEOUT NOW                     
         MTB,-1   CM:TOCNT,R5       YES, ON MORE TICK GONE                      
         BNEZ     CMCNTO            STILL OK                                    
         LI,R6    X'80'             TIMED OUT, FORCE CHAN END                   
         STB,R6   CM:BSY,R5                                                     
         LW,R6    CO:IIL            AND TRIGGER EXT INT                         
         WD,R6    X'1700'+COA:IG                                                
         MTW,+1   CM:PASS           LOG TIME-OUTS                               
*                                                                               
CMCNTO   LD,R6    COD:LPC,R5        RANGE OF LOGICLA LINES ON CMC               
         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         
         LW,R2    R7                L/LINE # FOR 2741DEL, CHKLOGON, COCM        
         B        COCHC5                                                        
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                                                                    
         B        COCHC8            NO USERS, CHECK NEXT LINE                   
*                                                                               
*                 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                              
         LB,R3    MODE,R7            RESET READ PENDING                         
         AND,R3   EF                                                            
         STB,R3   MODE,R7                                                       
         LH,R3    COCII,R7                                                      
         LI,R6    E:TO               SET TO REPORT TIMEOUT                      
         B        COCHC28                                                       
         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      %                                                             
         LH,R5    COH:DN,R3         L/COC ADR FOR THIS COC                      
         TIO,R13  0,R5              SEE IF THERE                                
         BCS,8    BADADR            NOPE                                        
CMCTSTP  EQU      %                                                             
         LI,R10   CM:START          CMD DBLWD BUFFER                            
         LI,R1    0                                                             
         LW,R13   DSENSE,R1         MOVE RAW CMDLIST                            
         STW,R13  *R10,R1           TO CM:START                                 
         AI,R1    +1                                                            
         CI,R1    +6                MOVE TWO IOCDS + 2 DATA WORDS               
         BL       %-4                                                           
         LW,R0    R10                                                           
         SLS,R0   -1                DA(CM:START)                                
         LI,R1    0                                                             
         LW,R14   R10                                                           
         AI,R14   +4                POINT TO LINE0SNS                           
         LI,R15   X'7FFFF'          BA MASK                                     
CMCTSTP1 SLS,R14  +2                BA(CM:START+4)                              
         STS,R14  *R10,R1           PUT IN CMDLIST                              
         SLS,R14  -2                                                            
         AI,R14   +1                                                            
         AI,R1    +2                BUMP STORE INDEX                            
         CI,R1    +4                                                            
         BL       CMCTSTP1                                                      
         LI,R12   10                NUMBER OF TIMES TO RETRY SIO                
CMCTSTP2 EQU      %                                                             
         SIO,0    0,R5              SENSE CMC                                   
         BCR,12   CMCTSTP4          SKIP IF SIO STARTED OK                      
         HIO,0    0,R5              CLEAR IF BUSY, SO CAN SENSE                 
         LI,R13   2000              SET TO DELAY                                
         BDR,R13  %                 DELAY A COUPLE OF MSECS                     
         BDR,R12  CMCTSTP2          AND RETRY                                   
         B        BADADR            REPORT ERROR                                
CMCTSTP4 EQU      %                                                             
         LI,R12   10                NUMBER OF TIMES TO RETRY TIO                
CMCTSTP5 EQU      %                                                             
         LI,R10   10000             DELAY                                       
         BDR,R10  %                 10 MSEC OR WHATEVER                         
         TIO,R13  0,R5              SEE IF SENSE DONE                           
         BCR,12   CMCTSTP6          SKIP IF SO                                  
         BDR,R12  CMCTSTP5          ELSE AROUND AGAIN                           
         HIO,0    0,R5              TOO LONG, KILL IT AND                       
         B        BADADR            ERROR, CMC HUNG UP ?????                    
CMCTSTP6 EQU      %                                                             
         LI,R12   0                 ASSUME NEITHER A NOR B                      
         LB,R10   CM:START+5        GET SENSE BYTE                              
         CI,R10   2                 CHECK IF PORT-A ON                          
         BAZ      %+2               NO, SKIP                                    
         AI,R12   X'400'            YES, SET TO ENABLE PORT-A                   
         CI,R10   1                 CHECK IF PORT-B ON                          
         BAZ      %+2               NO, SKIP                                    
         AI,R12   X'800'            YES, SET TO ENABLE PORT-B                   
         LI,R13   X'C00'                                                        
         STS,R12  SETUP             SET PORT IN SETUP ORDER                     
         STS,R12  SETUPF             AND IN FORCE CONNECT ORDER                 
         CI,10    X'80'             SEE IF RUNNING ON A OR B                    
         BANZ     ONPORTA           SYSTEM WIRED TO PORT A                      
         CI,10    1                 SEE IF SWITCH ALLOWS SYSTEM B               
         BANZ     OURS              IF SO, THIS SYSTEM CAN USE                  
         B        INIT300           IF NOT, NO OUR CMC, ONTO NEXT               
ONPORTA  EQU      %                                                             
         CI,10    2                 SEE IF SWITCH ALLOWS SYSTEM A               
         BAZ      INIT300           IF NOT, NOT OUR CMC, ONTO NEXT              
OURS     EQU      %                                                             
         LI,R10   CM:START          CMD DBLWD BUFFER                            
         LI,R1    0                                                             
         LW,R13   INITCL,R1         MOVE RAW CMDLIST                            
         STW,R13  *R10,R1           TO CM:START                                 
         AI,R1    +1                                                            
         CI,R1    +16                                                           
         BL       %-4                                                           
         LW,R0    R10                                                           
         SLS,R0   -1                DA(CM:START)                                
         LI,R1    0                 REL LINE ON CMC                             
         LW,R14   R10                                                           
         AI,R14   +16               POINT TO SETUP WDS                          
         LI,R15   X'7FFFF'          BA MASK                                     
INITCMD  SLS,R14  +2                BA(CM:START+16)                             
         STS,R14  *R10,R1           PUT IN CMDLIST                              
         SLS,R14  -2                                                            
         LW,R13   SETUP             GET SETUP WD                                
*                                                                               
*  SET MODEM/HW BITS IN SETUP COMMAND                                           
*                                                                               
*   R1 = LINE ON CMC  (0-7) * 2                                                 
*       R3 = CMC NUMBER (0-N)                                                   
*   R0 = DA(CM:START) COMMAND LIST                                              
*   R5 = I/O ADRESS OF CMC                                                      
*   R13 = SETUP WORD SET FOR HARD WIRE TERMINAL                                 
*                                                                               
*                                                                               
         LW,R4    R3                                                            
         SLS,R4   +3                CMC# * 8                                    
         SLS,R1   -1                                                            
         AW,R4    R1                + REL LINE = CP-V LINE #                    
         SLS,R1   +1                                                            
         LB,R8    MODE4INI,R4        IS IT AUTOBAUD                             
         BEZ      INIT219            YES  BRANCH                                
         LI,R9    15                 NO  SET UP FOR FORCE CONNECT               
         SLD,R8   16                                                            
         LW,R13   SETUPF                                                        
         STS,R8   R13                                                           
INIT219  RES      0                                                             
         LB,R9    MODE6,R4          CHECK HW BITS                               
         CI,R9    HW                IS THIS HARD WIRE?                          
         BANZ     %+2               YES, OK AS IS                               
         OR,R13   =X'0000C000'      NO, SET MODEM BITS                          
         STW,R13  *R14              PUT IN BUFFER                               
         AI,R14   +1                                                            
         AI,R1    +2                BUMP STORE INDEX                            
         CI,R1    +16                                                           
         BL       INITCMD                                                       
*                                                                               
*  NOW SET IN AIO INTERRUPT                                                     
*                                                                               
         LH,R1    DCT1                                                          
         CH,R5    DCT1,R1           LOOK UP CMC IN DCT                          
         BE       INIT220           FOUND IT                                    
         BDR,R1   %-2                                                           
         B        INIT300           BAD ADR                                     
*                                                                               
INIT220  LI,R4    X'40'                                                         
         LI,R13   CMC:IO:INT+1      SEND AIO INTS TO CMC:IO:INT                 
         STB,R4   R13               FOR ALL CMC'S                               
         STW,R13  DCT9,R1                                                       
         SIO,R0   0,R5                TO BE AVAILABLE                           
         LI,R9    +20               TRY 20 TIMES                                
SIOWT    LI,R8    X'7FFFF'                                                      
         BDR,R8   %                 DELAY                                       
         TIO,R13  0,R5                                                          
         BCR,12   INIT100           BRANCH IF SETUP DONE                        
         BDR,R9   SIOWT             TRY 5 TIMES                                 
********************************************************************************
*  SIO FAILURE ON THIS COC HAS OCCURED.                                         
*  GIVE THE OPERATOR A MESSAGE OF THE FOLLOWING FORM:                           
*                                                                               
*      LNXXX  SIO FAILURE                                                       
*                                                                               
*  GO ON TO NEXT COC                                                            
********************************************************************************
BADADR   EQU      %                                                             
         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                            
         BOUND    8                                                             
INITCL   GEN,8,24 X'03',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'13',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'23',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'33',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'43',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'53',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'63',BA(SETUP)                                               
         DATA     X'20000004'                                                   
         GEN,8,24 X'73',BA(SETUP)                                               
         DATA     X'00000004'                                                   
CM:START RES      24                                                            
*                                                                               
SETUP    DATA     X'4E9F90C0'                                                   
SETUPF   DATA     X'4E8E90C3'                                                   
DSENSE   GEN,8,24 X'83',BA(LINE0SNS)                                            
         DATA     X'20000004'       CC, BC=4                                    
         GEN,8,24 X'82',BA(SNSBUF)                                              
         DATA     X'00000001'       BC=1                                        
LINE0SNS DATA     X'0001A0A0'       MUST FOLLOW DSENSE                          
SNSBUF   DATA     0                                                             
*                                                                               
         PAGE                                                                   
INIT100  EQU      %                                                             
***********************************************************************         
*  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:IIL            EXTERNAL INT LEVEL BITS                     
         :WD,R4   ARM%DISABLE,COA:IIG    ARM & DISABLE INPUT 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                                                
*                                                                               
TOTYC    EQU      X'C0'                                                         
E:TO     EQU      %                  TIMEOUT EVENT                              
         OR,R7    Y4                 SET FLAG AND PROCESS AS INPUT COMPETE      
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   R7                 IS IT A TIMEOUT                            
         BEZ      E:CIC4             NO, BRANCH                                 
         LB,R11   RSZ,R7             GET REQUESTED BYTE COUNT                   
         LB,R12   ARSZ,R7            AND ACTUAL BYTE COUNT                      
         SW,R11   R12                CALC BYTE COUNT REMAINING                  
         LI,R12   TOTYC              SET TIMEOUT TYC                            
         B        E:CIC3                                                        
E:CIC4   EQU      %                                                             
         LB,R12   D4                TYC TO R12                                  
         CI,R12   0                 ANY                                         
         BNE      %+2               YES                                         
         LI,R12   1                 SET TO NORMAL                               
         LI,R11   0                 RBC                                         
E:CIC3   EQU      %                                                             
         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                                 
*                                                                               
CMCATTN  B        CMC:IO:INT        ATTENTION INTERRUPT ADDRESS                 
CMCPRE   EQU      %                                                             
CMCIO    EQU      %                                                             
COCIO    EQU      %                                                             
A:CMCIO  EQU      CMCIO                                                         
         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                                                                    
