         PCC      0                                                             
         SYSTEM   OPTIONS                                                       
         DEF      TTY                                                           
         DEF      6KLIMIT                                                       
         DEF      KBTIO,KBTCU                                                   
         DO1      #PLOTTER                                                      
         DEF      PLOT,PLOTCU                                                   
         DO1      #PTAPE                                                        
         DEF      PTAP,PTAPCU                                                   
         DO1      #LD                                                           
         DEF      LDPRE,LDPOST                                                  
         DO1      #EN                                                           
         DEF      ENPRE,ENPOST                                                  
OLAYFLAG EQU      'TTY '                                                        
         SYSTEM   CPRMON                                                        
         SPACE                                                                  
*        REF      IOSTRT,SCHEDXIT,REQSTRT                                       
*        SPACE                                                                  
6KLIMIT  RES      0                 THIS MUST BE THE FIRST OF THE               
*                                   MODULES PUT OVER 6K (24K)                   
TTY      RES      0                                                             
         TITLE    '** TTY - TYPEWRITER HANDLER **'                              
************************************************************************        
*    TYPEWRITER HANDLER PRE-PROCESSOR                                  *        
************************************************************************        
KBTIO    LI,R10   DOTTY                                                         
*                                                                               
         LB,R9    IOQ5,R3           GET CURRENT FUNCTION                        
         CI,R9    TTYFUN6           IS FORMATED WRITE                           
         BNE      COMLIST           NO                                          
*                                   YES                                         
         LW,R6    IOQ8,R3           BYTE ADDR                                   
         AH,R6    IOQ9,R3           BYTE COUNT                                  
         AI,R6    -1                GIVES BA(LAST BYTE)                         
*                                                                               
KBTIO10  RES      0                                                             
         LB,R9    0,R6              GET A BYTE                                  
         CI,R9    ' '               IS IT A BLANK                               
         BNE      KBTIO20           NO                                          
         AI,R6    -1                YES, SCAN IT OFF                            
         B        KBTIO10                                                       
*                                                                               
KBTIO20  RES      0                                                             
         SW,R6    IOQ8,R3           BYTE ADDRESS                                
         BLZ      COMLIST           ALL BLANKS                                  
         BAL,R0   RE:ENT            CHECK REENTRANCE                            
         AI,R6    1                 ADJUST TO GET BYTE COUNT                    
         STH,R6   IOQ9,R3           STORE NEW BYTE COUNT                        
         B        COMLIST                                                       
         PAGE                                                                   
************************************************************************        
*    TYPEWRITER HANDLER POST-PROCESSOR                                 *        
************************************************************************        
KBTCU    LI,R12   1                 NORMAL COMPLETION                           
         LI,R13   0                 SUPPRESS ERROR MESSAGE                      
         LD,R10   DCT13,R1          GET TDV INFORMATION                         
         AND,R11  M16               MASK                                        
         LB,R9    IOQ5,R3           PICK UP CURRENT FUNCTION STEP               
         CI,R9    TTYFUN6           IS IT A WRITE W/NEW LINE                    
         BNE      KBTCU10           NO                                          
*                                   YES                                         
         LW,R0    DCT12,R1          GET AIO STATUS                              
         CW,R0    XBIT12            IS IT AN UNUSUAL END INTERRUPT              
         BAZ      IOSCU             NO                                          
*                                   YES                                         
         LI,R12   FLGFOLOW          SET FOLLOW ON FLAG                          
         BAL,R0   RE:ENT            INHIBIT                                     
         LI,R0    TTYFUN5           WRITE NEW LINE FUNCTION                     
         STH,R0   DCT17,R1          SET UP FOLLOW ON FUNCTION                   
         B        IOSCU             AND PROCESS                                 
         PAGE                                                                   
KBTCU10  RES      0                                                             
         CI,R9    3                 EDITING                                     
         BANZ     IOSCU             NO                                          
         LW,R0    DCT12,R1          AIO STATUS                                  
         CW,R0    XBIT12            UNUSUAL END                                 
         BANZ     KBTIO5            YES, RETRY INPUT                            
*                                   NO, EDIT INPUT                              
         LH,R7    IOQ9,R3          PICK UP ORIGINAL BYTE COUNT                  
         LW,R5    IOQ8,R3           BUF ADDR (PICK UP )                         
         LW,R6    R5                BUF ADDR (STORE)                            
KBTIO1   LB,R9    0,R5              PICK UP BYTE                                
         CI,R9    8                                                             
         BE       KBTIO5            GO RETRY IF EOM                             
         CI,R9    X'15'                                                         
         BE       KBTIO1A           B IF NEW LINE                               
         CI,R9    X'4A'                                                         
         BNE      KBTIO3            B IF NOT BACKSPACE CHARACTER                
         AI,R6    -1                DECREMENT STORE INDEX                       
         CW,R6    IOQ8,R3                                                       
         BL       KBTIO5            B IF BACKSPACING OUT OF BUFFER              
         AI,R5    1                 ADVANCE PICKUP INDEX                        
         B        KBTIO1            GO GET NEXT BYTE                            
         PAGE                                                                   
KBTIO1A  LB,R9    BLANKS                                                        
KBTIO2   STB,R9   0,R6              BLANK NEXT CHAR                             
         AI,R6    1                 INCREMENT TO ADDRESS                        
         BDR,R7   KBTIO2            LOOP BACK IF NOT DONE                       
         LI,R11   0                 ZERO RBC                                    
         B        KBT106                                                        
********                                                                        
KBTIO3   STB,R9   0,R6              STORE BYTE                                  
         AI,R6    1                 ADV STORE INDEX                             
KBTIO4   AI,R5    1                 ADV PICKUP INDEX                            
         BDR,R7   KBTIO1            GO BACK FOR NEXT BYTE                       
         LI,R12   X'6000'           SET FOLLOW-ON (WRITE NEW LINE)              
         B        IOSCU             RETURN TO CLEANUP                           
********                                                                        
KBTIO5   LI,R9    TTYFUN4           RETRY FUNCTION                              
         BAL,R0   RE:ENT            CHECK FOR RE-ENTRANCE                       
         STH,R9   DCT17,R1                                                      
         LI,R12   FLGFOLOW          SET FLAG FOR FOLLOW-ON                      
         B        IOSCU              AND EXIT TO CLEANUP.                       
********                                                                        
KBT106   RES      0                                                             
         BAL,R5   4CHAR                                                         
         CW,R0    EODREC            IS IT !EOD                                  
         BNE      IOSCU             NO                                          
         LI,R12   6                 YES, SET TYC = EOD                          
         B        IOSCU                                                         
******                                                                          
CRNL     DATA     X'0D150000'                                                   
         PAGE                                                                   
         DO       #TOC                                                          
