         SYSTEM   SIG5P                                                         
         TITLE    ' C O C  R E F S  A N D  D E F S '                    00000630
*                                                                       00000640
         DEF      COCIPC            INPUT PARITY ERROR COUNT            00000480
         DEF      COCIPL            INPUT PARITY ERROR LINE NO. (LAST)  00000490
         DEF      COCOEC            OUTPUT EXTRANEOUS INTERRUPT COUNT   00000510
         DEF      COCOEL            OUTPUT EXTRANEOUS INTERRUPT LINE NO 00000520
         DEF      COCBLC            INPUT INVALID LINE COUNT            00000530
         DEF      COCBLN            INPUT INVALID LINE NUMBER           00000540
* COC ROUTINE ENTRY POINTS                                              00000650
*                                                                       00000660
         DEF      CSTART            COC INITIALIZATION AND STARTUP              
         DEF      CREAD             ROUTINE TO INITIATE INPUT                   
         DEF      CMOVE             ROUTINE TO MOVE DATA TO USER BUFFER         
         DEF      CWRITE            ROUTINE TO WRITE MESSAGE TO TERMINAL        
         DEF      CHECK             ROUTINE TO CHECK LINE STATE, MODE           
         DEF      CSET              ROUTINE TO SET LINE TABLE PARAMETERS        
         DEF      CSTOP             ROUTINE TO TERMINATE COC I/O                
         DEF      CONV              CONVERSION ROUTINE                  00000720
*                                                                       00000730
         DEF      STATE             LINE STATE                          00000740
         DEF      MODE              LINE MODE                           00000750
         DEF      FLAG              LINE FLAGS                          00000760
         DEF      COCOT             OUTPUT TRANSLATE TABLE POINTERS     00000770
         DEF      COCIT             INPUT TRANSLATE TABLE POINTERS      00000780
         DEF      LINKI             INPUT BUFFER REL. ADDR.-- HEAD LINK         
         DEF      LINKO             OUTPUT BUFFER REL. ADDR.--HEAD LINK         
         DEF      COCBAI            REL. BYTE ADDR. -- NEXT INPUT CHAR.         
         DEF      COCBAO            REL. BYTE ADDR. -- NEXT CHAR TO OUTP        
         DEF      COCMC             MAX. MESSAGE COUNT (INPUT)          00000820
         DEF      ARS               INPUT CHARACTER COUNT               00000830
         DEF      COCNL             NO. OF LINES CONNECTED TO COC       00000840
*                                                                       00000850
         TITLE    ' C O C  P R O C S '                                  00002600
*                                                                       00002610
STRING   CNAME                                                          00002620
         PROC                                                           00002630
LF       RES      0                                                             
X        SET      0                                                             
Y        SET      0                                                             
Z        SET      0                                                             
         DO       NUM(CF)>1                                             00002660
W        SET      CF(2)                                                 00002670
V        SET      AF(1)                                                 00002680
         ELSE                                                           00002690
W        SET      NUM(AF)                                               00002700
X        SET      1                                                     00002700
         FIN                                                            00002710
I        DO       W                                                     00002720
         DO       X=1                                                   00002730
Z        SET      Z**8|AF(I)                                            00002740
         ELSE                                                           00002750
Z        SET      Z**8|V                                                00002760
V        SET      V+AF(2)                                               00002770
         FIN                                                            00002780
         DO       Y=24                                                  00002790
         GEN,32   Z                                                     00002800
Y        SET      0                                                             
Z        SET      0                                                             
         ELSE                                                           00002820
Y        SET      Y+8                                                   00002830
         FIN                                                            00002840
         FIN                                                            00002850
         DO       Y>0                                                   00002860
         GEN,Y    Z                                                     00002870
         FIN                                                            00002880
         PEND                                                           00002890
         SPACE    4                                                             
FLAG     CNAME                      SET FLAG                            00002900
         PROC                                                           00002900
LF       LI,R4    AF(1)             VALUE OF FLAG                       00002910
         STB,R4   FLAG,R7           STORE                               00002920
         PEND                                                           00002930
         SPACE    4                                                             
*        ENABLES  C,I,& E INTERRUPT  GROUPS                                     
ENABLE   CNAME                                                          00002940
         PROC                                                           00002950
LF       GEN,8,24 X'6D',X'27'                                           00002960
         PEND                                                           00002970
         SPACE    2                                                             
*        DISABLES C,I,& E INTERRUPT  GROUPS                                     
DISABLE  CNAME                                                          00002980
         PROC                                                           00002990
LF       GEN,8,24  X'6D',X'37'                                          00003000
         PEND                                                           00003000
         SPACE    4                                                             
*                                                                       00003420
* INPUT/OUTPUT BUFFER POOL                                              00003430
POOL     CNAME                                                          00003440
         PROC                                                           00003450
M        SET      %+AF(2)                                               00003460
LF       RES      0                                                             
         DO       AF(1)-1                                               00003480
         GEN,16,16  (M-COCBUF),0                                        00003490
         RES,4    AF(2)-1                                               00003500
M        SET      M+AF(2)                                               00003510
         FIN                                                            00003520
         RES,4    AF(2)                                                 00003530
         PEND                                                           00003540
         TITLE    ' C O C  S T A T I S T I C S  '                       00000270
*                                                                       00000280
*                                                                       00000290
COCSTAT  EQU      0                 STATISTICS OPTION OFF               00000260
         DO       COCSTAT=1         STATISTICS OPTION                   00000300
         DEF      COCBW             LOOP COUNT WAITING FOR BUFFERS      00000310
         DEF      COCNLP            COUNT OF LINKS PERFORMED            00000320
         DEF      COCNLI            COUNT OF LINES INPUT                00000330
         DEF      COCNLO            COUNT OF LINES OUTPUT               00000340
         DEF      COCNCI            COUNT OF CHARACTERS INPUT           00000350
         DEF      COCNCO            COUNT OF CHARACTERS OUTPUT          00000360
         DEF      COCNII            COUNT OF INPUT INTERRUPTS           00000370
         DEF      COCNOI            COUNT OF OUTPUT INTERRUPTS          00000380
COCBW    GEN,32   0                                                     00000390
COCNLP   GEN,32   0                                                     00000400
COCNLI   GEN,32   0                                                     00000410
COCNLO   GEN,32   0                                                     00000420
COCNCI   GEN,32   0                                                     00000430
COCNCO   GEN,32   0                                                     00000440
COCNII   GEN,32   0                                                     00000450
COCNOI   GEN,32   0                                                     00000460
         FIN                                                            00000470
COCIPC   GEN,32   0                                                     00000550
COCIPL   GEN,32   0                                                     00000560
COCOEC   GEN,32   0                                                     00000590
COCOEL   GEN,32   0                                                     00000600
COCBLC   GEN,32   0                                                     00000610
COCBLN   GEN,32   0                                                     00000620
         TITLE    ' C O C  A S S E M B L Y  P A R A M E T E R S '       00000010
************************************************************************        
*                                                                       00000020
*  ASSEMBLY PARAMETERS                                                  00000030
*                                                                       00000040
*                                                                       00000050
* NOTE 1:  COC ROUTINE IS DESIGNED TO OPERATE IN ADDRESSES UP TO 128K   00000060
* NOTE 2:  THE INTERRUPT ADDRESSES MUST BE SET SO THAT THE HEX. LOC. OF         
*          THE INPUT(COCII) IS LOWER THAN OUTPUT(COCIO).                        
* NOTE 3:  MAXIMUM SIZE OF BUFFER POOL IS 16K WORDS (LIMITED BY COCBP)  00000090
* NOTE 4:  LINE NOS. ARE ASSUMED TO BE 0 TO COCNL-1, FOR ASSMBLY CODING.        
*          FORTRAN CALLS ASSUME LINE NOS. TO BE 1 TO COCNL.                     
* NOTE 5:  THE COC DEVICE ADDRESS IS SPECIFIED BY (COCNO AND COCDN). THE        
*          USER MUST SET THESE FOR HIS PARTICULAR INSTALLATION.                 
*                                                                       00000170
************************************************************************        
COCNB    EQU      10                NO. OF 4 WORD BUFFERS IN POOL               
COCNO    EQU      X'0'              COC NUMBER                                  
COCDN    DATA     X'10'             IOP=0, DEVICE=10                            
COCNL    EQU      7                 NUMBER LINES                                
COCII    EQU      X'60'             LOC. OF INPUT EXTERNAL INTERRUPT    00000220
COCIO    EQU      X'61'             LOC. OF OUTPUT EXTERNAL INTERRUPT   00000230
         TITLE    ' C O C  L I T E R A L S  '                           00000870
X7FFF    DATA     X'7FFF'                                               00000880
X20      DATA     X'20'                                                 00000890
XF       DATA     X'F'                                                  00000900
XFFFFFFF0 DATA    X'FFFFFFF0'                                           00000910
XFFFFFF7F DATA    X'FFFFFF7F'                                           00000920
X80      DATA     X'80'                                                 00000930
XFFFFFFBF DATA    X'FFFFFFBF'                                           00000940
X40      DATA     X'40'                                                 00000950
X7FFFF   DATA     X'7FFFF'                                              00000960
X3       DATA     X'3'                                                  00000970
XBF      DATA     X'BF'                                                 00000980
XFC      DATA     X'FC'                                                 00000990
X4       DATA     X'4'                                                  00001000
X7F      DATA     X'7F'                                                 00001000
XDF      DATA     X'DF'                                                 00001010
X3F      DATA     X'3F'                                                 00001020
X40000000 DATA    X'40000000'                                           00001030
X80000000 DATA    X'80000000'                                           00001040
         TITLE    ' C O C  L I N E  T A B L E S '                       00001050
* TERMINAL DESCRIPTION PARAMETERS                                       00001060
* ===============================                                               
*                                                                               
************************************************************************        
*                                                                       00001070
*   STATE BYTE TABLE - ONE BYTE PER LINE                                        
*      SET TO OUT-OF-SERVICE INITIALLY                                          
*                                                                               
*   CODE   MEANING                                                              
*   ----   -------                                                              
*     0    INACTIVE                                                             
*     1    ACCEPTING INPUT                                                      
*     2    TRANSMITTING OUTPUT                                                  
*     4    OUTPUT ACTIVE --INPUT WAITING FOR OUTPVT COMPLETION                  
*     8    INPUT COMPLETE                                                       
*    64    ERROR IN MSG.                                                        
*   128    OUT OF SERVICE                                                       
*                                                                       00001050
         BOUND    4                                                     00001060
STATE    EQU      %                                                     00001070
         DO       COCNL                                                 00001080
         DATA,1   X'80'             ALL LINES OUT OF SERVICE, INITIALLY         
         FIN                                                            00001100
         SPACE    5                                                             
************************************************************************        
*                                                                               
*                                                                               
*   FLAG BYTE TABLE - ONE BYTE PER LINE                                         
*      CONTROLS OUTPUT RESULTING FROM INPUT                                     
*                                                                               
*   FLAG = 0  USER PRODUCING OUTPUT                                             
*        = 1  SEND CR, THEN FINISHED(SET FLAG=4)                                
*        = 2  SEND LF, THEN FINISHED(SET FLAG=4)                                
*        = 3  SEND CR, THEN SET FLAG=2                                          
*        = 4  FINISHED                                                          
*        = 5  SEND NULL, THEN SET FLAG=6                                        
*        = 6  SEND NULL, THEN FINISHED                                          
*        = 7  NOT USED                                                          
*        = 8  SEND CANCEL, THEN FINISHED--K/D DELETES                           
*                                                                               
         BOUND    4                                                     00001110
FLAG     EQU      %                                                     00001130
         DO       COCNL                                                 00001140
         DATA,1   0                                                     00001150
         FIN                                                            00001160
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   MODE BYTE TABLE - ONE BYTE PER LINE                                         
*                                                                               
*      DEC. CODE   MEANING                                                      
*      ----------  -------                                                      
*           1      SIMPLEX - INPUT                                              
*           2      SIMPLEX - OUTPUT                                             
*           3      FULL-DUPLEX (I.E., INDEPENDENT, SIMULTANEOUS I/O)            
*           4      HALF-DUPLEX (I.E., LOCAL PRINTING UNLESS ECHO IS ON)         
*          16      NO-TRANSLATION TO BE DONE                                    
*          32      BREAK FLAG - LONG SPACE HAS BEEN RCVD. IF SET = 1            
*          64      ESCAPE SEQUENCE - ESC CHAR. HAS BEEN RECEIVED                
*         128      ECHO FLAG (HALF-DUPLEX SHOULD ALSO BE SET)                   
*                                                                               
         BOUND    4                                                     00001180
MODE     EQU      %                                                     00001190
         DO       COCNL                                                         
         DATA,1   X'84'                                                         
         FIN                                                                    
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   TERMINAL TYPE - BYTE TABLE                                          00001220
*        0 = M33 TELETYPE                                               00001230
*        1 = M35 TELETYPE                                               00001240
*        2 = M37 TELETYPE                                               00001250
*        4 = K/D  (EXTENDED CHARACTER MODE A)                                   
*        5 = K/D  (EXTENDED CHARACTER MODE B)                                   
         BOUND    4                                                     00001280
COCTERMN EQU      %                                                     00001290
         DATA,1   3                 K/D                                         
         DATA,1   0                 M33                                         
         DATA,1   3                 K/D                                         
         DATA,1   3                 K/D                                         
         DATA,1   3                 K/D                                         
         DATA,1   3                 K/D                                         
         DATA,1   0                 M33                                         
         DATA,1   0                 M33                                         
         DATA,1   0                 M33                                         
         DATA,1   0                 M33                                         
         DATA,1   0                 M33                                         
         DATA,1   0                 M33                                         
         DATA,1   3                 K/D                                         
         DATA,1   3                 K/D                                         
         DATA,1   3                 K/D                                         
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   INPUT TRANSLATE TABLE (POINTERS) - BY TERMINAL TYPE                 00001320
         BOUND    4                                                     00001330
COCIT    EQU      %                                                     00001340
         GEN,32   TTYIN             M33                                 00001350
         GEN,32   TTYIN             M35                                 00001360
         GEN,32   TTYIN             M37                                 00001370
         GEN,32   KDIN              K/D                                 00001380
         GEN,32   KDIN              K/D - MODE A                                
         GEN,32   KDIN              K/D - MODE B                                
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   OUTPUT TRANSLATE TABLE (POINTERS) - BY TERMINAL TYPE                00001400
         BOUND    4                                                     00001410
COCOT    EQU      %                                                     00001420
         GEN,32   TTYOUT            M33                                 00001430
         GEN,32   TTYOUT            M35                                 00001440
         GEN,32   TTYOUT            M37                                 00001450
         GEN,32   KDOUT             K/D                                 00001460
         GEN,32   KDOUT             K/D - MODE A                                
         GEN,32   KDOUT             K/D - MODE B                                
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   ACTUAL RECORD SIZE - COUNT OF INPUT CHARACTERS                              
*                                                                               
         BOUND    4                                                     00001490
ARS      EQU      %                                                     00001500
         DO       COCNL                                                 00001510
         DATA,2   0                                                             
         FIN                                                            00001530
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   MAX. COUNT OF INPUT CHARS. TO ACCEPT                                        
*                                                                               
         BOUND    4                                                             
COCMC    EQU      %                                                             
         DO       COCNL                                                         
         DATA,2   0                                                             
         FIN                                                                    
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   BUFFER POINTER  - BYTE ADDRESS FOR NEXT INPUT CHARACTER             00001540
         BOUND    4                                                     00001550
COCBAI   EQU      %                                                             
         DO       COCNL                                                 00001570
         DATA,2   0                                                     00001580
         FIN                                                            00001590
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   BUFFER POINTER - BYTE ADDRESS FOR NEXT OUTPUT CHARACTER                     
*                                                                               
         BOUND    4                                                             
COCBAO   EQU      %                                                             
         DO       COCNL                                                         
         DATA,2   0                                                             
         FIN                                                                    
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   END-ACTION INTERRUPT TABLES -- INPUT -- OUTPUT                              
*        (ONE WORD PER LINE IN EACH OF 2 TABLES )                               
         BOUND    4                                                             
COCENDI  EQU      %                                                             
         DO       COCNL                                                         
         DATA     0                                                             
         FIN                                                                    
         SPACE    2                                                             
         BOUND    4                                                             