*                                                                               
* ROUTINE TO PRECEED OC MESSAGES WITH TIME                                      
*                                                                               
TYTIMEX  RES      0                                                             
         LI,R5    OC                                                            
         CB,R1    OPLBS2,R5         IS IT OC DEVICE                             
         BNE      DELCOM            NO, DONT TAB OR TIME                        
*                                   YES                                         
         LW,R5    IOQ8,R3           GET BYTE ADDR OF BUFFER                     
         LB,R0    0,R5              GET BYTE 0                                  
         CI,R0    '!'               IS IT A BANG                                
         BNE      DELCOM            NO, DONT TAB OR TIME                        
         AI,R5    1                                                             
         LB,R0    0,R5              GET NEXT BYTE                               
         CI,R0    '!'               IS IT A BANG                                
         BNE      DELCOM            NO, DONT TAB OR TIME                        
TYTIME   RES      0                                                             
         LW,R13   K:TIME            GET TIME IN SECONDS                         
         LI,R12   0                                                             
         DW,R12   XD60              GET MIN IN R13, SEC IN R12                  
         LI,R12   0                 DITCH SEC                                   
         DW,R12   XD60              GET MIN IN R12 AND HR IN R13                
*                                                                               
         LW,R0    R12               SAVE MIN                                    
         LI,R12   0                                                             
         DW,R12   XA                                                            
         AI,R12   '0'               HOUR UNITS                                  
         AI,R13   '0'               HOUR TENS                                   
         SLS,R12  24                PUT UNITS TO TOP OF R12                     
         SCD,R12  24                PUT BOTH TO TOP OF R13                      
         XW,R13   R0                SAVE AND GET MIN                            
         PAGE                                                                   
         DW,R12   XA                                                            
         AI,R12   '0'               MIN UNITS                                   
         AI,R13   ':0'              MIN TENS AND COLON                          
         SLS,R12  24                PUT UNITS TO TOP OF R12                     
         SCD,R12  32                POSITION OVER                               
         AW,R12   R0                ADD IN HOUR                                 
         MTH,5    R13               PUT IN A TAB CHAR                           
         STD,R12  OCTIME            STORE TIME STAMP                            
*                                                                               
         AI,R8    BA(OCTIME)                                                    
         B        USECOM            AND DO IT                                   
*                                                                               
WR1TAB   RES      0                                                             
         AI,R8    BA(TABS)                                                      
         AI,R9    -5                MAKE BYTE COUNT 1                           
         B        USECOM                                                        
*                                                                               
         BOUND    8                                                             
OCTIME   DATA     0                                                             
         DATA     0                                                             
*                                                                               
TABS     DATA     X'05050505'       4 TAB CHAR                                  
*                                                                               
         FIN      #TOC                                                          
         PAGE                                                                   
*                                                                               
************************************************************************        
*   COMMAND LIST OFFSETS FOR TYPEWRITER                                         
************************************************************************        
*                                                                               
         BOUND    8                                                             
DOTTY    EQU      %                                                             
DOT      SET      %                                                             
TTYFUN0  :DOT     TYRE,255,TTYFUN4,TTYFUN5  0 READ WITH EDITING                 
TTYFUN1  :DOT     TYWD,2                    1 WRITE                             
TTYFUN2  :DOT     TYWN,2                    2 WRITE WITH DEVICE NAME            
TTYFUN3  :DOT     TYRNE,255                 3 READ WITHOUT EDITING              
TTYFUN4  :DOT     TYRER,255,TTYFUN4,TTYFUN5 4 READ WITH EDITING RETRY           
TTYFUN5  :DOT     TYWNL,1                   5 WRITE NEW LINE CHARACTER          
TTYFUN6  :DOT     TYWWNL,2                  6 WRITE WITH NEW LINE               
*                                                                               
* TIMEOUT VALUE OF 255 PREVENTS TIMING OUT THE TTY ON INPUT                     
*                                                                               
* EQUATED VALUES FROM CPRMON                                                    
*                                                                               
* FCRKPWE         0                 READ WITH EDITING                           
* FCWKP           1                 WRITE                                       
* FCWKPWDN        2                 WRITE WITH DEVICE NAME PREFEX               
* FCRKPWOE        3                 READ WITHOUT EDITING                        
* FCWNL           5                 WRITE A NEW LINE ONLY                       
* FCWKPWNL        6                 WRITE WITH A NEW LINE AFTER                 
*                                                                               
         PAGE                                                                   
*                                                                               
*   COMMAND LISTS FOR TYPEWRITER                                                
*                                                                               
TYRE     :CLIST   WRPRMTC,RDTYE,WRCRNC PROMPT, READ W/EDITING, CR               
TYWD     :CLIST   WRBNC                                                         
         DO       #TOC                                                          
TYWN     :CLIST   WRTIMECC          WRITE TIME                                  
         :CLIST   WR3TABSC          THREE TABS                                  
         :CLIST   WRTYDC            DEVICE NAME                                 
         :CLIST   WRBC              WRITE BINARY, W/CHAIN                       
         :CLIST   WRNLNC            WRITE NL, NO CHAIN                          
         ELSE     #TOC                                                          
TYWN     :CLIST   WRTYDC            DEVICE NAME ONLY                            
         :CLIST   WRBC              WRITE BINARY, W/CHAIN                       
         :CLIST   WRNLNC            WRITE NL, NO CHAIN                          
         FIN      #TOC                                                          
TYRNE    :CLIST   RDBNC             READ WITHOUT EDITING                        
TYRER    :CLIST   WRNLC             WRITE NL                                    
         :CLIST   WRPRMTC           PROMPT                                      
         :CLIST   RDTYE             READ W/EDITING                              
         :CLIST   WRCRNC            WRITE CR                                    
TYWNL    :CLIST   WRNLNC            WRITE NEW LINE CHARACTER                    
         DO       #TOC                                                          
TYWWNL   :CLIST   WRTIMEC           TIME                                        
         DO1      #550                                                          
         :CLIST   WAIT4BRK          WAIT FOR BREAK ARM                          
         :CLIST   WRBC              WRITE BINARY W/CHAIN                        
         :CLIST   WRNLNC            WRITE NL, NO CHAIN                          
         ELSE     #TOC                                                          
TYWWNL   :CLIST   WRBC              WRITE BINARY W/CHAIN                        
         :CLIST   WRNLNC            WRITE NL, NO CHAIN                          
         FIN      #TOC                                                          
         PAGE                                                                   
************************************************************************        
*   COMMAND DOUBLEWORDS FOR TYPEWRITER                                          
************************************************************************        
         BOUND    8                                                             
RDTYE    :CDW     X'86',0,CC,2      READ WITH EDITING                           
WRTYDC   :CDW     5,0,CC,3,8        TYPE DEVICE NAME, COMMAND CHAIN             
WRNLNC   :CDW     5,BA(CRNL),NCC,0,2 WRITE CR, NL W/O CHAINING                  
WRNLC    :CDW     5,BA(CRNL),CC,0,2 WRITE CR, NL W/CHAINING                     
WRCRNC   :CDW     5,BA(CRNL),NCC,0,1 WRITE CR, NO CHAINING                      
WRBC     :CDW     5,0,CC,2          WRITE BINARY, COMMAND CHAIN                 
WRBNC    :CDW     5,0,NCC,2         WRITE BINARY, NO COMMAND CHAIN              
RDBNC    :CDW     6,0,NCC,2         TY,CR&7T READ BINARY, NO COMMAND CH         
RDNC     :CDW     2,0,NCC,2         READ, NO COMMAND CHAIN                      
WRNC     :CDW     1,0,NCC,2         WRITE,NO COMMAND CHAIN                      
         DO       #TOC                                                          
WRTIMECC :CDW     5,TYTIME,CC,4,6   WRITE TIME UNCONDITIONALLY                  
WRTIMEC  :CDW     5,TYTIMEX,CC,4,6  WRITE TIME OR TAB                           
WR3TABSC :CDW     5,BA(TABS),CC,0,3 WRITE 3 TABS                                
         FIN      #TOC                                                          
WRPRMTC  :CDW     5,0,CC,1,1        WRITE PROMPT (1ST BYTE OF IOQ12)            
WAIT4BRK :CDW     X'14',0,CC,0      ARM TO WAIT FOR BREAK                       
         TITLE    '** TTY - PLOTTER HANDLER **'                                 
         DO       #PLOTTER                                                      
************************************************************************        
*   PLOTTER PRE-PROCESSOR                                                       
************************************************************************        
PLOT     LI,R10   DOTPL             ADDRESS OF TABLES                           
         B        COMLIST                                                       
*                                                                               
************************************************************************        
*   PLOTTER POST-PROCESSOR                                                      
************************************************************************        
PLOTCU   EQU      %                                                             
         BAL,R9   NEWIOCK           SET UP REGISTERS                            
         NOP      0                 IGNORE ERROR RETURN                         
         LI,12      1               SET TYC TO NORMAL                           
         LI,13      0               SET MESSAGE ADDRESS TO ZERO                 
         B        IOSCU             EXIT                                        
*                                                                               
************************************************************************        
*   COMMAND LIST OFFSET FOR PLOTTER                                             
************************************************************************        
         BOUND    8                                                             
DOTPL    EQU      %                                                             
DOT      SET      %                                                             
         :DOT     WRITE,X'FF',1,1                                               
************************************                                            
*   COMMAND LIST FOR PLOTTER                                                    
************************************                                            
WRITE    :CLIST   WTDW                                                          
************************************************************************        
*   COMMAND DOUBLEWORD FOR PLOTTER                                              
************************************************************************        
         BOUND    8                                                             
WTDW     :CDW     1,0,X'16',2       PLOT                                        
         FIN      #PLOTTER                                                      
         TITLE    '** TTY - PAPER TAPE HANDLERS **'                             
         DO       #PTAPE                                                        
************************************************************************        
*    PAPER TAPE HANDLER PRE-PROCESSOR                                  *        
************************************************************************        
PTAP     LI,R10   DOTPT             DOT ADDRESS                                 
         B        COMLIST                                                       
*                             INPUT FIRST BYTE                                  
PT10     LW,R11   IOQ8,R3           BUF ADDR                                    
         AND,R11  M24               MASK BUFFER ADDRESS                         
         OR,R8    R11               TO COMMAND                                  
         B        USECOM            STORE COMMAND                               
*                             INPUT BINARY COUNT                                
PT12     LW,R11   R7                CLIST ADDR                                  
         AI,R11   3                 ADD OFFSET TO INPUT COUNT                   
         SLS,R11  3                 MAKE BYTE ADDR                              
         OR,R8    R11               TO COMMAND                                  
         B        USECOM            STORE COMMAND                               
*                             OUTPUT BINARY HEADER                              
PT14     LW,R5    R7                CLIST ADDR                                  
         AI,R5    3                 OFFSET TO OUTPUT AREA                       
         LH,R12   IOQ9,R3           GET COUNT                                   
         AND,R12  M16               MASK                                        
         OR,R12   Y0011             BINARY INDICATOR                            
         SLS,R12  8                 POSITION TO HIGH ORDER                      
         BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**         
*                                                                               
         STD,R12  0,R5              STORE HEADER DATA                           
         SLS,R5   3                 MAKE BYTE ADDR                              
         OR,R8    R5                TO COMMAND                                  
         B        USECOM            STORE COMMAND                               
         PAGE                                                                   
PT16     LD,R8    0,R7              GET OLD COMMAND                             
         B        USECOM            STORE IT                                    
*                             INPUT BINARY DATA                                 
PT18     LW,R11   IOQ8,R3           BUF ADDR                                    
         AND,R11  M24               MASK BUFFER ADDRESS                         
         OR,R8    R11               TO COMMAND                                  
         LD,R12   6,R7              COUNT, RBC                                  
         CI,R13   0                 IS USER BUF TOO SMALL                       
         BL       PT20              YES                                         
         OR,R9    R12               NO, COUNT TO COMMAND                        
         B        USECOM            STORE COMMAND                               
PT20     EOR,R9   Y3                SET COMMAND CHAIN                           
         AW,R12   R13               COMPUTE USER BUF SIZE                       
         OR,R9    R12               TO COMMAND                                  
         B        USECOM            STORE COMMAND                               
*                             SET UP SKIP                                       
PT22     LCW,R13  R13               RBC = SKIP COUNT                            
         OR,R9    R13               TO COMMAND                                  
         B        USECOM            STORE COMMAND                               
         PAGE                                                                   
************************************************************************        
*    PAPER TAPE HANDLER POST-PROCESSOR                                 *        
************************************************************************        
PTAPCU   RES      0                                                             
         LB,R8    DCT3,R1           DCT SWITCHES                                
         LI,R12   1                 TYC = NORMAL                                
         LW,R6    DCT12,R1          GET AIO STATUS                              
         LH,R6    R6                STATUS TO LOW ORDER                         
         LD,R10   DCT13,R1          GET TDV STATUS                              
         LH,R5    R11               GET STATUS                                  
         CI,R5    X'7E'             ANY DEV INDEP ERRORS                        
         BAZ      PT25              NO                                          
         LI,R12   8                 SET ERROR TYC                               
         B        PT27              ERROR                                       
*                                                                               
PT25     AND,R11  M16               IS RBC 0                                    
         BNEZ     PT27              NO, LENGTH OK                               
         LW,R13   R10                                                           
         SLS,R13  1                 FORM WORD PTR TO CDW                        
         AI,R13   1                 POINT TO WORD 2 OF CDW                      
         LB,R13   *R13              GET FLAG BYTE                               
         CI,R13   DCFLAG**-24       IS DATA CHAIN FLAG SET                      
         BANZ     PT27              YES, NO LOST DATA ON INPUT                  
         CI,R5    X'80'             YES, IS ICL SET                             
         BAZ      PT27              NO, LENGTH OK                               
         LI,R12   2                 YES, SET TYC = LOST DATA                    