COCENDO  EQU      %                                                             
         DO       COCNL                                                         
         DATA     0                                                             
         FIN                                                                    
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   LINK TABLE - ADDRESS OF FIRST INPUT MESSAGE BUFFER                          
*                                                                               
         BOUND    4                                                             
LINKI    EQU      %                                                             
         DO       COCNL                                                         
         DATA,2   0                                                             
         FIN                                                                    
         SPACE    5                                                             
************************************************************************        
*                                                                               
*   LINK TABLE - ADDRESS OF FIRST OUTPUT MESSAGE BUFFER                         
*                                                                               
         BOUND    4                                                             
LINKO    EQU      %                                                             
         DO       COCNL                                                 00001620
         DATA,2   0                                                     00001630
         FIN                                                            00001640
         BOUND    4                                                     00001670
         SPACE    5                                                             
*                                                                               
************************************************************************        
*                                                                               
CIGNORE  EQU      X'36'             USED BY CMOVE ROUTINE                       
IOPDW    COM,*8,5,*19,8,8,16        CF(2),0,AF(1),AF(2),0,AF(3)         00001730
BT       EQU      1                 BYTE SIZE                           00001740
HW       EQU      2                 BYTES IN HALFWORD                   00001750
FW       EQU      4                 BYTES IN FULLWORD                   00001760
DW       EQU      8                 BYTES IN DOUBLEWORD                 00001770
R        EQU      2                 READ ORDER                          00001780
TC       EQU      8                 TRANSFER IN CHANNEL ORDER           00001790
ACOCBUF  GEN,32   BA(COCBUF)+2      BYTE ADDRESS OF COCBUF (FOR BIAS)   00001800
WDRING   EQU      (COCNL)**-2+1     RING BUFFER SIZE IN WORDS           00001810
COCBUF1  EQU      WDRING**2         RING SIZE IN BYTES                  00001820
         SPACE    2                                                             
         BOUND    4                                                     00001830
*        RING BUFFER FOR INPUT/OUTPUT CHAR.                                     
*                    INITIALLY SET TO X'FF'TO INDICATE UNUSED                   
RINGBUF  EQU      %                                                             
         DO       WDRING                                                00001850
         DATA     X'FFFFFFFF'                                           00001860
         FIN                                                            00001870
RINGTE   EQU      RINGBUF+WDRING                                                
         BOUND 8                                                        00001980
LNOLLIM  DATA     X'80'+COCNL       LINE NUMBER LIMIT TEST              00002010
         DATA     X'80'-1                                               00002020