PT27     RES      0                                                             
         LH,R5    DCT7,R1           CLIST ADDR                                  
         LB,R6    IOQ5,R3           FUNCTION CODE                               
         BAL,R0   RE:ENT            CHECK RE:ENT BEFORE BRANCH                  
         ENABLE                                                                 
         B        %+1,R6            TRANSFER VECTOR                             
         B        PT30              0                                           
         B        IOSCU             1                                           
         B        PT40              2                                           
         B        IOSCU             3                                           
         B        PT62              4                                           
         B        IOSCU             5                                           
         B        PT50              6                                           
         B        PT70              7                                           
         B        PT62              8                                           
         PAGE                                                                   
*                             FIRST BYTE IN (READ AUTO)                         
PT30     LW,R7    IOQ8,R3           BUF ADDR                                    
         LB,R8    0,R7              GET FIRST BYTE                              
         CI,R8    X'11'             IS REC BINARY                               
         BE       PT32              YES                                         
         LH,R8    IOQ9,R3           NO, INIT COUNT                              
         AND,R8   M16               MASK                                        
         BNEZ     PT52              B IF NOT MAX BYTE COUNT                     
         LI,R8    X'10000'          LOAD WITH MAX                               
         B        PT52                                                          
PT32     LI,R8    2                 SET CONTIN. TO READ COUNT                   
*                                                                               
PT34     BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**         
*                                                                               
         STH,R8   DCT17,R1                                                      
PT36     AI,R12   X'6000'           SET FOLLOW-ON, INTER-OP                     
         B        IOSCU                                                         
         PAGE                                                                   
*                             COUNT IN                                          
PT40     LD,R8    6,R5              RECORD COUNT                                
         SLS,R8   -16                                                           
         LH,R9    IOQ9,R3           USER COUNT                                  
         AND,R9   M16               MASK                                        
         BNEZ     %+2               B IF NOT MAX BYTE COUNT                     
         LI,R9    X'10000'          LOAD WITH MAX                               
         SW,R9    R8                COMPUTE RBC                                 
         B        PT57                                                          
         PAGE                                                                   
*                             BYTE IN (READ BCD)                                
PT50     LD,R8    6,R5              COUNT                                       
PT52     LD,R6    0,R5              CURRENT BUF ADDR                            
         OR,R6    Y8                READ IMMEDIATE                              
         LB,R9    0,R6              GET LAST CHAR READ                          
         CI,R9    8                 IS IT EOM                                   
         BNE      PT54              NO                                          
         LI,R8    0                 YES, SET CONTIN. TO READ AUTO               
         B        PT34                                                          
PT54     CI,R9    X'FF'             IS IT RUBOUT                                
         BE       PT57              YES, READ ANOTHER CHAR                      
PT56     CI,R9    X'15'             IS IT NEW LINE                              
         BE       PT56A             YES, END OF RECORD                          
         CI,R9    0                 NO, IS IT 0 (GAP)                           
         BNE      PT56B             NO                                          
PT56A    LI,R13    K40              GET BLANK BYTE                              
         STB,R13   0,R6             REPLACE N/L OR GAP (0)                      
         B         PT60             END OF RECORD                               
PT56B    AI,R6    1                 INC BUF ADDR                                
         AI,R8    -1                DEC BYTE COUNT                              
         BGZ      PT57              NOT 0 YET                                   
         LW,R6    R5                0 OR LESS, READ INTO CLIST                  
         SLS,R6   3                 MAKE BYTE ADDR                              
         AI,R6    28                INC TO INPUT AREA (WORD 8)                  
         OR,R6    Y82               ORDER CODE                                  
*                                                                               
PT57     BAL,R0   RE:ENT            RE-ENTRANCE TEST        **DISABLE**         
*                                                                               
         STD,R6   0,R5              COMMAND                                     
         STD,R8   6,R5              COUNT                                       
         B        PT36              FOLLOW-ON                                   
         PAGE                                                                   
*                             END OF RECORD (INPUT)                             
PT60     LW,R11    R8               GET RBC                                     
         BLZ       PT61             B IF DATA LOST                              
PT60A    AI,R8     -1               DEC. RBC                                    
         BLZ       PT62             B IF FILL DONE                              
         AI,R6     1                INC. BUFFER ADDRESS                         
         STB,R13   0,R6             FILL REM. OF                                
         B         PT60A            USER BUFFER                                 
PT61     LI,R12    2                TYC = LOST DATA                             
         LI,R11    0                RBC = 0                                     
PT62     BAL,R5   4CHAR             GET FIRST 4 CHARS                           
         CW,R0    EODREC            IS IT BANG EOD                              
         BNE      %+2               NO                                          
         LI,R12   6                 YES, SET TYC = EOD                          
         B        IOSCU                                                         
         PAGE                                                                   
*                             DATA IN (READ BINARY)                             
PT70     LD,R8    6,R5              COUNT,RBC                                   
         LH,R6    IOQ9,R3           BYTE COUNT                                  
         AND,R6   M16               MASK AND COMPARE TO MAX                     
         BNEZ     %+2               ADDRESS OF LAST BYTE                        
         LI,R6    X'10000'           TRANSFERRED = BUFFER                       
         AW,R6    IOQ8,R3            ADDRESS +                                  
         SW,R6     R9               USER COUNT - RBC - 1                        
         AI,R6     -1                                                           
         LW,R8     R9               RBC TO R8                                   
         LI,R13    0                GET FILL BYTE                               
         B        PT60              END OF RECORD                               
*                                                                               
         PAGE                                                                   
************************************************************************        
*   COMMAND LIST OFFSETS FOR PAPER TAPE                                         
************************************************************************        
         BOUND    8                                                             
DOTPT    EQU      %                                                             
DOT      SET      %                                                             
         :DOT     RA,1,0,6          0  READ AUTO                                
         :DOT     WE,120            1  WRITE EBCDIC                             
         :DOT     RC,1,0,7          2  READ COUNT                               
         :DOT     WB,120            3  WRITE BINARY                             
         :DOT     RD,120            4  READ DIRECT                              
         :DOT     WD,120            5  WRITE DIRECT                             
         :DOT     RE,1,0,6          6  READ EBCDIC                              
         :DOT     RB,120            7  READ BINARY                              
         :DOT     RI,120            8  READ IMMEDIATE                           
*                                                                               
* EQUATED VALUES IN CPRMON                                                      
*                                                                               
* FCRPTAUT        0                 READ AUTO                                   
* FCWPTBCD        1                 WRITE EBCDIC                                
* FCRPTCNT        2                 READ COUNT                                  
* FCWPTBIN        3                 WRITE BINARY                                
* FCRPTDIR        4                 READ DIRECT                                 
* FCWPTDIR        5                 WRITE DIRECT                                
* FCRPTBCD        6                 READ EBCDIC                                 
* FCRPTBIN        7                 READ BINARY                                 
* FCRPTIM         8                 READ IMMEDIATE                              
*                                                                               
*                                                                               
*   COMMAND LISTS FOR PAPER TAPE                                                
*                                                                               
RA       :CLIST   READ1A            READ AUTOMATIC                              
WE       :CLIST   WRC               WRITE, COMMAND CHAIN                        
         :CLIST   WRBL                                                          
RC       :CLIST   READ2             READ COUNT                                  
WB       :CLIST   WRHC              WRITE BINARY                                
         :CLIST   WRC                                                           
         :CLIST   WRBL                                                          
RD       :CLIST   RDDNC             READ DIRECT, NO COMMAND CHAIN               
WD       :CLIST   WRDNC             WRITE DIRECT, NO COMMAND CHAIN              
RE       :CLIST   READ1E            READ EBCDIC                                 
RB       :CLIST   RDB               READ BINARY                                 
         :CLIST   RDS                                                           
RI       :CLIST   RDI               READ IMMEDIATE                              
         PAGE                                                                   
************************************************************************        
*   COMMAND DOUBLEWORDS FOR PAPER TAPE                                          
************************************************************************        
         BOUND    8                                                             
READ1A   :CDW     2,PT10,NCC,4,1                                                
WRBL     :CDW     1,BA(ZEROS),NCC,0,2                                           
READ2    :CDW     X'82',PT12,NCC,4,2                                            
WRHC     :CDW     1,PT14,CC,4,3                                                 
RDDNC    :CDW     2,0,NCC,2                                                     
WRDNC    :CDW     1,0,NCC,2                                                     
READ1E   :CDW     0,PT16,0,4                                                    
RDB      :CDW     X'82',PT18,NCC,4                                              
RDS      :CDW     X'82',PT22,NCC+1,4                                            
RDI      :CDW     X'82',0,NCC,2                                                 
WRC      :CDW     1,0,CC,2          WRITE, COMMAND CHAIN                        
         FIN      #PTAPE                                                        
         TITLE    '** TTY - LOGICAL DEVICE HANDLER **'                          
*                                                                               
* LOGICAL DEVICE PRE-HANDLER                                                    
*                                                                               
*                                                                               
* THIS HANDLER IS A PSEUDO DEVICE WHICH COMBINES WRITE AND                      
* READ REQUESTS.  IT ACTS AS AN I/O PATH BETWEEN TASKS TALKING                  
* TO AND FROM IT.                                                               
* THERE ARE THREE FUNCTION CODES: 0 - READ                                      
*                                 1 - WRITE                                     
*                                 3 - WRITE EOF                                 
*                                                                               
* NEGATIVE TYC IS POSTED IN IOQ5, RBC IS POSTED IN IOQ8 UNTIL                   
* POSTING CAN BE DONE.                                                          
*                                                                               
         DO       #LD                                                           
LDPRE    RES      0                                                             
         STB,R3   DCT6,R1           SAVE IOQ PTR FOR KEY1                       
         LB,R0    IOQ4,R3           GET FUNCTION CODE                           
         CB,R0    IOQ5,R3           DOES REQUEST NEED CLEAN-UP                  
         BNE      LDPOST            YES                                         
*                                   NO                                          
         CI,R0    0                 IS THIS A READ REQUEST                      
         BNEZ     NEXTQUE           IGNORE IF NOT READ                          
*                                   YES                                         
         LB,R4    CIT1,R2           GET Q HEAD                                  
         B        %+2                                                           
         PAGE                                                                   
LDSEARCH RES      0                                                             
         LB,R4    IOQ2,R4           GET NEXT Q ENTRY                            
         BEZ      NEXTQUE           END OF QUE                                  
*                                   GOT A Q ENTRY                               
         LB,R0    IOQ4,R4           GET FUCTION CODE                            
         BEZ      LDSEARCH          IGNORE IF ANOTHER READ                      
*                                   NOT A READ                                  
         CB,R1    IOQ7,R4           IS THIS DEVICE                              
         BNE      LDSEARCH          NO, IGNORE                                  
*                                   YES                                         
         CI,R0    3                 IS FUNCTION A WEOF                          
         BE       LDWEOF            YES                                         
*                                   NO                                          
         CI,R0    1                 IS IT A WRITE                               
         BE       LDWRITE           YES                                         
         BAL,R0   RE:ENT            CHECK RE-ENTRANCE                           
         BAL,R14  IOINC             AND CRASH                                   
         PAGE                                                                   
*                                                                               
* LOGICAL DEVICE WRITE END-OF-FILE PROCESSING                                   
*                                                                               
LDWEOF   RES      0                                                             
         BAL,R0   RE:ENT                                                        
         LI,R0    -TYCEOF                                                       
         STB,R0   IOQ5,R3           SAVE EOF TYC FOR READ REQUEST               
*                                                                               
         LI,R0    -TYCOK                                                        
         STB,R0   IOQ5,R4           SAVE OK TYC FOR WEOF REQUEST                
*                                                                               
         LI,R0    0                                                             
         STW,R0   IOQ8,R3           FAKE RBC FOR READ REQUEST                   
         STW,R0   IOQ8,R4           AND FOR WEOF REQUEST                        
         B        LDPOST            AND SET UP FOR CLEAN-UP                     
         PAGE                                                                   
*                                                                               
* LOGICAL DEVICE WRITE PROCESSING                                               
*                                                                               
LDWRITE  RES      0                                                             
         LW,R6    IOQ8,R3           IS READ REQUEST A DATA CHAIN                
         BLZ      LDW10             YES                                         
*                                   NO                                          
         LI,R11   1                 READ CDW COUNT                              
         LH,R7    IOQ9,R3           READ BYTE COUNT                             
         BNEZ     %+2               OK IF NON ZERO                              
         LI,R7    X'10000'          ELSE USE MAX                                
         B        LDW20                                                         
********                                                                        
LDW10    RES      0                                                             
         LW,R10   R6                READ CDW PTR                                
         SLS,R10  1                 MAKE IT A WORD PTR                          
         LH,R11   IOQ9,R3           GET CDW COUNT                               
         BAL,R0   GETRCDW           GET A CDW                                   
*                                                                               
LDW20    RES      0                                                             
         LW,R5    IOQ8,R4           IS WRITE REQUEST A DATA CHAIN               
         BLZ      LDW30             YES                                         
*                                   NO                                          
         LI,R13   1                 WRITE CDW COUNT                             
         LH,R9    IOQ9,R4           WRITE BYTE COUNT                            
         BNEZ     %+2               OK IF NON-ZERO                              
         LI,R9    X'10000'          ELSE USE MAX                                
         B        LDW40                                                         