COCLST1  DATA     -COCBUF1          RING BUFFER POINTER (BIASED NEGATIV 00002070
         PAGE                                                           00002560
* EQUIVALANCES FOR CONDITION CODES                                      00002170
C1       EQU      8                                                     00002180
C2       EQU      4                                                     00002190
C3       EQU      2                                                     00002200
C4       EQU      1                                                     00002210
C1C2     EQU      12                                                    00002220
C1C4     EQU      9                                                     00002230
C3C4     EQU      3                                                     00002240
         SPACE    3                                                     00002250
* EQUIVLANCES FOR GENERAL REGISTERS                                     00002260
*        R0 THRU R7 USED FOR INDEXING                                           
R0       EQU      0                                                     00002270
R1       EQU      1                                                     00002280
R2       EQU      2                                                     00002290
R3       EQU      3                                                     00002300
R4       EQU      4                                                     00002300
R5       EQU      5                                                     00002310
R6       EQU      6                                                     00002320
R7       EQU      7                                                     00002330
R8       EQU      8                                                             
R9       EQU      9                                                             
R10      EQU      10                                                            
R11      EQU      11                                                            
R12      EQU      12                                                            
R13      EQU      13                                                            
R14      EQU      14                                                            
R15      EQU      15                                                            
R16      EQU      16                                                            
         SPACE    5                                                             
*        SR1 THRU SR4 USED AS SPECIAL STORAGE REGISTERS                         
SR1      EQU      8                                                     00002340
SR2      EQU      9                                                     00002350
SR3      EQU      10                                                    00002360
SR4      EQU      11                                                    00002370
         SPACE    5                                                             
*        D1 THRU D4 USED FOR                                                    
D1       EQU      12                                                    00002380
D2       EQU      13                                                    00002390
D3       EQU      14                                                    00002400
D4       EQU      15                                                    00002400
A        EQU      X'A'              USED ON CAL                         00002410
B        EQU      X'B'                                                  00002420
CI       EQU      4                 COUNTER INTERRUPT INHIBIT BIT       00002430
EI       EQU      1                 EXTERNAL INTERRUPT INHIBIT BIT      00002440
CCSTATUS EQU      X'3000'+COCNO**4  BASIC ADDRESS FOR COC STATUS TESTS  00002450
RCVRSTAT EQU      CCSTATUS          SENSE RECEIVER STATUS               00002460
RCVRON   EQU      CCSTATUS+1        TURN RECEIVER ON                    00002470
RCVROFF  EQU      CCSTATUS+2        TURN RECEIVER OFF                   00002480
RCVRDOFF EQU      CCSTATUS+3        TURN RECEIVER DATA SET OFF          00002490
XMITSTAT EQU      CCSTATUS+4        SENSE TRANSMITTER STATUS            00002500
XMITDATA EQU      CCSTATUS+5        TRANMIT DATA                        00002510
XMITDOFF EQU      CCSTATUS+7        TURN TRANSMIT DATA SET OFF          00002520
XMITLSPC EQU      CCSTATUS+13       TRANSMIT LONG SPACE                 00002530
XMITSTOP EQU      CCSTATUS+14       TRANSMIT STOP                       00002540
OUTRSP   EQU      CCSTATUS          OUTPUT RESPONSE                     00002550
         TITLE    ' I N P U T / O U T P U T  B U F F E R  P O O L '     00003550
*        COCBUF IS THE HEAD OF THE BUFFER POOL TO BE USED FOR INPUT/OUTP        
         BOUND    DW                                                    00003620
COCBUF   EQU      %                                                     00003560
         RES      4                                                             
*        A SET OF BUFFERS 4 WORDS IN LENGTH ARE RESERVED-THE NUMBER OF          
*          BUFFERS(COCNB) IS AN ASSEMBLY TIME PARAMETER                         
COCBUF0  EQU      %                                                     00003600
         POOL     COCNB,4                                               00003610
         TITLE    ' C O C  S T A R T U P '                              00003640
************************************************************************        
*                                                                       00003650
*          CSTART IS THE INITIALIZATION ROUTINE FOR THE COC PACKAGE             
*                                                                       00003670
*          THE CALLING SEQUENCES ARE AS FOLLOWS:                                
*          FROM FORTRAN PROGRAMS:                                               
*               CALL CSTART (LINE,STATUS)                                       
*                                                                       00003690
*          FROM ASSEMBLY PROGRAMS:                                              
*               LI,14   2                                                       
*               BAL,15  CSTART                                                  
*               ARG     LINE        LOC OF LINE # (IF #=0,TURN ON ALL)          
*               ARG     STATUS      LOCATION OF STATUS WORD                     
*               RETURN                                                          
*        STATUS          MEANING                                                
*        ******     ******************                                          
*           0       NORMAL RETURN                                               
*           1       ONE OR MORE RECEIVERS NOT TURNED ON;                        
*           2       COC ALREADY ACTIVE(INDIV. LINES WILL BE TURNED ON)          
*           4       UNABLE TO START COC                                         
*                                                                               
************************************************************************        
*                                                                               
COCFLAGS EQU      X'80'             DATA CHAIN ONLY                     00003730
COCSF    DATA     0                 COC STATUS FLAG                             
*                                                                       00003740
* COMMAND USED TO START UP THE TELETYPE INTERFACE                       00003750
*                                                                       00003760
         BOUND    DW                                                    00003770
*                                                                       00003780
COCCMND1 IOPDW,R  BA(RINGBUF),COCFLAGS,COCBUF1                                  
         IOPDW,TC DA(COCCMND1)                                          00003800
*                                                                       00003800
*                                                                       00003810
* START UP THE COC INTERFACE                                            00003890
*                                                                       00003900
CSTART   EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
         LI,R10   0                 CLEAR ERROR MESSAGE FLAG                    
         DISABLE                                                                
         LI,R9    2                 GET COC-ACTIVE FLAG                         
         XW,R9    COCSF               EXCH. AND CHECK PRIOR SETTING             
         BNEZ     COCFORE3             IF ALREADY ACTIVE, SKIP TURN-ON          
COCFORE1 LI,R0    DA(COCCMND1)      ADDRESS OF COMMAND DOUBLEWORD TO R0 00003900
         HIO,R0   *COCDN            CLEAR ANY PENDING INTERRUPTS        00003910
         SIO,R0   *COCDN            START COC1                          00003920
         BCR,C1C2 COCFORE2         DID START UP GO OK                           
         ENABLE                                                                 
         CAL1,2   FPT1              NO-TYPE MESSAGE                     00003940
         LI,R9    4                    AND GET STATUS CODE                      
         B        RUSER             RETURN TO USER                              
COCFORE2 EQU      %                                                     00004070
*        CONNECT INPUT/OUTPUT INTERRUPTS                                        
         CAL1,5   CONFPTI           INPUT INTERRUPT                             
         CAL1,5   CONFPTO           OUTPUT INTERRUPT                            
COCFORE3 EQU      %                                                             
         LI,R7    COCNL-1           TELETYPE NUMBER (INITIAL)           00004010
         ENABLE                                                                 
         LI,R12   0                                                             
         BAL,R13  FETCHA                                                        
         LW,R8    *R12              GET LINE #                                  
         BEZ      COCTTY              IF ZERO, TURN ON ALL LINES                
         LW,R7    R8                  OTHERWISE, ADJUST FORTRAN INTEGER         
         AI,R7    -1                  FOR SINGLE LINE TURN-ON (R8=SWITCH        
*                                                                               
COCTTY   EQU      %                                                     00004020
         WD,7     RCVRON            TURN RECEIVER ON                    00004030
      BCR,C4      COCTTY0             BRANCH IF BAD CONDITION CODE              
         DISABLE                                                                
         LB,R12   STATE,R7          OTHERWISE, MARK THE LINE                    
         AND,R12  =X'7F'              'IN-SERVICE'                              
         STB,R12  STATE,R7                                                      
         ENABLE                                                                 
         B        COCTTY3                                                       
*                                                                               
COCTTY0  EQU      %                                                             
         OR,R9    =1                ADD 1 TO STATUS: 'RCVR NOT ON'              
         MTW,0    R10               TEST ERROR MESSAGE FLAG                     
         BNEZ     COCTTY1           BRANCH IF SET                       00004090
         CAL1,2   FPT2              TYPE LABEL MESSAGE                  00004100
         AI,R10   1                 SET ERROR MESSAGE FLAG                      
COCTTY1  EQU      %                                                     00004110
         LW,R5    R7                WORD TO BE CONVERTED                00004120
         SLS,R5   24                LEFT JUSTIFY                        00004130
         LW,R3    COCM2P            CHAR. POINTER                       00004140
         LI,R2    2                 # CHAR.                             00004150
         BAL,R6   CONV              GENERATE RECEIVER NO. IN EBCDIC     00004160
         CAL1,2   FPT3              TYPE RECEIVER # MESSAGE             00004170
COCTTY3  EQU      %                                                             
         CI,R8    0                 SINGLE LINE TURN-ON?                        
         BNE      %+3                 EXIT, IF SO                               
         AI,R7    -1                OTHERWISE, DECREMENT LINE #,                
         BGEZ     COCTTY            BRANCH TIL LAST LINE SERVICED(#0)   00004200
*                                                                               
*                                                                               
RUSER    EQU      %                                                             
         LI,R12   1                                                             
         BAL,13   FETCHA                                                        
         STW,R9   *R12              STORE STATUS CODE                           
*                                                                               
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,15    14                                                            
         B        *15               RETURN TO CALLER                            
*                                                                               
*                                                                               
COCM1    TEXTC    'UNABLE TO START-UP COC'                                      
COCM2    TEXTC    'SKIPPING COC1 RECEIVER
'                             00003970
COCM3    TEXTC    '00
'                                                 00003980
FPT1     GEN,8,24 X'02',0           PARAMETER LIST                      00003990
         GEN,8,24 X'80',0                                               00004000
         GEN,15,17 0,COCM1          MESSAGE POINTER                     00004000
FPT2     GEN,8,24 X'02',0           PARAMETER LIST                      00004010
         GEN,8,24 X'80',0                                               00004020
         GEN,15,17 0,COCM2          MESSAGE POINTER                     00004030
FPT3     GEN,8,24 X'02',0           PARAMETER LIST                      00004040
         GEN,8,24  X'80',X'10'      WAIT FOR OUTPUT COMPLETION                  
         GEN,15,17 0,COCM3          MESSAGE POINTER                     00004060
*                                                                               
******** TASK CONTROL BLOCKS FOR I/O INTERRUPTS*********************************
         BOUND    DW                                                            
TCBII    RES      26                TCB FOR INPUT INTERRUPT                     
TCBOI    RES      26                TCB FOR OUTPUT INTERRUPT                    
*                                                                               
********************************************************************************
CONFPTI  GEN,8,8,16  X'04',0,COCII                                              
         GEN,8,3,4,17  X'80',0,0,TCBII                                          
         GEN,15,17     0,COCIP                                                  
CONFPTO  GEN,8,8,16  X'04',0,COCIO                                              
         GEN,8,3,4,17  X'80',0,0,TCBOI                                          
         GEN,15,17     0,COCOP                                                  
         TITLE    ' ROUTINE TO CONVERT BINARY TO HEXADECIMAL '          00004220
************************************************************************        
*  R2 = # CHAR.                                                         00004230
*  R3 = CHAR. POINTER - INCREMENTED UPON RETURN                         00004240
*  R4 = SCRATCH                                                         00004250
*  R5 = # TO BE CONVERTED                                               00004260
*  R6 = LINKAGE                                                         00004270
************************************************************************        
CONV     EQU      %                                                     00004280
         LI,R4    0                 CLEAR R4 FOR CONVERSION             00004290
         SLD,R4   4                 SHIFT 1 HEX CHAR. FROM R5 TO R4     00004300
         AI,R4    '0'               CONVERT                             00004310
         CI,R4    '9'               TEST FOR SPECIAL CASE               00004320
         BLE      %+2               IS CHAR. > 9                        00004330
         AI,R4    'A'-'9'-1         YES IS IT A-F                       00004340
         STB,R4   0,R3              STORE CONVERTED CHAR.               00004350
         AI,R3    1                 INCREMENT CHAR. POINTER             00004360
         BDR,R2   CONV              DECREMENT CHAR. COUNT               00004370
         B        0,R6              RETURN                              00004380
COCM2P   GEN,32   BA(COCM3)+1       POINTER TO OVERLAY FOR ERROR MESS.  00004390
         TITLE    ' I N P U T  I N T E R R U P T  R O U T I N E '       00004400
************************************************************************        
* ROUTINE TO PROCESS INPUT CHARACTERS FROM COMMON INPUT RING BUFFER     00004410
* AND MOVE EACH CHARACTER INTO PROPER LINE BUFFER                       00004420
*   INPUT INTERRUPT IS TIED TO EXTERNAL INTERRUPT LOC COCII                     
*   RBM MONITOR TRANSFERS CONTROL TO COCIP WHEN INTERRUPT OCCURS                
*   COCIP EXITS VIA A RETURN TO RBM                                             
************************************************************************        
         SPACE    2                                                             
COCIP    EQU      %                                                     00004430
*                                                                       00004450
         DO       COCSTAT=1         STATISTICS OPTION                   00004460
         MTW,1    COCNII            INCREMENT # OF INPUT INTERRUPTS   * 00004470
         FIN                                                            00004480
*                                                                       00004490
         LW,R6    COCLST1           RING POINTER                        00004500
         LB,R5    RINGTE,R6         PICK UP CHAR.                       00004510
         AI,R6    1                 INCREMENT RING POINTER              00004520
         LB,R7    RINGTE,R6         PICK UP LINE #                      00004530
COCIP5   LI,R4    X'FF'             PUT STOP CHAR.                      00004540
         STB,R4   RINGTE,R6         IN RING BUFFER                      00004550
         DO       COCSTAT=1         STATISTICS OPTION                   00004560
         MTW,1    COCNCI            INCREMENT INPUT CHAR. COUNT       * 00004570
         FIN                                                            00004580
         STW,R5   R2                SAVE CHAR RECEIVED FOR LATER                
         BIR,R6   COCIP5Z           ADVANCE POINTER                     00004600
         LI,R6    -COCBUF1          RESET                               00004600
COCIP5Z  STW,R6   COCLST1           SAVE RING POINTER                   00004610
         CI,R7    COCNL             TEST AGAINST # OF LINES             00004620
         BL       COCIP516          BRANCH IF OK                        00004630
         CLM,R7   LNOLLIM           LIMIT TEST WITH BREAK BIT SET       00004640
         BCR,9    COCIP8            RECORD ERROR IF OUT OF LIMIT        00004650
*                                                                               
*   BREAK CHAR. (LONG SPACE) RECEIVED ON VALID LINE                             
*                                                                               
         AND,R7   X7F               MASK OUT BREAK BIT - R7 = LINE NO.  00004660
         LB,R6    MODE,R7           GET LINE MODE                       00004700
         OR,R6    X20               SET BREAK BIT                       00004700
         STB,R6   MODE,R7                                               00004710
         LB,R6    STATE,R7          LINE STATE = INPUT ?                        
         CI,R6    1                                                             
         BANZ     COCIPBK              BRANCH IF YES                            
*                                                                               
*                                                                       00004810
*  CHECK FOR ANOTHER CHAR. IN RING BUFFER                                       
*                                                                       00004820
COCIP01  LW,R6    COCLST1           RING POINTER                        00004830
         AI,R6    1                 INCREMENT RING POINTER              00004840
         LB,R7    RINGTE,R6         PICK UP LINE #                      00004850
         CI,R7    X'FF'             IS IT STOP CHAR.                    00004860
         BE       RRBM              YES-RETURN TO RBM                           
         AI,R6    -1                DECREMENT BYTE COUNT                00004880
         LB,R5    RINGTE,R6         PICK UP CHAR.                       00004890
         AI,R6    1                 INCREMENT RING POINTER              00004900
         B        COCIP5            PROCESS AS NORMAL INTERRUPT         00004900
         SPACE    3                                                             
RRBM     EQU      %                                                             
         CAL1,9   1                 RETURN TO RBM VIA CALL TO MONITOR           
*                                                                       00005000
*                                                                       00005040
*                                                                       00005050
*                                                                       00005060
*   DETERMINE WHETHER TO ACCEPT CHARACTER                                       
*                                                                               
*                                                                               
COCIP516 EQU      %                                                             
         LB,R6    STATE,R7          CHECK FOR INPUT STATE                       
         CI,R6    1                                                             
         BAZ      COCIP01              IF NOT, IGNORE CHAR. AND RECYCLE         
*                                                                               
         LB,R6    FLAG,R7           CHECK FOR SPECIAL OUTPUT SEQUENCE           
         BNEZ     COCIP01              IF SO, IGNORE AND RECYCLE                
*                                                                               
         LH,R4    ARS,R7            CHECK REQUESTED CHAR. COUNT                 
         CH,R4    COCMC,R7                                                      
         BL       %+2                                                           
         BAL,R6   COCIC                IF = RCVD COUNT, SET INPUT COMPL.        
*                                                                               
         LB,R6    MODE,R7           IS CHAR. TO BE TRANSLATED?                  
         CI,R6    X'10'                                                         
         BAZ      %+3                                                           
         LW,R5    R2                   IF NOT, SKIP XLATE AND SPECIAL           
         B        X91                  CHAR. TEST                               
*                                                                               
*   TRANSLATE CHARACTER                                                         
*                                                                               
         LB,R4    COCTERMN,R7       TERMINAL TYPE                       00005010
         LW,R4    COCIT,R4          GET TABLE POINTER                   00005020
         LB,R5    *R4,R5            TRANSLATE                           00005030
*                                                                               
         CI,R6    X'40'             IS ESCAPE FLAG SET?                         
         BANZ     COCESC               IF SO, GO HANDLE ESCAPE SEQUENCE         
*   INPUT CHAR. TESTED FOR BEING A SPECIAL CHAR.                                
*                                                                       00005200
         CI,R5    X'40'                                                         
         BGE      X91               BRANCH IF NOT SPECIAL                       
         CW,R5    SPEC                                                          
         BLE      COCSAT,R5         BRANCH IF IN SPEC. CHAR. RANGE              
*   IF NO BRANCH, ASSUME PARITY ERROR CODE                                      
         SPACE    5                                                             
COCIP20  MTW,1    COCIPC            INCREMENT PARITY ERROR COUNT        00005250
         STW,7    COCIPL            STORE LINE NO.                      00005260
         LB,R5    COCTERMN,R7       IS TERM. A K/D                              
         CI,R5    3                                                             
         BL       COCIP2A                                                       
         LB,R5    MODE,R7           IF SO, IS IT IN MSG. MODE?                  
         CI,R5    X'80'                                                         
         BANZ     COCIP2A                                                       
         LB,R6    STATE,R7          IF SO, IS ERROR FLAG SET ALREADY?           
         CI,R6    X'40'                                                         
         BANZ     COCIP21              IF SO, SKIP                              
         LI,R5    X'1500'           IF NOT, GET NAK CODE                        
         OR,R6    =X'40'               AND SET ERROR FLAG                       
         STB,R6   STATE,R7                                                      
         B        %+2                                                           
*                                                                               
COCIP2A  EQU      %                                                             
         LI,5     X'2300'           REPLACE CHARACTER BY #              00005270
         OR,5     7                 MERGE BYTE + LINE NUMBER            00005280
         WD,R5    XMITDATA          SEND CHAR. TO TERMINAL                      
         FLAG     4                 SET LINE FLAG TO 4                  00005300
COCIP21  LI,5     X'2F'             2F IS NOW THE CHARACTER             00005300
COCIP22  EQU      %                                                     00005310
         LH,R4    COCBAI,R7         TEST IF ANY LINKS ARE ASSIGNED              
         BNEZ     COCIP23           BRANCH IF LINK AVAIL                00005330
         BAL,R6   COCGETB           GET A BUFFER                        00005340
         STH,R4   LINKI,R7          STORE THE LINK (HEAD)                       
COCIP22A EQU      %                                                     00005360
         SLS,R4   2                 MULT BY 4 TO GET REL. BYTE PTR.     00005370
         AI,R4    1                 + BIAS OF 1 BYTE                    00005380
         SPACE    2                                                             
*   SAVE RELATIVE BYTE POINTER  (COCBAI=NEXT POSN. TO STORE CHAR.)              
*                                                                               
COCIP23  EQU      %                                                     00005390
         AI,R4    1                 INCREMENT CHAR. BYTE ADDRESS        00005400
         STH,R4   COCBAI,R7         STORE REL. BYTE POINTER                     
         LW,R6    R4                SAVE RELATIVE BYTE POSITION         00005410
         AND,R4   XF                IS BYTE COUNT MODULO 16             00005420
         BNEZ     COCIP24           BRANCH IF NO                        00005430
         BAL,R6   COCGETB           GET A BUFFER                        00005440
         LH,R6    COCBAI,R7         RESTORE R6                                  
         AI,R6    -16               BACK UP PTR. BY 16 BYTES (4 WORDS)  00005460
         SLS,6    -1       DIVIDE BY 2 TO GET REL. HALF WORD POINTER    00005470
         STH,R4   COCBUF,R6         STORE CHAIN ADDRESS                 00005480
         B        COCIP22A          SET CHAR. POINTER AND STORE CHAR.   00005490
         SPACE    2                                                             
*   STORE INPUT CHAR IN COCBUF                                                  
*                                                                               
COCIP24  STB,R5   COCBUF,R6         STORE CHAR. IN BUFFER               00005500
         MTH,1    ARS,R7            INCR. ACTUAL RECORD SIZE                    
         B        COCIP01           RECYCLE                             00005510
         SPACE    3                                                             
*   COUNT INVALID LINE INTERRUPTS                                               
*                                                                               
COCIP8   EQU      %                                                             
         MTW,1    COCBLC            COUNT INTERRUPTS FROM INVALID LINES         
         STW,R7   COCBLN              SAVE LINE #                               
         B        COCIP01           RECYCLE                                     
         SPACE    2                                                             
*   PROCESS BREAK SIGNAL FOR LINE IN INPUT STATE                                
*        (OR NAK FROM K/D, CAUSED BY 'TRANSMIT' IN CHAR. MODE)                  
*                                                                               
COCIPBK  EQU      %                                                             
         BAL,R6   COCIC             DO INPUT-COMPLETE PROCESSING                
         LI,R5    X'04'             GET E-O-T CHAR.                             
         B        COCIP22           STORE THE E-O-T, AND EXIT                   
*                                                                               
         SPACE    4                                                             
*  ESC CHAR. RECEIVED                                                           
XA       BAL,R6   COCIC             DO INPUT COMPLETE (IC) PROCESSING   00005640
         LI,5     X'FE'             PUT 'FE' IN THE BUFFER              00005650
         B        COCIP22                                               00005660
*                                                                               
*                                                                               
*   ESC CHAR. RECEIVED -- HANDLE AS FRST OF A 2-CHAR. ESC SEQUENCE              
*                                                                               
XB       EQU      %                                                             
         LB,R6    MODE,R7                                                       
         OR,R6    =X'40'            SET ESCAPE BIT IN MODE                      
         STB,R6   MODE,R7                                                       
         B        X6                                                            
         SPACE    4                                                             
*  CR CHAR. RECEIVED                                                            
X0       EQU      %                                                     00005670
         LB,R6    COCTERMN,R7       CHECK TERM. TYPE                            
         CI,R6    3                    IF K/D, HANDLE CR AS EXTENDED            
         BGE      KDX                  CHARACTER                                
*                                                                               
         BAL,R6   COCIC             DO INPUT COMPLETE (IC) PROCESSING   00005680
         BCS,C1   X0010             BRANCH IF IN ECHO MODE              00005690
         LI,R6    X'0A00'           REPLACE CHARACTER BY LF             00005700
         LI,R4    4                 SET LINE FLAG TO 4                  00005700
         B        X0010A            PUT CHAR. IN BUFF AND SEND          00005710
         SPACE    4                                                             
X0010    LI,R6    X'0D00'           CR                                  00005850
         LI,R4    X'2'              SET FLAG = 2                        00005860
X0010A   OR,R6    R7                MERGE BYTE + LINE NUMBER            00005870
         WD,R6    XMITDATA          SEND CHAR. TO TERMINAL                      
         STB,R4   FLAG,R7           RESET FLAG                          00005890
         B        COCIP22           PUT CHARACTER IN BUFFER             00005910
         SPACE    4                                                             
*  LF CHAR. RECEIVED                                                            
X1       EQU      %                                                     00005920
         LB,R6    COCTERMN,R7       CHECK TERM. TYPE                            
         CI,R6    4                    IF K/D MODE A,                           
         BE       X1010                   DON'T MARK INPUT COMPLETE             
*                                                                               
X101     EQU      %                                                             
         BAL,R6   COCIC             DO INPUT COMPLETE (IC) PROCESSING   00005930
         BCS,C1   X1010             BRANCH IF IN ECHO MODE              00005940
         LI,5     X'0D00'           REPLACE CHARACTER BY CR             00005950
         OR,5     7                 MERGE BYTE + LINE NUMBER            00005960
         WD,R5    XMITDATA          SEND CHAR. TO TERMINAL                      
         FLAG     4                 SET LINE FLAG TO 4                  00005980
         LI,5     X'15'             PUT CHARACTER '15' IN THE BUFFER    00005990
         B        COCIP22                                               00006000
X1010    LB,R5    COCTERMN,R7       CHECK TERMINAL TYPE                 00006010
         CI,5     3                 IS IT K/D                           00006020
         BL       %+4                  NO - SKIP                                
         LI,R4    X'5'              YES - SET FLAG = 5                  00006040
         LI,R5    X'0A00'           REPLACE CHARACTER BY LF             00006050
         B        %+3                                                   00006060
         LI,R4    X'2'              SET FLAG = 2                        00006070
         LI,R5    X'0D00'           REPLACE CHARACTER BY CR             00006080
         OR,5     7                 MERGE BYTE + LINE NUMBER            00006090
         WD,R5    XMITDATA          SEND CHAR. TO TERMINAL                      
         STB,R4   FLAG,R7           RESET LINE FLAG                     00006100
         LI,5     X'15'             PUT CHARACTER '15' IN INPUT BUFFER  00006110
         B        COCIP22           PUT CHARACTER IN BUFFER             00006120
         SPACE    4                                                             
*  RUBOUT-REPLACE CHAR. WITH BACK SLASH                                         
X2       EQU      %                                                             
         LI,R4    4                                                             
         LB,R6    COCTERMN,R7       TERMINAL TYPE                               
         CI,R6    3                    IF K/D MODE A OR B,                      
         BG       KDX                  HANDLE AS EXTENDED CHAR.                 
         BL       X201              IF NOT K/D, PROC. NORMALLY                  
         LI,R4    8                 OTHERWISE, GET CANCEL FLAG                  
         LI,R5    X'1900'           GET CURSOR LEFT                             
         B        %+2                                                           
*                                                                               
X201     LI,R5    X'5C00'           GET BACK-SLASH CHAR.                        
         OR,5     7                 MERGE BYTE + LINE NUMBER            00006140
         WD,5     XMITDATA          SEND CHARACTER                      00006150
         STB,R4   FLAG,R7                                                       
         MTH,0    ARS,R7            TEST ACTUAL RECORD SIZE                     
         BNEZ     X2A               BRANCH IF ARS NOT ZERO              00006170
         FLAG     3                 IF ARS = 0, SET LINE FLAG = 3               
         B        COCIP01           RECYCLE                             00006190
*                                                                       00006200
X2A      EQU      %                                                     00006200
         MTH,-1   ARS,R7            DECR. ACTUAL RECORD SIZE                    
         BNEZ     X2B               BRANCH IF ARS NOT ZERO              00006220
         LH,R4    LINKI,R7            OTHERWISE, GET THE HEAD LINK,             
         BAL,R6   COCPUTBL            RELEASE THE BUFFER                00006240
         B        X5A                 ZERO PTRS. AND RECYCLE            00006250
X2B      EQU      %                                                     00006260
         LH,R6    COCBAI,R7         GET REL. BYTE ADDR.                         
         AND,R6   XF                LOOK AT BYTE POSITION WITHIN BUFFER 00006280
         CI,6     2                 IS IT AT THE BEGINNING              00006290
         BNE      X2010             BRANCH IF NO - BUFFER HAS SOMETHING 00006300
         LH,R4    COCBAI,R7         GET REL. BYTE ADDR.                         
         AND,R4   XFFFFFFF0         MAKE MULTIPLE OF 4 WORDS            00006320
         SCS,R4   -2                (IN WORDS)                          00006330
         LW,R5    R4                SAVE R4                             00006340
         BAL,R6   COCPUTBL          RELEASE THE BUFFER                  00006350
         LH,R6    LINKI,R7          GET HEAD LINK                               
         LW,R4    COCBUF,R6         GET REL. LINK                       00006370
         LH,R4    R4                CHAIN                               00006380
         CW,R4    R5                LAST LINK                           00006390
         BE       %+3               BRANCH IF YES                       00006400
         LW,R6    R4                MOVE TO NEXT LINK                   00006410
         B        %-5                                                   00006420
         LI,R5    0                 ZERO                                00006430
         SLS,R6   1                 MULT BY 2 TO GET HF. WD. PTR.       00006440
         STH,R5   COCBUF,R6         ZERO LINK PTR.                      00006450
         SLS,R6   1                 MULT BY 2 TO GET BYTE PTR.          00006460
         AI,R6    16                POSITION AT LAST BYTE+1             00006470
         STH,R6   COCBAI,R7         STORE NEW REL. BYTE POINTER                 
X2010    MTH,-1   COCBAI,R7         DECREMENT REL. BYTE POINTER                 
         B        COCIP01           RECYCLE                             00006510
         SPACE    4                                                             
*   TOGGLE ECHO MODE                                                            
*                                                                               
X3X      LB,R4    MODE,R7           LINE MODE                           00006520
         EOR,R4   =X'80'            INVERT ECHO FLAG                            
X31      STB,4    MODE,7            RESET                               00006580
X6       EQU      %                                                             
         B        COCIP01           RECYCLE                             00006600
         SPACE    4                                                             
*                                                                       00006680
*   X5 IS USED TO DELETE A LINE                                                 
*                                                                               
X5       EQU      %                                                             
         LB,R5    COCTERMN,R7       TERM. TYPE                                  
         CI,R5    3                    IF K/D MODE A OR B,                      
         BG       KDX                  HANDLE AS EXTENDED CHAR.                 
         BL       %+3                                                           
         LI,R5    X'0D00'           IF NORMAL K/D, SEND CR, THEN CANCEL         
         B        %+2                                                           
*                                                                               
         LI,R5    X'5F00'           REPLACE CHAR. WITH BACK-ARROW               
         OR,R5    R7                MERGE BYTE + LINE NUMBER            00006700
         WD,R5    XMITDATA          SEND CHARACTER                      00006710
         LH,R4    LINKI,R7          GET HEAD LINK                               
         BEZ      X5030             BRANCH IF NO ASSIGNED LINKS         00006730
         BAL,R6   COCPUTBL          RELEASE LINK TO THE POOL            00006740
         LW,R4    R6                NEXT LINK POINTER                   00006750
         BNEZ     %-2               KEEP RELEASING TIL = 0              00006760
X5A      EQU      %                                                     00006770
         STH,R6   COCBAI,R7         ZERO REL. BYTE POINTER                      
         STH,R6   LINKI,R7               HEAD LINK                              
         STH,R6   ARS,R7                                                        
*                                                                               
X5030    LB,R5    COCTERMN,R7       TERMINAL TYPE                       00006790
         CI,R5    3                 IS IT K/D                           00006800
         BNE      %+3               NO                                  00006810
         LI,R6    8                 YES - SET LINE FLAG = 8                     
         B        %+2                                                   00006830
         LI,R6    X'3'              NO - SET FLAG = 3                   00006840
         STB,R6   FLAG,R7           RESET LINE FLAG                     00006850
         B        COCIP01           RECYCLE                             00006860
         SPACE    5                                                             
X9       BAL,R6   COCIC             DO INPUT COMPLETE (IC) PROCESSING   00007000
X91      LC       MODE,7            TEST LINE MODE                      00007090
         BCR,C1   COCIP22           BRANCH IF NOT IN ECHO MODE          00007100
         LW,R6    R2                RECOVER ORIG ASCII CHAR.                    
         SCS,6    8                 MOVE OUTPUT CHARACTER OVER          00007120
         OR,6     7                 MERGE BYTE + LINE NUMBER            00007130
         WD,R6    XMITDATA          SEND CHAR. TO TERMINAL                      
         FLAG     4                 SET LINE FLAG TO 4                  00007150
         B        COCIP22           PUT CHARACTER IN INPUT BUFFER       00007160
         SPACE 4                                                                
XSTX     EQU %    STX RECEIVED                                                  
         LB,R6    COCTERMN,R7       CHECK WHETHER TERMINAL IS K/D               
         CI,R6    3                                                             
         BL       X91                  IF NOT, PROCESS CHAR NORMALLY            
*                                                                               
         LB,R6    MODE,R7           OTHERWISE, PREPARE FOR MSG. MODE IN.        
         AND,R6   =X'7F'                                                        
         STB,R6   MODE,R7              TURN OFF ECHO FLAG                       
         LB,SR2   STATE,R7                                                      
         AND,SR2  =X'BF'               TURN OFF ERROR FLAG                      
         LW,R6    R7                                                            
         BAL,R1   COCAB1               RELEASE ANY ASSIGNED BUFFERS             
         B        COCIP01           RECYCLE                                     
*                                                                               
         SPACE    4                                                             
XETX     EQU      %                 ETX RECEIVED                                
         LB,R6    STATE,R7                                                      
         CI,R6    X'40'             IF ERROR FLAG IS SET, IGNORE ETX            
         BANZ     COCIP01                                                       
*                                                                               
         LB,R6    COCTERMN,R7       CHECK WHETHER TERMINAL IS K/D               
         CI,R6    3                                                             
         BL       X91                  IF NOT, PROC. CHAR. NORMALLY             
*                                                                               
         LB,R6    MODE,R7           OTHERWISE, SET ECHO FLAG                    
         OR,R6    =X'80'                                                        
         STB,R6   MODE,R7                                                       
         LI,R2    6                 GET ACK CODE                                
         B        X9                   SEND OUT AND SET INPUT COMPLETE          
*                                                                               
         SPACE 4                                                                
*                                                                               
*   PROCESS CHARS. IN THE K/D EXTENDED SET                                      
*                                                                               
KDX      EQU      %                                                             
         LB,R6    MODE,R7           IF IN MSG. MODE (I.E., K/D NOT              
         CI,R6    X'80'                ECHOING),                                
         BAZ      X91                  GO PROCESS THE CHAR.                     
*                                                                               
         LB,R6    COCTERMN,R7       CHECK TERMINAL TYPE                         
         CI,R6    3                                                             
         BL       X91                  IF NOT K/D, PROC. CHAR. NORMALLU         
*                                                                               
         BE       COCIP01           IF NORMAL K/D MODE, I~NORE CHAR.            
         CI,R6    4                                                             
         BE       X91               IF K/D MODE A, ECHO AND PUT IN BUFF         
         B        X9                  IF MODE B, SET INPUT COMPLETE ALSO        
*                                                                               
         SPACE    4                                                             
XDC1     EQU      %                                                             
XDC3     EQU      %                                                             
         LB,R6    COCTERMN,R7       CHECK TERM. TYPE                            
         CI,R6    3                                                             
         BL       X91                  IF NOT K/D, PROC. NORMALLY               
         BG       KDX                  IF K/D MODE A OR B, GO KDX ROUTE         
*                                                                               
         SCS,R2   8                 OTHERWISE, ECHO THE ROLL CHAR.              
         OR,R2    R7                                                            
         WD,R2    XMITDATA                                                      
         FLAG     4                 SET LINE FLAG = 4                           
         B        COCIP01           RECYCLE                                     
*                                                                               
         SPACE    5                                                             
COCESC   EQU      %                                                             
         AND,R6   =X'BF'            TURN OFF ESCAPE BIT                         
         STB,R6   MODE,R7              IN MODE                                  
         LB,R6    CESCNR            GET NO. OF ENTRIES IN ESC TABLES            
*                                                                               
COCESC1  LB,R4    CESCNR,R6         GET ENTRY FROM FOLLOWER CHAR. TABLE         
         CW,R4    R5                COMPARE WITH TRANSLATED INPUT CHAR          
         BE       CESCTBL-1,R6         IF EQUAL, JUMP THRU BRANCH TABLE         
         BDR,R6   COCESC1             OTHERWISE, LOOP BACK                      
         B        X6                IF NO COMPARE, DISCARD SEQUENCE             
*                                                                               
         SPACE    4                                                             
*   SET INPUT-COMPLETE STATUS ON LINE                                           
*                                                                               
COCIC    EQU      %                                                             
         DISABLE                                                                
         LB,R4    STATE,R7                                                      
         AND,R4   =X'FE'                                                        
         OR,R4    =8                                                            
         STB,R4   STATE,R7          SET STATE FOR THIS LINE                     
         ENABLE                                                                 
         MTW,0    COCENDI,R7        WAS END-ACTION SPECIFIED?                   
         BEZ      %+2                                                           
         CAL1,5   COCENDI,R7           IF SO, TRIGGER SPEC'D INTERRUPT          
         LC       MODE,R7           SET CONDITION CODE WITH MODE BITS           
         B        0,R6              EXIT                                        
*                                                                       00007170
         TITLE    ' O U T P U T  I N T E R R U P T  R O U T I N E '     00007180
************************************************************************        
*                                                                       00007190
* OUTPUT INTERRUPT ROUTINE                                                      
*  OUTPUT INTERRUPT IS TIED TO EXTERNAL INTERRUPT LOC COCIO                     
*   RBM MONITOR TRANSFERS CONTROL TO COCOP WHEN INTERRUPT OCCURS                
*   COCOP EXITS VIA A RETURN TO RBM                                             
*                                                                       00007200
*                                                                       00007210
************************************************************************        
COCOP    EQU      %                                                     00007220
         DO       COCSTAT=1         STATISTICS OPTION                   00007260
         MTW,1    COCNOI            INCREMENT # OUTPUT INTERRUPTS       00007270
         FIN                                                            00007280
         RD,R7    OUTRSP            OUTPUT RESPONSE: FIND LINE NUMBER   00007290
         AND,R7   X3F               MASK OFF EXTRA BITS                 00007300
         CI,R7    COCNL             FIND OUT IF LEGAL LINE              00007300
         BL       COCOP30           YES                                 00007310
         MTW,1    COCOEC            NO - INCREMENT ERROR COUNT (OUTPUT) 00007320
         STW,R7   COCOEL            RECORD LINE NO.                     00007330
         B        COCOP20           CLEAN-UP AND RETURN                 00007340
         SPACE    2                                                             
*  THIS IS A LEGAL LINE NUMBER SO PROCESS                                       
COCOP30  LB,R5    FLAG,R7           LINE FLAG                           00007350
         BEZ      COCOP50           BRANCH IF 0                         00007360
         B        %,R5              BRANCH ON FLAG                      00007370
         B        COCOP45A          FLAG = 1                            00007380
         B        COCOP46           FLAG = 2                            00007390
         B        COCOP47           FLAG = 3                            00007400
         B        COCOP38           FLAG = 4                            00007410
         B        COCOP35           FLAG = 5                            00007420
         B        COCOP36           FLAG = 6                            00007430
         B        %                 FLAG=7(NOT USED)                            
         B        COCOP33           FLAG=8  SEND CANCEL                         
         SPACE    5                                                             
COCOP33  LI,R5    X'1800'           SEND XC (CANCEL)                    00007460
         B        COCOP46+1         SET FLAG = 4                        00007470
*  FLAG=5                                                                       
COCOP35  LI,R5    X'0000'           SEND NULL                           00007480
         LI,R6    6                 SET FLAG = 6                        00007490
         B        COCOP45+1                                             00007500
*  FLAG=6                                                                       
COCOP36  LI,R5    X'0000'           SEND NULL                           00007510
         LI,R6    4                 SET FLAG = 4                        00007520
         B        COCOP45+1                                             00007530
*  FLAG=4                                                                       
COCOP38  EQU      %                                                     00007540
         LI,R5    0                 ZERO                                00007550
         STB,R5   FLAG,R7           OUTPUT FLAG                         00007560
         LB,R5    STATE,R7          CHECK LINE STATE                    00007570
         CI,R5    6                    BRANCH IF XMTG (OR WAITING TO            
         BANZ     COCOP40                INPUT)                                 
*                                                                       00007610
*                                                                       00007650
*  CLEANUP AND THEN RETURN                                                      
COCOP20  WD,R7    XMITSTOP          NO-CLEAR SCANNER WITH STOP TRANSMIT 00007660
*                                                                       00007670
         CAL1,9   1                 RETURN TO RBM                               
*                                                                       00007720
COCOP40  EQU      %                                                             
         LH,R6    LINKO,R7          GET NEXT BUFFER LINK                        
         SLS,R6   2                 MULT. BY 4 TO GET REL. BYTE POINTER 00007740
         AI,R6    2                 + BIAS OF 2 BYTES                   00007750
         STH,R6   COCBAO,R7         STORE RELATIVE BYTE POINTER                 
         B        COCOP50+1         PICK UP CHARACTER                   00007770
*  FLAG=1                                                                       
COCOP45A LI,R6    4                 SET FLAG = 4                        00007780
COCOP45  LI,R5    X'8D00'           SET CHAR. = CR                      00007790
         OR,R5    R7                MERGE LINE NO.                      00007800
         WD,R5    XMITDATA          SEND CHARACTER                      00007810
         STB,R6   FLAG,R7           SET FLAG                            00007820
         B        COCOP95           RETURN                              00007830
*  FLAG=2                                                                       
COCOP46  LI,R5    X'0A00'           SEND LF                             00007840
         LI,R6    4                 SET FLAG = 4                        00007850
         B        COCOP45+1                                             00007860
*  FLAG=3                                                                       
COCOP47  LI,R5    X'8D00'           SEND CR                             00007870
         LI,R6    2                 SET FLAG = 2                        00007880
         B        COCOP45+1                                             00007890
         SPACE    2                                                             
*                                                                       00007900
*  NORMAL OUTPUT OF CHAR.                                                       
COCOP50  EQU      %                                                             
         LH,R6    COCBAO,R7         GET REL. BYTE PTR.                          
         LB,R5    COCBUF,R6         PICK UP CHARACTER                   00007920
         SCS,R5   8                 MOVE CHARACTER OVER                 00007930
         OR,R5    R7                MERGE LINE NUMBER                   00007940
         WD,R5    XMITDATA          SEND CHARACTER                      00007950
         AI,R6    1                 INCREMENT POINTER                   00007960
         STH,R6   COCBAO,R7            AND STORE                                
         LW,R4    R6                COPY POINTER                        00007980
         AND,R4   XF                IS BYTE COUNT MODULO 16             00007990
         BEZ      COCOP60              IF SO, RELEASE BUFFER BLOCK              
*                                                                               
COCOP55  LB,R6    COCBUF,R6         EXAMINE NEXT CHARACTER              00008010
         CI,R6    X'FF'             IS IT END OF MESSAGE                00008020
         BNE      COCOP95           NO-MORE CHAR TO BE XTMD                     
COCOP60  EQU      %                                                             
         LH,R4    LINKO,R7          GET HEAD LINK                               
         BAL,R6   COCPUTBL          RELEASE THE LINK                    00008050
         BEZ      COCOP80           BRANCH IF LAST BUFFER               00008060
         STH,R6   LINKO,R7          UPDATE NEW HEAD LINK                        
         SLS,R6   2                 MULT. BY 4 TO GET REL. BYTE PTR.    00008080
         AI,R6    2                 +BIAS OF 2 BYTES (NEW BYTE POINTER) 00008090
         STH,R6   COCBAO,R7         STORE REL. BYTE PTR.                        
         B        COCOP55           EXAMINE NEXT CHARACTER              00008010
         SPACE    2                                                             
*   LAST BUFFER WAS RELEASED                                                    
*                                                                               
COCOP80  EQU      %                                                             
         DISABLE                    INHIBIT INTERRUPTS                          
         STH,R6   COCBAO,R7         ZERO REL. BYTE PTR. (R6 CONTAINS )          
         STH,R6   LINKO,R7               HEAD LINK      (ZERO NOW    )          
         LB,R5    STATE,R7          CLEAR OUTPUT STATE                          
         AND,R5   =X'FD'                                                        
         CI,R5    4                 IS INPUT-WAIT STATE SET ?                   
         BAZ      COCOP90              BRANCH IF NOT                            
         EOR,R5   =5                YES - CHANGE TO INPUT STATE                 
COCOP90  STB,R5   STATE,R7          STORE NEW LINE STATE                        
         FLAG     4                 SET LINE FLAG TO 4                          
         ENABLE                     RE-ENABLE INTERRUPTS                        
*                                                                       00008090
         MTW,0    COCENDO,R7        WAS END-ACTION SPECIFIED?                   
         BEZ      %+2                                                           
         CAL1,5   COCENDO,R7           IF SO, TRIGGER SPEC'D INTERRUPT          
*                                                                               
*                                                                               
COCOP95  EQU      %                                                     00008110
*                                                                               
         CAL1,9   1                 RETURN TO RBM                               
         TITLE    ' C O C  B U F F E R  B L O C K  A L L O C A T O R '  00008190
************************************************************************00008220
* INPUT/OUTPUT BUFFER BLOCK ALLOCATOR                                   00008230
*   USED BY CWRITE AND COCIP TO GET A NEW BUFFER                                
*    DESTROYS:  R4,R5                                                   00008240
*   LINKAGE:  BAL,R6  COCGETB                                           00008250
* ENTER WITH LINE NO. IN R7 RT. JUSTIFIED                                       
* EXIT WITH BUFFER BLOCK ADDRESS IN REGISTER R4                         00008260
************************************************************************00008270
         SPACE    1                                                     00008210
COCGETB  EQU      %                                                     00008290
         DISABLE                                                        00008300
         LH,R4    COCHPB            TEST ALLOCATOR BUFFER BLOCK HEAD    00008310
         BNEZ     COCGETB1          BRANCH IF BUFFER AVAILABLE          00008320
         ENABLE                                                         00008330
         DO       COCSTAT=1         STATISTICS OPTION                   000     
         MTW,1    COCBW             INCREMENT BUFFER POOL FULL COUNT  * 00008350
         FIN                                                            00008360
*   NO BUFFERS AVAIALABLE                                                       
         LB,R4    STATE,R7          TEST LINE STATE                     00008370
         CI,R4    1                 ACCEPTING INPUT                     00008380
         BAZ      COCGETB2             NO - SET R4=0 AND RETURN                 
         B        X5                YES - DELETE LINE                   00008400
*                                                                       00008410
COCGETB1 EQU      %                                                     00008420
         STW,R5   COCHPB            SAVE R5                             00008430
         LI,R5    0                 ZERO                                00008440
         XW,R5    COCBUF,R4         0 TO BUF, CHAIN TO R5               00008450
         XW,R5    COCHPB            RESTORE R5, SET HEAD TO CHAIN       00008460
         ENABLE                                                         00008470
         B        0,R6              EXIT                                00008510
COCGETB2 LI,R4    0                 SET BLOCK ADDR=0(NO MORE BUFFERS)           
         B        0,R6              RETURN TO CALLER                            
COCHPB   GEN,16,16 (COCBUF0-COCBUF),0 BUFFER BLOCK HEAD(REL. WORD PTR.) 00008200
         PAGE                                                           00008520
************************************************************************00008530
* INPUT/OUTPUT LINE BUFFER BLOCK UPDATE ROUTINE                         00008540
*   USED BY COCOP,COCIP,CWRITE,CMOVE TO RELEASE A BUFFER TO POOL                
* ENTER WITH BUFFER BLOCK ADDRESS RT. JUSTIFIED IN R4                   00008550
* EXIT WITH NEXT LINK RT. JUSTIFIED IN R6                               00008560
************************************************************************00008570
         SPACE    1                                                     00008580
COCPUTBL EQU      %                                                     00008590
         DISABLE                                                        00008600
         XW,R6    COCHPB            OLD CHAIN TO R6, EXIT TO COCHPB     00008610
         XW,R6    COCBUF,R4         CHAIN BLOCKS                        00008620
         SLS,R4   16                LEFT JUSTIFY REL. BUFF. PTR.        00008630
         XW,R4    COCHPB            EXIT TO R4, REL BUFF PTR. TO HEAD   00008640
         ENABLE                                                         00008650
         LH,R6    R6                RIGHT JUSTIFY NEXT PTR.             00008660
         B        0,R4              EXIT                                00008670
         TITLE    'ARGUMENT FETCH SUBROUTINE'                                   
************************************************************************        
*        FETCH THE EFFECTIVE ADDRESS OF AN ARGUMENT                    *        
*        ENTER WITH ARG. NO. IN R12(0-N):0 IS FIRST ARG.AFTER BAL,15 SB*        
*        CALLING SEQUENCE                                              *        
*        BAL,13   FETCHA                                               *        
*                                                                      *        
*        RETURN   NORMAL, ADDRESS IN R12                               *        
************************************************************************        
FETCHA   AW,12    15                GET LOCATION OF ARG.                        
         LW,12    *12               GET ADDR. IN ARG.                           
         CW,12    =X'7E700000'      CHECK FOR INTG(01),OR *INTG(81)             
         BCS,4    FETCH9            B IF ANY ONES COMP.,ERROR EXIT              
         LW,12    12                SET CC'S                                    
         BGEZ     %+2               B IF NO IND. ADDR.                          
         LW,12    *12                                                           
         AND,12   =X'0001FFFF'      EXTRACT ADDR.                               
         B        *13                                                           
FETCH9   CAL1,2   FPTFET                                                        
         CAL1,9   1                 CALL EXIT                                   
FPTFET   GEN,8,24 X'02',0                                                       
         GEN,8,24 X'80',0                                                       
         GEN,15,17 0,CMT                                                        
CMT      TEXTC    'ERROR IN CALLING SEQ (FORTRAN)'                              
         TITLE    ' C O C  R E A D  R O U T I N E '                             
*********************************************************************** 00008690
*                                                                               
*   ROUTINE TO ACCEPT INPUT ON A GIVEN LINE                                     
*   CALLING SEQUENCES ARE AS FOLLOWS:                                           
*   FROM FORTRAN PROGRAM:                                                       
*        CALL     CREAD(LINE,COUNT,STATUS<,END>)                                
*                     ( ARGS ENCLOSED IN < > ARE OPTIONAL )                     
*                                                                               
*   FROM ASSEMBLY LANGUAGE PROGRAM:                                             
         LI,14    3 (OR 4)                                                      
*        BAL,15   CREAD                                                         
*        ARG1     ADDRESS OF LINE #                                             
*        ARG2     ADDR OF BYTE-COUNT VARIABLE                                   
*        ARG3     ADDR OF STATUS WORD                                           
*     OPTIONAL                                                                  
*        ARG4     ADDR OF END-ACTION INTERRUPT SPECIFICATION                    
*                                                                               
*                                                                               
*        STATUS VALUE   MEANING      (ON RETURN TO USER)                        
*        ************   ********************************                        
*            0          NORMAL-REQUEST ACCEPTED/INPUT MAY PROCEED               
*            2          INVALID LINE NO.-REQUEST IGNORED                        
*            4          INVALID LINE STATE-REQUEST IGNORED                      
*            8          BREAK SIGNAL RECEIVED- INPUT TERMINATED IF IN           
*                                              PROGRESS                         
*                                             -NOT BEGUN IF BRK RECEIVED        
*                                              PRIOR TO  INPUT REQUEST          
*                                                                               
************************************************************************        
CREAD    EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
*   INITIALIZE REGISTERS FOR PROCESSING                                         
         LI,R12   0                                                             
         BAL,R13  FETCHA                                                        
         LW,R12   *R12              ACTUAL LINE NO. TO R6                       
         AI,R12   -1                ADJUST FORTRAN INTEGER                      
         STW,R12  R6                                                            
         LI,R11   2                                                             
         CI,6     COCNL-1           IS LINE NO. LEGAL                   00008740
         BG       AIRET                NO - EXIT WITH STATUS = 2                
         LI,R11   8                                                             
         BAL,SR3  COCBK             WAS BREAK SIGNAL RECEIVED?                  
         BANZ     AIRET                IF SO, EXIT WITH STATUS = 8              
*                                                                               
         DISABLE                                                        00008760
         LI,R11   4                                                             
         LI,SR2   1                                                             
         LB,SR1   STATE,R6          PRESENT STATE                       00008770
         BEZ      COCAI25              BRANCH IF STATE INACTIVE                 
*                                                                               
COCAI20  EQU      %                 LINE IS ACTIVE                              
         CI,SR1   X'FD'               IS STATE OTHER THAN OUTPUT                
         BANZ     AIRET                 YES - EXIT WITH STATUS =4               
         LB,SR2   MODE,R6               NO - CHANGE STATE TO INPUT-WAIT         
         AND,SR2  =7                      OR IN+OUT AS MODE DICTATES            
COCAI25  EQU      %                                                             
         BAL,R1   COCAB1            STORE STATE, CLEAR ARS,COCBAI, LINKI        
*                                      (AND RELEASE ANY ASSIGNED BUFF'S)        
         LI,R12   1                                                             
         BAL,R13  FETCHA                                                        
         LW,R12   *R12              GET SPEC'D BYTE COUNT                       
         AI,R12   -1                   DECREMENT                                
         STH,R12  COCMC,R6             AND SAVE IN LINE TABLE                   
         LI,R12   3                                                             
         BAL,R1   CSETEND           GET END-ACTION INTERUPT SPEC, BUILD         
         STW,R2   COCENDI,R6           FPT, AND SAVE (IF NONE, FPT=0 )          
         LI,R11   0                 GET NORMAL STATUS CODE                      
*                                                                               
AIRET    EQU      %                                                             
         ENABLE                                                                 
         LI,R12   2                                                             
         BAL,R13  FETCHA                                                        
         STW,R11  *R12              STORE STATUS IN USER'S LOC.                 
*                                                                               
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,R15   R14               BAL LINK+ NO. OF ARG.                       
         B        *R15              RETURN TO CALLER                            
         SPACE    4                                                             
COCBK    EQU      %                                                             
         LB,SR1   MODE,R6                                                       
         CI,SR1   X'20'             SET CC2 IF BREAK HAS BEEN RECEIVED          
         AND,SR1  XDF               CLEAR BREAK BIT                             
         STB,SR1  MODE,R6                                                       
         B        *SR3              RETURN                                      
         SPACE    4                                                             
************************************************************************        
*                                                                               
*   SET UP END-ACTION INTERRUPT FPT                                             
*    --USED BY CREAD AND CWRITE--                                               
*                                                                               
*   LINKAGE:      BAL,R1  CSETEND                                               
*                                                                               
*   ENTER WITH CALL SEQ. PARAM. # IN R12                                        
*   EXIT WITH FPT (OR ZERO IF NO END-ACTION SPEC'D) IN R2                       
*   DESTROYS R13                                                                
************************************************************************        
*                                                                               
CSETEND  EQU      %                                                             
         LI,R2    0                 IF END PARAM. NOT PRESENT,                  
         CW,R12   R14                  EXIT WITH FPT = 0                        
         BGE      0,R1                                                          
         BAL,R13  FETCHA            OTHERWISE,GET END-ACTION ARGUMENT           
         LW,R2    *R12                                                          
         BEZ      0,R1                                                          
         CI,R2    X'10000'          TEST FOR FORM OF SPEC.                      
         BL       0,R1                 IF ABS. ADDR., EXIT AS-IS                
         SLS,R2   0,R1                                                          
         AI,R2    X'10000'             IF INT. LABEL GIVEN, RIGHT-JUST.,        
         B        0,R1                 SET LABEL FLAG, AND EXIT                 
         SPACE    4                                                             
         TITLE    ' C O C  M O V E  R O U T I N E '                             
*********************************************************************** 00009050
*                                                                       00009060
*   ROUTINE TO MOVE RECEIVED DATA TO USERS BUFFER                               
*                                                                               
*   CALLING SEQUENCES ARE AS FOLLOWS:                                           
*                                                                               
*   FROM FORTRAN PROGRAM:                                                       
*        CALL     CMOVE(LINE #,BUFFER ADDR,DISPLACEMENT,BYTE CNT,STATUS)        
*                                                                               
*   FROM ASSEMBLY LANGUAGE PROGRAM:                                             
*        LI,14    5                 (NO. OF ARG IN CALLING SEQ)                 
*        BAL,15   CMOVE                                                         
*        ARG1     ADDR OF LINE #             (R1 WILL HOLD LINE #)              
*        ARG2     ADDR OF USER'S BUFFER      (R4 WILL HOLD BUF ADDR)            
*        ARG3     ADDR OF BYTE DISPLACEMENT  (R7 WILL HOLD BYTE DISPL)          
*        ARG4     ADDR OF BYTE COUNT         (R8 WILL HOLD BYTE COUNT)          
*        ARG5     ADDR OF OPTION/STATUS WORD (R5 WILL HOLD STATUS ADDR)         
*                                                                               
*        OPTION CODE    MEANING  (AS SET BY USER)                               
*        ***********    *************************                               
*            0          NORMAL OPERATION                                        
*            1          TERMINATE INPUT IF NOT ALREADY INACTIVE                 
*                                                                               
*        STATUS VALUE   MEANING        (ON RETURN TO USER)                      
*        ************   **********************************                      
*            0          NORMAL OPERATION-ALL INPUT MOVED(ARG4=BYTE CNT)         
*            1          NORMAL OPERATION-NOTALL INPUT MOVED(ARG4=CNT OF         
*                                        BYTES REMAINING TO BE MOVED)           
*            2          INVALID LINE #- REQUEST IGNORED                         
*            4          INPUT IS ACTIVE (INFO. ONLY - NO EFFECT ON MOVE)        
*            8          BREAK SIGNAL RECEIVED                                   
*                                                                               
*                                                                       00009030
*********************************************************************** 00009040
CMOVE    EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
*                                                                               
*   PICK UP LINE NO. AND PLACE IT IN R6                                         
         LI,R12   0                                                             
         BAL,R13  FETCHA                                                        
         LW,R13   *R12                                                          
         AI,R13   -1                ADJUST FOR FORTRAN INTEGER                  
         STW,R13  R1                LINE NO. TO R1                              
*                                                                               
*   PICK UP USER'S BUFFER ADDRESS AND PLACE IT IN R4                            
         LI,R12   1                                                             
         BAL,R13  FETCHA                                                        
         STW,R12  R4                BUFFER ADDRESS TO R4                        
*                                                                               
*   PICK UP USER'S BYTE DISPLACEMENT AND PLACE IN R7                            
         LI,R12   2                                                             
         BAL,R13  FETCHA                                                        
         LW,R13   *R12                                                          
         STW,R13  R7                BYTE DISPL  TO R7                           
*                                                                               
*   PICK UP USER'S BYTE COUNT AND PLACE IN R8                                   
         LI,R12   3                                                             
         BAL,R13  FETCHA                                                        
         LW,R13   *R12                                                          
         STW,R13  R8                BYTE COUNT TO R8                            
*                                                                               
*   PICK UP USER'S STATUS WORD ADDR. AND PLACE IN R5                            
         LI,R12   4                                                             
         BAL,R13  FETCHA                                                        
         STW,R12  R5                STATUS WORD ADDRESS IN R5                   
*                                                                               
         SPACE    4                                                             
         LI,R3    2                                                             
         CI,R1    COCNL-1           IF LINE # INVALID,                          
         BG       RMOV                 EXIT WITH STATUS = 2                     
*                                                                               
         LW,R12   *R5               GET OPTION ARG.                             
         BEZ      CMOVE10              SKIP IF BLANK                            
         DISABLE                                                                
         LB,R2    STATE,R1          OTHERWISE, GET LINE STATE                   
         CI,R2    1                    IF INPUT IS ACTIVE,                      
         BAZ      %+3                                                           
         EOR,R2   =9                   SWITCH TO INPUT-COMPLETE                 
         STB,R2   STATE,R1                                                      
         ENABLE                                                                 
*                                                                               
CMOVE10  EQU      %                                                             
         LI,R12   CIGNORE           GET IGNORE CHARACTER                        
*                                                                               
         CH,R8    ARS,R1            COMPARE REQUEST WITH ACTUAL REC SIZE        
         BL       %+2                                                           
         LH,R8    ARS,R1               IF GRTR, REPLACE WITH ARS                
*                                                                               
         LH,R6    LINKI,R1                                                      
         LW,SR3   SR1               BYTE STRING COUNT                   00009230
         LW,R3    R4                SAVE ADDR OF USER BUFFER                    
CMOVE20  EQU      %                                                             
         LW,R4    R6                SAVE LINK ADDR IN R4                        
         SLS,R6   2                 MULT. BY 4 TO GET REL. BYTE PTR.    00009260
         AW,R6    ACOCBUF           ABSOLUTIZE SOURCE ADDRESS (LINK)    00009270
         LI,SR2   14                SET UP TO MOVE 14 BYTES                     
         CW,SR3   SR2                                                           
         BGE      CMOVE21                                                       
         LW,SR2   SR3               IF LESS THAN 14 LEFT, USE REMAINDER         
         BEZ      CMOVE30              EXIT IF NONE TO MOVE --                  
*                                                                               
CMOVE21  EQU      %                                                             
         LB,R2    0,R6              GET 1 BYTE FROM POOL BUFFER                 
         CI,R2    CIGNORE           IS IT AN IGNORE CHAR.                       
         BNE      %+3                                                           
         AI,SR3   1                    IF SO, ADJUST REMAINDER                  
         B        CMOVE25              AND SKIP THE CHARACTER                   
*                                                                               
         STB,R2   *R3,R7            OTHERWISE, STORE IN USERS BUFFER            
         STB,R12  0,R6              PUT IGNORE CHAR IN POOL BUFFER              
         AI,R7    1                 INCR. USER BUFF POINTER                     
CMOVE25  EQU      %                                                             
         AI,R6    1                 INCR. POOL POINTER                          
         BDR,SR2  CMOVE21           DECR. BYTES-LEFT-IN-BLK, AND LOOP           
*                                                                               
         AI,SR3   -14               IF BLOCK EMPTY, REDUCE REMAINDER            
         BLEZ     CMOVE30              IF REQUEST SATISFIED, FINISH UP          
*                                                                               
         BAL,R6   COCPUTBL          OTHERWISE, RELESE THE BLOCK TO POOL         
         STH,R6   LINKI,R1             AND SAVE THE LINK                        
         BNEZ     CMOVE20           IF NOT LAST LINK, MOVE NEXT BLOCK           
*                                                                               
*   ALL BYTES MOVED -- FINISH UP AND EXIT                                       
*                                                                               
CMOVE30  EQU      %                                                             
         DISABLE                                                                
         LI,R3    0                 GET NORMAL STATUS CODE                      
         LH,SR3   ARS,R1                                                        
         SW,SR3   SR1               DECR. ACTUAL RECORD SIZE BY COUNT           
         STH,SR3  ARS,R1               OF BYTES MOVED                           
         BEZ      CMOVE35                                                       
         LW,SR1   SR3               IF NOT ALL MOVED, GET REMAINDER             
         LI,R3    1                    COUNT AND NOT-ALL-MOVED CODE             
         B        CMOVE40                                                       
*                                                                               
CMOVE35  EQU      %                                                             
         LB,SR3   STATE,R1          TURN OFF INPUT-COMPLETE STATE               
         AND,SR3  =X'F7'                                                        
         STB,SR3  STATE,R1                                                      
         LH,R4    LINKI,R1          GET LAST LINK                               
         BEZ      CMOVE40                                                       
         STH,R3   LINKI,R1             IF NOT ZERO, CLEAR IT                    
         BAL,R6   COCPUTBL             AND RELEASE BLOCK TO POOL                
*                                                                               
CMOVE40  EQU      %                                                             
         ENABLE                                                                 
         LI,R12   2                                                             
         BAL,R13  FETCHA                                                        
         STW,R7   *R12              SAVE BYTE DISPL FOR USER                    
         LI,R12   3                                                             
         BAL,R13  FETCHA                                                        
         STW,R8   *R12              SAVE BYTE COUNT FOR USER                    
         LW,R6    R1                LINE # INTO R6                              
         BAL,SR3  COCBK             TEST (AND RESET) BREAK BIT IN MODE          
         BAZ      %+2                                                           
         AI,R3    8                    IF SET, ADD TO STATUS                    
         LB,SR3   STATE,R6                                                      
         CI,SR3   1                 IF INPUT IS ACTIVE,                         
         BAZ      %+2                                                           
         AI,R3    4                    ADD TO STATUS                            
*                                                                               
*                                                                               
RMOV     EQU      %                                                             
         STW,R3   *R5               STORE STATUS FOR USER                       
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,15    14                                                            
         B        *15                                                           
*                                                                       00009760
         TITLE    ' C O C  W R I T E  R O U T I N E '                   00009770
*********************************************************************** 00009780
*                                                                       00009790
*   THIS ROUTINE OUTPUTS THE CONTENTS OF A BUFFER TO THE COC ON LINE(N)         
*                                                                               
*   THE CALLING SEQUENCES ARE AS FOLLOWS:                                       
*                                                                               
*   FROM FORTRAN PROGRAM:                                                       
*                                                                               
*        CALL     CWRITE(LINE,BUFFER,DISPL,COUNT,STATUS<,END>)                  
*                                                                               
*   FROM ASSEMBLY PROGRAM:                                                      
*                                                                               
*        LI,14    5 (OR 6)                                                      
*        BAL,15   CWRITE                        REGISTERS USED                  
*      0 ARG1     ADDR OF LINE #                    (R6-LINE #)                 
*      1 ARG2     ADDR OF DATA TO BE OUTPUT         (R11-ADDR OF BUFFER)        
*      2 ARG3     ADDR OF BYTE-DISPL(REL TO BUFFER) (R7-DISPL)                  
*      3 ARG4     ADDR OF BYTE-COUNT TO BE XMTD     (R8-CNT)                    
*      4 ARG5     ADDR OF OPTION/STATUS WORD                                    
*    OPTIONAL                                                                   
*      5 ARG6     ADDR OF END-ACTION INTERRUPT SPECIFICATION                    
*                                                                               
*        OPTION CODE     MEANING                                                
*        ***********     ***************                                        
*          0             NORMAL OUTPUT OPERATION                                
*          1             ABORT INPUT IF IN PROGRESS                             
*          2             ABORT OUTPUT IF IN PROGRESS                            
*                                                                               
*        STATUS VALUE    MEANING                                                
*        ***********     ************                                           
*          0             NORMAL TRANSFER;REQ. ACCEPT.-OUTPUTTING                
*          1             NOT ENOUGH BUFFER SPACE; REQUEST IGNORED               
*          2             INVALID LINE NO,; REQ. IGNORED                         
*          4             INVALID LINE STATE; REQ. IGNORED                       
*          8             BREAK RECEIVED (INFO. ONLY; NO EFFECT ON OUTPUT        
*                                                                               
*********************************************************************** 00009840
CWRITE   EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
*   PICK UP USER'S LINE NO.AND PLACE IN R6                                      
         LI,R12   0                                                             
         BAL,13   FETCHA                                                        
         LW,R12   *R12              ACTUAL LINE #                               
         AI,R12   -1                ADJUST FORTRAN INTGERS                      
         STW,R12  R6                                                            
*   PICK UP USER'S BUFFER  AND PLACE IN R11                                     
         LI,R12   1                 ADDR OF DATA BUFFER                         
         BAL,13   FETCHA                                                        
         STW,R12  R11               R11=DATA BUFFER                             
*   PICK UP USER'S BYTE DISPL AND PLACE IN R7                                   
         LI,R12   2                                                             
         BAL,13   FETCHA                                                        
         LW,R12   *R12              GET ACTUAL BYTE DISPL                       
         STW,R12  R7                R7=BYTE DISPL                               
*   PICK UP USER'S BYTE COUNT AND PLACE IN R8                                   
         LI,R12   3                 GET BYTE COUNT TO BE XMTD                   
         BAL,13   FETCHA                                                        
         LW,R12   *R12                                                          
         STW,R12  R8                R8=BYTE COUNT                               
         SPACE    3                                                     00008280
*   CHECK THAT LINE NUMBER IS VALID                                             
*                                                                               
         LI,SR2   2                                                             
         CI,R6    COCNL-1           CHECK LINE #                                
         BG       RWRT+1               IF BAD, EXIT WITH STATUS = 2             
         LB,SR2   STATE,R6          LINE STATE                          00009860
         BEZ      COCWR10           BRANCH IF INACTIVE                  00009870
         CI,SR2   128               CHECK THAT LINE IS IN SERVICE               
         BGE      COCWR6               IF NOT, GO SET STATUS=4 AND EXIT         
*                                                                               
         LI,R12   4                 CHECK OPTIONS IN CALLING SEQUENCE           
         BAL,R13  FETCHA                                                        
         LW,R12   *R12                                                          
         CI,R12   1                 CHECK FOR ABORT-INPUT OPTION                
         BAZ      COCWR3                                                        
         BAL,R1   COCABIN              IF SET, GO PROCESS IT                    
*                                                                               
COCWR3   EQU      %                                                             
         CI,SR2   2                 IS STATE = OUTPUT?                          
         BAZ      COCWR4               NO -- BRANCH                             
         CI,R12   2                    YES - TEST FOR ABORT-OUT. OPTION         
         BAZ      COCWR10                                                       
         BAL,R1   COCABOUT                IF SET, GO PROCESS IT                 
*                                                                               
COCWR4   EQU      %                                                             
         CI,SR2   0                 CHECK WHETHER STATE IS NOW INACTIVE         
         BE       COCWR10              YES - BRANCH                             
         LB,R12   MODE,R6           NO - CHECK FOR FULL-DUPLEX MODE             
         AND,R12  SR2                                                           
         CI,R12   1                    AND STATE = INPUT                        
         BE       COCWR10                BRANCH IF SO                           
*                                                                               
COCWR6   EQU      %                                                             
         LI,SR2   4                 OTHERWISE, GET CODE FOR INVALID             
         B        RWRT+1               STATE AND EXIT                           
*                                                                       00009970
*                                                                       00009980
*   LINE NO. IS VALID SO START OUTPUT PROCESSING                                
*                                                                               
COCWR10  EQU      %                                                             
         LW,R3    R7                USER BUFFER POINTER TO R3           00010000
         LW,R7    R6                LINE NUMBER TO R7                   000100 0
         LW,R1    SR1               SAVE SR1 --COUNT--                  000100 0
         BEZ      COCWR82A             EXIT IF BYTE-COUNT = 0                   
         LB,R5    COCTERMN,R7       TERMINAL TYPE                       000100 0
         LW,SR3   COCOT,R5          OUTPUT TRANSLATE TABLE POINTER      000100 0
COCWR30  BAL,R6   COCGETB           GET A BUFFER                        000100 0
         CI,R4    0                                                             
         BEZ      NMBUF             NO MORE BUFFERS-PARTIAL XFER ONLY           
         LW,SR2   R4                SAVE 1ST REL. BUFFER ADDRESS        000100 0
         SLS,R4   2                 MULT. BY 4 TO GET BYTE PTR.         000100 0
         AI,R4    2                 + BIAS OF 2 BYTES                   000100 0
         SPACE    2                                                             
*   START DATA TRANSLATION                                                      
*   PICK UP NEXT CHAR. FROM USER'S BUFFER AND PROCESS                           
COCWR40  LB,R5    *R11,R3           GET CHAR. FROM USER BUFFER                  
         LC       MODE,R7           CHECK FOR NO-TRANSLATE MODE                 
         BCS,C4   COCWR60              IF SO, SKIP TRANSLATION                  
         LB,R5    *SR3,R5           TRANSLATE                           000100 0
         CI,R5    X'0A'             IS IT LF FOR K/D                    000100 0
         BNE      COCWR40A          BRANCH IF NO                        000100 0
         BAL,R2   COCPCIB           PLACE LF IN BUFFER                  000100 0
         LI,R5    X'8D'             CR                                          
         BAL,R2   COCPCIB              PLACE IN BUFFER                          
         LI,R5    0                 NULL                                        
         BAL,R2   COCPCIB              PLACE IN BUFFER                          
         LI,R5    0                 NULL                                        
         BAL,R2   COCPCIB           PLACE CHAR. IN BUFFER               000100 0
         LI,R5    X'00'             NULL                                000100 0
         B        COCWR60           PLACE IN A 2ND TIME                 000100 0
COCWR40A EQU      %                                                     000100 0
         CI,R5    X'F1'             IS IT = OR> F1                      000100 0
         BL       COCWR60           B IF L.T.'F1'                               
*   OUTPUT SPECIAL ACTION TABLE                                                 
F1       EQU      X'F1'                                                 000100 0
COCWR41  B        %-F1+1,R5         SWITCH ON CODE                      000100 0
         B        COCWR70           IGNORE THE CHARACTER (F1)           000100 0
         B        COCWR50           PUT CR AND LF IN BUFFER (F2)        000100 0
         B        COCWR60           PUT CHAR. IN BUFFER (F3)            000100 0
         B        COCWR80           QUIT (F4)                           000100 0
         B        COCWR60           F5 -VALID CHAR. - STORE IN BUFFER           
         B        COCWR60           F6 - VALID                                  
         B        COCWR70           F7 - AVAILABLE SPECIAL-ACTION CODE          
         B        COCWR70           F8 - AVAILABLE                              
         B        COCWR60           F9 -VALID                                   
         B        COCWR60           FA -VALID                                   
         B        COCWR70           FB - AVAILABLE                              
         B        COCWR60           FC -VALID                                   
         B        COCWR70           FD - AVAILABLE                              
         B        COCWR70           FE - AVAILABLE                              
         B        COCWR60           FF -VALID                                   
*                                                                               
*                                                                               
COCWR50  LI,R5    X'0D'             CR                                  000100 0
         BAL,R2   COCPCIB           STORE CHARACTER IN BUFFER           000100 0
         AI,R1    1                 INCREMENT COUNT (TO BE PRINTED)     000100 0
         LI,R5    X'0A'             LF                                  000100 0
COCWR60  BAL,R2   COCPCIB           STORE CHARACTER IN BUFFER           000100 0
COCWR70  AI,R3    1                 INCREMENT BYTE POINTER              000100 0
         BDR,SR1 COCWR40     DECR. USER BYTE COUNT & GET NEXT CHAR.     000100 0
COCWR80  LI,R5    X'FF'             NONE LEFT - PICK UP FF              000100 0
         STB,R5   COCBUF,R4         STORE LAST CHAR. IN BUFFER          000100 0
*                                                                       000100 0
         DISABLE                                                        000100 0
*                                                                       000100 0
*   SET UP HEAD LINK FOR CHAR OUTPUT                                            
*                                                                       000100 0
         LH,R3    LINKO,R7          GET HEAD LINK POINTER                       
         BEZ      COCWR83           BRANCH IF ZERO                      000100 0
COCWR81  EQU      %                                                     000100 0
         SLS,R3   1                 MULT. BY 2 TO GET REL. HALF WD. PTR 000100 0
         LH,R4    COCBUF,R3         GET 1ST WORD                        000100 0
         BEZ      COCWR82           ZERO                                000100 0
         LW,R3    R4                SET NEW WORD POINTER                000100 0
         B        COCWR81                                               000100 0
COCWR82  STH,SR2  COCBUF,R3         CHAIN NEW BUFFERS ONTO OLD          000100 0
         ENABLE                                                         000100 0
*                                                                               
*   PREPARE FOR NORMAL EXIT                                                     
*                                                                               
COCWR82A EQU      %                                                             
         LI,SR2   0                 GET NORMAL STATUS CODE                      
         LI,R12   5                                                             
         BAL,R1   CSETEND           SET UP FPT FOR END-ACTION INTERRUPT         
         STW,R2   COCENDO,R7           (ZERO IF NONE SPECIFIED)                 
         B        RWRT              RETURN TO CALLER                            
*                                                                       000100 0
COCWR83  EQU      %                                                     000100 0
         ENABLE                                                         000100 0
         STH,SR2  LINKO,R7          CREATE NEW HEAD LINK                        
         LW,R3    SR2               COPY SR2                            000100 0
         SLS,R3   2                 MULT. BY 4 TO GET REL. BYTE PTR.    000100 0
         AI,R3    2                 +BIAS OF 2 BYTES                    000100 0
         DISABLE                                                        000100 0
         LB,R4    FLAG,R7           IS USER OUTPUT                              
         BEZ      COCWR85           YES-OUTPUT NEXT CHAR.                       
         STH,R3   COCBAO,R7         OUTPUT IS ACTIVE - STORE NEW POINTER        
         LB,R5    STATE,R7          SET STATE                                   
         OR,R5    =2                                                            
         STB,R5   STATE,R7          TO OUT (=2)                         000100 0
         ENABLE                                                         000100 0
         B        COCWR82A          WRAPUP                              000100 0
*                                                                               
*   OUTPUT FIRST CHAR. TO LINE AND THEN RETURN TO CALLER                        
COCWR85  EQU      %                                                     000100 0
         ENABLE                                                         000100 0
         LB,R5    COCBUF,R3         GET 1ST CHARACTER                   000100 0
         AI,R3    1                 ADVANCE POINTER                     000100 0
         CI,R5    X'FF'             IS CHAR. = 'FF'                     000100 0
         BE       COCWR85B          BRANCH IF YES                       000100 0
         LB,R4    COCBUF,R3         EXAMINE NEXT CHAR.                  000100 0
         CI,R4    X'FF'             IS IT = FF                          000100 0
         BNE      COCWR85A          BRANCH IF NO                        000100 0
*                                                                               
*   OUTPUT ONE CHAR. AND SET FLAG TO FINISHED(FLAG=4)                           
         LI,R4    4                 SET LINE FLAG                       000100 0
         STB,R4   FLAG,R7            TO 4                               000100 0
         SCS,R5   8                 MOVE CHAR. OVER                     000100 0
         OR,R5    R7                MERGE LINE NO.                      000100 0
         WD,R5    XMITDATA          SEND THE DATA                       000100 0
*                                                                               
*   NO MORE CHAR. TO OUTPUT SO RELEASE BUFFERS                                  
COCWR85B LW,R4    SR2               REL. LINK POINTER                   000100 0
         BAL,R6   COCPUTBL          RELEASE BLOCK                       000100 0
         STH,R6   LINKO,R7          CLEAR LINKO                                 
         STH,R6   COCBAO,R7               COCBAO                                
         B        COCWR82A          RESTORE REGISTERS                   000100 0
*                                                                               
*   SEND OUT FIRST CHAR. AND SET STATE=2 FOR OUTPUTTING                         
*                                                                               
COCWR85A EQU      %                                                             
         STH,R3   COCBAO,R7         STORE NEW POINTER                           
         DISABLE                                                                
         LB,R3    STATE,R7                                                      
         OR,R3    =2                SET STATE                                   
         STB,R3   STATE,R7          TO OUT (=2)                         000100 0
         ENABLE                                                                 
         SCS,R5   8                 MOVE CHARACTER OVER                 000100 0
         OR,R5    R7                MERGE LINE NO.                      000100 0
         WD,R5    XMITDATA          SEND THE CHARACTER                  000100 0
         B        COCWR82A          EXIT                                000100 0
*                                                                       000100 0
*                                                                       000100 0
*   PUT CHAR. IN BUFFER FOR OUTPUTING TO LINE 'N'.                              
**                                                                      000100 0
COCPCIB  STB,R5   COCBUF,R4         STORE CHARACTER IN BUFFER           000100 0
         AI,R4    1                 INCREMENT REL. BYTE POINTER         000100 0
         LW,R5    R4                EXAMINE BYTE COUNT                  000100 0
         AND,R5   XF                IS BYTE COUNT MODULO 16             000100 0
         BNEZ     0,R2              NO - RETURN                         000100 0
         LW,R5    R4                SAVE R4                             000100 0
         BAL,R6   COCGETB           GET A BUFFER                        000100 0
         CI,R4    0                                                             
         BEZ      NMBUF             B IF NO MORE BUFFERS                        
         AI,R5    -16               BACK UP PTR. BY 16 BYTES (4WDS.)    000100 0
         SLS,R5   -1                DIV. BY 2 TO GET REL. HALF WD. PTR. 000100 0
         STH,R4   COCBUF,R5         LINK NEW BUFFER TO LAST             000100 0
         SLS,R4   2                 MULT. BY 4 TO GET REL. BYTE PTR.    000100 0
         AI,R4    2                 + BIAS OF 2 BYTES                   000100 0
         B        0,R2              EXIT                                000100 0
*   ONLY A PARTIAL XFER WAS ACCOMPLISHED SO SET STATUS=1,BYTE-CNT,BYTE-         
*        DISPL AND RETURN TO CALLER                                             
*                                                                               
NMBUF    EQU      %                                                             
         LW,R6    R7                RELEASE ASSIGNED BUFFERS                    
         BAL,R1   COCAB1                                                        
         LI,SR2   1                 GET OUT-OF-BUFFERS CODE                     
*                                                                               
RWRT     EQU      %                                                             
         LW,R6    R7                LINE # TO R6                                
         BAL,SR3  COCBK             CHEAK BREAK BIT (AND RESET) IN MODE         
         BAZ      %+2                                                           
         AI,SR2   8                    IF SET, ADD TO STATUS                    
*                                                                               
         LI,R12   4                                                             
         BAL,R13  FETCHA                                                        
         STW,SR2  *R12              STORE STATUS IN USER LOC.                   
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,15    14                                                            
         B        *15                                                           
         TITLE    ' COC I/O ABORT ROUTINES '                                    
************************************************************************        
*                                                                               
*   ABORT INPUT (OUTPUT) ROUTINE                                                
*      USED BY CWRITE TO TERMINATE AN ACTIVE INPUT (OUTPUT), AND IN PART        
*      BY OTHER ROUTINES TO RELEASE A CHAIN OF BUFFERS TO THE POOL              
*                                                                               
*   LINKAGE:   BAL,R1  COCABIN (COCABOUT)                                       
*     ENTER WITH LINE # IN R6                                                   
*     EXIT WITH UPDATED STATE BYTE IN LINE TABLE AND IN SR2                     
*     DESTROYS R2,R4,R13                                                        
*                                                                               
************************************************************************        
*                                                                               
COCABIN  EQU      %                                                             
         DISABLE                                                                
         LB,SR2   STATE,R6          GET LINE STATE                              
         AND,SR2  =6                TURN OFF INPUT AND INPUT-COMPLETE           
         CI,SR2   4                 TEST FOR INPUT-WAITING                      
         BAZ      %+2                                                           
         EOR,SR2  =6                IF SET, CLEAR AND SET OUTPUT                
COCAB1   EQU      %                                                             
         STB,SR2  STATE,R6                                                      
         LI,R2    0                                                             
         STH,R2   ARS,R6            CLEAR ACTUAL RECORD SIZE                    
         STH,R2   COCBAI,R6               RELATIVE BYTE ADDRESS                 
         ENABLE                                                                 
         STW,R6   R13               SAVE LINE #                                 
         LH,R4    LINKI,R6          GET LINK                                    
         STH,R2   LINKI,R6          CLEAR LINK TABLE ENTRY                      
COCAB2   EQU      %                                                             
         BEZ      COCABX            EXIT IF LINK IS ZERO                        
         BAL,R6   COCPUTBL          RELEASE A BLOCK TO POOL                     
         LW,R4    R6                GET NEW LINK                                
         B        COCAB2               AND LOOP BACK                            
COCABX   EQU      %                                                             
         LW,R6    R13               RESTORE LINE # TO R6                        
         B        0,R1                                                          
*                                                                               
*                                                                               
COCABOUT EQU      %                                                             
         DISABLE                                                                
         LB,SR2   STATE,R6          GET LINE STATE                              
         AND,SR2  =X'FD'               TURN OFF OUTPUT BIT                      
COCABO1  STB,SR2  STATE,R6                                                      
         LI,R2    0                                                             
         STH,R2   COCBAO,R6         CLEAR RELATIVE BYTE ADDRESS                 
         ENABLE                                                                 
         STW,R6   R13               SAVE LINE # IN R13                          
         LH,R4    LINKO,R6          GET LINK FROM LINE TABLE                    
         STH,R2   LINKO,R6                                                      
         B        COCAB2            GO RELEASE ASSIGNED CHAIN                   
         SPACE    5                                                             
         TITLE    ' TERMINATE ROUTINE '                                 000100 0
*********************************************************************** 000100 0
*   THIS ROUTINE TERMINATES ALL OPERATIONS ON THE COC                           
*                                                                               
*   THE CALLING SEQUENCES ARE:                                                  
*                                                                               
*   FROM FORTRAN PROGRAMS:                                                      
*                                                                               
*        CALL     CSTOP                                                         
*   FROM ASSEMBLY PROGRAMS:                                                     
*                                                                               
*        LI,14    0                                                             
*        BAL,15   CSTOP                                                         
*                                                                               
*   TO TURN OFF A SINGLE LINE ONLY, THE CALLING SEQUENCES ARE:                  
*                                                                               
*      FROM FORTRAN PROGRAMS:                                                   
*                                                                               
*        CALL     CSTOP(LINE)                                                   
*                                                                               
*     FROM ASSEMBLY PROGRAMS:                                                   
*                                                                               
*        LI,14    1                                                             
*        BAL,15   CSTOP                                                         
*        ARG      ADDR. OF LINE # VARIABLE                                      
*                                                                               
*********************************************************************** 000100 0
CSTOP    EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
         CI,R14   0                 CHECK FOR SINGLE LINE TURN-OFF              
         BE       CSTOP1               NO - TURN OFF EVERYTHING                 
         LI,R12   0                    YES - GET LINE NUMBER                    
         BAL,R13  FETCHA                                                        
         LW,R7    *R12                                                          
         AI,R7    -1                   ADJUST FORTRAN INTEGER                   
         B        CSTOP2                                                        
CSTOP1   EQU      %                                                             
         STW,R14  COCSF             CLEAR COC  STATUS FLAG                      
         CAL1,5   DISFPTI           DISARM INPUT INTERRUPT                      
         CAL1,5   DISFPTO           DISARM OUTPUT INTERRUPT                     
*   TURN OFF ALL RECEIVERS                                                      
         LI,R7    COCNL-1           TERMINAL LINE NO.                           
CSTOP2   EQU      %                                                             
         LI,SR2   128               GET OUT-OF-SERVICE STATE                    
*                                                                               
CST      WD,R7    RCVROFF           TURN RECEIVER OFF                           
         LW,R6    R7                                                            
         BAL,R1   COCAB1            MARK LINE OUT-OF-SERVICE, RELEASE           
         BAL,R1   COCABO1              ALL ASSIGNED BUFFERS TO POOL             
         MTW,0    R14               SINGLE LINE TURN-OFF?                       
         BNEZ     STPRET               IF SO, EXIT                              
         AI,R7    -1                DECREMENT LINE NO.                          
         BGEZ     CST               B TIL LAST LINE SERVICED(#0)                
         HIO,0    *COCDN            HALT IOP FOR COC                            
STPRET   EQU      %                                                             
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,15    14                                                            
         B        *15                                                           
DISFPTI  GEN,8,8,16  X'03',0,COCII                                              
         GEN,15,17   0,TCBII                                                    
         GEN,15,17     0,COCIP                                                  
DISFPTO  GEN,8,8,16  X'03',0,COCIO                                              
         GEN,15,17   0,TCBOI                                                    
         GEN,15,17     0,COCOP                                                  
         TITLE    '  C O C  L I N E  S T A T E  '                               
************************************************************************        
*   ROUTINE TO RETURN LINE STATUS TO THE USER                                   
*                                                                               
*   THE CALLING SEQUENCES ARE:                                                  
*                                                                               
*   FROM FORTRAN PROGRAMS:                                                      
*        CALL     CHECK(LINE,MODE,STATE,BYTES-RCVD)                             
*                                                                               
*   FROM ASSEMBLY PROGRAMS:                                                     
*                                                                               
*        LI,14    4                                                             
*        BAL,15   CHECK                                                         
*        ARG1     ADDRESS OF LINE # TO BE EXAMINED                              
*        ARG2     ADDRESS OF TERMINAL MODE VARIABLE                             
*        ARG3     ADDRESS OF LINE STATE VARIABLE                                
*        ARG4     ADDRESS OF INPUT BYTE COUNT VARIABLE                          
*                                                                               
*   THE STATE VALUE UPON RETURN TO THE USER WILL BE:                            
*         0- LINE INACTIVE(NOT ACCEPTING OR TRANSMITTING CHAR.)                 
*         1- LINE ACCEPTING INPUT                                               
*         2- LINE TRANSMITTING OUTPUT                                           
*         4- INPUT WAITING - INPUT WILL BE ACCEPTED WHEN INPUT COMPLETE         
*         8- INPUT COMPLETE                                                     
*        64- ERROR IN MSG.                                                      
*       128- OUT OF SERVICE                                                     
*       255- INVALID LINE # - REQUEST IGNORED                                   
*                                                                               
*       VALID COMBINATIONS OF THE ABOVE ARE INDICATED BY THE SUM OF             
*       THEIR CORRESPONDING VALUES                                              
*                                                                               
*   THE MODE WILL BE SET EQUAL TO:                                              
*         1- SIMPLEX-INPUT                                                      
*         2- SIMPLEX-OUTPUT                                                     
*         3- FULL-DUPLEX (I.E., INDEPENDENT SIMUTANEOUS I/O )                   
*         4- HALF-DUPLEX (OR K/D OPERATING IN MESSAGE MODE )                    
*        16- NO-TRANSLATE MODE                                                  
*        32- BREAK SIGNAL (LONG SPACE) HAS BEEN RECEIVD                         
*        64- ESCAPE SEQUENCE IN PROGRESS                                        
*       128- ECHOPLEX (IN CONJUNCTION WITH HALF-DUPLEX)                         
*       VALID COMBINATIONS INDICATED BY SUM OF CORRESPONDING VALUES             
*                                                                               
CHECK    EQU      %                                                             
         LCI      0                  SAVE ALL REGISTERS                         
         PSM,R0   *X'4E'            IN TEMP STACK                               
         LI,R12   0                                                             
         BAL,R13  FETCHA                                                        
         LW,R12   *R12              ACTUAL LINE # TO BE EXAMINED                
         AI,R12   -1                ADJUST FORTRAN INTEGER (LN #)               
         STW,R12  R7                                                            
         LI,R12   2                                                             
         BAL,R13  FETCHA                                                        
         CI,R7    COCNL-1           IS LINE NO. LEGAL                           
         BG       ERLN              NO-SET STATE WORDS=5 AND RETURN             
         LB,R4    STATE,R7          GET LINE STATE                              
         STW,R4   *R12                                                          
         LI,R12   3                                                             
         BAL,R13  FETCHA                                                        
         LH,R5    ARS,R7            GET COUNT OF CHARACTERS RECEIVED            
         STW,R5   *R12              STORE IN USER'S CALLING SEQ.                
         LI,R12   1                                                             
         BAL,R13  FETCHA                                                        
         LB,R5    MODE,R7           GET TERMINAL MODE FROM LINE TABLE           
         STW,R5   *R12                                                          
*                                                                               
STRET    EQU      %                                                             
         LCI      0                 RESTORE ALL REGISTERS                       
         PLM,R0   *X'4E'            FROM TEMP STACK                             
         AW,15    14                                                            
         B        *15               RETURN TO CALLER                            
ERLN     EQU      %                                                             
         LI,R5    255               SET STATE VARIABLE=255 (BAD LINE #)         
         STW,R5   *R12              AND RETURN TO CALLER                        
         B        STRET                                                         
         TITLE    '  COC LINE PARAMETER SET-UP  '                               
************************************************************************        
*                                                                               
*   ROUTINE FOR MODIFYING ENTRIES IN MODE AND TERMINAL TYPE TABLES              
*                                                                               
*   CALLING SEQUENCE:                                                           
*                                                                               
*      FROM FORTRAN PROGRAMS:                                                   
*                                                                               
*        CALL     CSET(LINE,MODE,TYPE)                                          
*                                                                               
*      FROM ASSEMBLY PROGRAMS:                                                  
*                                                                               
*        LI,14    3                                                             
*        BAL,15   CSET                                                          
*        ARG      ADDRESS OF LINE # VARIABLE                                    
*        ARG      ADDRESS OF MODE VARIABLE                                      
*        ARG      ADDRESS OF TERMINAL TYPE VARIABLE                             
*                                                                               
*    THE MODE VARIABLE MAY HAVE THE FOLLOWING VALUES:                           
*                                                                               
*         1 = SIMPLEX-INPUT                                                     
*         2 = SIMPLEX-OUTPUT                                                    
*         3 = FULL-DUPLEX                                                       
*         4 = HALF-DUPLEX (NO ECHO - LOCAL PRINTING)                            
*        16 = NO-TRANSLATE MODE (MUST BE COMBINED WITH ANOTHER CODE)            
*       132 = ECHOPLEX (I.E., FULL-DUPLEX, SIMULATING HALF-DUPLEX)              
*                                                                               
*    THE TERMINAL TYPE VARIABLE MAY HAVE THE FOLLOWING VALUES:                  
*                                                                               
*         0 = M33 TELETYPE                                                      
*         1 = M35 TELETYPE                                                      
*         2 = M37 TELETYPE                                                      
*         3 = KEYBOARD/DISPLAY                                                  
*         4 = K/D - EXTENDED CHAR. MODE A                                       
*         5 = K/D - EXTENDED CHAR. MODE B                                       
*                                                                               
*    IF EITHER VARIABLE > 255, NO CHANGE WILL BE MADE TO THE                    
*    CORRESPONDING LINE TABLE ENTRY                                             
************************************************************************        
CSET     EQU      %                                                             
         LCI      0                 SAVE REGISTERS IN TEMP STACK                
         PSM,0    *X'4E'                                                        
         LI,R12   0                                                             
         BAL,R13  FETCHA                                                        
         LW,R7    *R12              GET LINE #                                  
         AI,R7    -1                   ADJUST FORTRAN INTEGER                   
         CI,R7    COCNL-1                                                       
         BG       CSETX             IF LINE # IS INVALID, EXIT                  
*                                                                               
         LI,R12   1                 OTHERWISE, GET MODE VARIABLE                
         BAL,R13  FETCHA                                                        
         LW,R12   *R12                                                          
         CI,R12   255                 TEST RANGE                                
         BG       CSET1                IF > 255, SKIP IT                        
         STB,R12  MODE,R7              IF NOT,STORE IN MODE TABLE               
*                                                                               
CSET1    LI,R12   2                 GET TERMINAL TYPE VARIABLE                  
         BAL,R13  FETCHA                                                        
         LW,R12   *R12                                                          
         CI,R12   255                 TEST RANGE                                
         BG       CSETX                IF > 255, SKIP IT                        
         STB,R12  COCTERMN,R7          IF NOT, STORE IN COCTERMN TABLE          
*                                                                               
CSETX    EQU      %                                                             
         LCI      0                 RESTORE REGISTERS FROM TEMP STACK           
         PLM,0    *X'4E'                                                        
         AW,R15   R14                                                           
         B        *R15                                                          
         SPACE    5                                                             
         TITLE    '   COC ESCAPE SEQUENCE TABLES  '                             
*                                                                               
********************************************************************************
*                                                                               
*   TABLE OF ESCAPE SEQUENCE FOLLOWER CHARACTERS -- ACCESSED FOR FIRST          
*      CHAR. RECEIVED AFTER RECEIPT OF AN ESC CHAR.                             
*      CODE IS EBCDIC -- I.E., THE INPUT CHAR. IS TRANSLATED BEFORE             
*      COMPARING WITH THE TABLE ENTRIES                                         
*                                                                               
         BOUND    4                                                             
CESCNR   EQU      %                 NO. OF ENTRIES IN ESCAPE TABLES             
         DATA,1   10                                                            
*                                                                               
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
         DATA,1   0                 DUMMY FOLLOWER CHARACTER                    
*                                                                               
*   TABLE OF ESCAPE SEQUENCE BRANCHES -- ENTRIES ARE KEYED TO TABLE             
*      OF FOLLOWER CHARS., ABOVE                                                
*                                                                               
         BOUND    4                                                             
CESCTBL  EQU      %                                                             
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
         B        X6                DUMMY ENTRY - IGNORE THE SEQUENCE           
*                                                                               
*                                                                               
         TITLE    ' SPECIAL ACTION TABLES '                                     
*                                                                               
*   BRANCH TABLE TO HANDLE SPECIAL ACTIONS FOR CONTROL CHARACTER INPUT          
*                                                                               
COCSAT   EQU      %                                                             
         B        X6                00 - NULL (IGNORE FOR THE PRESENT)          
         B        X91                1 - SOH                                    
         B        XSTX               2 - STX                                    
         B        XETX               3 - ETX                                    
         B        X6                 4 - EOT  (IGNORE)                          
         B        KDX                5 - HT OR CURSOR RIGHT                     
         B        X91                6 - ACK                                    
         B        KDX                7 - BEL OR CURSOR UP                       
*                                                                               
         B        KDX               08 - BS                                     
         B        X91                9 - ENQ                                    
         B        COCIPBK            A - NAK - K/D INPUT-COMPLETE               
         B        KDX                B - VT OR CURSOR HOME                      
         B        X91                C - FF                                     
         B        X0                 D - CARRIAGE OR CURSOR RETURN              
         B        KDX                E - SO OR INSERT ON                        
         B        KDX                F - SI OR INSERT OFF                       
*                                                                               
         B        X91               10 - DLE                                    
         B        XDC1               1 - DC1 OR ROLL FORWARD                    
         B        X91                2 - DC2                                    
         B        XDC3               3 - DC3 OR ROLL BACKWARD                   
         B        X91                4 - DC4                                    
         B        X1                 5 - NEW LINE                               
         B        X91                6 - SYN                                    
         B        X91                7 - ETB                                    
*                                                                               
         B        X5                18 - CAN - DELETE LINE                      
         B        KDX                9 - EM OR CURSOR LEFT                      
         B        KDX                A - SUB OR CURSOR DOWN                     
         B        XB                 B - ESC - BEGIN 2 CHAR. SEQUENCE           
         B        X91                C - FS OR OP1                              
         B        X91                D - GS OR OP2                              
         B        X91                E - RS OR OP3                              
         B        X3X                F - US OR OP4 - TOGGLE ECHO MODE           
         B        X2                20 - DEL - XLATED FROM ASCII 7F             
*   CODES 21 - 3F ARE AVAILABLE FOR ASSIGNMENT -- TO USE THEM, EXPAND           
*      THE TABLE TO COVER THE DESIRED RANGE, AND CHANGE THE PARAMETER           
*      'SPEC' ACCORDIN~LY.  CODES 2F AND 38 ARE ASSIGNED AS PARITY              
*      ERROR CODES.                                                             
*                                                                               
SPEC     DATA     X'20'             MAX. ASSIGNED SPECIAL ACTION CODE           
*                                                                               
         TITLE    ' C O C  T R A N S L A T E  T A B L E S '             000100 0
*                                                                       000100 0
*        TTY AND K/D  INPUT TRANSLATE TABLE --ASCII TO EBCDIC           000100 0
*                                                                       000100 0
*                 PARITY ERROR CODE (38)                                000100 0
*                                                                       000100 0
TTYIN    EQU      %                                                     000100 0
KDIN     EQU      %                                                     000100 0
*                 EBCDIC EQUIVAVENT OF ..... ASCII CHARACTERS           000100 0
*    0                                                                  000100 0
         DATA,1   X'00',X'38',X'38',X'03'    NUL,  #,  #,ETX            000100 0
         DATA,1   X'38',X'09',X'06',X'38'      #,ENQ,ACK,  #            000100 0
         DATA,1   X'38',X'05',X'15',X'38'      #, HT, NL,  #                    
         DATA,1   X'0C',X'38',X'38',X'0F'     FF,  #,  #, SI            000100 0
*    1                                                                  000100 0
         DATA,1   X'38',X'11',X'12',X'38'      #,DC1,DC2,  #            000100 0
         DATA,1   X'14',X'38',X'38',X'17'    DC4,  #,  #,ETB            000100 0
         DATA,1   X'18',X'38',X'38',X'1B'    CAN,  #,  #,ESC                    
         DATA,1   X'38',X'1D',X'1E',X'38'      #, GS, RS,  #            000100 0
*    2                                                                  000100 0
         DATA,1   X'38',X'5A',X'7F',X'38'      #,  !,  ",  #            000100 0
         DATA,1   X'5B',X'38',X'38',X'7D'      %,  #,  #,  '            000100 0
         DATA,1   X'4D',X'38',X'38',X'4E'      (,  #,  #,  +            000100 0
         DATA,1   X'38',X'60',X'4B',X'38'      #,  -,  .,  #            000100 0
*    3                                                                  000100 0
         DATA,1   X'F0',X'38',X'38',X'F3'      0,  #,  #,  3            000100 0
         DATA,1   X'38',X'F5',X'F6',X'38'      #,  5,  6,  #            000100 0
         DATA,1   X'38',X'F9',X'7A',X'38'      #,  9,  :,  #            000100 0
         DATA,1   X'4C',X'38',X'38',X'6F'      <,  #,  #,  ?            000100 0
*    4                                                                  000100 0
         DATA,1   X'38',X'C1',X'C2',X'38'      #,  A,  B,  #            000100 0
         DATA,1   X'C4',X'38',X'38',X'C7'      D,  #,  #,  G            000100 0
         DATA,1   X'C8',X'38',X'38',X'D2'      H,  #,  #,  K            000100 0
         DATA,1   X'38',X'D4',X'D5',X'38'      #,  M,  N,  #            000100 0
*    5                                                                  000100 0
         DATA,1   X'D7',X'38',X'38',X'E2'      P,  #,  #,  S            000100 0
         DATA,1   X'38',X'E4',X'E5',X'38'      #,  U,  V,  #            000100 0
         DATA,1   X'38',X'E8',X'E9',X'38'      #,  Y,  Z,  #            000100 0
         DATA,1   X'B1',X'38',X'38',X'6D'    BK/,  #,  #,  -            000100 0
*    6                                                                  000100 0
         DATA,1   X'4A',X'38',X'38',X'83'    BK',  #,  #, LC LOWER CASE 000100 0
         DATA,1   X'38',X'85',X'86',X'38'      #, LE, LF,  #            000100 0
         DATA,1   X'38',X'89',X'91',X'38'      #, LI, LJ,  #            000100 0
         DATA,1   X'93',X'38',X'38',X'96'     LL,  #,  #, LO            000100 0
*    7                                                                  000100 0
         DATA,1   X'38',X'98',X'99',X'38'      #, LQ, LR,  #            000100 0
         DATA,1   X'A3',X'38',X'38',X'A6'     LT,  #,  #, LW            000100 0
         DATA,1   X'A7',X'38',X'38',X'B2'     LX,  #,  #,CR(            000100 0
         DATA,1   X'38',X'B3',X'5F',X'38'      #,CR),NOT,  #            000100 0
*    8                                                                  000100 0
         DATA,1   X'38',X'01',X'02',X'38'      #,SOH,STX,  #            000100 0
         DATA,1   X'04',X'38',X'38',X'07'    EOT,  #,  #,BEL                    
         DATA,1   X'08',X'38',X'38',X'0B'     BS,  #,  #, VT                    
         DATA,1   X'38',X'0D',X'0E',X'38'      #, CR, SO,  #                    
*    9                                                                  000100 0
         DATA,1   X'10',X'38',X'38',X'13'    DLE,  #,  #,DC3            000100 0
         DATA,1   X'38',X'0A',X'16',X'38'      #,NAK,SYN,  #            000100 0
         DATA,1   X'38',X'19',X'1A',X'38'      #, EM, SS,  #            000100 0
         DATA,1   X'1C',X'38',X'38',X'1F'     FS,  #,  #, US                    
*    A                                                                  000100 0
         DATA,1   X'40',X'38',X'38',X'7B'     SP,  #,  #,  #(REAL #)    000100 0
         DATA,1   X'38',X'6C',X'50',X'38'      #,  %,  &,  #            000100 0
         DATA,1   X'38',X'5D',X'5C',X'38'      #,  ),  *,  #            000100 0
         DATA,1   X'6B',X'38',X'38',X'61'      ,,  #,  #,  /            000100 0
*    B                                                                  000100 0
         DATA,1   X'38',X'F1',X'F2',X'38'      #,  1,  2,  #            000100 0
         DATA,1   X'F4',X'38',X'38',X'F7'      4,  #,  #,  7            000100 0
         DATA,1   X'F8',X'38',X'38',X'5E'      8,  #,  #,  ;            000100 0
         DATA,1   X'38',X'7E',X'6E',X'38'      #,  =,  >,  #            000100 0
*    C                                                                  000100 0
         DATA,1   X'7C',X'38',X'38',X'C3'      @,  #,  #,  C            000100 0
         DATA,1   X'38',X'C5',X'C6',X'38'      #,  E,  F,  #            000100 0
         DATA,1   X'38',X'C9',X'D1',X'38'      #,  I,  J,  #            000100 0
         DATA,1   X'D3',X'38',X'38',X'D6'      L,  #,  #,  O            000100 0
*    D                                                                  000100 0
         DATA,1   X'38',X'D8',X'D9',X'38'      #,  Q,  R,  #            000100 0
         DATA,1   X'E3',X'38',X'38',X'E6'      T,  #,  #,  W            000100 0
         DATA,1   X'E7',X'38',X'38',X'B4'      X,  #,  #,SQ(            000100 0
         DATA,1   X'38',X'B5',X'6A',X'38'      #,SQ), UP,  #            000100 0
*    E                                                                  000100 0
         DATA,1   X'38',X'81',X'82',X'38'      #, LA, LB,  #            000100 0
         DATA,1   X'84',X'38',X'38',X'87'     LD,  #,  #, LG            000100 0
         DATA,1   X'88',X'38',X'38',X'92'     LH,  #,  #, LK            000100 0
         DATA,1   X'38',X'94',X'95',X'38'      #, LM, LN,  #            000100 0
*    F                                                                  000100 0
         DATA,1   X'97',X'38',X'38',X'A2'     LP,  #,  #, LS            000100 0
         DATA,1   X'38',X'A4',X'A5',X'38'      #, LU, LV,  #            000100 0
         DATA,1   X'38',X'A8',X'A9',X'38'      #, LY, LZ,  #            000100 0
         DATA,1   X'4F',X'38',X'38',X'20'      |,  #,  #,DEL                    
         PAGE                                                           000100 0
*                                                                       000100 0
*        TTY AND K/D  OUTPUT TRANSLATE TABLE -- EBCDIC TO ASCII         000100 0
*                                                                       000100 0
KDOUT    EQU      %                 K/D OUTPUT TRANSLATE TABLE          000100 0
TTYOUT   EQU      KDOUT                                                 000100 0
*    0                                                                          
         STRING   X'F4',X'81',X'82',X'03'    NUL,SOH,STX,ETX            000100 0
         STRING   X'84',X'09',X'06',X'87'    EOT,HT,ACK,BEL             000100 0
         STRING   X'88',X'05',X'95',X'8B'    BS,ENQ,NAK,VT              000100 0
         STRING   X'0C',X'F2',X'8E',X'0F'    FF,CR,SO,SI                000100 0
*    1                                                                          
         STRING   X'90',X'11',X'12',X'93'    DLE,DC1,DC2,DC3            000100 0
         STRING   X'14',X'0A',X'96',X'17'    DC4,NL,SYN,ETB                     
         STRING   X'18',X'99',X'9A',X'1B'    CAN,EM,SS,ESC              000100 0
         STRING   X'9C',X'1D',X'1E',X'9F'    FS,GS,RS,US                000100 0
*    2                                                                          
         STRING,15  X'F1',X'00'                                         000100 0
         STRING   X'A3'                                                 000100 0
*    3                                                                  000100 0
         STRING,16  X'F1',X'00'                                         000100 0
*    4                                                                  000100 0
         STRING   X'A0',X'F1',X'F1'                                     000100 0
         STRING,7 X'F1',X'00'                                           000100 0
         STRING   X'60',X'2E',X'3C',X'28',X'2B',X'FC',X'A6',X'F1',X'F1'         
         STRING,7 X'F1',X'00'                                           000100 0
         STRING   X'21',X'24',X'AA',X'A9',X'BB',X'7E',X'2D',X'AF',X'F1'         
         STRING,7 X'F1',X'00'                                           000100 0
         STRING   X'DE',X'AC',X'A5',X'5F',X'BE',X'3F'                   000100 0
*    7                                                                  000100 0
         STRING,10  X'F1',X'00'                                         000100 0
         STRING   X'3A',X'A3',X'C0',X'27',X'BD',X'22'                   000100 0
*    8                                                                  000100 0
         STRING   X'F1',X'E1',X'E2',X'63',X'E4',X'65'                   000100 0
         STRING   X'66',X'E7',X'E8',X'69'                               000100 0
         STRING,7  X'F1',X'00'                                          000100 0
         STRING   X'6A',X'EB',X'6C',X'ED',X'EE',X'6F',X'F0',X'71',X'72' 000100 0
         STRING,8  X'F1',X'00'                                          000100 0
         STRING   X'F3',X'74',X'F5',X'F6',X'77',X'78',X'F9',X'FA'       000100 0
         STRING,7  X'F1',X'00'                                          000100 0
         STRING   X'5C',X'7B',X'7D',X'DB',X'DD'                         000100 0
         STRING,11  X'F1',X'00'                                         000100 0
         STRING   X'41',X'42',X'C3',X'44',X'C5',X'C6',X'47',X'48',X'C9' 000100 0
         STRING,7  X'F1',X'00'                                          000100 0
         STRING   X'CA',X'4B',X'CC',X'4D',X'4E',X'CF',X'50',X'D1',X'D2' 000100 0
         STRING,8  X'F1',X'00'                                          000100 0
         STRING   X'53',X'D4',X'55',X'56',X'D7',X'D8',X'59',X'5A'       000100 0
         STRING,6  X'F1',X'00'                                          000100 0
         STRING   X'30',X'B1',X'B2',X'33',X'B4',X'35'                   000100 0
         STRING   X'36',X'B7',X'B8',X'39'                               000100 0
         STRING,5  X'F1',X'00'                                          000100 0
         STRING   X'FF'             DEL                                         
* END OF K/D OUTPUT TRANSLATE TABLE                                     000100 0
*                                                                       000100 0
         END                                                                    