********                                                                        
LDW30    RES      0                                                             
         LW,R12   R5                WRITE CDW PTR                               
         SLS,R12  1                 MAKE IT A WORD PTR                          
         LH,R13   IOQ9,R4           GET CDW COUNT                               
         BAL,R0   GETWCDW           GET A CDW                                   
         PAGE                                                                   
*                                                                               
* R3     READ REQUEST IOQ INDEX                                                 
* R4     WRITE REQUEST IOQ INDEX                                                
* R5     WRITE BYTE ADDRESS                                                     
* R6     READ BYTE ADDRESS                                                      
* R7     READ BYTE COUNT                                                        
* R8     TEMPORARY USE                                                          
* R9     WRITE BYTE COUNT                                                       
* R10    READ CDW PTR                                                           
* R11    READ CDW COUNT                                                         
* R12    WRITE CDW PTR                                                          
* R13    WRITE CDW COUNT                                                        
*                                                                               
LDW40    RES      0                                                             
         BAL,R0   RE:ENT                                                        
         DO1      #SIGMA9                                                       
         WD,0     X'47'             GO INTO REAL EXTENDED MODE                  
         DO       #SIGMA9M                                                      
         LPSD,0   PSDRE1                                                        
         BOUND    8                                                             
PSDRE1   DATA     %+2                                                           
         DATA     X'07800000'                                                   
         FIN      #SIGMA9M                                                      
         LB,R0    0,R5                                                          
         STB,R0   0,R6                                                          
         DO1      #SIGMA9                                                       
         WD,0     X'46'             LEAVE REAL EXTENDED MODE                    
         DO       #SIGMA9M                                                      
         LPSD,0   PSDRE2                                                        
         BOUND    8                                                             
PSDRE2   DATA     %+2                                                           
         DATA     X'07000000'                                                   
         FIN      #SIGMA9M                                                      
         ENABLE                                                                 
*                                                                               
         AI,R5    1                 BUMP WRITE BYTE ADDRESS                     
         AI,R6    1                 BUMP READ BYTE ADDRESS                      
*                                                                               
         BDR,R9   LDW50             DECREMENT WRITE BYTE COUNT                  
         BDR,R13  %+2               DECREMENT WRITE CDW COUNT                   
         B        LDWDONE           DONE WITH WRITE                             
         BAL,R0   GETWCDW           GET NEXT WRITE CDW                          
         PAGE                                                                   
LDW50    RES      0                                                             
         BDR,R7   LDW40             DECREMENT READ BYTE COUNT                   
         BDR,R11  %+2               DECREMENT READ CDW COUNT                    
         B        LDRDONE           READ ALL DONE                               
         BAL,R0   GETRCDW           GET NEXT READ CDW                           
         B        LDW40             AND LOOP                                    
         PAGE                                                                   
*                                                                               
* WRITE ALL DONE HERE                                                           
*                                                                               
*                                                                               
LDWDONE  RES      0                                                             
         AI,R7    -1                ADJUST READ BYTE COUNT                      
         AI,R10   1                 ADJUST READ CDW PTR                         
         B        %+3               SKIP LOOP FIRST TIME                        
         AW,R7    *R10                                                          
         AI,R10   2                                                             
         BDR,R11  %-2               ADD UP READ RBC IN R7                       
*                                                                               
         LI,R10   -TYCOK            WRITE TYC                                   
         LI,R11   -TYCOK            READ TYC                                    
         B        LDSETTYC          SET UP TYC                                  
********                                                                        
*                                                                               
* READ ALL DONE HERE                                                            
*                                                                               
LDRDONE  RES      0                                                             
         AI,R12   1                 ADJUST WRITE CDW PTR                        
         B        %+3               SKIP LOOP FIRST TIME                        
         AW,R9    *R12                                                          
         AI,R12   2                                                             
         BDR,R13  %-2               ADD UP WRITE RBC IN R9                      
*                                                                               
         LI,R10   -TYCOK            WRITE TYC                                   
         LI,R11   -TYCOK            READ TYC                                    
         CI,R9    0                 IS WRITE RBC 0                              
         BEZ      %+2               YES, FINISHED OK                            
         B        LDSETTYC                                                      
         LI,R11   -TYCLOST          NO, LOST DATA CASE                          
         B        LDSETTYC                                                      
         PAGE                                                                   
*                                                                               
* SET UP TYC AND RBC IN IOQ5 AND IOQ8                                           
*                                                                               
LDSETTYC RES      0                                                             
         BAL,R0   RE:ENT                                                        
         LI,R0    -TYCOK                                                        
         STB,R11  IOQ5,R3                                                       
         STB,R10  IOQ5,R4                                                       
*                                                                               
         STW,R7   IOQ8,R3           READ RBC                                    
         STW,R9   IOQ8,R4           WRITE RBC                                   
*                                                                               
LDPOST   RES      0                                                             
         LW,R11   IOQ8,R3           GET RBC                                     
         LB,R12   IOQ5,R3           GET -TYC                                    
         AI,R12   -X'100'                                                       
         LCW,R12  R12               COMPLEMENT IT                               
         BAL,R0   RE:ENT            INHIBIT                                     
         DO1      #ERRORLOG                                                     
         MTW,1    DCT#IO,R1         COUNT I/O ACTIVITY                          
         MTH,1    DCT10,R1          BUMP RE-ENT COUNT                           
         BAL,R5   REQCOM            WRAP UP REQUEST                             
         B        RESCHED                                                       
         PAGE                                                                   
*                                                                               
* GET A WRITE CDW                                                               
*                                                                               
GETWCDW  RES      0                                                             
         LD,R8    *R12                                                          
         AI,R12   2                                                             
         LW,R5    R8                MOVE BYTE ADDR TO R5                        
         B        *R0                                                           
********                                                                        
*                                                                               
* GET A READ CDW                                                                
*                                                                               
GETRCDW  RES      0                                                             
         LD,R6    *R10                                                          
         AI,R10   2                                                             
         B        *R0                                                           
********                                                                        
         FIN      #LD                                                           
         TITLE    '** TTY - ETHERNET DEVICE HANDLER **'                         
         DO       #EN                                                           
         SPACE                                                                  
DCT      EQU      R1                DCT INDEX                                   
CIT      EQU      R2                CIT INDEX                                   
IOQ      EQU      R3                IOQ INDEX                                   
CHAN     EQU      R4                CHANNEL ALLOCATION FLAGS                    
BASE     EQU      R6                REGISTER FOR SELF-RELOCATION                
         SPACE                                                                  
ATTN     EQU      2                 CLIST OFFSET TO ATTENTION STATE             
         SPACE                                                                  
*        SYSTEM   SIG9P                                                         
         SPACE                                                                  
RA       FNAME                      RETURN RELATIVE ADDRESS                     
         PROC                                                                   
         PEND     AF(1)-ENPRE,BASE                                              
         SPACE                                                                  
*        CODE EXECUTED ON I/O INTERRUPT LEVEL                                   
*        R1 = AIO STATUS                                                        
*        R7 = DCT INDEX                                                         
*        R14= LINK                                                              
         SPACE                                                                  
ENATT    EQU      %                 ATTENTION ENTRY                             
         LH,R6    DCT7,R7           COMPUTE WA(IOCDW)                           
         SLS,R6   1                                                             
         SPACE                                                                  
         XW,R1    ATTN,R6           EXCHANGE CURRENT                            
         BEZ      *R14              WITH PREVIOUS (EXIT OK)                     
         SPACE                                                                  
         AI,R14   1                 PREVIOUS STATUS NOT                         
         B        *R14              ZERO (EXIT, MESSAGE)                        
         SPACE                                                                  
         B        ENATT             MUST POINT TO ATTN ENTRY                    
         SPACE                                                                  
ENPRE    EQU      %                 PRE-HANDLER                                 
         LW,BASE  DCT8,DCT           LOAD ADDRESS FOR SELF RELOCATION           
         SPACE                                                                  
         LH,R12   DCT7,DCT          COMPUTE WORD ADDRESS                        
         SLS,R12  1                  OF CLIST                                   
         SPACE                                                                  
         AI,R12   ATTN              OFFSET TO ATTENTION STATE                   
         LI,R13   0                  INITIALIZE FIRST NON-READ IOQ              
         LI,R11   0                   AND FIRST IOQ FOR OTHER DEVICE            
         SPACE                                                                  
         BAL,R0   RE:ENT            RE-ENTRY CHECK (DISABLES)                   
         SPACE                                                                  
QLOOP0   EQU      %                                                             
         CB,DCT   IOQ7,IOQ          SKIP IF IOQ FOR                             
         BNE      RA(QLOOP0A)        ANOTHER DEVICE                             
         SPACE                                                                  
         LB,R0    IOQ4,IOQ          GET CURRENT FUNCTION                        
         BNEZ     RA(QLOOP3)         AND SKIP IF NOT READ                       
         SPACE                                                                  
         LI,R0    0                 EXCHANGE 0 WITH                             
         XW,R0    *R12               CURRENT ATTENTION STATE                    
         BEZ      RA(QLOOP4)          SKIP IF NOT PREVIOUSLY SET                
         B        RA(QLOOP0B)          ELSE BUILD CHANNEL PROGRAM               
         SPACE                                                                  
QLOOP0A  EQU      %                 IOQ FOR ANOTHER DEVICE                      
         MTW,0    R11                SAVE THE FIRST ONE                         
         BNEZ     RA(%+2)             (BUSY REQUEST REJECTED                    
         STW,IOQ  R11                  IN SERVICE DEVICE)                       
         B        RA(QLOOP4)                                                    
         PAGE                                                                   
QLOOP0B  EQU      %                                                             
         LW,R8    RA(RFMCDW)        PREPARE TO BUILD                            
         LW,R9    RA(RFMCDW+1)       CLIST FOR READ FRAME                       
         SPACE                                                                  
         LW,R11   IOQ8,IOQ          GET BUFFER ADDRESS                          
         CW,R11   Y8                 SKIP IF THIS IS A                          
         BANZ     RA(QLOOP1)          DATA-CHAINED REQUEST                      
         SPACE                                                                  
         AND,R11  M24               CLEAR HIGH BYTE                             
         OR,R8    R11                AND SET ORDER BYTE                         
         SPACE                                                                  
         LH,R11   IOQ9,IOQ          GET BUFFER SIZE                             
         AND,R11  M16                SET HIGH HALFWORD TO ZERO                  
         OR,R9    R11                 AND SET FLAGS                             
         SPACE                                                                  
         LH,R7    DCT7,DCT          GET ADDRESS OF CLIST                        
         STD,R8   0,R7               AND STORE CDW IN CLIST                     
         SPACE                                                                  
         LW,R0    R7                SET DA(CLIST) FOR SIO                       
         LI,R8    2                  SET SMALL TIMEOUT                          
         B        IOSTRT              SKIP TO START I/O                         
         PAGE                                                                   
QLOOP1   EQU      %                 DATA-CHAINED REQUEST                        
         LI,R5    X'FFFF'            SET DA(SECONDARY CLIST)                    
         AND,R5   R11                                                           
         SPACE                                                                  
         LB,R8    R8                ISOLATE ORIGINAL ORDER                      
         LB,R9    R9                 AND ORIGINAL FLAGS                         
         SPACE                                                                  
         LH,R11   IOQ9,IOQ          FETCH NUMBER OF LINKS                       
         SPACE                                                                  
QLOOP2   EQU      %                                                             
         LD,R12   0,R5              FETCH LINK IN DATA-CHAIN                    
         SPACE                                                                  
         STB,R8   R12               SET ORDER BYTE                              
         STB,R9   R13                SET FLAGS                                  
         SPACE                                                                  
         CI,R11   1                 SKIP IF LAST LINK                           
         BE       RA(%+3)                                                       
         SPACE                                                                  
         OR,R13   YE                ELSE SET BIT 0 (DC)                         
         EOR,R13  Y6                 AND RESET BITS 1 AND 2                     
         SPACE                                                                  
         STD,R12  0,R5              REPLACE MODIFIED LINK                       
         SPACE                                                                  
         AI,R5    1                 POINT TO NEXT LINK                          
         BDR,R11  RA(QLOOP2)                                                    
         SPACE                                                                  
         LW,R0    IOQ8,IOQ          GET DA(SECONDARY CLIST)                     
         AND,R0   M16                FOR SIO INSTRUCTION                        
         LI,R8    2                   SET SMALL TIMEOUT                         
         B        IOSTRT               GO START I/O                             
         PAGE                                                                   
QLOOP3   EQU      %                 NON-READ FUNCTION                           
         MTW,0    *R12               START IMMEDIATELY IF                       
         BEZ      RA(QLOOP5)          ATTENTION STATE IDLE                      
         SPACE                                                                  
         MTW,0    R13               SAVE ONLY THE                               
         BNEZ     RA(%+2)            VERY FIRST NON-READ IOQ                    
         STW,IOQ  R13                                                           
         SPACE                                                                  
QLOOP4   EQU      %                                                             
         LB,IOQ   IOQ2,IOQ          GET FORWARD IOQ LINK                        
         BNEZ     RA(QLOOP0)         CONTINUE IF NOT TAIL                       
         SPACE                                                                  
         LW,IOQ   R13               FETCH NON-READ IOQ                          
         BEZ      RA(QLOOP6)         SKIP IF NULL                               
         SPACE                                                                  
QLOOP5   EQU      %                 NON-READ FUNCTION                           
         LB,R0    IOQ4,IOQ           FETCH ACTUAL FUNCTION CODE                 
         CI,R0    2                   SKIP IF NOT SET MODE                      
         BNE      RA(QLOOP5A)                                                   
         SPACE                                                                  
         LW,R0    IOQ12,IOQ         GET MODE INFORMATION                        
         SLS,R0   -24                POSITION TO LOOK AT                        
         CI,R0    X'3F'               ACTUAL MODE BYTE                          
         BNE      RA(QLOOP5A)          SKIP IF NOT RESET                        
         SPACE                                                                  
         LI,R0    0                 FOR RESET CLEAR                             
         STW,R0   *R12               THE ATTENTION                              
         SPACE                                                                  
QLOOP5A  EQU      %                                                             
         LI,R10   DOTEN-ENPRE        WILL BE STARTED HERE                       
         AW,R10   BASE                                                          
         B        COMLIST             VIA COMLIST                               
         SPACE                                                                  
QLOOP6   EQU      %                                                             
         LW,IOQ   R11               FETCH FIRST IOQ FOR                         
         BEZ      SCHEDXIT           ANOTHER DEVICE.  SKIP IF                   
         B        REQSTRT             NULL ELSE ATTEMPT START.                  
         PAGE                                                                   
         BOUND    8                                                             
DOTEN    EQU      %                                                             
DOT      SET      %                                                             
         SPACE                                                                  
         :DOT     RFM,2,0,0         0 - READ FRAME                              
         :DOT     WFM,2,0,0         1 - WRITE FRAME                             
         :DOT     SET,2,0,0         2 - SET MODE                                
         :DOT     SNS,2,0,0         3 - SENSE AND CLEAR STATISTICS              
         :DOT     LPA,2,0,0         4 - LOAD PHYSICAL ADDRESS                   
         :DOT     SND,2,0,0         5 - SENSE AND CLEAR DELAYS                  
         :DOT     LGA,2,0,0         6 - LOAD GROUP ADDRESS                      
         :DOT     DGA,2,0,0         7 - DELETE GROUP ADDRESS                    
         SPACE                                                                  
RFM      :CLIST   RFMCDW            0                                           
WFM      :CLIST   WFMCDW            1                                           
SET      :CLIST   SETCDW            2                                           
SNS      :CLIST   SNSCDW            3                                           
LPA      :CLIST   LPACDW            4                                           
SND      :CLIST   SNDCDW            5                                           
LGA      :CLIST   LGACDW            6                                           
DGA      :CLIST   DGACDW            7                                           
         SPACE                                                                  
         BOUND    8                                                             
RFMCDW   :CDW     X'02',0,X'14',0,0 READ FRAME                                  
WFMCDW   :CDW     X'01',0,X'14',2,0 WRITE FRAME                                 
SETCDW   :CDW     X'03',0,X'14',1,1 SET MODE (USE IOQ12)                        
SNSCDW   :CDW     X'04',0,X'14',2,0 SENSE AND CLEAR STATISTICS                  
LPACDW   :CDW     X'09',0,X'14',2,0 LOAD PHYSICAL ADDRESS                       
SNDCDW   :CDW     X'14',0,X'14',2,0 SENSE AND CLEAR DELAYS                      
LGACDW   :CDW     X'19',0,X'14',2,0 LOAD GROUP ADDRESS                          
DGACDW   :CDW     X'29',0,X'14',2,0 DELETE GROUP ADDRESS                        
         PAGE                                                                   
ENPOST   EQU      %                 POST-HANDLER                                
         BAL,R9   NEWIOCK            SET UP STATUS                              
         NOP                          IGNORE ERROR RETURN                       
         SPACE                                                                  
         LW,BASE  DCT8,DCT          LOAD BASE REGISTER                          
         LI,R12   X'01'              LOAD DEFAULT TYC                           
         SPACE                                                                  
         CI,R8    X'013F'           SKIP IF NO FATAL ERRORS                     
         BAZ      RA(NOFE)                                                      
         SPACE                                                                  
FE       LI,R12   X'0208'           SET TYC TO 8 AND                            
         B        IOSCU              FORCE MESSAGE DISPLAY                      
         SPACE                                                                  
NOFE     CI,R8    X'0800'           SKIP IF UE                                  
         BANZ     RA(UE)             WAS PRESENT                                
         SPACE                                                                  
NOUE     CI,R5    X'F000'           CONSTRAIN TDV STATUS                        
         BANZ     RA(FE)             TO ZERO (COMPLETION CODE)                  
         B        IOSCU               ELSE FATAL ERROR                          
         SPACE                                                                  
UE       CI,R8    X'0040'           SKIP IF TE                                  
         BAZ      RA(NOTE)           NOT PRESENT                                
         SPACE                                                                  
TE       CI,R5    X'F000'           CONSTRAIN TDV STATUS                        
         BAZ      RA(FE)             TO NON-ZERO (COMPLETION CODE)              
         SPACE                                                                  
         LB,R0    IOQ4,IOQ          EXAMINE ORIGINAL                            
         CI,R0    X'01'              FUNCTION CODE                              
         BNE      RA(ERROR)           SKIP IF NOT WRITE                         
         SPACE                                                                  
         LW,R12   R5                SKIP IF COMPLETION CODE                     
         SLS,R12  -12                IS X'1' (SUCCESS WITH COLLISION)           
         CI,R12   X'1'                TYC SET TO X'2'                           
         BNE      RA(%+2)                                                       
         LI,R12   X'02'-X'20'                                                   
         SPACE                                                                  
         AI,R12   X'20'             OFFSET COMPLETION CODE                      
         B        IOSCU              TO CREATE TYC>7 (ERROR)                    
         SPACE                                                                  
NOTE     CI,R8    X'0080'           SKIP IF IL SET                              
         BANZ     RA(IL)                                                        
         SPACE                                                                  
         CI,R5    X'F000'           FATAL ERROR IF TDV STATUS                   
         BAZ      RA(FE)             (COMPLETION CODE) IS ZERO                  
         B        RA(ERROR)           ELSE HANDLE AS NORMAL ERROR               
         SPACE                                                                  
IL       CI,R5    X'F000'           LOST DATA IF TDV STATUS                     
         BAZ      RA(LOST)           (COMPLETION CODE) IS ZERO                  
         SPACE                                                                  
ERROR    LI,R12   X'F000'           POSTION COMPLETION CODE                     
         AND,R12  R5                 AND CREATE TYC FOR I/O SYSTEM              
         SLS,R12  -12                                                           
         AI,R12   X'20'                                                         
         B        IOSCU                                                         
         SPACE                                                                  
LOST     LI,R12   X'02'             IL ALONE, FORCE                             
         B        IOSCU              TYC TO X'02' (LOST DATA)                   
         SPACE                                                                  
         FIN      #EN                                                           
         END                                                                    
