&LLL     PROC  &P,0,                                                   XEM000010
               &PGID=,                                                 XEM000020
               &SIZE=,                                                 XEM000030
               &EXEC=,                                                 XEM000040
               &N10=,                                                  XEM000050
               &N12=,                                                  XEM000060
               &N1ST=,                                                 XEM000070
               &N2ND=,                                                 XEM000080
               &PRTDRUM=,                                              XEM000090
               &PUNCH5=,                                               XEM000100
               &N11=,                                                  XEM000110
               &N14=,                                                  XEM000120
               &PUNCH1=,                                               XEM000130
               &PUNCH2=,                                               XEM000140
               &PUNCH4=,                                               XEM000150
               &PUNCH6=,                                               XEM000160
               &PRTTEN4=,                                              XEM000170
               &PRTBARR=,                                              XEM000180
               &STUB=,                                                 XEM000190
               &TEN1=,                                                 XEM000200
               &TEN1C=,                                                XEM000210
               &TEN1D=,                                                XEM000220
               &PTAPE=,                                                XEM000230
               &ODR=,                                                  XEM000240
               &IMAGE=,                                                XEM000250
               &RES=,                                                  XEM000260
               &TRANS=,                                                XEM000270
               &RESDEV=,                                               XEM000280
               &CHNLODR=,                                              XEM000290
               &CHNLPPT=,                                              XEM000300
               &CR0716=,                                               XEM000310
               &CR1001=,                                               XEM000320
               &CR1004=,                                               XEM000330
               &CHNL768=,                                              XEM000340
               &CHNL101=,                                              XEM000350
               &CHNL104=,                                              XEM000360
               &CHNL716=,                                              XEM000370
               &CHNL604=,                                              XEM000380
               &NCCW=,                                                 XEM000390
               &PA768=,                                                XEM000400
               &PB768=,                                                XEM000410
               &PC768=,                                                XEM000420
               &DTASK=,                                                XEM000421
               &TTASK=,                                                XEM000422
               &PRT93=                                                  EM000430
EM923    NAME  0                                                        EM000440
         LCL   &PWK                                                     EM000450
         LCL   &P1                                                      EM000460
         LCL   &LB                                                      EM000470
         LCL   &L$12                                                    EM000480
         LCL   &L$06                                                    EM000490
         LCL   &L$07                                                    EM000500
         LCL   &L$08                                                    EM000510
         LCL   &L$09                                                    EM000520
         LCL   &L$13                                                    EM000530
         LCL   &K$01                                                    EM000540
         LCL   &K$02                                                    EM000550
         GBL   &L$10                                                    EM000560
         LCL   &L$C04                                                   EM000570
         LCL   &L$C1                                                    EM000580
         LCL   &L$C2                                                    EM000590
         LCL   &L$C3                                                    EM000600
         LCL   &L$C4                                                    EM000610
         LCL   &L$C5                                                    EM000620
         LCL   &L$C6                                                    EM000630
         LCL   &L$C7                                                    EM000640
         LCL   &L$D                                                     EM000650
         LCL   &L$D1                                                    EM000660
         LCL   &L$D2                                                    EM000670
         LCL   &L$D3                                                    EM000680
         LCL   &L$PT1                                                   EM000690
         LCL   &L$OD1                                                   EM000700
         LCL   &L$CC1                                                   EM000710
         LCL   &L$CC                                                    EM000720
&L$C4    SET   64                                                       EM000730
.*                       PROCESS PGID                                   EM000740
&PWK     SET   '&PGID'                                                  EM000750
         DO    '&PGID'=''                                               EM000760
&PWK     SET   'EM92R2'                                                 EM000770
         PNOTE *,'PGID= NOT SPECIFIED - EM92R2 USED'                    EM000780
         GOTO  .LL1                                                     EM000790
         ENDO                                                           EM000800
.LL1     LABEL                                                          EM000810
&P1      SET   '&PWK.000000'(1,6)                                       EM000820
.*                                                                      EM000830
&LB      SET   '&P1.        '(1,8)                                      EM000840
&LB      STRTAR                                                         EM000850
BEGIN    EQU   *                                                        EM000860
START    EQU   *                                                        EM000870
         USING E9$XCBPS,14                                              EM000880
         USING E9$RX4TB,4                                               EM000890
         PRINT OFF                                                      EM000900
         SUPEQU                                                         EM000910
         PRINT ON                                                       EM000920
E9$XCBPS EQU   JT$PSW                                                   EM000930
E9$XCBR0 EQU   JT$SA                                                    EM000940
E9$XCBR1 EQU   JT$SA+4                                                  EM000950
E9$XCBR2 EQU   JT$SA+8                                                  EM000960
E9$XCBR3 EQU   JT$SA+12                                                 EM000970
E9$XCBR4 EQU   JT$SA+16                                                 EM000980
E9$XCBR5 EQU   JT$SA+20                                                 EM000990
E9$XCBR6 EQU   JT$SA+24                                                 EM001000
E9$XCBR7 EQU   JT$SA+28                                                 EM001010
E9$XCBR8 EQU   JT$SA+32                                                 EM001020
E9$XCBR9 EQU   JT$SA+36                                                 EM001030
E9$XCBRA EQU   JT$SA+40                                                 EM001040
E9$XCBRB EQU   JT$SA+44                                                 EM001050
E9$XCBRC EQU   JT$SA+48                                                 EM001060
E9$XCBRD EQU   JT$SA+52                                                 EM001070
E9$XCBRE EQU   JT$SA+56                                                 EM001080
E9$XCBRF EQU   JT$SA+60                                                 EM001090
         TITLE '92/9300 MEMORY PARTITION'                               EM001100
*********************************************************************** EM001110
*********************************************************************** EM001120
*                                                                     * EM001130
*        92/9300 MEMORY PARTITION                                     * EM001140
*                                                                     * EM001150
*********************************************************************** EM001160
         USING *,0                                                      EM001170
E9$R9MEM EQU   *                                                        EM001180
E9$RMEMY EQU   *                                                        EM001190
         LCL   &M                                                       EM001200
         DO    &SIZE=0                                                  EM001210
&M       SET   8                                                        EM001220
         GOTO  .NEX1                                                    EM001230
         ENDO                                                           EM001240
         DO    &SIZE=0=0                                                EM001250
&M       SET   &SIZE                                                    EM001260
         ENDO                                                           EM001270
.NEX1    LABEL                                                          EM001280
         DO    &M                                                       EM001290
         DC    4XL256'0'                                                EM001300
         ENDO                                                           EM001310
E9$RADTB EQU   *                                                        EM001320
         USING *,6                                                      EM001330
         TITLE 'INITIALIZATION ROUTINE'                                 EM001340
*********************************************************************** EM001350
*        INITIALIZE CODING FOR EMULATOR 92                              EM001360
*********************************************************************** EM001370
         ORG   E9$RADTB-X'1000'                                         EM001380
STEM92   EQU   *                                                        EM001390
E9$RINTT EQU   *                                                        EM001400
         USING *+2,8                                                    EM001410
         BALR  8,0                                                      EM001420
         WTLD  E9$RMSG6,44                                              EM001430
         L     6,E9$RADAD                                               EM001440
         L     4,E9$RALUT                                               EM001450
         LA    2,E9$RDR17                                               EM001460
         RDFCB READ171,(2)                                              EM001470
E9$RDR17 EQU   *                                                        EM001480
         LA    2,E9$PRT73                                               EM001490
         RDFCB PRNTR731,(2)                                             EM001500
E9$PRT73 EQU   *                                                        EM001510
         LA    2,E9$PCH05                                               EM001520
         RDFCB PUNCH051,(2)                                             EM001530
E9$PCH05 EQU   *                                                        EM001540
         DO    '&PUNCH5'='ROW'                                          EM001550
         USING E9$RCOV5,5                                               EM001560
         L     5,E9$COV                                                 EM001570
         LA    2,E9$PTEA                                                EM001580
         RDFCB PUNCH041,(2)                                             EM001590
         TM    PUNCH041+11,X'40'        ROW PUNCH BIT ON                EM001600
         BO    E9$PTEA                                                  EM001610
         OI    PCHSWIT,X'01'                                            EM001620
         OI    E9$PCCB+3,X'08'                                          EM001630
         DROP  5                                                        EM001640
E9$PTEA  EQU   *                                                        EM001650
         ENDO                                                           EM001660
E9$RWBYP EQU   *                                                        EM001670
         DO    '&PRTDRUM'>'0'                                           EM001680
         USING E9$RCOV5,5                                               EM001690
         L     5,E9$COV                                                 EM001700
         LA    2,E9$PDBY                                                EM001710
         RDFCB PRNTR681,(2)                                             EM001720
         TM    PRNTR681+11,X'20'        0768 SET ?                      EM001730
         BO    E9$PDBY                                                  EM001740
         OI    DRUMPCC1+3,X'08'                                         EM001750
         TM    PRNTR681+11,X'20'        0768 PRINTER ?                  EM001760
         BO    E9$PDBY                                                  EM001770
         TM    PRNTR681+11,X'80'        0770 PRINTER ?                  EM001780
         BNO   E9$773S                                                  EM001790
         OI    DSWITCH,X'80'            SET 770 SWITCH                  EM001800
         B     E9$PCCBS                                                 EM001810
E9$773S  OI    DSWITCH,X'40'            SET 773 SWITCH                  EM001820
E9$PCCBS OI    DRUMPCCB+3,X'08'         SET SYS USER BIT                EM001830
         DO    '&PA768'>''                                              EM001840
         OI    DSWITCH+1,X'01'          SET 0768 A PRINTER              EM001850
         ENDO                                                           EM001860
         DO    '&PB768'>''                                              EM001870
         OI    DSWITCH+1,X'02'          SET 0768 B PRINTER              EM001880
         ENDO                                                           EM001890
         DO    '&PC768'>''                                              EM001900
         OI    DSWITCH+1,X'02'          SET 0768 C PRINTER              EM001910
         ENDO                                                           EM001920
         DO    ('&PA768'='')**('&PB768'='')**('&PC768'='')              EM001930
         OI    DSWITCH+1,X'01'          SET 0768 A PRINTER DEFAULT      EM001940
         ENDO                                                           EM001950
         MVC   E9$RAKAR+8(8),E9$RSTND                                   EM001960
         OI    E9$RTYPE,X'01'           SET 0768 LFD BIT                EM001970
         BAL   7,LOADB                                                  EM001980
         NI    E9$RTYPE,X'FE'                                           EM001990
         DROP  5                                                        EM002000
         ENDO                                                           EM002010
E9$PDBY  EQU   *                                                        EM002020
         DO    '&CR0716'>'0'                                            EM002030
         L     5,E9$COV                                                 EM002040
         LA    2,E9$ABYP                                                EM002050
         RDFCB READ161,(2)                                              EM002060
E9$ABYP  EQU   *                                                        EM002070
         ENDO                                                           EM002080
E9$DBYPS EQU   *                                                        EM002090
         CLC   READ171+14(2),E9$PUBTP+2  COMP FOR ZEROS IN PUB          EM002100
         BE    E9$RNOCR                 BRANCH EQUAL NO CARD RDR        EM002110
*                                                                       EM002120
*                                                                       EM002130
         TM    READ171+11,X'20'         IS IT A 0717                    EM002140
         BO    E9$RNOCR                                                 EM002150
         OI    READCCB+3,X'08'          IF 0716 SET BIT                 EM002160
E9$RNOCR EQU   *                                                        EM002170
         CLC   PRNTR731+14(2),E9$PUBTP+2  COMP FOR ZEROS IN PUB         EM002180
         BE    E9$RNOCP                 BRANCH EQUAL NO PRINTER         EM002190
*                                                                       EM002200
*                                                                       EM002210
         TM    PRNTR731+11,X'40'        IS IT A 0773                    EM002220
         BO    E9$RNOCP                                                 EM002230
         OI    PRINTCCB+3,X'08'         SET SYSTEM USER BIT             EM002240
         TM    E9$PUBTP,X'20'           WAS IT 0768                     EM002250
         BO    E9$RNOCP                 BYPASS SETTING 0770 VFB         EM002260
E9$RNOCP EQU   *                                                        EM002270
         CLC   PUNCH051+14(2),E9$PUBTP+2  COMP FOR ZEROS IN PUB         EM002280
         BE    E9$RNOCH                 BRANCH EQUAL NO PUNCH           EM002290
*                                                                       EM002300
*                                                                       EM002310
         TM    PUNCH051+11,X'20'        IS IT A 0605                    EM002320
         BO    E9$RNOCH                                                 EM002330
         OI    PUNCHCCB+3,X'08'         SET SYSTEM USER BIT             EM002340
E9$RNOCH EQU   *                                                        EM002350
         MVC   READER,READ171+14                                        EM002360
         MVC   PRINTER,PRNTR731+14                                      EM002370
         MVC   PIO93,PRNTR731+14                                        EM002380
         MVC   PUNCH,PUNCH051+14                                        EM002390
         MVC   E9$RAKAR+8(8),E9$RSTND                                   EM002400
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM002410
         DO    '&N12'>'0'                                               EM002420
&L$12    SET   '&N12'                                                   EM002430
         GOTO  .PT1                                                     EM002440
         ENDO                                                           EM002450
&L$12    SET   0                                                        EM002460
.PT1     LABEL                                                          EM002470
         DO    '&N1ST'>'0'                                              EM002480
&L$06    SET   '&N1ST'                                                  EM002490
         GOTO  .PT2                                                     EM002500
         ENDO                                                           EM002510
&L$06    SET   0                                                        EM002520
.PT2     LABEL                                                          EM002530
         DO    '&N2ND'>'0'                                              EM002540
&L$07    SET   '&N2ND'                                                  EM002550
         GOTO  .PT3                                                     EM002560
         ENDO                                                           EM002570
&L$07    SET   0                                                        EM002580
.PT3     LABEL                                                          EM002590
&L$09    SET   &L$06+&L$07+&L$12                                        EM002600
         AIF   (&L$09 GT 8).PT4                                         EM002610
&L$08    SET   &L$09                                                    EM002620
         GOTO  .PT5                                                     EM002630
.PT4     LABEL                                                          EM002640
&L$08    SET   8                                                        EM002650
.PT5     LABEL                                                          EM002660
&L$10    SET   &L$08                                                    EM002670
         ENDO                                                           EM002680
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM002690
&L$13    SET   0                                                        EM002700
         USING E9$RTAPH,5                                               EM002710
         L     5,E9$ATAPH                                               EM002720
         DO    '&TTASK'='YES'                                           EM002721
         OI    E9$RIOII,X'80'           SET TAPE TASK ON                EM002722
         ENDO                                                           EM002723
         TM    E9$RIOII,X'80'           TASKING SET                     EM002730
         BNO   E9$NTSK                  BRANCH AROUND IF NOT            EM002740
         LM    0,1,TAPETSK              SET UP REGISTERS                EM002750
         ATTACH (1),(0)                                                 EM002760
         CHAP  1                                                        EM002770
E9$NTSK  EQU   *                                                        EM002780
         DO    &L$13<&L$10                                              EM002790
         LA    2,E9$RTP1                                                EM002800
*********************************************************************** EM002810
         RDFCB E2$TAPE0,(2)                                             EM002820
E9$RTP1  EQU   *                                                        EM002830
&L$13    SET   &L$13+1                                                  EM002840
         GOTO  .PT6                                                     EM002850
         ENDO                                                           EM002860
.PT6     LABEL                                                          EM002870
         DO    &L$13<&L$10                                              EM002880
         LA    2,E9$RTP2                                                EM002890
*********************************************************************** EM002900
         RDFCB E2$TAPE1,(2)                                             EM002910
E9$RTP2  EQU   *                                                        EM002920
&L$13    SET   &L$13+1                                                  EM002930
         GOTO  .PT7                                                     EM002940
         ENDO                                                           EM002950
.PT7     LABEL                                                          EM002960
         DO    &L$13<&L$10                                              EM002970
         LA    2,E9$RTP3                                                EM002980
*********************************************************************** EM002990
         RDFCB E2$TAPE2,(2)                                             EM003000
E9$RTP3  EQU   *                                                        EM003010
&L$13    SET   &L$13+1                                                  EM003020
         GOTO  .PT8                                                     EM003030
         ENDO                                                           EM003040
.PT8     LABEL                                                          EM003050
         DO    &L$13<&L$10                                              EM003060
         LA    2,E9$RTP4                                                EM003070
*********************************************************************** EM003080
         RDFCB E2$TAPE3,(2)                                             EM003090
E9$RTP4  EQU   *                                                        EM003100
&L$13    SET   &L$13+1                                                  EM003110
         GOTO  .PT9                                                     EM003120
         ENDO                                                           EM003130
.PT9     LABEL                                                          EM003140
         DO    &L$13<&L$10                                              EM003150
         LA    2,E9$RTP5                                                EM003160
*********************************************************************** EM003170
         RDFCB E2$TAPE4,(2)                                             EM003180
E9$RTP5  EQU   *                                                        EM003190
&L$13    SET   &L$13+1                                                  EM003200
         GOTO  .PTA                                                     EM003210
         ENDO                                                           EM003220
.PTA     LABEL                                                          EM003230
         DO    &L$13<&L$10                                              EM003240
         LA    2,E9$TP6                                                 EM003250
*********************************************************************** EM003260
         RDFCB E2$TAPE5,(2)                                             EM003270
E9$TP6   EQU   *                                                        EM003280
&L$13    SET   &L$13+1                                                  EM003290
         GOTO  .PTB                                                     EM003300
         ENDO                                                           EM003310
.PTB     LABEL                                                          EM003320
         DO    &L$13<&L$10                                              EM003330
         LA    2,E9$RTP7                                                EM003340
*********************************************************************** EM003350
         RDFCB E2$TAPE6,(2)                                             EM003360
E9$RTP7  EQU   *                                                        EM003370
&L$13    SET   &L$13+1                                                  EM003380
         GOTO  .PTC                                                     EM003390
         ENDO                                                           EM003400
.PTC     LABEL                                                          EM003410
         DO    &L$13<&L$10                                              EM003420
         LA    2,E9$TNORQ                                               EM003430
*********************************************************************** EM003440
         RDFCB E2$TAPE7,(2)                                             EM003450
*********************************************************************** EM003460
E9$TNORQ EQU   *                                                        EM003470
&L$13    SET   &L$13+1                                                  EM003480
         GOTO  .PTD                                                     EM003490
         ENDO                                                           EM003500
         DROP  5                                                        EM003510
         ENDO                                                           EM003520
.PTD     LABEL                                                          EM003530
         DO    '&N10'>'0'                                               EM003540
         EJECT                                                          EM003550
*********************************************************************** EM003560
*                                                                     * EM003570
*        8410 DISC DISPATCHER INITIALIZATION                          * EM003580
*                                                                     * EM003590
*********************************************************************** EM003600
         SPACE 1                                                        EM003610
         USING E9$K$,9                                                  EM003620
         USING E9$K10,5                                                 EM003630
         L     5,E9$AK10           LD R5 W/8410 DISPATCHER ADDR         EM003640
         OI    E9$RTYPE+1,X'80'         SET 8410 ON SYSTEM              EM003650
E9$KIAA  GETCS E9$KGCS             GETCS                                EM003660
         CLC   E9$KGCS(2),=C'/$'   /$ ?                                 EM003670
         BE    E9$KIAA             BR TO E9$KIAA IF YES                 EM003680
         CLI   E9$KGCS+79,C'B'     B-CARD ?                             EM003690
         BNE   E9$KIAB             BR TO E9$KIAB IF NO                  EM003700
         ST    1,E9$KCSPT          SAVE GETCS POINTER                   EM003710
         ST    1,E9$KSCPT               SAVE GETCS PTR                  EM003720
E9$KIAF  LA    9,E9$KT10           LD R9 W/DISC DVC TABLE               EM003730
         USING E9$K$,9                                                  EM003740
         NI    E9$KGCS+13,X'0F'    ERASE ZONE                           EM003750
E9$KIAE  CLI   E9$K$DVC,X'FF'      SENTINEL ?                           EM003760
         BE    E9$KIAC             BR TO E9$KIAC IF YES                 EM003770
         CLC   E9$K$DVC(1),E9$KGCS+13  MATCH ?                          EM003780
         BE    E9$KIAD             BR TO E9$KIAD IF YES                 EM003790
         LA    9,E9$K$L(9)         GET NEXT ENTRY                       EM003800
         B     E9$KIAE             BR TO E9$KIAE                        EM003810
E9$KIAD  OI    E9$K$FLG,X'80'      SET 'USED BIT'                       EM003820
E9$KIAC  GETCS E9$KGCS             GETCS                                EM003830
         CLI   E9$KGCS+79,C'B'     B-CARD ?                             EM003840
         BE    E9$KIAF             BR TO E9$KIAF IF YES                 EM003850
E9$KIAB  DS    0H                                                       EM003860
         CLI   E9$KGCS,C'L'             IS IT AN L CARD                 EM003870
         BNE   E9$KNOLC                                                 EM003880
         CLI   E9$KGCS+9,X'40'          IS SPACE IN NAME                EM003890
         BNE   E9$KCNPT                                                 EM003900
         OI    E9$RTYPE,X'04'           SET BYPASS                      EM003910
         B     E9$KIAC                                                  EM003920
E9$KCNPT EQU   *                                                        EM003930
         CLI   E9$KGCS+19,X'40'         IS NORMAL PRINTER REQ           EM003940
         BNE   E9$KK768                                                 EM003950
         OI    E9$RTYPE,X'04'                                           EM003960
         B     E9$KNPRT                                                 EM003970
E9$KK768 EQU   *                                                        EM003980
         CLI   E9$KGCS+19,X'F1'                                         EM003990
         BNE   E9$KC141                                                 EM004000
         OI    E9$RTYPE,X'01'                                           EM004010
         B     E9$KNPRT                                                 EM004020
E9$KC141 EQU   *                                                        EM004030
         CLI   E9$KGCS+19,X'F2'                                         EM004040
         BNE   E9$KNPRT                                                 EM004050
         OI    E9$RTYPE,X'0A'                                           EM004060
E9$KNPRT EQU   *                                                        EM004070
         MVC   E9$RAKAR+8(8),E9$KGCS+9                                  EM004080
         BAL   7,LOADB                                                  EM004090
         B     E9$KIAC                                                  EM004100
E9$KNOLC EQU   *                                                        EM004110
         DO    '&CR1001'>'0'                                            EM004120
         CLI   E9$KGCS+79,C'C'                                          EM004130
         BE    E9$WNT                                                   EM004140
         ENDO                                                           EM004150
         CLI   E9$KGCS+79,C'G'     CHECK FOR G-CARD                     EM004160
         BNE   E9$KIBAP                                                 EM004170
         MVC   E9$IPLUN(1),E9$KGCS                                      EM004180
         NI    E9$IPLUN,X'0F'           ERASE FIRST FOUR BITS           EM004190
         GETCS E9$KGCS                                                  EM004200
E9$KIBAP CLI   E9$KGCS+79,C'P'          CHECK FOR P CARD                EM004210
         BNE   E9$KIBA                  CONT CHECK                      EM004220
         CLI   E9$KGCS,X'F1'            IS DOUBLE B READER SET?         EM004230
         BNE   *+8                                                      EM004240
         NI    RDB,X'DF'                ERASE                           EM004250
         CLI   E9$KGCS+1,X'F1'          IS DOUBLE B PUNCH SET?          EM004260
         BNE   *+8                                                      EM004270
         NI    PCB,X'DF'                ERASE                           EM004280
         CLI   E9$KGCS+2,X'F1'          IS DOUBLE B PRINTER SET?        EM004290
         BNE   E9$KIAC                                                  EM004300
         NI    PRB,X'DF'                ERASE                           EM004310
         B     E9$KIAC                                                  EM004320
E9$KIBA  CLC   RDEND,E9$KGCS            COMP FOR OVERRIDE SET           EM004330
         BNE   E9$KIBX             BR TO E9$KIBX IF NO                  EM004340
         OI    E9$RIOII,X'10'      SET OVERRIDE BIT                     EM004350
E9$KIBX  ST    1,E9$KCSQT          SAVE GETCS POINTER                   EM004360
         LA    9,E9$KT10           LD R9 W/DISC DVC TABLE               EM004370
E9$KIBE  L     1,E9$KCSPT          SET GETCS POINTER                    EM004380
         CLI   E9$K$DVC,X'FF'      SENTINEL ?                           EM004390
         BE    E9$KIBB             BR TO E9$KIBB IF YES                 EM004400
         TM    E9$K$FLG,X'80'      'USED-BIT' SET ?                     EM004410
         BZ    E9$KIBC             BR TO E9$KIBC IF NO                  EM004420
         SETCS (1),R               SETCS                                EM004430
E9$KIBD  GETCS E9$KGCS             GETCS                                EM004440
         ST    1,E9$KCSPT                                               EM004450
         CLI   E9$KGCS+79,C'B'     B-CARD ?                             EM004460
         BNE   E9$KIBC             BR TO E9$KIBC IF NO                  EM004470
         NI    E9$KGCS+13,X'0F'    ERASE ZONE                           EM004480
         CLC   E9$K$DVC(1),E9$KGCS+13  MATCH ?                          EM004490
         BNE   E9$KIBD             BR TO E9$KIBD IF NO                  EM004500
         CLC   E9$K$MNT(2),E9$KGCS+3 MOUNT THIS DRIVE ?                 EM004510
         BNE   E9$KIBD             BR TO E9$KIBD IF NO                  EM004520
         MVC   E9$KDXXX+5(3),E9$KGCS  SET LFD NAME                      EM004530
         L     11,E9$K$BUF                                              EM004540
         LA    11,5(11)                                                 EM004550
         MVC   0(8,11),E9$KDXXX    SET PIOCB NAME                       EM004560
         MVC   8(2,11),=H'256'     SET FCB LNG                          EM004570
         LR    1,11                                                     EM004580
         RDFCB (1)                 RDFCB                                EM004590
         MVC   76(18,11),E9$KGCS+24 MOVE PACK-NAME                      EM004600
         MVC   30(26,11),E9$KGCS+42                                     EM004610
         MVC   118(6,11),E9$KGCS+5  MOVE VSN                            EM004620
         L     1,E9$K$SAT                                               EM004630
         MVC   33(3,1),E9$KGCS     SET LFD NAME IN SAT                  EM004640
         OI    37(1),X'04'         SET FCB IN CORE                      EM004650
         OPEN  (1)                 OPEN                                 EM004660
         NI    37(1),X'FB'         CLEAR FCB IN CORE                    EM004670
         TM    36(1),X'80'         OPEN-BIT ON ?                        EM004680
         BZ    E9$KIBC             BR TO E9$KIBC IF NO                  EM004690
         OI    E9$K$FLG,X'40'      SET OPEN-BIT                         EM004700
         CLI   E9$KGCS+16,C' '     SYSRES ?                             EM004710
         BE    E9$KIBC             BR TO E9$KIBC IF NO                  EM004720
         OI    E9$K$FLG,X'01'      SET SYSRES                           EM004730
E9$KIBC  LA    9,E9$K$L(9)         GET NEXT ENTRY                       EM004740
         B     E9$KIBE             BR TO E9$KIBE                        EM004750
E9$KDXXX DC    CL8'E9$KDXXX'       PIOCB NAME                           EM004760
         LTORG                                                          EM004770
E9$KGCS  DS    CL80                BUFFER FOR GETCS                     EM004780
E9$KCSQT DC    F'0'                                                     EM004790
E9$KIBB  DS    0H                                                       EM004800
         L     1,E9$KCSQT          SET GETCS POINTER                    EM004810
         SETCS (1),R               SETCS                                EM004820
         DROP  5                                                        EM004830
         DROP  9                                                        EM004840
******** 8410 DISC INITIALIZER COMPLETED *******                        EM004850
         ENDO                                                           EM004860
         DO    '&CHNL104'>'0'                                           EM004870
&L$C04   SET   &CHNL104                                                 EM004880
         ENDO                                                           EM004890
         DO    '&CHNL104'=''                                            EM004900
&L$C04   SET   10                                                       EM004910
         ENDO                                                           EM004920
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM004930
*********************************************************************** EM004940
*                                                                     * EM004950
*        INITIALIZER FOR 1004 HANDLER                                 * EM004960
*                                                                     * EM004970
*********************************************************************** EM004980
         SPACE 1                                                        EM004990
         L     5,E9$COV                                                 EM005000
         USING E9$MUXH,5                                                EM005010
         RDFCB READ141,E9$YERA                                          EM005020
         MVC   E9$YRTP(6),READ141+10 SET DVC TYPE & PUB POINTER         EM005030
         TM    E9$YRTP+1,X'80'     716 ?                                EM005040
         BNO   E9$YDD                                                   EM005050
         OI    E9$YRCCB+3,X'08'    SET SYSTEM USER BIT                  EM005060
E9$YDD   DS    0H                                                       EM005070
E9$YAA   RDFCB PRNTR141,E9$YERB                                         EM005080
         MVC   E9$YLTP(6),PRNTR141+10 SET DVC TYPE & PUB POINTER        EM005090
         TM    E9$YLTP+1,X'40'          IS 0773 ASSIGNED                EM005100
         BO    E9$YEE                                                   EM005110
         OI    E9$YLCCB+3,X'08'    SET SYSTEM USER BIT                  EM005120
E9$YEE   DS    0H                                                       EM005130
         MVC   PIO93,PRNTR141+14                                        EM005140
         TM    E9$RTYPE,X'08'           DID L CARD SET LVB              EM005150
         BO    E9$YBLVB                                                 EM005160
         MVC   E9$RAKAR+8(8),E9$RSTND   SET STANDARD ISSUE LOOP         EM005170
         OI    E9$RTYPE,X'02'           SET BIT FOR 1004 LFD            EM005180
         BAL   7,LOADB                                                  EM005190
E9$YBLVB EQU   *                                                        EM005200
         NI    E9$RTYPE,X'F7'           ERASE BIT                       EM005210
E9$YBB   RDFCB PUNCH141,E9$YERC                                         EM005220
         MVC   E9$YPTP(6),PUNCH141+10 SET DVC TYPE & PUB POINTER        EM005230
         TM    E9$YPTP+1,X'40'     ROW PUNCH SET ?                      EM005240
         BNO   E9$YFF                                                   EM005250
         OI    E9$YPCCB+3,X'08'    SET SYSTEM USER BIT                  EM005260
E9$YFF   DS    0H                                                       EM005270
         B     E9$YXXX                                                  EM005280
E9$YERA  MVC   E9$YARDR,E9$YAERR                                        EM005290
         B     E9$YAA                                                   EM005300
E9$YERB  MVC   E9$YAPRT,E9$YAERR                                        EM005310
         B     E9$YBB                                                   EM005320
E9$YERC  MVC   E9$YAPCH,E9$YAERR                                        EM005330
E9$YXXX  DS    0H                                                       EM005340
         ENDO                                                           EM005350
         DO    ('&N11'>'0')++('&N14'>'0')                               EM005360
*********************************************************************** EM005370
*                                                                     * EM005380
*        8411/8414 DISC DISPATCHER INITIALIZATION                     * EM005390
*                                                                     * EM005400
*********************************************************************** EM005410
E9$DINIT DS    0H                                                       EM005420
         USING E9$D11,5                                                 EM005430
         L     5,E9$DINTA                                               EM005440
         DO    '&DTASK'='YES'                                           EM005441
         OI    E9$RIOII+1,X'80'         SET DISK TASKING                EM005442
         ENDO                                                           EM005443
         TM    E9$RIOII+1,X'80'         IS BIT SET FOR TASKING          EM005450
         BNO   E9$NDTSK                 BR AROUND IF NOT                EM005460
         LM    0,1,DISCTSK              LD REGISTERS FOR SETUP          EM005470
         ATTACH (1),(0)                                                 EM005480
         CHAP   1                                                       EM005490
E9$NDTSK EQU   *                        POINT OF BYPASS                 EM005500
         DO    '&N11'>'0'                                               EM005510
&L$D1    SET   '&N11'                                                   EM005520
         GOTO  .DSI1                                                    EM005530
         ENDO                                                           EM005540
&L$D1    SET   0                                                        EM005550
.DSI1    LABEL                                                          EM005560
         DO    '&N14'>'0'                                               EM005570
&L$D2    SET   '&N14'                                                   EM005580
         GOTO  .DSI2                                                    EM005590
         ENDO                                                           EM005600
&L$D2    SET   0                                                        EM005610
.DSI2    LABEL                                                          EM005620
&L$D3    SET   &L$D1+&L$D2                                              EM005630
         DO    &L$D3>8                                                  EM005640
&L$D3    SET   8                                                        EM005650
         ENDO                                                           EM005660
&L$D0    DO    &L$D3                                                    EM005670
&L$D     SET   &L$D0-1                                                  EM005680
E9$DINT&L$D  RDFCB E9$DISC&L$D,E9$DINT&L$D0                             EM005690
         MVI   E9$DTC&L$D.+5,X'80'                                      EM005700
         ENDO                                                           EM005710
         B     E9$DINT&L$D0                                             EM005720
E9$DINTA DC    A(E9$D11)                                                EM005730
E9$DINT&L$D0   DS  0H                                                   EM005740
         DROP  5                                                        EM005750
         ENDO                                                           EM005760
*                                                                       EM005770
*                                                                       EM005780
*                                                                       EM005790
*                                                                       EM005800
*                                                                       EM005810
E9$RXIOP EQU   *                                                        EM005820
         BAL   7,E9$RXIPP                                               EM005830
*********************************************************************** EM005840
*        NOTE: REG 4 POINTS TO FIRST ADDRESS IN LOG UNIT TABLE WHICH    EM005850
*        IS THE READER.                                                 EM005860
*********************************************************************** EM005870
         L     4,E9$RALUT               LD ADDRESS TABLE VALUE          EM005880
         OI    E9$RXS3,X'04'            SET TRANSLATE BIT IN RDR        EM005890
         DO    ('&RES'='0711')++('&RES'='0716')++('&RES'='1001')++('&REXEM005900
               S'='1004')                                               EM005910
         OI    E9$RIOII+2,X'44'         SET INIT & LOAD MODE            EM005920
         ENDO                                                           EM005930
         DO    ('&EXEC'='')++('&EXEC'='EXEC1')                          EM005940
         OI    E9$RTYPE,X'80'           SET EXEC1                       EM005950
         ENDO                                                           EM005960
         DO    ('&EXEC'='NCOS')++('&EXEC'='COS')                        EM005970
         OI    E9$RTYPE,X'20'           SET NCOS/COS                    EM005980
         ENDO                                                           EM005990
         DO    ('&EXEC'='MOS')++('&EXEC'='EXEC2')                       EM006000
         OI    E9$RTYPE,X'50'           SET MOS MODE/EXEC2              EM006010
         ENDO                                                           EM006020
         SR    2,2                      SET RECEIVE AREA W/REL ZERO     EM006030
         L     3,E9$RXBUF               LD VALUE OF RDR BUFFER          EM006040
         MVC   E9$RXGSZ(1),E9$RXMSZ     SET UP GET SIZE WITH MAXSIZE    EM006050
         L     1,E9$RXDTF               LD RDR DTF ADDRESS              EM006060
         MVI   0(3),X'02'               SET UP FUNCTION CODE            EM006070
         DO    ('&RES'='0711')++('&RES'='0716')++('&RES'='1001')++('&REXEM006080
               S'='1004')                                               EM006090
         OI    E9$RIOII+1,X'04'         SET MODE TO I/O ON INITIALIZE   EM006100
         ENDO                                                           EM006110
*                                                                       EM006120
         OI    E9$RXS2,X'08'            SET READER TO GETCS             EM006130
         DO    1-('&N10'>'0')                                           EM006140
         LR    1,3                      SET REG 1 TO BUFF ADDRESS       EM006150
         GETCS (1)                      DUMMY GETCS FOR /$              EM006160
E9$GINFO EQU   *                                                        EM006170
         L     3,E9$RXBUF                                               EM006180
         LR    1,3                                                      EM006190
         GETCS (1)                                                      EM006200
         DO    '&CR1001'>'0'                                            EM006210
         CLI   79(3),C'C'          C-CARD?                              EM006220
         BE    E9$WNT              YES,   INITIALIZE 1001 ROUTINE       EM006230
         ENDO                                                           EM006240
         CLI   0(3),C'L'                IS IT AN L CARD                 EM006250
         BNE   E9$RNOLC                 BR NOT EQUAL TO NO L CARD       EM006260
         CLI   9(3),X'40'               IS SPACE IN NAME                EM006270
         BNE   E9$CKNPT                                                 EM006280
         OI    E9$RTYPE,X'04'           SET BY OF LCB                   EM006290
         B     E9$GINFO                                                 EM006300
E9$CKNPT EQU   *                                                        EM006310
         CLI   19(3),X'40'              IS NORMAL PRINTER REQ           EM006320
         BNE   E9$CK768                                                 EM006330
         OI    E9$RTYPE,X'04'           SET BIT FOR LVB ISSUED L CARD   EM006340
         B     E9$NPRTR                                                 EM006350
E9$CK768 EQU   *                                                        EM006360
         CLI   19(3),X'F1'              IS 0768 REQ?                    EM006370
         BNE   E9$CK141                                                 EM006380
         OI    E9$RTYPE,X'01'           SET 768 LFD REQ                 EM006390
         B     E9$NPRTR                                                 EM006400
E9$CK141 EQU   *                                                        EM006410
         CLI   19(3),X'F2'              IS 1004 REQ ?                   EM006420
         BNE   E9$NPRTR                                                 EM006430
         OI    E9$RTYPE,X'0A'           SET BIT 104 LVB ISSUED L CARD   EM006440
E9$NPRTR EQU   *                                                        EM006450
         MVC   E9$RAKAR+8(8),9(3)                                       EM006460
         BAL   7,LOADB                                                  EM006470
         B     E9$GINFO                                                 EM006480
E9$RNOLC EQU   *                                                        EM006490
         CLI   79(3),C'B'               IS IT A B CARD                  EM006500
         BE    E9$GINFO                 GET ANOTHER CARD                EM006510
         CLI   79(3),C'G'               CHECK FOR G CARD                EM006520
         BNE   E9$CKPC                                                  EM006530
         MVC   E9$IPLUN(1),0(3)                                         EM006540
         NI    E9$IPLUN,X'0F'           ERASE FIRST FOUR BITS           EM006550
         B     E9$GINFO                                                 EM006560
E9$CKPC  EQU   *                                                        EM006570
         CLI   79(3),C'P'              CHECK FOR P CARD                 EM006580
         BNE   E9$CKEN                                                  EM006590
         CLI   0(3),X'F1'              IS D B SET FOR READER            EM006600
         BNE   *+8                                                      EM006610
         NI    RDB,X'DF'               ERASE BIT                        EM006620
         CLI   1(3),X'F1'              IS D B SET FOR PUNCH             EM006630
         BNE   *+8                                                      EM006640
         NI    PCB,X'DF'               ERASE BIT                        EM006650
         CLI   2(3),X'F1'              IS DB SET FOR PRINTER            EM006660
         BNE   E9$GINFO                                                 EM006670
         NI    PRB,X'DF'                                                EM006680
         B     E9$GINFO                                                 EM006690
E9$CKEN  EQU   *                                                        EM006700
         CLC   RDEND,0(3)               COMP FOR OVERRIDE TO BE SET     EM006710
         BNE   *+12                                                     EM006720
         OI    E9$RIOII,X'10'           SET OVERRIDE BIT                EM006730
         NI    E9$RXS2,X'F7'                                            EM006740
         SETCS (1),R                                                    EM006750
         ENDO                                                           EM006760
         TM    E9$RTYPE,X'04'                                           EM006770
         BO    E9$BYLVB                                                 EM006780
         MVC   E9$RAKAR+8(8),E9$RSTND   SET STANDARD LOOP               EM006790
         CLC   PRNTR731+14(2),E9$PUBTP+2     NO PUB ?                   EM006800
         BE    E9$BYLVB                                                 EM006810
         BAL   7,LOADB                                                  EM006820
E9$BYLVB EQU   *                                                        EM006830
         NI    E9$RTYPE,X'FB'           RESET BIT                       EM006840
         TM    E9$RXS2,X'20'            IS D B SET                      EM006850
         BO    *+16                                                     EM006860
         MVI   E9$R01B1,X'02'                                           EM006870
         BAL   7,E9$R071                                                EM006880
         ST    9,E9$RXBUF                                               EM006890
         L     3,E9$RXBUF                                               EM006900
         MVI   0(3),X'02'                                               EM006910
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM006920
         DO    '&RES'='1004'                                            EM006930
         SPACE 3                                                        EM006940
*********************************************************************** EM006950
*        1004 IPL ROUTINE                                             * EM006960
*********************************************************************** EM006970
         SPACE 1                                                        EM006980
         L     5,E9$COV                                                 EM006990
         USING E9$MUXH,5                                                EM007000
         OI    E9$RIOII+3,X'04'         SET CNTRL RDR TO 1004           EM007010
         LA    1,E9$YRCCB          LD R1 W/CCB ADDR                     EM007020
         LA    3,E9$YRBCW          LD R3 W/BCW ADDR                     EM007030
         MVC   0(8,3),E9$YWK1                                           EM007040
         EXCP  (1)                 READ 1ST CARD                        EM007050
         TM    2(1),X'80'                                               EM007060
         BZ    *-4                                                      EM007070
         MVC   0(8,3),E9$YWK2                                           EM007080
         EXCP  (1)                 READ 2ND CARD                        EM007090
         TM    2(1),X'80'                                               EM007100
         BZ    *-4                                                      EM007110
         TR    0(160),E9$RTBPU     TR TO COMPRESS                       EM007120
         B     E9$RLDRG            BR TO E9$RLDRG                       EM007130
E9$YWK1  DC    X'0200005000000050' FOR 1ST CARD                         EM007140
E9$YWK2  DC    X'0200000000000050' FOR 2ND CARD                         EM007150
         DROP  5                                                        EM007160
         ENDO                                                           EM007170
         ENDO                                                           EM007180
         DO    '&RES'='8410'                                            EM007190
         B     E9$KIPL             BR TO E9$KIPL (IPL SIMULATION)       EM007200
         ENDO                                                           EM007210
         DO    '&CR1001'>'0'                                            EM007220
         B     E9$WNTC                                                  EM007230
*********************************************************************** EM007240
*                                                                     * EM007250
*        1001 CARD CONTROLLER INITIALIZATION                          * EM007260
*                                                                     * EM007270
*********************************************************************** EM007280
         SPACE 1                                                        EM007290
         USING E9$MUXH,5                                                EM007300
E9$WNT   DS    0H                                                       EM007310
         L     5,E9$COV                                                 EM007320
         SPACE 2                                                        EM007330
*********************************************************************** EM007340
*                                                                     * EM007350
*  DESCRIPTOR CARD TYPE C                                             * EM007360
*                                                                     * EM007370
*              1001 ENTRY                                             * EM007380
*       COL.   PRIMARY           COL.   SECONDARY                     * EM007390
*       1-3.... DVC LU #         8-10... DVC LU #                     * EM007400
*       4...... 0711             11..... 0711                         * EM007410
*       5...... 0716             12..... 0716                         * EM007420
*       6...... 0717             13..... 0717                         * EM007430
*       7...... GETCS            14..... GETCS                        * EM007440
*                                                                     * EM007450
*********************************************************************** EM007460
         SPACE 2                                                        EM007470
E9$WNT1  DS    0H                                                       EM007480
         DO    1-('&N10'>'0')                                           EM007490
         LR    R9,R3               BUFFER ADDRESS TO R9                 EM007500
         ENDO                                                           EM007510
         DO    '&N10'>'0'                                               EM007520
         LA    R9,E9$KGCS                                               EM007530
         ENDO                                                           EM007540
         CLI   6(R9),C' '          GETCS REQUIRED ?                     EM007550
         BE    E9$WNT2             YES,   NO WNT2                       EM007560
         OI    E9$WASN,X'10'       GETCS ASSIGNED                       EM007570
         B     E9$WNT3                                                  EM007580
*                                                                       EM007590
E9$WNT2  RDFCB E9$CCP,E9$WNT3                                           EM007600
         DO    '&RES'='1001'                                            EM007610
         MVC   READER,E9$CCP+14    SET PUBPOINTER FOR IGET ROUTINE      EM007620
         ENDO                                                           EM007630
         OI    E9$WASN,X'20'       READER ASSIGNED                      EM007640
         CLI   5(R9),C' '          0717 REQUIRED ?                      EM007650
         BE    E9$WNT3             NO,  YES CHECK SECONDARY             EM007660
         OI    E9$WCCB1+3,X'08'    SET SYSTEM USER'S BIT                EM007670
*                                                                       EM007680
E9$WNT3  CLI   13(R9),C' '         GETCS REQUIED ?                      EM007690
         BE    E9$WNT4             YES,   NO WNT4                       EM007700
         TM    E9$WASN,X'10'       GETCS FOR PRIMARY ALSO?              EM007710
         BO    E9$WNTER            NO, YES DISPLAY ERROR                EM007720
         OI    E9$WASN,X'01'       GETCS ASSIGNED AS SECONDARY          EM007730
         B     E9$WNTB                                                  EM007740
*                                                                       EM007750
E9$WNT4  RDFCB E9$CCS,E9$WNTB                                           EM007760
         OI    E9$WASN,X'02'       READER ASSIGNED                      EM007770
         CLI   12(R9),C' '         0717 ?                               EM007780
         BE    E9$WNTB             NO,   YESGO TO WNTB                  EM007790
         OI    E9$WCCB2+3,X'08'    SET SYSTEM USER'S BIT TO BE 1        EM007800
         DO    '&N10'>'0'                                               EM007810
E9$WNTB  B     E9$KIAC                                                  EM007820
         ENDO                                                           EM007830
         DO    1-('&N10'>'0')                                           EM007840
E9$WNTB  B     E9$GINFO                                                 EM007850
         ENDO                                                           EM007860
*                                                                       EM007870
*                                                                       EM007880
*                                                                       EM007890
E9$WNTER LA    R1,E9$WNTC1                                              EM007900
         WTLD  R1,44                                                    EM007910
         CANCEL                                                         EM007920
E9$WNTC1 DC    C'92/9300 EMULATOR 1001 ENTRIES DOUBLE DEFINED'          EM007930
*                                                                       EM007940
E9$WNTC  DS    0H                                                       EM007950
         ENDO                                                           EM007960
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM007970
         DO    '&RES'='TAPE'                                            EM007980
         B     E9$TIPL                                                  EM007990
         ENDO                                                           EM008000
         ENDO                                                           EM008010
         DO    ('&RES'='8411')*('&N11'>'0')++('&RES'='8414')*('&N14'>'0XEM008020
               ')                                                       EM008030
         B     E9$IDPL                                                  EM008040
         ENDO                                                           EM008050
         DO    '&RES'='1001'                                            EM008060
         OI    E9$RIOII+3,X'02'         SET CNTRL RDR TO 1001           EM008070
         ENDO                                                           EM008080
         DO    '&RES'='0716'                                            EM008090
         OI    E9$RIOII+3,X'01'         SET CONTROL RDR TO 0716         EM008100
         ENDO                                                           EM008110
         OI    E9$RIOII+3,X'08'         SET CNTRL RDR TO 0711           EM008120
         L     1,E9$RXDTF                                               EM008130
         BAL   10,E9$RIGET                                              EM008140
         DO    '&RES'='1001'                                            EM008150
         OI    E9$RIOII+3,X'40'    1004 INDICATOR FOR LOAD-IPL COMMAND  EM008160
         L     R1,E9$RXDTF         DTF INFORMATION FOR SAT IN IGET      EM008170
         LA    R2,80                                                    EM008180
         L     3,E9$RXBUF                                               EM008190
         OI    E9$RXS3,X'04'       SET TRANSLATE BIT                    EM008200
         OI    E9$RIOII+2,X'40'    SET BOOT MODE AGAIN                  EM008210
         BAL   10,E9$RIGET         GET SECOND CARD FOR BOOT             EM008220
         OI    E9$RIOII+2,X'40'    FOR RETURN                           EM008230
         L     R1,E9$RXDTF                                              EM008240
         LA    R2,E9$WBUFF                                              EM008250
         L     3,E9$RXBUF                                               EM008260
         BAL   10,E9$RIGET                                              EM008270
         ENDO                                                           EM008280
         NI    E9$RXS3,X'FB'            ERASE TRANSLATE BIT             EM008290
E9$RLDRG EQU   *                                                        EM008300
         MVI   E9$RSRG8,X'00'           SET UP CLEAR OF ZEROS           EM008310
         MVC   E9$RSRG8+1(31),E9$RSRG8  CLEAR AREA OF SAVE REG 8 - 15   EM008320
         LA    3,E9$RIR8                LD I/O 9300 REG 8 VALUE         EM008330
         L     2,E9$R8                  SET CONSTANT FOR COUNT          EM008340
         LA    4,E9$RSVRG                                               EM008350
E9$RILOD MVC   0(2,4),0(3)                                              EM008360
         LA    3,2(,3)                  INCR 9300 LOCATION REG          EM008370
         LA    4,4(,4)                  INCR 9-3 SAVE REG LOC           EM008380
         BCT   2,E9$RILOD               BR ON COUNT FOR INITILIZE LOD   EM008390
         LM    9,15,E9$RSRG9            LOAD 90/30 REG 9 THRU 15        EM008400
         DO    ('&RES'='0711')++('&RES'='0716')++('&RES'='1001')++('&REXEM008410
               S'='1004')                                               EM008420
         OI    E9$RASW3,X'01'           SET SWITCH FOR INITIALIZE       EM008430
         ENDO                                                           EM008440
         STXIT PC,E9$RPCIC,E9$RAPCS                                     EM008450
         STXIT OC,E9$ROPCM,E9$RAOCS,E9$ROPKA,20                         EM008460
         B     E9$RSTTL                                                 EM008470
E9$RXIPP EQU   *                                                        EM008480
         CLI   0(4),X'FF'               END OF TABLE?                   EM008490
         BNE   E9$ICK                                                   EM008500
         BR    7                        RETURN                          EM008510
E9$ICK   EQU   *                                                        EM008520
         TM    E9$RXS2,X'80'            OPEN CLOSE REQ?                 EM008530
         BZ    E9$RXIOA                                                 EM008540
         OI    E9$RXS2,X'40'                                            EM008550
E9$RXIOA EQU   *                                                        EM008560
         LA    4,36(,4)                 GET NEXT POINTER.               EM008570
         B     E9$RXIPP                                                 EM008580
         CNOP  0,4                                                      EM008590
E9$RADAD DC    A(E9$RADTB)                                              EM008600
E9$RLXTE DC    Y(36)                                                    EM008610
         CNOP  0,4                                                      EM008620
E9$RMSG6 DC    CL44'92/9300 EMULATOR - VERS. IS4.00.0 - 76/09/01'       EM008630
         CNOP  0,4                                                      EM008640
*********************************************************************** EM008650
********************* VERTICAL FORMAT BUFFER ************************** EM008660
*********************************************************************** EM008670
LOADB    EQU   *                                                        EM008680
         ST    7,E9$RTTUS                                               EM008690
         MVC   PRINTBCW+7(1),PRINTSZ                                    EM008700
         TM    E9$RIOII+3,X'10'         DO LOADCODE ?                   EM008710
         BNO   E9$BYLDC                                                 EM008720
         EXCP  LC93                     LOAD CODE BUFFER                EM008730
         WAIT  1                                                        EM008740
E9$BYLDC EQU   *                                                        EM008750
         OI    E9$RIOII+3,X'40'         SET BIT COMING FROM INIT        EM008760
         LA    0,E9$RPRB1+1             SET UP OVERLAY AREA             EM008770
         LA    15,E9$RPRB1+3            SET COVER                       EM008780
         LA    1,E9$ROVLN               SETUP OVERLAY NAME              EM008790
         LOADR (1),(0)                                                  EM008800
         BAL   7,E9$RPRB1+1                                             EM008810
         NI    E9$RIOII+3,X'BF'         ERASE BIT                       EM008820
         L     7,E9$RTTUS               SETUP RETURN                    EM008830
         BR    7                        RETURN                          EM008840
         CNOP  0,4                                                      EM008850
E9$RSTND DC    C'STANLP00'              STANDARD LOOP NAME              EM008860
E9$RTTUS DC    F'0'                     SAVE AREA                       EM008870
E9$ROVLN DC    C'E9$RCT00'              OVERLAY NAME                    EM008880
         CNOP  0,4                                                      EM008890
LC93     CCB   PIO93-14,BCW93L,,X'20'                                   EM008900
BCW93L   BCW   X'FB',BL93,,88           LOAD CODE                       EM008910
         CNOP  0,4                                                      EM008920
PIO93    DC    XL2'08C0'                                                EM008930
BL93     DC    X'8400'                                                  EM008940
         DC    C'ZYXWVUTS'                                              EM008950
         DC    C'RQPONMLK'                                              EM008960
         DC    C'JIHGFEDC'                                              EM008970
         DC    C'BA987654'                                              EM008980
         DC    C'3210-/)('                                              EM008990
         DC    C'$,+''*=&&.'                                            EM009000
         DC    XL8'0000000000000000'                                    EM009010
         DC    XL8'0000000000000000'                                    EM009020
         DC    XL8'0000000000000000'                                    EM009030
         CNOP  0,4                                                      EM009040
E9$IPLUN DC    Y(0)                                                     EM009050
         CNOP  0,4                                                      EM009060
READ171  PIOCB 20                                                       EM009070
PRNTR731 PIOCB 20                                                       EM009080
PUNCH051 PIOCB 20                                                       EM009090
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM009100
READ141  PIOCB 16                                                       EM009110
PRNTR141 PIOCB 16                                                       EM009120
PUNCH141 PIOCB 16                                                       EM009130
         ENDO                                                           EM009140
*********************************************************************** EM009150
         CNOP  0,4                                                      EM009160
RDEND    DC    XL4'6F5C6140'                                            EM009170
E9$PUBTP DC    XL4'00000000'                                            EM009180
         DO    '&RES'='8410'                                            EM009190
         EJECT                                                          EM009200
*********************************************************************** EM009210
*                                                                     * EM009220
*        8410 DISC IPL ROUTINE                                        * EM009230
*                                                                     * EM009240
*********************************************************************** EM009250
         SPACE 1                                                        EM009260
E9$KIPL  DS    0H                  ENTRY                                EM009270
         L     5,E9$AK10           LOAD 8410 ADDR                       EM009280
         USING E9$K10,5                                                 EM009290
         USING E9$K$,9                                                  EM009300
         MVI   E9$KIIPL,1          SET IPL INDICATOR                    EM009310
         MVC   E9$K49(4),E9$K55         SET INITIAL SEARCH LIMIT        EM009320
**       SEARCH IPL DEVICE                                              EM009330
         LA    9,E9$KT10           LD R9 W/DISC DVC TABLE               EM009340
E9$K183  CLI   E9$K$DVC,X'FF'      SENTINEL ?                           EM009350
         BNE   E9$K100             BR TO E9$K100 IF NO                  EM009360
         WTLD  E9$KIPMG,24                                              EM009370
         B     E9$REOJE            BR TO E9$REOJE                       EM009380
E9$KIPMG DC    CL24'NO 8410 SYSRES AVAILABLE'                           EM009390
E9$K100  TM    E9$K$FLG,X'41'      IPL DEVICE ?                         EM009400
         BO    E9$KLR              BR TO E9$KLR IF YES                  EM009410
         LA    9,E9$K$L(9)         GET NEXT ENTRY                       EM009420
         B     E9$K183             BR TO E9$K183                        EM009430
E9$KLR   BAL   7,E9$KDU            READ FILE HEADER                     EM009440
         CLC   E9$KTL+6(8),E9$KDFNM SYSFILE ID ?                        EM009450
         BE    E9$KL2              BR TO E9$KL2 IF YES                  EM009460
         CLC   E9$KTL+1(3),E9$K55  LAST FILE HEADER ?                   EM009470
         BNE   E9$KL9              BR TO E9$KL9 IF NO                   EM009480
         MVI   E9$KHPR+8,X'C5'          SET CANNOT LOCATE FILE          EM009490
         B     E9$KDISP            BR TO E9$KDISP                       EM009500
E9$KL9   BAL   7,E9$KIX            UPDATE DISC ADDR                     EM009510
         B     E9$KLR              BR TO E9$KLR                         EM009520
E9$KL2   MVC   E9$KDFAD(4),E9$KTL+1 SAVE FILE HEADER TTSS               EM009530
         MVC   E9$KTL+1(4),E9$KTL+57 SET DIR LOW TO TTSS                EM009540
E9$K56   BAL   7,E9$KDU            READ 1ST DIR RECORD                  EM009550
         LH    10,E9$KIPKT+2       LOAD IO AREA ADDR                    EM009560
E9$K91   CLC   5(5,10),E9$KER      END RECORD ENTRY ?                   EM009570
         BNE   E9$KLF              BR TO E9$KLF IF NO                   EM009580
         MVI   E9$KHPR+8,X'C6'          SET CANNOT LOCATE SUPR          EM009590
         B     E9$KDISP            BR TO E9$KDISP                       EM009600
E9$KLF   CLC   5(8,10),E9$KDPID    SUPR ID ?                            EM009610
         BE    E9$K58              BR TO E9$K58 IF YES                  EM009620
E9$K63   CH    10,E9$K57           LIMIT ?                              EM009630
         BE    E9$K59              BR TO E9$K59 IF YES                  EM009640
         LA    10,26(10)           INCR FOR NEXT ENTRY                  EM009650
         B     E9$K91              BR TO E9$K91                         EM009660
E9$K59   BAL   7,E9$KIX            UPDATE DISC ADDR                     EM009670
         B     E9$K56              BR TO E9$K56                         EM009680
E9$K58   MVC   E9$K49(4),27(10)    SAVE EXTENT LIMIT                    EM009690
         MVC   E9$K51+1(1),21(10)  SAVE U VALUE                         EM009700
         MVC   E9$K61(4),E9$KTL+1  SAVE TTSS                            EM009710
         MVC   E9$KTL+1(4),22(10)  SET PROG TTSS IN IO AREA             EM009720
         BAL   7,E9$KDU            READ 1ST REC OF SUPR                 EM009730
         CLC   E9$KTL+5(2),E9$KPR  IS PHASE 1ST 80 BYTES                EM009740
         BE    E9$K62              BR TO E9$K62 IF YES                  EM009750
         MVC   E9$KTL+5(80),E9$KTL+85 SHIFT PHASE UP                    EM009760
E9$K62   CLI   E9$KTL+10,6         LOADABLE ELEMENT ?                   EM009770
         BE    E9$K64              BR TO E9$K64 IF YES                  EM009780
         MVC   E9$KTL+1(4),E9$K61  RESET DIR TTSS                       EM009790
         B     E9$K63              BR TO E9$K63                         EM009800
E9$K64   LH    11,E9$KIPKT+2       LOAD IO BASE                         EM009810
         CLC   85(2,11),E9$KPR     2ND REC PHASE ?                      EM009820
         B     E9$K90              BR TO E9$K90                         EM009830
E9$K43   BAL   7,E9$KDU            READ NEXT SUPR REC                   EM009840
         B     E9$K44              BR TO E9$K44                         EM009850
E9$K42   LA    11,80(11)           POINT TO 2ND 80 BYTES                EM009860
E9$K44   CLC   5(2,11),E9$KTY      TEXT RECORD                          EM009870
         BNE   E9$K45              BR TO E9$K45 IF NO                   EM009880
         MVC   E9$KMT+1(1),7(11)   MOVE TEXT TO MEMORY                  EM009890
         MVC   E9$KADMV(2),9(11)                                        EM009900
         LH    1,E9$KADMV                                               EM009910
         CLC   9(2,11),E9$KNL                                           EM009920
         BE    E9$KMT+6                                                 EM009930
E9$KMT   MVC   0(1,1),15(11)                                            EM009940
         CH    11,E9$K41           SECTOR LIMIT ?                       EM009950
E9$K90   BNE   E9$K42              BR TO E9$K42 IF NO                   EM009960
         BAL   7,E9$KIX            UPDATE DISC ADDR                     EM009970
         LH    11,E9$KIPKT+2       LD R11 W/IO BASE                     EM009980
         B     E9$K43              BR TO E9$K43                         EM009990
E9$K45   CLC   5(2,11),E9$KTZ      TRANSFER RECORD ?                    EM010000
         BE    E9$K46              BR TO E9$K46 IY YES                  EM010010
         MVI   E9$KHPR+8,X'C2'          UNLOADABLE RECORD               EM010020
         MVI   E9$KHPR+7,X'C2'                                          EM010030
         B     E9$KDISP            BR TO E9$KDISP                       EM010040
E9$K46   XC    67(2),67            CLR DS & DA                          EM010050
         MVC   E9$RIPSC(4),294     SET I/O PSC                          EM010060
         OI    E9$RIOII+3,X'80'    SET 8410 IPL MODE                    EM010070
         MVC   E9$KWKHW(2),19(11)  SET TRF ADDR IN WORK AREA            EM010080
         LH    7,E9$KWKHW          SET TRF ADDR IN R7                   EM010090
         MVI   E9$KIIPL,0          RESET IPL INDICATOR                  EM010100
         NI    E9$RIOII+1,X'FB'    ERASE I/O MODE BIT                   EM010110
         B     E9$RLDRG            BR TO E9$RLDRG                       EM010120
E9$KDU   DS    0H                                                       EM010130
         ST    7,E9$KDUR           SAVE RETURN ADDR                     EM010140
         LA    15,E9$KIPKT         LD R15 W/PACKET ADDR                 EM010150
         STM   9,11,E9$KSV91       SAVE R9 - R11                        EM010160
         BALR  14,5                READ SIMULATION                      EM010170
         LM    9,11,E9$KSV91       RELOAD R9 - R11                      EM010180
         CLI   E9$KIPKT+6,X'FF'    COMPLETE ?                           EM010190
         BNE   E9$KIERR            BR TO E9$KIERR IF NO                 EM010200
         L     7,E9$KDUR           RELOAD RETURN ADDR                   EM010210
         BR    7                   RETURN                               EM010220
E9$KIX   DS    0H                                                       EM010230
         ST    7,E9$KIXR           SAVE RETURN ADDR                     EM010240
         PACK  E9$K50(3),E9$KTL+1(4) PACK TTSS                          EM010250
         MVN   E9$K50+2(1),E9$KCONE  MOVE PLUS SIGN                     EM010260
         AP    E9$K50(3),E9$KCONE(1) ADD 1                              EM010270
         UNPK  E9$KTL+1(4),E9$K50(3) UNPK TTSS                          EM010280
         NC    E9$KTL+1(4),E9$K48  ERASE ZONES                          EM010290
         CLC   E9$KTL+1(4),E9$K49  EXTENT END ?                         EM010300
         BNHR  7                   EXIT IF NO                           EM010310
         MVC   E9$KTL+1(4),E9$KDFAD RESTORE FILE HEADER TTSS            EM010320
         BAL   7,E9$KDU            REREAD FILE HEADER                   EM010330
         LH    11,E9$KIPKT+2       LD R11 W/IO BASE                     EM010340
         AH    11,E9$K51           ADD EXTENT INCR                      EM010350
         MVC   E9$K49(4),71(11)    MOVE NEW LIM                         EM010360
         MVC   E9$KTL+1(4),67(11)       MOVE NEW LIMIT                  EM010370
         AI    E9$K51,10           ADD TO EXTENT INCR                   EM010380
         L     7,E9$KIXR                                                EM010390
         BR    7                                                        EM010400
E9$KIERR DS    0H                                                       EM010410
E9$KDISP DS    0H                                                       EM010420
         WTLD  E9$KHPR,50                                               EM010430
         B     E9$REOJE                                                 EM010440
E9$KIPKT DS    0H                  REQUEST PACKET FOR 8410 IPL          EM010450
         DC    Y(165)              BYTE COUNT                           EM010460
         DC    Y(E9$KTL)           IO ADDR                              EM010470
         DC    X'0'                CHAIN INDICATOR                      EM010480
         DC    X'61'               FUNCTION (READ)                      EM010490
         DC    X'00'               STATUS INDICATOR                     EM010500
         DC    X'00'               LU #                                 EM010510
         DC    H'0'                CHAIN ADDR                           EM010520
E9$KTL   DC    XL5'4'              UTTSS                                EM010530
         DS    CL160               IO AREA                              EM010540
E9$KDUR  DS    F                   RETURN ADDR SAVE AREA                EM010550
E9$KIXR  DS    F                   RETURN ADDR SAVE AREA                EM010560
E9$KSV91 DS    3F                  SAVE AREA (R9 - R11)                 EM010570
E9$KDFNM DC    CL8'SYSFILE '       FILE ID                              EM010580
E9$KDPID DC    CL8'SUPR    '       NCOS ID                              EM010590
E9$KPR   DC    XL2'D131'           A CARD                               EM010600
E9$KTY   DC    XL2'D10A'           Q CARD                               EM010610
E9$KTZ   DC    XL2'D10C'           T CARD                               EM010620
E9$K41   DC    Y(E9$KTL+80)        HALF SECTOR LIMIT                    EM010630
E9$K57   DC    Y(E9$KTL+160)       SECTOR LIMIT                         EM010640
E9$KADMV DS    H                                                        EM010650
E9$KHPR  DC    CL50'HALT 1400 8410 IPL ERROR CHECK FILES PROGRAM CANCL' EM010660
E9$KNL   DC    XL2'10'             PSC LOAD TO BE SKIPPED               EM010670
E9$K55   DC    XL4'0504'           FILE LABELS LIMIT TTSS               EM010680
E9$K48   DC    XL4'0F0F0F0F'       ERASE MASK                           EM010690
E9$KER   DC    XL5'5500C5D5C4'     END REC FORMAT                       EM010700
E9$KCONE DC    P'1'                CONSTANT 1                           EM010710
E9$K61   EQU   X'20',4             TTSS WS                              EM010720
E9$K49   EQU   X'24',4             EXTENT ULIM                          EM010730
E9$KDFAD EQU   X'28',4             CURRENT TTSS                         EM010740
E9$K50   EQU   X'2C',3             DECIMAL WS                           EM010750
E9$KDSTA EQU   X'2F',1             STATUS                               EM010760
E9$KWKHW DS    H                   WORK AREA (BOUNDARY)                 EM010770
E9$K51   DC    H'0'                EXTENT INCR                          EM010780
         DROP  5                                                        EM010790
         DROP  9                                                        EM010800
         ENDO                                                           EM010810
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM010820
         DO    '&RES'='TAPE'                                            EM010830
*********************************************************************** EM010840
*        TAPE IPL ROUTINE STARTS AT THIS POINT                          EM010850
*********************************************************************** EM010860
         USING E9$RTAPH,5                                               EM010870
E9$TIPL  EQU   *                                                        EM010880
         L     5,E9$ATAPH                                               EM010890
         LA    4,TPADDRS                                                EM010900
E9$TAGIN EQU   *                                                        EM010910
         CLC   0(1,4),E9$IPLUN                                          EM010920
         BE    E9$SETUT                                                 EM010930
         LA    4,8(,4)                                                  EM010940
         CLI   0(4),X'FF'                                               EM010950
         BNE   E9$TAGIN                                                 EM010960
         B     E9$TDEFT                                                 EM010970
E9$SETUT EQU   *                                                        EM010980
         MVC   TPBOOT+2(2),6(4)                                         EM010990
E9$TDEFT EQU   *                                                        EM011000
         SR    2,2                      CLR R2                          EM011010
E9$TRD1  EQU   *                                                        EM011020
         BAL   7,E9$TIP1                GET BY FIRST & SECOND BLK       EM011030
         BAL   7,E9$TIP1                                                EM011040
E9$TIP2  EQU   *                                                        EM011050
         LH    3,BLKLTH                 RESET 261  READ TO              EM011060
         STH   3,IPLLGTH                READ 246                        EM011070
         B     TEXTSW                                                   EM011080
RDNEXTBK EQU   *                                                        EM011090
         BAL   7,E9$TIP1                GET ANOTHER BLOCK               EM011100
TEXTSW   EQU   *                                                        EM011110
         NOP   CHKPHASE                 FALL THRU ON FIRST READ         EM011120
         MVI   TEXTSW+1,X'F0'           MAKE TEXTSW GO TO CHK PHASE     EM011130
RESET14  EQU   *                                                        EM011140
         L     3,BUFRD                  LD BUFFER POINTER               EM011150
         B     RDNEXTBK                                                 EM011160
CHKPHASE EQU   *                                                        EM011170
         CLC   4(2,3),PHASEID           PHASE RECORD                    EM011180
         BNE   RDNEXTBK                                                 EM011190
CHKROUT  EQU   *                                                        EM011200
         CLC   20(4,3),SUPR             CHK FOR SUPR PHASE RECORD       EM011210
CMSGBR   EQU   *                                                        EM011220
         BNE   E9$CMSGS                 BR TO CANCEL MSG IF NOT         EM011230
         MVC   TEXTSW+2(2),CHTEXT                                       EM011240
ADVANCE  EQU   *                                                        EM011250
         CH    3,BUFRD1+2               EQUAL TO EOB                    EM011260
         BE    RESET14                                                  EM011270
         LA    3,80(,3)                 INCR R3 BY 80                   EM011280
CHKTEXT  EQU   *                                                        EM011290
         CLC   4(2,3),TEXTID            TEXT RECORD                     EM011300
         BNE   TRANSFER                 IF NOT MUST BE TRANSFER         EM011310
FIRSTTXT EQU   *                                                        EM011320
NEXTTEXT EQU   *                                                        EM011330
         SR    2,2                      CLR R2                          EM011340
         LH    2,8(3)                   GET TEXT LOAD ADDRESS           EM011350
         MVC   MOVETEXT+1(1),6(3)       SET BYTE FOR MVE SIZE           EM011360
MOVETEXT EQU   *                                                        EM011370
         MVC   0(1,2),14(3)             MVE TEXT TO LOAD ADDRESS        EM011380
         B     ADVANCE                                                  EM011390
TRANSFER EQU   *                                                        EM011400
         MVC   TEXTSW+2(2),CHPHASE                                      EM011410
SUPRLAST EQU   *                                                        EM011420
         NOP   JBCNLAST                                                 EM011430
         MVI   SUPRLAST+1,X'F0'                                         EM011440
         MVC   CHKROUT+4(2),JBCNA                                       EM011450
         MVC   CMSGBR+2(2),E9$JMSG                                      EM011460
         B     RESET14                                                  EM011470
JBCNLAST EQU   *                                                        EM011480
         SR    7,7                      CLR R7                          EM011490
         LH    7,18(3)                  LD R7 W/TRANSFER ADDRESS        EM011500
         OI    E9$RIOII+1,X'01'         SET OP REQ BIT                  EM011510
         NI    E9$RIOII+1,X'FB'         ERASE I/O BIT                   EM011520
         OI    E9$RIOII+3,X'80'         SET BIT FOR TRANS IPL START     EM011530
         MVC   E9$RIPSC(4),E9$IA                                        EM011540
         NI    E9$RIPSC,X'00'           CLR FIRST BYTE AND CC           EM011550
         TM    E9$RSUPV,X'F0'          CHK FOR OLD REV. NO. SYST.       EM011560
         BNO   E9$RLDRG                IF NOT OLD MUST BE NEW           EM011570
         CLI   E9$RSUPV,X'F8'          IF OLD NUMBER SYS IS IT <        EM011580
         BNL   E9$RLDRG                IF > THAN CONTINUE               EM011590
         STH   7,E9$RPFAP              STORE TRANSFER ADD TO PROC FAP   EM011600
         STH   7,E9$RIR15              SET UP R15                       EM011610
         LH    7,E9$RTRNA              LD OLD TRNS ADDR                 EM011620
         B     E9$RLDRG                                                 EM011630
E9$RSUPV EQU   278                     VERSION NO 9300 SUP              EM011640
E9$RTRNA EQU   322                     LOC OF OLD TRANS ADDR            EM011650
E9$TIP1  EQU   *                                                        EM011660
         MVC   IOTBCW+4(2),IPLLGTH      SET COUNT AND INFO              EM011670
         MVI   IOTBCW+7,X'01'           SET UP RD COUNT                 EM011680
         NI    IOTBCW+6,X'00'           CLR BYTE 6                      EM011690
         MVC   IOTBCW(4),BUFRD          SET UP BUFF AREA                EM011700
         MVI   IOTBCW,X'02'             SET RD FUNCT                    EM011710
         L     1,TPBOOT                 LD CORRESPONDING BOOT CCB       EM011720
BTISSUE  EQU   *                                                        EM011730
         EXCP  (1)                                                      EM011740
         TM    2(1),X'80'               TEST COMPLETION                 EM011750
         BNO   *-4                      BR BACK IF NOT                  EM011760
         TM    2(1),X'20'                UNIQUE SET FOR REISSUE         EM011770
         BO    BTISSUE                                                  EM011780
         BR    7                        GO TO REQUESTOR                 EM011790
*********************************************************************** EM011800
         CNOP  0,4                                                      EM011810
TEXTID   DC    XL2'D10A'                TEXT RECORD CONSTANT            EM011820
PHASEID  DC    XL2'D131'                PHASE RECORD CONSTANT           EM011830
CHTEXT   DC    S(CHKTEXT)                                               EM011840
BUFRD    DC    A(RDBUF)                 ADDRESS OF BUFFER               EM011850
LTHBLK   DC    A(BLKLTH)                ADDRESS OF BLK LGTH             EM011860
TPBOOT   DC    A(TP0)                   ADDRESS OF TAPE BOOT(TP0)       EM011870
SUPR     DC    XL4'E2E4D7D9'            SUPR                            EM011880
JBCN     DC    XL4'D1C2C3D5'            JBCN                            EM011890
CHPHASE  DC    S(CHKPHASE)                                              EM011900
BUFRD1   DC    A(RDBUF+160)             ADDRESS CONSTANT OF EOB         EM011910
JBCNA    DC    S(JBCN)                                                  EM011920
IPLLGTH  DC    Y(261)                   IPL SIZE                        EM011930
BLKLTH   DC    Y(246)                   SIZE OF BLK RD                  EM011940
E9$JMSG  DC    S(E9$CMSGJ)                                              EM011950
E9$CMSGS WTLD  CMSGS,40                 DISPLAY NO SUPR MSG.            EM011960
         B     E9$REOJE                 CANCEL                          EM011970
E9$CMSGJ WTLD  CMSGJ,40                 DISPLAY NO JBCN MSG             EM011980
         B     E9$REOJE                 CANCEL                          EM011990
         CNOP  0,4                                                      EM012000
CMSGS    DC    CL40'SUPR NOT FOUND AS FIRST ROUTINE ON TAPE '           EM012010
         CNOP  0,4                                                      EM012020
CMSGJ    DC    CL40'JBCN NOT FOUND AS SECOND ROUTINE ON TAPE'           EM012030
         CNOP  0,4                                                      EM012040
RDBUF    DC    XL256'0'                 TAPE READ BUFFER                EM012050
         DC    XL10'0'                                                  EM012060
E9$IA    EQU   294                                                      EM012070
         DROP  5                                                        EM012080
         ENDO                                                           EM012090
         ENDO                                                           EM012100
         DO    ('&RES'='8411')*('&N11'>'0')++('&RES'='8414')*('&N14'>'0XEM012110
               ')                                                       EM012120
E9$IA    EQU   294                                                      EM012130
         USING E9$D11,5                                                 EM012140
***                                                                     EM012150
*    8411/14 SUBSTITUTE IPL                                             EM012160
*                                                                       EM012170
***                                                                     EM012180
* REGISTERS 8   COVERS THIS IPL CODE. IT IS LOADED BY INITIALIZE        EM012190
* REG 5 COVERS DISC HANDLER. IPL LOADS 5 WITH HANDLER ACON, E9$AD11     EM012200
E9$IDPL  EQU   *                                                        EM012210
         L     5,E9$AD11    SET COVER FOR DISPATCHER                    EM012220
         OC    E9$MS1+34(1),E9$IPLUN   PUT SYSRES UNIT INTO MESSAGES    EM012230
         OC    E9$MS2+34(1),E9$IPLUN                                    EM012240
         OC    E9$MS3+34(1),E9$IPLUN                                    EM012250
         SR    RA,RA                                                    EM012260
         IC    RA,E9$IPLUN    PICK UP 8411/14 CCB    NUMBER             EM012270
         SLL   RA,3           MULTIPLY BY 8                             EM012280
E9$ID11  L     RCCB,E9$DTCCB(RA)   ADDR OF CCB FOR SYSRES               EM012290
         LA    RA,E9$DTCCB(RA)     ADDR OF POINTER TO CCB               EM012300
         TM    5(RA),X'80'    IS UNIT INITIALIZED                       EM012310
         BC    1,E9$ID12      NO, YES CONTINUE                          EM012320
         WTLD  E9$MS1,40      MESSAGE-UNIT NOT EMULATED                 EM012330
         EOJ                  CANCEL EMULATOR                           EM012340
E9$ID12  LA    RA,E9$IDAT                                               EM012350
         MVC   12(4,RCCB),E9$ID208   CCW ADDR TO CCB                    EM012360
         EXCP  1                        READ                            EM012370
E9$ID13  TM    2(1),X'80'                                               EM012380
         BNO   E9$ID13    LOOP UNTIL DONE                               EM012390
         CLC   0(4,RA),E9$ID192    IS VOL1                              EM012400
         BE    E9$ID14             NO,  YES CONTINUE                    EM012410
E9$ID15  WTLD  E9$MS2,40                                                EM012420
         EOJ                                                            EM012430
E9$ID14  MVC   E9$ID191(5),15(RA)  DISC ADDR OF FORMAT4 TO SEEK-SEARCH  EM012440
         MVI   E9$ID187+7,140                                           EM012450
         EXCP  1                        READ                            EM012460
         TM    2(1),X'80'                                               EM012470
         BNO   *-4           LOOP UNTIL DONE                            EM012480
         CLI    44(RA),X'F4'    IS FORMAT 4                             EM012490
         BNE   E9$ID15          YES, NO DISPLAY AND CANCEL              EM012500
         MVC   E9$ID193(4),107(RA)  SAVE LOW LIMIT OF VTOC  CCHH        EM012510
         MVC   E9$ID194(5),45(RA)   SAVE LAST ACTIVE FORMAT 1 CCHHR     EM012520
         MVC   E9$ID191(5),E9$ID193 LOW LIMIT TO READ NEXT              EM012530
         CLI   65(RA),10        IS 8411                                 EM012540
         BE    *+12                                                     EM012550
         MVI   E9$ID186,20      SET FOR 8414  HEADS PER CYL             EM012560
         MVI   E9$ID185,25                    RECS  PER HEAD            EM012570
E9$ID16  BAL   7,E9$ID160       UPDATE DISC READ CCHHR                  EM012580
         CLC   E9$ID191(4),E9$ID194 IS END OF VTOC                      EM012590
         BC    2,E9$ID15   NO, YES CANCEL                               EM012600
         EXCP  1               READ VTOC RECORD                         EM012610
         TM    2(1),X'80'                                               EM012620
         BNO   *-4             LOOP UNTIL DONE                          EM012630
         CLI   44(RA),X'F1'  IS FORMAT 1                                EM012640
         BNE   E9$ID16  YES, NO GET NEXT VTOC REC                       EM012650
         CLC   E9$ID195(8),0(RA)   IS SYSFILE                           EM012660
         BNE   E9$ID16  YES, NO GET NEXT VTOC REC                       EM012670
******  SYSFILE IS FOUND                                                EM012680
         MVC   E9$ID191(4),107(RA)   SYSFILE DIRECTORY ADDR TO READ     EM012690
         MVI   E9$ID191+4,0                                             EM012700
         MVI   E9$ID187+7,160        SET BLOCK SIZE FOR DIRECTORY       EM012710
E9$ID17  BAL   7,E9$ID160     UPDATE DISC ADDRESS                       EM012720
         LA    RA,E9$IDAT                                               EM012730
         EXCP  1              READ  DIRECTORY RECORD                    EM012740
         TM    2(1),X'80'                                               EM012750
         BNO   *-4            LOOP UNTIL DONE                           EM012760
E9$ID20  CLC   E9$ID196(5),0(RA)    IS END OF DIRECTORY                 EM012770
         BNE   E9$ID19                                                  EM012780
E9$ID18  WTLD  E9$MS3,40      SUPERVISOR NOT FOUND MESSAGE              EM012790
         EOJ                                                            EM012800
E9$ID19  CLC   E9$ID197(8),0(RA)    IS SUPERVISOR                       EM012810
         BE    E9$ID21        NO, YES FOUND                             EM012820
E9$ID19B CH    RA,E9$ID198          IS LAST ENTRY OF DIRECTORY BLOCK    EM012830
         BE    E9$ID17        NO, YES READ NEXT                         EM012840
         AH    RA,E9$ID199    STEP TO NEXT ENTRY                        EM012850
         B     E9$ID20        LOOP                                      EM012860
E9$ID21B MVC   E9$IDAT(80),E9$IDAT+80                                   EM012870
E9$ID21  MVC   E9$IDSAV(5),E9$ID191                                     EM012880
         ST    RA,E9$IDREG                                              EM012890
         MVC   E9$ID201,E9$IDAT    THE DIRECTORY ITEM IS SAVED          EM012900
         MVC   E9$ID191+1(4),17(RA)  SET TO READ SUPR MODULE            EM012910
         B     E9$ID23                                                  EM012920
E9$ID22  BAL   7,E9$ID160   UPDATE DISC ADDRESS                         EM012930
E9$ID23   LA         RA,E9$IDAT                                         EM012940
          EXCP      1    READ SUPR MODULE                               EM012950
         TM    2(1),X'80'                                               EM012960
         BNO   *-4          LOOP UNTIL DONE                             EM012970
         CLC   E9$ID202,0(RA)    IS PHASE RECORD                        EM012980
         BE    *+10         NO, YES                                     EM012990
         MVC   0(80,RA),80(RA)  SHIFT PHASE DOWN                        EM013000
         CLI   5(RA),6      IS SUPR LOADABLE                            EM013010
         BE    E9$ID24      NO, YES                                     EM013020
         MVC   E9$ID191(5),E9$IDSAV   RESTORE  DIRECTORY                EM013030
         L     RA,E9$IDREG                                              EM013040
         MVC   E9$IDAT(160),E9$ID201                                    EM013050
         B     E9$ID19B    CONTINUE READING THE DIRECTORY               EM013060
E9$ID24  LA    7,E9$R9MEM+X'50'            CLEAR 9300 MEMORY            EM013070
E9$ID25  MVI   0(7),X'0'                                                EM013080
         MVC   1(256,7),0(7)                                            EM013090
         CH    7,E9$ID209                                               EM013100
         BE    E9$ID26      BRANCH IF CLEARING DONE                     EM013110
         AH    7,E9$ID203                                               EM013120
         CH    7,E9$ID209                                               EM013130
         BC    12,E9$ID25       YES, NO                                 EM013140
         LA    7,E9$RLDRG-257                                           EM013150
         B     E9$ID25                                                  EM013160
E9$ID26  CLC   E9$ID202,E9$IDAT+80 IS 2ND OF BLOCK A PHASE RECORD       EM013170
         BE    E9$ID29     NO, YES GET NEXT BLOCK                       EM013180
E9$ID27  LA    RA,E9$IDAT+80                                            EM013190
         B     E9$ID291                 PROCESS SECOND TEXT             EM013200
E9$ID30  LH    7,4(0,RA)   GET LOAD ADDRESS                             EM013210
         MVC   E9$ID28+1(1),2(RA) SET NUMBER OF LOAD BYTES              EM013220
E9$ID28  MVC   0(1,7),10(RA)  LOAD IT                                   EM013230
         CH    RA,E9$ID204   WAS 1ST OF BLOCK                           EM013240
         BE    E9$ID27       NO, YES DO 2ND RECORD OF BLOCK             EM013250
E9$ID29  LA    RA,E9$IDAT                                               EM013260
         BAL   7,E9$ID160   UPDATE DISC ADDR                            EM013270
         EXCP  1            READ LOADABLE BLOCK                         EM013280
         TM    2(1),X'80'                                               EM013290
         BNO   *-4                                                      EM013300
E9$ID291 DS    0H                                                       EM013310
         CLC   E9$ID205,0(RA)   IS TEXT                                 EM013320
         BE    E9$ID30          NO, YES GO LOAD THE TEXT                EM013330
         MVC   12(4,RCCB),E9$ID207   ADDR OF E9$DPOOL TO CCB            EM013340
         MVC   E9$ID206+2(2),14(RA)                                     EM013350
         MVC   E9$R9MEM(4),E9$ID206                                     EM013360
         LH    7,E9$R9MEM+272           LOAD ADDR OF EOJ                EM013370
         LA    7,26(,7)                 INCR R7 BY 1A                   EM013380
         LH    7,0(7)                                                   EM013390
         MVC   1(1,7),E9$IPLUN  PLACE LU IN SUPERVISOR'S EOJ CODE       EM013400
         NI    1(7),X'0F'                                               EM013410
         OI    E9$RIOII+3,X'80' SET BIT TO START AT TRANS ADDR          EM013420
         NI    E9$RIOII+1,X'FB'   ERASE I/O BIT                         EM013430
         MVC   E9$RIPSC(4),E9$IA                                        EM013440
         NI    E9$RIPSC,X'00'                                           EM013450
         LH    7,E9$RSRCT                                               EM013460
         LH    7,42(,7)                                                 EM013470
         MVC   4(4,7),E9$ID210                                          EM013480
         LH    7,E9$ID206+2                                             EM013490
         B     E9$RLDRG           GO EMULATE IN PROC MODE TO BEGIN AT   EM013500
*****                        9300 SUPR EOJ ROUTINE WHICH LOADS JOB CTL  EM013510
****   ENTER THIS ROUTINE WITH A BAL 7,E9$ID160                         EM013520
E9$ID160 AI    E9$ID190+5,1  *ROUTINE TO UPDATE READ CCHHR*             EM013530
         CLC   E9$ID190+6(1),E9$ID185   IS REC NUMB > MAXIMUM           EM013540
         BCR   12,7          YES, NO EXIT                               EM013550
         MVI   E9$ID190+6,1   SET REC 1                                 EM013560
         MVC   E9$ID184+1(1),E9$ID190+5                                 EM013570
         AI    E9$ID184,1             ADD TO HEAD NUMB                  EM013580
         MVC   E9$ID190+5(1),E9$ID184+1                                 EM013590
         CLC   E9$ID184+1(1),E9$ID186 IS HEAD NUMB = MAXIMUM            EM013600
         BCR   7,7           YES, NO EXIT                               EM013610
         MVI   E9$ID190+5,0                                             EM013620
         MVC   E9$ID184+1(1),E9$ID190+3                                 EM013630
         AI    E9$ID184,1                                               EM013640
         MVC   E9$ID190+3(1),E9$ID184+1                                 EM013650
         BR    7                                                        EM013660
         CNOP  0,4                                                      EM013670
E9$MS1   DC    CL40'SYSRES DEVICE NOT EMULATED ? UNIT 0'                EM013680
         CNOP  0,4                                                      EM013690
E9$MS2   DC    CL40'SYSFILE NOT FOUND ON 8411/14 UNIT 0'                EM013700
         CNOP  0,4                                                      EM013710
E9$MS3   DC    CL40'SUPERVISOR NOT FOUND 8411/14 UNIT 0'                EM013720
E9$ID188 CCW   X'7',E9$ID190,X'60',6   (OP,DATA-ADDR,FLAG,COUNT) SEEK   EM013730
E9$ID189 CCW   X'31',E9$ID191,X'60',5   SEARCH                          EM013740
         CCW   X'8',E9$ID189,X'60'      TIC                             EM013750
E9$ID187 CCW   X'0E',E9$IDAT,X'20',84   READ KEY DATA                   EM013760
E9$ID184 DC    H'0'    WORK AREA                                        EM013770
         DC    X'0'                                                     EM013780
E9$ID186 DC    HL1'10'   HEADS PER CYLINDER 8411                        EM013790
E9$ID185 DC    HL1'16'   RECORDS PER TRACK 8411                         EM013800
E9$ID190 DC    XL7'3'   CYL 0  HEAD 0   FORM 000000 CC00 HHRR           EM013810
E9$ID191 EQU   E9$ID190+2       CYL0,HEAD0,REC3 FORM CCC CHHHHRR        EM013820
E9$IDAT  DC    XL255'0'   DISC READ AREA                                EM013830
E9$IDSAV DC    XL5'0'  SAVE AREA FOR DISC ADDR FROM E9$ID191            EM013840
E9$IDREG DC    F'0'    SAVE AREA FOR RA                                 EM013850
E9$ID192 DC    C'VOL1'                                                  EM013860
E9$ID193 DC    XL5'0'   SAVE AREA  CCHH0 LOW LIMIT OF VTOC              EM013870
E9$ID194 DC    XL5'0'   SAVE AREA  CCHHR LAST ACTIVE FORM 1 LOCATION    EM013880
E9$ID195 DC    CL8'SYSFILE'                                             EM013890
E9$ID196 DC    X'5500C5D5C4'                                            EM013900
E9$ID197 DC    CL8'SUPR'                                                EM013910
E9$ID198 DC    Y(E9$IDAT+130)                                           EM013920
E9$ID199 DC    H'26'                                                    EM013930
E9$ID200 DC    X'FFFF'                                                  EM013940
E9$ID201 DC    XL160'0'   DIRECTORY BLOCK STORAGE                       EM013950
E9$ID202 DC    X'D131'    PHASE ID                                      EM013960
E9$ID203 DC    Y(256)                                                   EM013970
E9$ID204 DC    Y(E9$IDAT)                                               EM013980
E9$ID205 DC    X'D10A'                                                  EM013990
E9$ID210 DC    XL4'A12A0000'            DUMMY SRC FOR DISC              EM014000
E9$ID209 DC    Y(E9$RLDRG-257)                                          EM014010
E9$ID207 DC    A(E9$DPOOL)                                              EM014020
E9$ID208 DC    A(E9$ID188)                                              EM014030
E9$ID206 DC    2H'0'                                                    EM014040
         ENDO                                                           EM014050
         ORG   E9$RADTB                                                 EM014060
         EJECT                                                          EM014070
*********************************************************************** EM014080
         TITLE 'ADDRESS TABLE'                                          EM014090
*              SIMULATOR ADDRESS TABLE AND INDICATOR INFORMATION        EM014100
*********************************************************************** EM014110
         E9$RAD                                                         EM014120
*********************************************************************** EM014130
*        TO ERASE ASSEMBLER ERROR FLAGS                               * EM014140
*********************************************************************** EM014150
         SPACE 1                                                        EM014160
         DO    1-('&N10'>'0')                                           EM014170
E9$KMNT  EQU   0                                                        EM014180
E9$KCLS  EQU   0                                                        EM014190
         ENDO                                                           EM014200
         DO    1-(('&RES'='1004')++('&RES'='1001'))                     EM014210
E9$YRIPL EQU   0                                                        EM014220
         ENDO                                                           EM014230
         DO    1-('&CR1001'>'0')                                        EM014240
E9$W     EQU   0                                                        EM014250
         ENDO                                                           EM014260
         SPACE 3                                                        EM014270
         EJECT                                                          EM014280
         CNOP  0,4                                                      EM014290
*********************************************************************** EM014300
*        ADDRESS TABLE DEFAULT ASSUMPTIONS                              EM014310
*  *  *     DEVISE TYPE * * * * * * * * * * * * * * ADDRESS/CHNL NO     EM014320
*********************************************************************** EM014330
*********************************************************************** EM014340
* VIC 1ST CONTROL UNIT                                 8                EM014350
* VIC 2ND CONTROL UNIT                                 9                EM014360
* 8410 DISC UNIT                                       5                EM014370
* 8411                                                 X'30'            EM014380
* 8414                                                 X'38'            EM014390
* U12                                                  X'70'            EM014400
* 604 ROW PUNCH                                        6                EM014410
* 1001 CARD CONTROLLER                                 7                EM014420
* 2703 ODR                                             15               EM014430
* PAPER TAPE                                           12               EM014440
* DRUM PRINTER 0768                                    11               EM014450
* 1004                                                 10               EM014460
* 0716 1000 CPM RDR                                    12               EM014470
*                                                                       EM014480
*********************************************************************** EM014490
*                                                                     * EM014500
*              ADDRESS TABLE  BYTE (BIT) BREAKDOWN                    * EM014510
*                                                                     * EM014520
*********************************************************************** EM014530
*                                                                     * EM014540
*********************************************************************** EM014550
*    TAG NAME ** BYTE NO. ******   EXPLANATION  *******               * EM014560
*                                                                     * EM014570
*********************************************************************** EM014580
*    E9$RXDA   BYTE 0      CHNL NUMBER OF DEVISE FOR XIO/TIO MATCH    * EM014590
*    E9$RXSRC  BYTE 1      SRC VALUE (FF) IF NOT VALID                * EM014600
*    E9$RXMSZ  BYTE 2      SIZE OF MAXIMUM MOVE (BCW COUNT) IF IMAGE  * EM014610
*                          MODE MOVE IS (2X(BCW))                     * EM014620
*    E9$RXBCW  BYTE 3      BCW ADDRESS (IF RD/PCH) BCW IS -4          * EM014630
*    E9$RXENT  BYTE 4-7    BCW ADDRESS 9300 (USED BY TRANSIENT TV$E9U * EM014640
*                          CALL NO 55 DECIMAL. SRC VALUE ADDRESS IF   * EM014650
*                          PERFORMED BY 90/30 INTERCEPT               * EM014660
*    E9$RXDTF  BYTE 8-11   FILE TABLE ADDRESS (DTF EQUIVALENT)        * EM014670
*    E9$RXBUF  BYTE 12-15  BUFFER ADDRESS FOR DEVISE                  * EM014680
*    E9$RXRBF  BYTE 16-19  BUFFER ADDRESS FOR READ BUFFER IF RD/PCH   * EM014690
*    E9$RXFN1  BYTE 20     92/93 FUNC RD(X'02')RDR, RD(X'02')PUNCH    * EM014700
*    E9$RXFN2  BYTE 21     92/93 FUNC READ IMAGE(X'06') NO TRANS      * EM014710
*    E9$RXFN3  BYTE 22     92/93 FUNC PUNCH/PRINT & SPACE (X'01')     * EM014720
*    E9$RXFN4  BYTE 23     92/93 FUNC PCH IMAGE(X'05')/SPACE(X'03')   * EM014730
*    E9$RXFN5  BYTE 24     92/93 FUNC PUNCH & READ (X'03')            * EM014740
*    E9$RXFN6  BYTE 25     92/93 FUNC PCH & READ IMAGE (X'07') NO TR  * EM014750
*    E9$RXS1   BYTE 26   *    *    *    *    *    *    *    *    *    * EM014760
*        BIT 0   0= GET / 1= PUT                                      * EM014770
*        BIT 1   1= STACKER SEL PUNCH                                 * EM014780
*        BIT 2   1= FORMS RUNAWAY SWITCH IF SET                       * EM014790
*        BIT 3   1= INTERRUPT/STATUS PENDING FOR THIS DEVISE          * EM014800
*        BIT 4   1= INTERRUPT PERMITTED FOR THIS DEVISE               * EM014810
*        BIT 5   1= EOF CARDS ENCOUNTERED (NOT USED YET)              * EM014820
*        BIT 6   1= PRINTER OVERFLOW SET FOR DEVISE (IF PRINTER)      * EM014830
*        BIT 7   NOT USED                                             * EM014840
*    E9$RXS2   BYTE 27   *    *    *    *    *    *    *    *    *    * EM014850
*        BIT 0   1= OPEN CLOSE REQUIRED                               * EM014860
*        BIT 1   1= OPEN  0= CLOSED                                   * EM014870
*        BIT 2   1= NO DOUBLE BUFFERING                               * EM014880
*        BIT 3   1= SRC COMPLETED BY 92/9300  0= SRC COMPL BY 90/30   * EM014890
*        BIT 4   1= GETCS / 0= CARD I/O ROUTINE                       * EM014900
*        BIT 5   1= CLEAR WITH X'40' 0= CLEAR WITH X'00'              * EM014910
*        BIT 6   1= 48 CHARACTER REQ  0= 63 CHARACTER REQ             * EM014920
*        BIT 7   NOT USED                                             * EM014930
*    E9$RXS3   BYTE 28   *    *    *    *    *    *    *    *    *    * EM014940
*        BIT 0   NOT USED                                             * EM014950
*        BIT 1   1= READ REQUEST ON PUNCH ISSUED                      * EM014960
*        BIT 2   1= BAR PRINTER 9300 THIS DEVISE                      * EM014970
*        BIT 3   1= INTERNAL 0711 READER  THIS DEVISE                 * EM014980
*        BIT 4   1= INTERNAL 0603 PUNCH THIS DEVISE                   * EM014990
*        BIT 5   1= TRANSLATE REQUIRED                                * EM015000
*        BIT 6   1= RD/PUNCH UNIT THIS DEVISE                         * EM015010
*        BIT 7   1= PUT/GET RD/PCH                                    * EM015020
*    E9$RXFC   BYTE 29     ONE BYTE FUNCTION CODE (MATCHED CODE)      * EM015030
*    E9$RXGSZ  BYTE 30     CURRENT GET SIZE OF COUNT                  * EM015040
*    E9$RXPSZ  BYTE 31     CURRENT PUT SIZE OF COUNT                  * EM015050
*    E9$RXWCB  BYTE 32-35  BUFFER CONTROL WORD 90/30 BCW-CCB          * EM015060
*********************************************************************** EM015070
*********************************************************************** EM015080
*        LOGICAL UNIT TABLE SETUP FOR INTERNAL DEVISES                  EM015090
*        LOG UNIT TABLE INFO FOR READER                                 EM015100
*********************************************************************** EM015110
E9$RLUT  EQU   *                                                        EM015120
         DC    XL1'01'                  DEVISE ADDRESS NUMBER FOR RDR   EM015130
         DC    XL1'02'                  SRC VALUE                       EM015140
         DC    XL1'50'                  MAXSIZE READER                  EM015150
         DC    XL1'44'                  BCW LOCATION                    EM015160
         DC    XL4'00'                  SRC IF INTERCEPTED/STOR IF NOT  EM015170
         DC    A(E9$R071)               INLINE DTF ENTRANCE             EM015180
         DC    A(E9$R01B1)              ADDRESS OF READ BUFF            EM015190
         DC    XL4'0'                  DUMMY BUFF POSITION              EM015200
         DC    XL1'02'                  FN1                             EM015210
         DC    XL1'06'                  FN2                             EM015220
         DC    XL1'00'                  FN3                             EM015230
         DC    XL1'00'                  FN4                             EM015240
         DC    XL1'00'                  FN5                             EM015250
         DC    XL1'00'                  FN6                             EM015260
         DC    XL1'00'                  BYTE 22 XS1                     EM015270
RDB      DC    XL1'B0'                 BYTE 23 XS2                      EM015280
         DC    XL1'10'                  BYTE 24 XS3                     EM015290
         DC    XL1'00'                  XFC AREA                        EM015300
         DC    XL1'00'                  GSZ                             EM015310
         DC    XL1'00'                  PSZ                             EM015320
         DC    A(READBCW)               READ BUFFER CNTRL WD ADDR       EM015330
*********************************************************************** EM015340
*        LOG UNIT TABLE INFO FOR THE PUNCH                              EM015350
*********************************************************************** EM015360
         DC    XL1'02'                  DEVISE ADDRESS NO FOR PUNCH     EM015370
         DC    XL1'04'                  SRC VALUE                       EM015380
         DC    XL1'50'                  MAXSIZE PUNCH                   EM015390
         DC    XL1'4C'                  BCW LOCATION                    EM015400
         DC    XL4'00'                  SRC IF INTERCEPTED/STOR IF NOT  EM015410
         DC    A(E9$RSER)               INLINE DTF ENTRANCE             EM015420
         DC    A(E9$RP0B1)              ADDRESS OF PUNCH BUFFER         EM015430
         DC    A(E9$RRPB1)             RD/PCH READ BUFF                 EM015440
         DC    XL1'02'                  FN1                             EM015450
         DC    XL1'00'                  FN2                             EM015460
         DC    XL1'01'                  FN3                             EM015470
         DC    XL1'05'                  FN4                             EM015480
         DC    XL1'03'                  FN5                             EM015490
         DC    XL1'07'                  FN6                             EM015500
         DC    XL1'80'                  BYTE 22 XS1                     EM015510
PCB      DC    XL1'B0'                 BYTE 23 XS2                      EM015520
         DC    XL1'08'                  BYTE 24 XS3                     EM015530
         DC    XL1'00'                  XFC AREA                        EM015540
         DC    XL1'00'                  GSZ                             EM015550
         DC    XL1'00'                  PSZ                             EM015560
         DC    A(PUNCHBCW)              PUNCH BUFFER CNTRL WD ADDR      EM015570
*********************************************************************** EM015580
*        LOG UNIT TABLE INFO FOR THE PRINTER                            EM015590
*********************************************************************** EM015600
         DC    XL1'03'                  DEVISE ADDRESS NO FOR PRINTER   EM015610
         DC    XL1'06'                  SRC VALUE                       EM015620
         DC    XL1'90'                  MAXSIZE PRINTER                 EM015630
         DC    XL1'50'                  BCW LOCATION                    EM015640
         DC    XL4'00'                  SRC ADD IF INTERCEPTED/STOR     EM015650
         DC    A(E9$RBAR)               INLINE DTF ENTRANCE             EM015660
         DC    A(E9$RPRB1)              ADDRESS OF PRINT BUFFER         EM015670
         DC    XL4'0'                  DUMMY BUFF POSITION              EM015680
         DC    XL1'00'                  FN1                             EM015690
         DC    XL1'00'                  FN2                             EM015700
         DC    XL1'01'                  FN3                             EM015710
         DC    XL1'03'                  FN4                             EM015720
         DC    XL1'00'                  FN5                             EM015730
         DC    XL1'00'                  FN6                             EM015740
         DC    XL1'80'                  BYTE 22 XS1                     EM015750
PRB      DC    XL1'B0'                 BYTE 23 XS2                      EM015760
         DC    XL1'20'                  BYTE 24 XS3                     EM015770
         DC    XL1'00'                  XFC AREA                        EM015780
         DC    XL1'00'                  GSZ                             EM015790
*        THIS ENTRY PUT SIZE WILL BE DETERMINED BY THE PROC PAREMETERS  EM015800
PRINTSZ  EQU   *                                                        EM015810
         DO    ('&PRT93'='')++('&PRT93'='132')                          EM015820
         DC    XL1'84'                                                  EM015830
         ENDO                                                           EM015840
         DO    '&PRT93'='120'                                           EM015850
         DC    XL1'78'                                                  EM015860
         ENDO                                                           EM015870
         DO    '&PRT93'='096'                                           EM015880
         DC    XL1'60'                                                  EM015890
         ENDO                                                           EM015900
         DC    A(PRINTBCW)              PRINT BUFFER CNTRL WD ADDR      EM015910
*********************************************************************** EM015920
         DO    '&PUNCH5'='ROW'                                          EM015930
         DO    '&CHNL604'>'0'                                           EM015940
&L$C3    SET   '&CHNL604'                                               EM015950
         ENDO                                                           EM015960
         DO    '&CHNL604'=''                                            EM015970
&L$C3    SET   6                                                        EM015980
         ENDO                                                           EM015990
**********************************************************************  EM016000
*        LOG UNIT TABLE INFO FOR THE ROW PUNCH                          EM016010
*********************************************************************** EM016020
         DC    YL1(&L$C3)                                               EM016030
         DC    YL1(&L$C3+&L$C3)                                         EM016040
         DC    XL1'50'                  MAXSIZE PUNCH                   EM016050
         DC    YL1(&L$C3+&L$C3+&L$C3+&L$C3+&L$C4)                       EM016060
         DC    XL4'00'                  SRC ADDR IF INTERCEPT/STOR      EM016070
         DC    A(E9$PCCB)                                               EM016080
         DC    XL4'00'                                                  EM016090
         DC    XL4'00'                                                  EM016100
         DC    XL1'00'                  FN1                             EM016110
         DC    XL1'00'                  FN2                             EM016120
         DC    XL1'00'                  FN3                             EM016130
         DC    XL1'00'                  FN4                             EM016140
         DC    XL1'00'                  FN5                             EM016150
         DC    XL1'00'                  FN6                             EM016160
         DC    XL1'88'                                                  EM016170
         DC    XL1'B0'                  BYTE 23 XS2                     EM016180
         DC    XL1'00'                  XS3                             EM016190
         DC    XL1'00'                  XFC                             EM016200
         DC    XL1'00'                  GSZ                             EM016210
         DC    XL1'00'                  PSZ                             EM016220
         DC    A(E9$PBCW)                                               EM016230
**********************************************************************  EM016240
         ENDO                                                           EM016250
         DO    '&PRTDRUM'>'0'                                           EM016260
         DO    '&CHNL768'>'0'                                           EM016270
&L$C2    SET   '&CHNL768'                                               EM016280
         ENDO                                                           EM016290
         DO    '&CHNL768'=''                                            EM016300
&L$C2    SET   11                                                       EM016310
         ENDO                                                           EM016320
*********************************************************************** EM016330
*        LOG UNIT TABLE INFO FOR THE DRUM PRINTER                     * EM016340
*********************************************************************** EM016350
         DC    YL1(&L$C2)                                               EM016360
         DC    YL1(&L$C2+&L$C2)                                         EM016370
         DC    XL1'90'                  MAXSIZE PRINT POSITIONS         EM016380
         DC    YL1(&L$C2+&L$C2+&L$C2+&L$C2+&L$C4)                       EM016390
         DC    XL4'00'                  SRC ADD IF INTERCEPT/OR STOR    EM016400
         DC    A(DRUMPCCB)                                              EM016410
         DC    A(DRUMBUF1)                                              EM016420
         DC    XL4'00'                  DUMMY BUFF POSITION             EM016430
         DC    XL1'00'                  FN1                             EM016440
         DC    XL1'00'                  FN2                             EM016450
         DC    XL1'00'                  FN3                             EM016460
         DC    XL1'00'                  FN4                             EM016470
         DC    XL1'00'                  FN5                             EM016480
         DC    XL1'00'                  FN6                             EM016490
         DC    XL1'88'                                                  EM016500
         DC    XL1'B4'                  BYTE 23 XS2                     EM016510
         DC    XL1'00'                  BYTE 24 XS3                     EM016520
         DC    XL1'00'                  XFC AREA                        EM016530
         DC    XL1'00'                  GSZ                             EM016540
         DC    XL1'90'                  SIZE OF PRINTER                 EM016550
         DC    A(DRUMPBCW)              DRUM PRINTER BCW ADDR           EM016560
**********************************************************************  EM016570
         ENDO                                                           EM016580
         DO    '&CR0716'>'0'                                            EM016590
         DO    '&CHNL716'>'0'                                           EM016600
&L$C1    SET   '&CHNL716'                                               EM016610
         ENDO                                                           EM016620
         DO    '&CHNL716'=''                                            EM016630
&L$C1    SET   12                                                       EM016640
         ENDO                                                           EM016650
*********************************************************************** EM016660
*        LOG UNIT TABLE INFO FOR THE 0716 READER                        EM016670
*********************************************************************** EM016680
         DC    YL1(&L$C1)                                               EM016690
         DC    YL1(&L$C1+&L$C1)                                         EM016700
         DC    XL1'50'                  MAXSIZE READ                    EM016710
         DC    YL1(&L$C1+&L$C1+&L$C1+&L$C1+&L$C4)                       EM016720
         DC    XL4'00'                  SRC ADD IF INTERCEPT            EM016730
         DC    A(RDCCB716)                                              EM016740
         DC    XL4'00'                                                  EM016750
         DC    XL4'00'                                                  EM016760
         DC    XL1'00'                  FN1                             EM016770
         DC    XL1'00'                  FN2                             EM016780
         DC    XL1'00'                  FN3                             EM016790
         DC    XL1'00'                  FN4                             EM016800
         DC    XL1'00'                  FN5                             EM016810
         DC    XL1'00'                  FN6                             EM016820
         DC    XL1'08'                  XS1                             EM016830
         DC    XL1'B0'                  XS2                             EM016840
         DC    XL1'00'                  XS3                             EM016850
         DC    XL1'00'                  XFC                             EM016860
         DC    XL1'00'                  GSZ                             EM016870
         DC    XL1'00'                  PSZ                             EM016880
         DC    A(RDBCW716)                                              EM016890
**********************************************************************  EM016900
         ENDO                                                           EM016910
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM016920
*********************************************************************** EM016930
*        LOG UNIT TABLE INFO FOR 1004                                 * EM016940
*********************************************************************** EM016950
E9$YLUT  DC    AL1(&L$C04)                                              EM016960
         DC    AL1(&L$C04+&L$C04)                                       EM016970
         DC    AL1(132)                                                 EM016980
         DC    AL1(&L$C04*4+64)                                         EM016990
         DC    XL4'0'              SRC ADD IF INTERCEPT                 EM017000
         DC    A(0)                                                     EM017010
         DC    XL4'0'                                                   EM017020
         DC    XL4'0'                                                   EM017030
         DC    XL1'0'              FN1                                  EM017040
         DC    XL1'0'              FN2                                  EM017050
         DC    XL1'0'              FN3                                  EM017060
         DC    XL1'0'              FN4                                  EM017070
         DC    XL1'0'              FN5                                  EM017080
         DC    XL1'0'              FN6                                  EM017090
         DC    XL1'80'             XS1                                  EM017100
         DC    XL1'B4'             XS2                                  EM017110
         DC    XL1'00'             XS3                                  EM017120
         DC    XL1'00'             XFC                                  EM017130
         DC    XL1'00'             GSZ                                  EM017140
         DC    XL1'00'             PSZ                                  EM017150
         DC    A(0)                                                     EM017160
         ENDO                                                           EM017170
         DO    '&CR1001'>'0'                                            EM017180
         DO    '&CHNL101'>'0'                                           EM017190
&L$CC1   SET   '&CHNL101'                                               EM017200
         ENDO                                                           EM017210
         DO    '&CHNL101'=''                                            EM017220
&L$CC1   SET   7                                                        EM017230
         ENDO                                                           EM017240
*********************************************************************** EM017250
*        LOG UNIT TABLE INFO FOR 1001 CC                              * EM017260
*********************************************************************** EM017270
         DC    AL1(&L$CC1)                                              EM017280
         DC    AL1(&L$CC1+&L$CC1)                                       EM017290
         DC    AL1(80)                                                  EM017300
         DC    AL1(&L$CC1*4+64)                                         EM017310
         DC    XL4'0'                                                   EM017320
         DC    A(0)                                                     EM017330
         DC    XL4'0'                                                   EM017340
         DC    XL4'0'                                                   EM017350
         DC    XL1'0'                   FN1                             EM017360
         DC    XL1'0'                   FN2                             EM017370
         DC    XL1'0'                   FN3                             EM017380
         DC    XL1'0'                   FN4                             EM017390
         DC    XL1'0'                   FN5                             EM017400
         DC    XL1'0'                   FN6                             EM017410
         DC    XL1'0'                   XS1                             EM017420
         DC    XL1'B0'                  XS2                             EM017430
         DC    XL1'0'                   XS3                             EM017440
         DC    XL1'0'                   XFC                             EM017450
         DC    XL1'0'                   GSZ                             EM017460
         DC    XL1'0'                   PSZ                             EM017470
         DC    A(0)                                                     EM017480
*********************************************************************** EM017490
         ENDO                                                           EM017500
         DO    '&ODR'>'0'                                               EM017510
         DO    '&CHNLODR'>'0'                                           EM017520
&L$OD1   SET   '&CHNLODR'                                               EM017530
         ENDO                                                           EM017540
         DO    '&CHNLODR'=''                                            EM017550
&L$OD1   SET   13                                                       EM017560
         ENDO                                                           EM017570
*********************************************************************** EM017580
*                                                                     * EM017590
*        LOG UNIT TABLE INFO FOR 2703 ODR                             * EM017600
*********************************************************************** EM017610
         DC    AL1(&L$OD1)                                              EM017620
         DC    AL1(&L$OD1+&L$OD1)                                       EM017630
         DC    AL1(0)                                                   EM017640
         DC    AL1(&L$OD1*4+64)                                         EM017650
         DC    XL4'0'                                                   EM017660
         DC    A(0)                                                     EM017670
         DC    XL4'00'                                                  EM017680
         DC    XL4'00'                                                  EM017690
         DC    XL1'00'                  FN1                             EM017700
         DC    XL1'00'                  FN2                             EM017710
         DC    XL1'00'                  FN3                             EM017720
         DC    XL1'00'                  FN4                             EM017730
         DC    XL1'00'                  FN5                             EM017740
         DC    XL1'00'                  FN6                             EM017750
         DC    XL1'00'                  XS1                             EM017760
         DC    XL1'00'                  XS2                             EM017770
         DC    XL1'00'                  XS3                             EM017780
         DC    XL1'00'                  XFC                             EM017790
         DC    XL1'00'                  GSZ                             EM017800
         DC    XL1'00'                  PSZ                             EM017810
         DC    A(0)                                                     EM017820
*********************************************************************** EM017830
         ENDO                                                           EM017840
         DO    '&PTAPE'>'0'                                             EM017850
         DO    '&CHNLPPT'>'0'                                           EM017860
&L$PT1   SET   '&CHNLPPT'                                               EM017870
         ENDO                                                           EM017880
         DO    '&CHNLPPT'=''                                            EM017890
&L$PT1   SET   12                                                       EM017900
         ENDO                                                           EM017910
*********************************************************************** EM017920
*                                                                     * EM017930
*        LOG UNIT TABLE INFO FOR 0920 PPT                             * EM017940
*                                                                     * EM017950
*********************************************************************** EM017960
         DC    AL1(&L$PT1)                                              EM017970
         DC    AL1(&L$PT1+&L$PT1)                                       EM017980
         DC    AL1(0)                                                   EM017990
         DC    AL1(&L$PT1*4+64)                                         EM018000
         DC    XL4'0'                                                   EM018010
         DC    A(0)                                                     EM018020
         DC    XL4'00'                                                  EM018030
         DC    XL4'00'                                                  EM018040
         DC    XL1'00'                  FN1                             EM018050
         DC    XL1'00'                  FN2                             EM018060
         DC    XL1'00'                  FN3                             EM018070
         DC    XL1'00'                  FN4                             EM018080
         DC    XL1'00'                  FN5                             EM018090
         DC    XL1'00'                  FN6                             EM018100
         DC    XL1'00'                  XS1                             EM018110
         DC    XL1'00'                  XS2                             EM018120
         DC    XL1'00'                  XS3                             EM018130
         DC    XL1'00'                  XFC                             EM018140
         DC    XL1'00'                  GSZ                             EM018150
         DC    XL1'00'                  PSZ                             EM018160
         DC    A(0)                                                     EM018170
*********************************************************************** EM018180
         ENDO                                                           EM018190
*                                                                       EM018200
*********************************************************************** EM018210
*        FALSE ENTRY IN TABLE                                         * EM018220
*********************************************************************** EM018230
         DC    30XL1'FF'                FALSE ENTRY                     EM018240
*********************************************************************** EM018250
         TITLE '92/9300 - 90/30 CROSSREFERENCE'                         EM018260
*********************************************************************** EM018270
*              TAPE ADDRESS TABLE 90/30 CROSS REFERENCE               * EM018280
*********************************************************************** EM018290
         CNOP  0,4                                                      EM018300
TPADDRS  EQU   *                                                        EM018310
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM018320
&L$13    SET   0                                                        EM018330
         DO    &L$13<&L$10                                              EM018340
         DC    X'00'                    PHYSICAL ZERO CALL              EM018350
         DC    XL3'00'                                                  EM018360
         DC    A(TP0)                   ADDRESS OF 90/30 PHYSICAL       EM018370
*********************************************************************** EM018380
&L$13    SET   &L$13+1                                                  EM018390
         GOTO  .T0                                                      EM018400
         ENDO                                                           EM018410
.T0      LABEL                                                          EM018420
         DO    &L$13<&L$10                                              EM018430
         DC    X'01'                    PHYSICAL UNIT ONE               EM018440
         DC    XL3'00'                                                  EM018450
         DC    A(TP1)                   ADDRESS OF 90/30 PHYSICAL       EM018460
*********************************************************************** EM018470
&L$13    SET   &L$13+1                                                  EM018480
         GOTO  .T1                                                      EM018490
         ENDO                                                           EM018500
.T1      LABEL                                                          EM018510
         DO    &L$13<&L$10                                              EM018520
         DC    X'02'                    PHYSICAL UNIT TWO               EM018530
         DC    XL3'00'                                                  EM018540
         DC    A(TP2)                   ADDRESS OF 90/30 PHYSICAL       EM018550
*********************************************************************** EM018560
&L$13    SET   &L$13+1                                                  EM018570
         GOTO  .T2                                                      EM018580
         ENDO                                                           EM018590
.T2      LABEL                                                          EM018600
         DO    &L$13<&L$10                                              EM018610
         DC    X'03'                    PHYSICAL UNIT THREE             EM018620
         DC    XL3'00'                                                  EM018630
         DC    A(TP3)                   ADDRESS OF 90/30 PHYSICAL       EM018640
*********************************************************************** EM018650
&L$13    SET   &L$13+1                                                  EM018660
         GOTO  .T3                                                      EM018670
         ENDO                                                           EM018680
.T3      LABEL                                                          EM018690
         DO    &L$13<&L$10                                              EM018700
         DC    X'04'                    PHYSICAL UNIT FOUR              EM018710
         DC    XL3'00'                                                  EM018720
         DC    A(TP4)                   ADDRESS OF 90/30 PHYSICAL       EM018730
*********************************************************************** EM018740
&L$13    SET   &L$13+1                                                  EM018750
         GOTO  .T4                                                      EM018760
         ENDO                                                           EM018770
.T4      LABEL                                                          EM018780
         DO    &L$13<&L$10                                              EM018790
         DC    X'05'                    PHYSICAL UNIT FIVE              EM018800
         DC    XL3'00'                                                  EM018810
         DC    A(TP5)                   ADDRESS OF 90/30 PHYSICAL       EM018820
*********************************************************************** EM018830
&L$13    SET   &L$13+1                                                  EM018840
         GOTO  .T5                                                      EM018850
         ENDO                                                           EM018860
.T5      LABEL                                                          EM018870
         DO    &L$13<&L$10                                              EM018880
         DC    X'06'                                                    EM018890
         DC    XL3'00'                                                  EM018900
         DC    A(TP6)                   ADDRESS OF 90/30 PHYSICAL       EM018910
*********************************************************************** EM018920
&L$13    SET   &L$13+1                                                  EM018930
         GOTO  .T6                                                      EM018940
         ENDO                                                           EM018950
.T6      LABEL                                                          EM018960
         DO    &L$13<&L$10                                              EM018970
         DC    X'07'                                                    EM018980
         DC    XL3'00'                                                  EM018990
         DC    A(TP7)                   ADDRESS OF 90/30 PHYSICAL       EM019000
*********************************************************************** EM019010
&L$13    SET   &L$13+1                                                  EM019020
         GOTO  .T7                                                      EM019030
         ENDO                                                           EM019040
.T7      LABEL                                                          EM019050
         DC    XL2'FFFF'                                                EM019060
         ENDO                                                           EM019070
         CNOP  0,4                                                      EM019080
*********************************************************************** EM019090
*********************************************************************** EM019100
*              EMULATOR 92/9300 EQUATE TABLE FOR MEMORY PARTION         EM019110
*********************************************************************** EM019120
E9$RPPSC EQU   E9$R9MEM                 PROC PSC EQUAL TO 4 BYTES       EM019130
E9$RPFAP EQU   E9$R9MEM+2               PROC PSC FAP                    EM019140
E9$RRAD  EQU   E9$R9MEM+4               RESTRICTED ALTER/DISPLAY 1 BYT  EM019150
E9$RORL  EQU   E9$R9MEM+5               OPERATOR REQUEST LOC 1 BYTE     EM019160
E9$RPINR EQU   E9$R9MEM+6               PROC INSTR REG 6 BYTES          EM019170
E9$RIPSC EQU   E9$R9MEM+16              I/O PROG STATE CONTROL 4 BYTES  EM019180
E9$RIFAP EQU   E9$R9MEM+18              I/O  PSC FAP                    EM019190
E9$RREST EQU   E9$R9MEM+22              RESTART INSTR REG 6 BYTES       EM019200
E9$RPR8  EQU   E9$R9MEM+32              PROC REG 8 - 2 BYTES            EM019210
E9$RPR9  EQU   E9$R9MEM+34              PROC REG 9 - 2 BYTES            EM019220
E9$RPR10 EQU   E9$R9MEM+36              PROC REG 10 - 2 BYTES           EM019230
E9$RPR11 EQU   E9$R9MEM+38              PROC REG 11 - 2 BYTES           EM019240
E9$RPR12 EQU   E9$R9MEM+40              PROC REG 12 - 2 BYTES           EM019250
E9$RPR13 EQU   E9$R9MEM+42              PROC REG 13 - 2 BYTES           EM019260
E9$RPR14 EQU   E9$R9MEM+44              PROC REG 14 - 2 BYTES           EM019270
E9$RPR15 EQU   E9$R9MEM+46              PROC REG 15 - 2 BYTES           EM019280
E9$RIR8  EQU   E9$R9MEM+48              I/O REG 8 - 2 BYTES             EM019290
E9$RIR9  EQU   E9$R9MEM+50              I/O REG 9 - 2 BYTES             EM019300
E9$RIR10 EQU   E9$R9MEM+52              I/O REG 10 - 2 BYTES            EM019310
E9$RIR11 EQU   E9$R9MEM+54              I/O REG 11 - 2 BYTES            EM019320
E9$RIR12 EQU   E9$R9MEM+56              I/O REG 12 - 2 BYTES            EM019330
E9$RIR13 EQU   E9$R9MEM+58              I/O REG 13 - 2 BYTES            EM019340
E9$RIR14 EQU   E9$R9MEM+60              I/O REG 14 - 2 BYTES            EM019350
E9$RIR15 EQU   E9$R9MEM+62              I/O REG 15 - 2 BYTES            EM019360
E9$R9DS  EQU   E9$R9MEM+66              DEVISE STATUS 1 BYTE            EM019370
E9$R9DA  EQU   E9$R9MEM+67              DEVISE ADDRESS 1 BYTE           EM019380
E9$R9BCW EQU   E9$R9MEM+68              BCW LOCATIONS REFERENCE POINT   EM019390
E9$R9CR  EQU   E9$R9BCW                 CARD READER BCW 4 BYTES         EM019400
E9$R9RPR EQU   E9$R9BCW+4               READ/PUNCH/READER 4 BYTES       EM019410
E9$R9CP  EQU   E9$R9BCW+8               CARD PUNCH BCW 4 BYTES          EM019420
E9$RCH8  EQU   E9$R9BCW+28              CHNL 8 BCW 4 BYTES              EM019430
E9$R9PR  EQU   E9$R9BCW+12              PRINTER BCW 4 BYTES             EM019440
E9$RCH6  EQU   E9$R9BCW+20              CHNL 6 BCW 4 BYTES              EM019450
E9$RCH5  EQU   E9$R9BCW+16              CHNL 5 BCW 4 BYTES              EM019460
E9$RCH7  EQU   E9$R9BCW+24              CHNL 7 BCW 4 BYTES              EM019470
E9$RCH9  EQU   E9$R9BCW+32              CHNL 9 BCW 4 BYTES              EM019480
E9$RCH10 EQU   E9$R9BCW+36              CHNL 10 BCW 4 BYTES             EM019490
E9$RCH11 EQU   E9$R9BCW+40              CHNL 11 BCW 4 BYTES             EM019500
E9$RCH12 EQU   E9$R9BCW+44              CHNL 12 BCW 4 BYTES             EM019510
E9$RCH13 EQU   E9$R9BCW+48              CHNL 13 BCW 4 BYTES             EM019520
E9$RCH14 EQU   E9$R9BCW+52              CHNL 14 BCW 4 BYTES             EM019530
E9$RCH15 EQU   E9$R9BCW+56              CHNL 15 BCW 4 BYTES             EM019540
E9$RPBUF EQU   E9$R9BCW+60              PRINT BUFFER 132 BYTES          EM019550
E9$RPCC  EQU   E9$R9MEM                 PROC CONDITION CODE LOCATION    EM019560
E9$RIOCC EQU   E9$R9MEM+16              I/O CONDITION CODE LOCATION     EM019570
E9$RB1D1 EQU   E9$RCINS+2                                               EM019580
E9$RPCIR EQU   E9$RAPCS+8               EQU TO SAVE REG POSITION PCIC   EM019590
E9$RPSW2 EQU   E9$RAPCS+1               SECOND BYTE OF PSW              EM019600
E9$RPSW3 EQU   E9$RAPCS+2               PSW POINTER TO 3RD BYTE POS     EM019610
E9$RPSW5 EQU   E9$RAPCS+4               PSW POINTER TO 5TH BYTE POS     EM019620
E9$RPSW7 EQU   E9$RAPCS+6               PSW POINTER TO 7TH BYTE POS     EM019630
E9$RSRG4 EQU   E9$RAPCS+24              REG 4 PSW SAVE                  EM019640
E9$RSRG8 EQU   E9$RAPCS+40                                              EM019650
E9$RSRG9 EQU   E9$RAPCS+44                                              EM019660
E9$RSVRG EQU   E9$RAPCS+42              SAVE REG 8 POINTER HALF BYTE    EM019670
E9$RPUBA EQU   260                      9300 PU TABLE BASE ADDRESS      EM019680
E9$RLUBA EQU   262                      9300 LU TABLE BASE ADDRESS      EM019690
E9$REAS  EQU   264                      EXEC ACTIVITY SUM               EM019700
E9$RINIT EQU   270                      INTERRUPT TABLE BASE ADDRESS    EM019710
E9$RSRCT EQU   272                      SRC TABLE BASE ADDRESS          EM019720
E9$TTSRC EQU   291                                                      EM019730
E9$SR289 EQU   289                                                      EM019740
E9$ROPEX EQU   0                                                        EM019750
E9$RALST EQU   0                                                        EM019760
         EJECT                                                          EM019770
         TITLE 'PROGRAM CHECK ISLAND CODE -INLINE'                      EM019780
*********************************************************************** EM019790
*              PROGRAM CHECK ISLAND CODE OPERAND DECODE FUNCTION ROU    EM019800
*              ANALYZE PSW & SET THE PSW BACK TO INSTR BEGINNING        EM019810
*********************************************************************** EM019820
         USING E9$RCOV5,5                                               EM019830
E9$RPCIC EQU   *                                                        EM019840
*                                                                       EM019850
         SR    2,2                      CLEAR REG.2                     EM019860
         IC    2,E9$RPSW                INSERT MSB OF PSW WORD          EM019870
         SRL   2,6(0)                   SHIFT RIGHT 6 BIT POSITIONS     EM019880
         AR    2,2                      DOUBLE REG                      EM019890
         L     3,E9$RPSW                LD REG 3 W/PSW                  EM019900
         SLL   3,8(0)                   LOP OFF MSB                     EM019910
         SRL   3,8(0)                   REPOSITION                      EM019920
         SR    3,2                      SUBTRACT                        EM019930
         ST    3,E9$RCFST               STORE COMPUTED PSW LOC          EM019940
*********************************************************************** EM019950
*              CODING ROUTINE FOR CHECKING THE TYPE OF  EXCEPTION       EM019960
*              ENCOUNTERED BY THE HARDWARE MICROCODE AND PASSED         EM019970
*              ON AS AN INVALID OP CODE                                 EM019980
*              ADJUST THE SI INSTRUCTION B1D1 ADDRESS AND STORE THE     EM019990
*              COMPUTED VALUE IN THE CURRENT INSTRUCTION SAVE AREA      EM020000
*              LABELED E9$RCINS.                                        EM020010
*********************************************************************** EM020020
         MVC   E9$RCINS,0(3)            MOVE INSTR TO WORK STOR         EM020030
         MVC   E9$RPSW7-1(3),E9$RCFST+1  SET UP NEW PSW LOC             EM020040
         AI    E9$RPSW7,4                                               EM020050
         CLC   E9$RPSW7-1(3),E9$RADAT+1  CHECK FOR VALID ADDRESS        EM020060
         BL    E9$RBTOA                 IF LOW CONT                     EM020070
         OI    E9$RASW3,X'40'           SET INVALID SWITCH              EM020080
         B     E9$RSTTL                 GO TO LPSC TRANS                EM020090
E9$RBTOA EQU   *                                                        EM020100
         TM    E9$RB1D1,X'80'           COMP FOR REGISTER NOTATION      EM020110
         BZ    E9$RBYPS                                                 EM020120
         SR    4,4                      CLEAR REG 4                     EM020130
         IC    4,E9$RCINS+2                                             EM020140
         SRL   4,4                                                      EM020150
         AR    4,4                      DOUBLE REG                      EM020160
         AR    4,4                      DOUBLE REG                      EM020170
         NI    E9$RB1D1,X'0F'           CLEAR MSB OF HALF BYTE          EM020180
         LA    3,E9$RPCIR               LOAD SAVE REG ADD               EM020190
         AR    4,3                      ADD THE DISPLACEMENT TO IT      EM020200
         LH    3,2(,4)                                                  EM020210
         AH    3,E9$RB1D1               ADD INSTRUTION DISPLACEMENT     EM020220
         STH   3,E9$RB1D1               STORE BACK TO SAVE              EM020230
E9$RBYPS EQU   *                                                        EM020240
         L     5,E9$RINVL                                               EM020250
         CLI   E9$ROP,X'48'                                             EM020260
         BE    E9$IVALD                                                 EM020270
         CLI   E9$ROP,X'A6'                                             EM020280
         BE    E9$IVALD                                                 EM020290
         CLI   E9$ROP,X'A5'             COMP BYTE FOR TIO               EM020300
         BE    E9$RTIO                                                  EM020310
         CLI   E9$ROP,X'A0'             COMP FOR SPSC                   EM020320
         BE    E9$RSPSC                                                 EM020330
         DO    '&TRANS'=''                                              EM020340
         L     5,E9$RLPSC                                               EM020350
         ENDO                                                           EM020360
         CLI   E9$ROP,X'A4'             COMP FOR XIOF                   EM020370
         BNE   E9$RC1                                                   EM020380
         CLI   E9$RDA,X'03'             COMP IF INTERNAL                EM020390
         DO    '&TRANS'='YES'                                           EM020400
         BNH   E9$RC1                                                   EM020410
         ENDO                                                           EM020420
         DO    '&TRANS'=''                                              EM020430
         BNHR  5                                                        EM020440
         ENDO                                                           EM020450
         L     5,E9$COV                                                 EM020460
         B     E9$MUXH                                                  EM020470
E9$RC1   EQU   *                                                        EM020480
         MVI   E9$RPSVC+1,E9$XXIOT      MOVE VALUE OF XIO TRANS TO SVC  EM020490
         CLI   E9$ROP,X'A8'             COMP BYTE FOR LPSC              EM020500
         DO    '&TRANS'='YES'                                           EM020510
         BE    E9$RSTTL                                                 EM020520
         ENDO                                                           EM020530
         DO    '&TRANS'=''                                              EM020540
         BER   5                                                        EM020550
         ENDO                                                           EM020560
         CLI   E9$ROP,X'A1'             COMP BYTE FOR SRC               EM020570
         BNE   E9$RPSVC                                                 EM020580
         CLI   E9$RDA,X'00'             COMP FOR RESTART                EM020590
         DO    '&TRANS'='YES'                                           EM020600
         BE    E9$RSTTL                 CALL IN SRC TRANS               EM020610
         ENDO                                                           EM020620
         DO    '&TRANS'=''                                              EM020630
         BER   5                                                        EM020640
         ENDO                                                           EM020650
         CLI   E9$RDA,X'2A'             COMP FOR DISC REQ 8411/14       EM020660
         BNE   E9$TSTTP                                                 EM020670
         L     5,E9$AD11                LOAD 8411/14 DISC HANDLER ADDR  EM020680
         BR    5                   GO TO 8411/8414 HANDLER              EM020690
E9$TSTTP EQU   *                                                        EM020700
         CLC   E9$TTSRC(1),E9$RDA       COMP SRC VALUE TO TAPE          EM020710
         BNE   E9$8410C                                                 EM020720
         L     5,E9$ATAPH               LOAD TAPH ADDR                  EM020730
         BR    5                   GO TO TAPE HANDLER                   EM020740
E9$8410C EQU   *                                                        EM020750
         CLC   E9$SR289(1),E9$RDA       COMP FOR 8410 REQ               EM020760
         DO    '&TRANS'='YES'                                           EM020770
         BNE   E9$RSRCV                                                 EM020780
         ENDO                                                           EM020790
         DO    '&TRANS'=''                                              EM020800
         BNER  5                                                        EM020810
         ENDO                                                           EM020820
         L     5,E9$AK10                LOAD 8410 ADDR                  EM020830
         BR    5                   GO TO 8410 HANDLER                   EM020840
E9$RSRCV EQU   *                                                        EM020850
E9$RSTTL MVI   E9$RPSVC+1,E9$TLPST      MOVE VALUE OF LPSC TRAN TO SVC  EM020860
E9$RPSVC SVC   E9$XXIOT                                                 EM020870
TPFDE    EQU   *                        TRANSIENT EXITS                 EM020880
E9$REXIT EQU   *                                                        EM020890
         TM    E9$RASW3,X'FD'           CHECK FOR OPCOM NEEDED          EM020900
         BNZ   E9$RTCM                  BR IF NOT ZEROS TO ROOT COM     EM020910
         TM    E9$RIOII+2,X'03'         CHK FOR OP REQ                  EM020920
         BZ    E9$ROUT                                                  EM020930
E9$RTCM  EQU   *                                                        EM020940
         SVC   E9$RCOMT                 CALL IN ROOT TRANS OPCOM        EM020950
E9$ROUT  EQU   *                                                        EM020960
         EXIT  PC                                                       EM020970
E9$REOJE EOJ                                                            EM020980
         CNOP  0,4                                                      EM020990
E9$COV   DC    A(E9$RCOV5)                                              EM021000
E9$ATAPH DC    A(E9$RTAPH)              ADDR OF TAPE HANDLER            EM021010
E9$AK10  DC    A(E9$K10)                ADDR OF 8410 HANDLER            EM021020
E9$AD11  DC    A(E9$D11)                ADDR OF 8411/14 HANDLER         EM021030
E9$RINVL DC    A(E9$IVALD)                                              EM021040
         DO    '&TRANS'=''                                              EM021050
E9$RLPSC DC    A(E9$TLPSC)                                              EM021060
         ENDO                                                           EM021070
E9$RUSKN EQU   54                                                       EM021080
E9$XXIOT EQU   55                                                       EM021090
E9$TLPST EQU   56                                                       EM021100
E9$RCOMT EQU   57                                                       EM021110
*********************************************************************** EM021120
         CNOP  0,4                                                      EM021130
*********************************************************************** EM021140
         TITLE 'SPSC HANDLER - INLINE'                                  EM021150
*********************************************************************** EM021160
*              SPSC WAS ENCOUNTERED, THIS SUBROUTINE WILL HANDLE &      EM021170
*              SET UP ACCORDINGLY THE APPROPIATE ACTION.                EM021180
*********************************************************************** EM021190
E9$RSPSC EQU   *                                                        EM021200
E9$TSPSC EQU   *                                                        EM021210
         LH    3,E9$RB1D1               LOAD CONVERTED VALUE B1D1       EM021220
         TM    E9$RDA,X'20'             CHK MODE TO BE ACTED UPON       EM021230
         BNO   E9$TSPPR                 NO MATCH PROC IS TO BE STORED   EM021240
         TM    E9$RIOII+1,X'04'         CHK CURRENT MODE FOR I/O        EM021250
         BNO   E9$TSIPC                 IF NOT IN I/O MODE ST I/O PSC   EM021260
         MVC   0(4,3),E9$RPSW5          MOVE VALUE TO B1D1 POS          EM021270
         MVI   1(3),X'00'                                               EM021280
         BAL   7,E9$T93CC                                               EM021290
         MVC   E9$RIPSC(4),0(3)         UPDATE PSC LOC                  EM021300
         B     E9$REXIT                 GO TO EXIT PC                   EM021310
E9$TSIPC MVC   0(4,3),E9$RIPSC          I/O ACT UPON, CUR MODE PROC     EM021320
         B     E9$REXIT                 GO TO EXIT PC                   EM021330
E9$TSPPR TM    E9$RIOII+1,X'04'         PROC MODE IS TO BE ACTED UPON   EM021340
         BO    E9$TSPPC                 IF IN I/O MODE,STORE PROC PSC   EM021350
         MVC   0(4,3),E9$RPSW5          MOVE VALUE TO B1D1 POS          EM021360
         MVI   1(3),X'00'                                               EM021370
         BAL   7,E9$T93CC                                               EM021380
         MVC   E9$RPPSC(4),0(3)         UPDATE PSC LOC                  EM021390
         B     E9$REXIT                 GO TO EXIT PC                   EM021400
E9$TSPPC MVC   0(4,3),E9$RPPSC          STORE PROC PSC                  EM021410
         B     E9$REXIT                 GO TO EXIT PC                   EM021420
E9$T93CC OI    0(3),X'80'               SET CC POS ON FOR 9300 CODE     EM021430
         TM    E9$RPSW5,X'20'           CHK PSW SETTING                 EM021440
         BO    *+8                      BYPASS NEXT INSTR IF SET        EM021450
         NI    0(3),X'7F'               ERASE IF NOT SET                EM021460
         OI    0(3),X'40'               SET CC SECOND POSITION ON       EM021470
         TM    E9$RPSW5,X'10'           CHK PSW SETTING                 EM021480
         BO    *+8                      BYPASS NEXT INSTR IF SET        EM021490
         NI    0(3),X'BF'               ERASE IF NOT                    EM021500
         BR    7                        BR BACK                         EM021510
*********************************************************************** EM021520
         TITLE 'TIO HANDLER ROUTINE'                                    EM021530
*********************************************************************** EM021540
*              A TIO WAS ENCOUNTERED . GO TO THE SCAN TABLE TO CHECK    EM021550
*              FOR A VALID TIO BY MEANS OF THE (DA)                     EM021560
*********************************************************************** EM021570
E9$RTIO  EQU   *                                                        EM021580
         LA    9,E9$REXIT                                               EM021590
         BAL   7,E9$RSCAN                                               EM021600
         LH    5,E9$RB1D1                                               EM021610
         TM    E9$RXS1,X'10'            CHK FOR INT OR STATUS PEND      EM021620
         BNO   E9$RTSET                                                 EM021630
         TM    E9$RXS3,X'20'            INT PENDING CHK FOR PRINTER     EM021640
         BNO   E9$RTSET                                                 EM021650
         TM    E9$RXS1,X'02'            IF PRINTER CHK FOR OVERFLOW     EM021660
         BNO   E9$RTSET                                                 EM021670
         NI    E9$RPSW5,X'DF'           ERASE BIT IN CC                 EM021680
         OI    E9$RPSW5,X'10'                                           EM021690
         MVI   0(5),X'02'               SET B1D1 FOR FORM OVERFLOW      EM021700
         NI    E9$RXS1,X'ED'            ERASE STATUS PEND AND FOV       EM021710
         BR    9                        GO TO EXIT                      EM021720
E9$RTSET EQU   *                                                        EM021730
         TM    E9$RXS1,X'02'            CHK FOR OVERFLOW COND MUX       EM021740
         BNO   E9$RNOOV                                                 EM021750
         MVI   0(5),X'01'               SET UP OVERFLOW MUX             EM021760
         NI    E9$RXS1,X'FD'            ERASE OVERFLOW BIT              EM021770
         B     E9$RSETC                                                 EM021780
E9$RNOOV EQU   *                                                        EM021790
         CLI   E9$RDA,X'04'                                             EM021800
         BL    E9$RXPON                                                 EM021810
         MVC   0(1,5),E9$R9DS           SET USER LOC WITH DS 42         EM021820
         B     E9$RSETC                                                 EM021830
E9$RXPON DS    0H                                                       EM021840
         MVI   0(5),X'00'                                               EM021850
E9$RSETC EQU   *                                                        EM021860
         NI    E9$RPSW5,X'CF'           SET CC TO 00                    EM021870
         NI    E9$RXS1,X'EF'            SET BIT OFF                     EM021880
         BR    9                        GO TO EXIT                      EM021890
E9$RSCAN EQU   *                                                        EM021900
         L     4,E9$RALUT               LOAD ADDR OF LOG UNIT TABLE     EM021910
         TM    E9$RDA,X'80'             SHARED BIT ON                   EM021920
         BNO   E9$RAC                                                   EM021930
         IC    2,E9$RDA                 LD R2 W/VALUE                   EM021940
         SLL   2,25                                                     EM021950
         SRL   2,28                                                     EM021960
         STC   2,E9$ATEPS+2                                             EM021970
         CLI   E9$ATEPS+2,X'04'                                         EM021980
         BL    E9$RAC                                                   EM021990
         STC   2,E9$RDA                                                 EM022000
E9$RAC   EQU   *                                                        EM022010
         CLC   E9$RDA(1),0(4)           COMP FOR MATCH                  EM022020
         BER   7                        GO BACK TO REQUESTOR            EM022030
         CLI   0(4),X'FF'               COMP FOR END OF TABLE           EM022040
         BC    8,E9$RBTIO               END OF TABLE REACHED ?          EM022050
         LA    4,36(,4)                 INCREMENT FOR NEXT CHK          EM022060
         B     E9$RAC                   BRANCH BACK                     EM022070
*********************************************************************** EM022080
*        A MATCH FOR A TIO WAS NOT FOUND BY THE SCAN TABLE              EM022090
*              ROUTINE , THEREFORE THE TIO COULD STILL BE VALID FOR     EM022100
*              CHECKING THE TEST AND RESET LT SUMMARY OR ONE SECOND     EM022110
*              DELAY. IN ANY EVENT CHECK AND BYPASS                     EM022120
*********************************************************************** EM022130
E9$RBTIO EQU   *                                                        EM022140
         CLI   E9$RDA,X'80'             COMP FOR RESET OP REQ           EM022150
         BER   9                        BRANCH TO EXIT                  EM022160
         CLI   E9$RDA,X'88'             COMP FOR RESET LT SUMMARY       EM022170
         BER   9                        BRANCH TO EXIT                  EM022180
         CLI   E9$RDA,X'90'             TST/RESET ONE SECOND INT        EM022190
         BER   9                        BRANCH TO EXIT                  EM022200
         OI    E9$RPSW5,X'30'           SET REJECT STATUS               EM022210
         BR    9                        BRANCH TO EXIT                  EM022220
         CNOP  0,4                                                      EM022230
*********************************************************************** EM022240
         TITLE 'OP COM ISLAND CODE INLINE'                              EM022250
*********************************************************************** EM022260
E9$ROPCM EQU   *                                                        EM022270
         L     6,E9$RADA0                                               EM022280
         OI    E9$RASW3,X'20'                                           EM022290
         SVC   E9$RUSKN                                                 EM022300
         CNOP  0,4                                                      EM022310
E9$RADA0 EQU   *                                                        EM022320
         DC    A(E9$RADTB)                                              EM022330
*********************************************************************** EM022340
         TITLE 'GET CODE INLINE'                                        EM022350
**********************************************************************  EM022360
*              GET INTERFACE ROUTINE FOR SAT                            EM022370
**********************************************************************  EM022380
E9$RIGET EQU   *                                                        EM022390
E9$RGET  EQU   *                        INPUT UNIT RECORD SAT           EM022400
*********************************************************************** EM022410
*        BYPASS GETCS IF BIT IS SET TO OVERRIDE GETCS                 * EM022420
*********************************************************************** EM022430
         TM    E9$RIOII,X'10'           BYPASS GETCS IF BIT IS SET      EM022440
         BO    E9$RMVG2                                                 EM022450
         TM    E9$RXS2,X'08'            CHECK FOR GETCS SET             EM022460
         BNO   E9$RMVG2                 DO GET CS IF SET,OTHERWISE GET  EM022470
         LR    1,3                      SET REG TO BUFF ADDR            EM022480
E9$RGTCS GETCS (1)                                                      EM022490
         B     E9$RMVG0                 BRANCH AROUND GET               EM022500
E9$RMVG2 EQU   *                                                        EM022510
*        GET   (1)                                                      EM022520
         BAL   7,0(,1)                  TEMP GET CODE INLINE DTF        EM022530
E9$RMVG0 EQU   *                                                        EM022540
         SR    7,7                      CLR REG 7                       EM022550
         IC    7,E9$RXGSZ               LD R7 WITH BUFF SIZE            EM022560
         TM    E9$RXS3,X'04'            COMP IF TRANSLATE               EM022570
         BO    E9$RSGSZ                 BR AROUNT IF TRANS              EM022580
         AR    7,7                                                      EM022590
E9$RSGSZ BCTR  7,0                                                      EM022600
         STC   7,E9$RMVG+1              STORE SIZE INTO MOVE            EM022610
         CLI   E9$RMVG+1,X'FF'          CHK FOR ZERO CHAR MOVE          EM022620
         BE    *+10                                                     EM022630
E9$RMVG  MVC   0(,2),0(3)                                               EM022640
         TM    E9$RXS2,X'28'           DOUBLE BUFF OR GETCS             EM022650
         BNZ   *+8                                                      EM022660
         ST    9,E9$RXBUF               STOR SAT I/O REG IN XIO TBL     EM022670
E9$RTREQ TM    E9$RXS3,X'04'            TRANSLATE REQ                   EM022680
         BNO   E9$RTRBY                 NO, GO TO TRANSLATE BYPASS      EM022690
         MVC   E9$RTRGT+1(1),E9$RMVG+1                                  EM022700
         CLI   E9$RTRGT+1,X'FF'         CHK FOR ZERO TRANS              EM022710
         BE    *+10                                                     EM022720
E9$RTRGT TR    0(,2),E9$RTBPU           TRANSLATE                       EM022730
E9$RTRBY TM    E9$RIOII+2,X'04'         CHK IF IN LD MODE               EM022740
         BNO   E9$REXIT                                                 EM022750
         CLC   0(2,2),E9$RTEND          CHECK FOR TRANSFER CARD         EM022760
         BNE   E9$RTBOT                                                 EM022770
         NI    E9$RIOII+2,X'FB'         TURN OFF LD MODE                EM022780
         MVC   E9$RLXIO(4),E9$RCFST     SET ADD OF LOADER-LOAD XIOF     EM022790
         NI    E9$RXS2,X'F7'            ERASE GETCS BIT                 EM022800
E9$RTBOT TM    E9$RIOII+2,X'40'         IS THIS BOOT CARD MODE?         EM022810
         BNO   E9$REXIT                                                 EM022820
         NI    E9$RIOII+2,X'BF'         ERASE BOOT CARD MODE            EM022830
E9$RIGEX BR    10                                                       EM022840
E9$REOF  EQU   *                                                        EM022850
         B     E9$RMVG0                                                 EM022860
*********************************************************************** EM022870
*        EBCDIC TO COMPRESSED                                           EM022880
*********************************************************************** EM022890
E9$RTBPU EQU   *                                                        EM022900
     DC    XL8'BDB1D191A1C1F1E1' 00,01,02,03,04,05,06,07                EM022910
     DC    XL8'89B9D999A9C9F9E9' 08,09,0A,0B,0C,0D,0E,0F                EM022920
     DC    XL8'BBB2D292A2C2F2E2' 10,11,12,13,14,15,16,17                EM022930
     DC    XL8'8ABADA9AAACAFAEA' 18,19,1A,1B,1C,1D,1E,1F                EM022940
     DC    XL8'BEB4D494A4C4F4E4' 20,21,22,23,24,25,26,27                EM022950
     DC    XL8'8CBCDC9CACCCFCEC' 28,29,2A,2B,2C,2D,2E,2F                EM022960
     DC    XL8'BFB0D090A0C0F0E0' 30,31,32,33,34,35,36,37                EM022970
     DC    XL8'88B8D898A8C8F8E8' 38,39,3A,3B,3C,3D,3E,3F                EM022980
     DC    XL8'00B5D595A5C5F5E5'  ,41,42,43,44,45,46,47                 EM022990
     DC    XL8'8D39591929497969' 48,49,,.,<,(,+,1                      EM023000
     DC    XL8'01B3D393A3C3F3E3' &,51,52,53,54,55,56,57                 EM023010
     DC    XL8'8B3A5A1A2A4A7A6A' 58,59,!,$,*,),;,^                      EM023020
     DC    XL8'0234D696A6C6F6E6' -,/,62,63,64,65,66,67                  EM023030
     DC    XL8'8E3C031C2C4C7C6C' 68,69,6A,,,%,_,>,?                     EM023040
     DC    XL8'07B7D797A7C7F7E7' 70,71,72,73,74,75,76,77                EM023050
     DC    XL8'8F38581828487868' 78,79,:,#,@,',=,"                      EM023060
       DC     XL8'3D35551525457565'    80 - 87                          EM023070
       DC    XL8'0D855D1D2D4D7D6D'     88 - 8F                          EM023080
       DC    XL8'3B33531323437363'     90 - 97                          EM023090
       DC    XL8'0B835B1B2B4B7B6B'     98 - 9F                          EM023100
       DC    XL8'3E36561626467666'     A0 - A7                          EM023110
       DC    XL8'0E865E1E2E4E7E6E'     A8 - AF                          EM023120
       DC    XL8'3F37571727477767'     B0 - B7                          EM023130
       DC    XL8'0F875F1F2F4F7F6F'     B8 - BF                          EM023140
       DC    XL8'0531511121417161'     BL,A,B,C,D,E,F,G                 EM023150
       DC    XL8'0981DD9DADCDFDED'     H,I,CA - CF                      EM023160
       DC    XL8'0632521222427262'     D0,J,K,L,M,N,O,P                 EM023170
       DC    XL8'0A82DB9BABCBFBEB'     Q,R,DA - DF                      EM023180
       DC    XL8'5CB6541424447464'     E0,E1,S,T,U,V,W,X                EM023190
       DC    XL8'0C84DE9EAECEFEEE'     Y,Z, EA - EF                     EM023200
       DC    XL8'0430501020407060'     0,1,2,3,4,5,6,7                  EM023210
       DC    XL8'0880DF9FAFCFFFEF'     8,9, FA - FF                     EM023220
*********************************************************************** EM023230
*        COMPRESSED TO EBCDIC                                           EM023240
*********************************************************************** EM023250
*********************************************************************** EM023260
E9$RTBRD EQU   *                                                        EM023270
     DC    XL8'4050606AF0C0D070'  ,&,-,03,0,05,06,07                    EM023280
     DC    XL8'F8C8D898E888A8B8' 8,H,0,0B,Y,0D,0E,0F                    EM023290
     DC    XL8'F3C3D393E383A3B3' 3,O,L,13,T,15,16,17                    EM023300
     DC    XL8'7B4B5B9B6B8BABBB'                                        EM023310
     DC    XL8'F4C4D494E484A4B4' 4,D,M,23,U,25,26,27                    EM023320
     DC    XL8'7C4C5C9C6C8CACBC' @,<,*,2B,%,2D,2E,2F                    EM023330
     DC    XL8'F1C1D1916181A1B1' 1,A3,33,1,35,36,37                     EM023340
     DC    XL8'794959906980A0B0' 38,39,3A,3B,3C,3D,3E,3F                EM023350
     DC    XL8'F5C5D595E585A5B5' 5,E,N,43,V,45,46,47                    EM023360
     DC    XL8'7D4D5D9D6D8DADBD'                                        EM023370
       DC    XL8'F2C2D292E282A2B2'  2,B,K,53,S,55,56,57                 EM023380
     DC    XL8'7A4A5A9AE08AAABA' :,,!,5B,5C,5D,5E,5F                   EM023390
     DC    XL8'F7C7D797E787A7B7' 7,G,P,63,X,65,66,67                    EM023400
     DC    XL8'7F4F5F9F6F8FAFBF' ",1,^,6B,?,6D,6E,6F                    EM023410
     DC    XL8'F6C6D696E686A6B6' 6,F,O,73,W,75,76,77                    EM023420
     DC    XL8'7E4E5E9E6E8EAEBE' =,+,;,7B,>,7D,7E,7F                    EM023430
     DC    XL8'F9C9D999E989A9B9' 9,I,R,83,Z,85,86,87                    EM023440
     DC    XL8'3808185828486878' 88,89,8A,8B,8C,8D,8E,8F                EM023450
     DC    XL8'3303135323436373'                                        EM023460
     DC    XL8'3B0B1BDB2BCBEBFB' 98,99,9A,9B,9C,9D,9E,9F                EM023470
     DC    XL8'3404145424446474' A0,A1,A2,A3,A4,A5,A6,A7                EM023480
     DC    XL8'3C0C1CDC2CCCECFC' A8,A9,AA,AB,AC,AD,AE,AF                EM023490
     DC    XL8'310111512141E171' B0,B1,B2,B3,B4,B5,B6,B7                EM023500
     DC    XL8'3909191029002030' B8,B9,BA,BB,BC,BD,BE,BF                EM023510
     DC    XL8'3505155525456575' C0,C1,C2,C3,C4,C5,C6,C7                EM023520
     DC    XL8'3D0D1DDD2DCDEDFD' C8,C9,CA,CB,CC,CD,CE,CF                EM023530
     DC    XL8'3202125222426272' D0,D1,D2,D3,D4,D5,D6,D7                EM023540
     DC    XL8'3A0A1ADA2ACAEAFA' D8,D9,DA,DB,DC,DD,DE,DF                EM023550
     DC    XL8'3707175727476777' E0,E1,E2,E3,E4,E5,E6,E7                EM023560
     DC    XL8'3F0F1FDF2FCFEFFF' E8,E9,EA,EB,EC,ED,EE,EF                EM023570
     DC    XL8'3606165626466676' F0,F1,F2,F3,F4,F5,F6,F7                EM023580
     DC    XL8'3E0E1EDE2ECEEEFE' F8,F9,FA,FB,FC,FD,FE,FF                EM023590
*********************************************************************** EM023600
         TITLE 'TRANS FOR SIX BIT CODE'                                 EM023610
         CNOP  0,4                                                      EM023620
*********************************************************************** EM023630
E9$TR63  EQU   *                                                        EM023640
* 63 CHAR TRANS     00010203040506070809   SIX BIT CODE                 EM023650
         DC    XL10'40C1C2C3C4C5C6C7C8C9'  EQUIV 8 BIT CODE             EM023660
*                   0A0B0C0D0E0F10111213   SIX BIT CODE                 EM023670
         DC    XL10'4A4B4C4D4E4F50D1D2D3'  EQUIV 8 BIT CODE             EM023680
*                   1415161718191A1B1C1D   SIX BIT CODE                 EM023690
         DC    XL10'D4D5D6D7D8D95A5B5C5D'  EQUIV 8 BIT CODE             EM023700
*                   1E1F2021222324252627   SIX BIT CODE                 EM023710
         DC    XL10'5E5F6061E2E3E4E5E6E7'  EQUIV 8 BIT CODE             EM023720
*                   28292A2B2C2D2E2F3031   SIX BIT CODE                 EM023730
         DC    XL10'E8E9406B6C6D6E6FF0F1'  EQUIV 8 BIT CODE             EM023740
*                   32333435363738393A3B   SIX BIT CODE                 EM023750
         DC    XL10'F2F3F4F5F6F7F8F97A7B'  EQUIV 8 BIT CODE             EM023760
*                  3C3D3E3F                SIX BIT CODE                 EM023770
         DC    XL4'7C7D7E7F'               EQUIV 8 BIT CODE             EM023780
*********************************************************************** EM023790
         CNOP  0,4                                                      EM023800
E9$TR48  EQU   *                                                        EM023810
* 48 CHAR TRANS     00010203040506070809                                EM023820
         DC    XL10'C1C2C3C4C5C6C7C8C9D1'   A,B,C,D,E,F,G,H,I,J,        EM023830
*                   0A0B0C0D0E0F10111213                                EM023840
         DC    XL10'D2D3D4D5D6D740404040'   K,L,M,N,O,P, , , ,          EM023850
*                   1415161718191A1B1C1D                                EM023860
         DC    XL10'40404040404040404040'   , , , , , , , , , , ,       EM023870
*                   1E1F2021222324252627                                EM023880
         DC    XL10'4040D8D9E2E3E4E5E6E7'    , ,Q,R,S,T,U,V,W,X,        EM023890
*                   28292A2B2C2D2E2F3031                                EM023900
         DC    XL10'E8E94E506C7B7C5EF0F1'   Y,Z,+,&,%,#,@,;,0,1,        EM023910
*                   32333435363738393A3B                                EM023920
         DC    XL10'F2F3F4F5F6F7F8F94B5B'   2,3,4,5,6,7,8,9,.,$,        EM023930
*                   3C3D3E3F                                            EM023940
         DC    XL4'5C60616B'                *,-,/,,,                    EM023950
*********************************************************************** EM023960
         DO    ('&PRTTEN4'>'0')++('&CR1004'>'0')                        EM023970
*********************************************************************** EM023980
*                                                                     * EM023990
*        EXESS-3 TO EBCDIC  (FOR 1001 AND 1004)                       * EM024000
*                                                                     * EM024010
*********************************************************************** EM024020
         SPACE 1                                                        EM024030
E9$RX3TE DS    0H                                                       EM024040
         DC    XL16'405D60F0F1F2F3F4F5F6F7F8F96E5E4D'                   EM024050
         DC    XL16'507D4BC0C1C2C3C4C5C6C7C8C97B4E4F'                   EM024060
         DC    XL16'7F5C5BD0D1D2D3D4D5D6D7D8D96D7C5F'                   EM024070
         DC    XL16'E06C6B7A61E2E3E4E5E6E7E8E94C7E6F'                   EM024080
         ENDO                                                           EM024090
         TITLE 'PUT CODE INLINE'                                        EM024100
*              PUT INTERFACE ROUTINE FOR SAT                            EM024110
**********************************************************************  EM024120
E9$RPUT  EQU   *                                                        EM024130
         ST    4,E9$RSRG4                                               EM024140
*        PUT   (1)                                                      EM024150
         BAL   7,0(,1)                                                  EM024160
         L     4,E9$RSRG4                                               EM024170
         TM    E9$RXS2,X'20'            SAT DOUBLE BUFFERED             EM024180
         BO    *+8                                                      EM024190
         ST    9,E9$RXBUF                                               EM024200
         TM    E9$RXS3,X'20'            TST FOR PRINTER                 EM024210
         BO    E9$RBYTR                 BR IF NOT                       EM024220
         TM    E9$RXS3,X'41'            IS PUNCH READ SET               EM024230
         BZ    E9$RBYTR                 BR IF NOT                       EM024240
         NI    E9$RXS3,X'BE'            IF SET ERASE                    EM024250
         SR    7,7                      CLR R7                          EM024260
         IC    7,E9$RXGSZ               LD GETSIZE TO R7                EM024270
         TM    E9$RXS3,X'04'            TEST FOR TRANSLATE              EM024280
         BO    E9$RPGSZ                 IF TRANS BYPASS                 EM024290
         AR    7,7                      DOUBLE IF NOT                   EM024300
E9$RPGSZ STC   7,E9$RGPMV+1             STORE IN MVE INSTR              EM024310
         AI    E9$RGPMV,0               DECREMENT BY ONE FOR MVE        EM024320
         ORG   *-3                                                      EM024330
         DC    XL1'FF'                                                  EM024340
         ORG   *+2                                                      EM024350
E9$RGPMV MVC   0(,2),1(3)               MVE TO USER AREA                EM024360
         TM    E9$RXS2,X'20'            TEST FOR DOUBLE BUFF            EM024370
         BO    *+8                      BR AROUND IF NOT                EM024380
         ST    8,E9$RXRBF                                               EM024390
         TM    E9$RXS3,X'0C'            TEST TRANS REQ W/INTERNAL ONLY  EM024400
         BNO   E9$RBYTR                 BRANCH AROUND IF NOT SET        EM024410
         MVC   E9$RGPTR+1(1),E9$RGPMV+1  SET UP SIZE                    EM024420
E9$RGPTR TR    0(,2),E9$RTBPU           TRANSLATE                       EM024430
E9$RBYTR EQU   *                                                        EM024440
         B     E9$REXIT                 RETURN                          EM024450
*********************************************************************** EM024460
         EJECT                                                          EM024470
         TITLE 'FORMS OVERFLOW HANDLER'                                 EM024480
*********************************************************************** EM024490
* THIS ROUTINE WILL MARK STATUS OF THE CONDITION CODE AND ALSO THE      EM024500
* TABLE WITH THE FORMS OVERFLOW BIT SETTING                             EM024510
*********************************************************************** EM024520
E9$RFOVL EQU   *                        FORMS OVERFLOW ROUTINE          EM024530
E9$RFOV  EQU   *                                                        EM024540
         L     4,E9$RSRG4                                               EM024550
         OI    E9$RXS1,X'12'            SET STATUS PEND & FOV           EM024560
         TM    E9$RXS1,X'08'            INT PERMIT                      EM024570
         BNO   *+8                                                      EM024580
         OI    E9$RPSW5,X'30'           SET CC TO REJ                   EM024590
         NI    PRINTCCB+2,X'F7'        RESET OVFL BIT                   EM024600
         B     E9$REXIT                                                 EM024610
         TITLE 'PRINTER LOOP TABLE'                                     EM024620
**********************************************************************  EM024630
*                                                                     * EM024640
*                        PRINTER LOOP CARRIAGE TABLE                  * EM024650
*                                                                     * EM024660
**********************************************************************  EM024670
         CNOP  0,4                                                      EM024680
E9$RCCID DC    XL1'00'                                                  EM024690
E9$RCCNO DC    XL1'00'                                                  EM024700
E9$RCCST DC    XL1'00'                                                  EM024710
E9$RCCTB DC    132XL1'00'                                               EM024720
E9$RCCE  EQU   *                                                        EM024730
         TITLE 'DEFINE THE FILE, INLINE'                                EM024740
RPPX     DC    F'0'                                                     EM024750
E9$R071  EQU   *                                                        EM024760
         ST    7,RPPX                   STORE REG 7 TEMP                EM024770
         TM    E9$RXS2,X'20'            CURRENT UNIT DOUBLE BUFFERED    EM024780
         BO    E9$BY                                                    EM024790
         TM    READCCB+2,X'80'          TEST FOR LAST COMPLETION        EM024800
         BNO   *-4                      LOOP TILL COMP                  EM024810
         L     3,READBCW                LOAD LAST BUFF FILLED           EM024820
         SLL   3,8(0)                   ERASE MSB                       EM024830
         SRL   3,8(0)                   REPOSITION                      EM024840
E9$BY    L     9,E9$RXBUF                                               EM024850
         LA    9,1(,9)                  INCREMENT R9                    EM024860
         ST    9,READBCW                SET UP IN ADDRESS               EM024870
         ST    9,READBCW+8                                              EM024871
         L     9,E9$RXBUF               RELOAD FOR FUNCTION INSERT      EM024880
         MVC   READBCW(1),0(9)          SETUP FUNCTION CODE             EM024890
         EXCP  READCCB                                                  EM024900
         TM    E9$RXS2,X'20'            TEST FOR DOUBLE BUFF            EM024910
         BNO   E9$BR                                                    EM024920
         TM    READCCB+2,X'80'          COMP FOR COMPLETION             EM024930
         BNO   *-4                      BR BACK IF NOT                  EM024940
         L     3,READBCW                                                EM024950
         SLL   3,8(0)                                                   EM024960
         SRL   3,8(0)                                                   EM024970
E9$BR    L     7,E9$RXBUF                                               EM024980
         LA    9,E9$R01B1               COMP AGAINST BUFF1              EM024990
         CR    9,7                      COMP                            EM025000
         BNE   *+8                      BRANCH IF NOT EQUAL             EM025010
         LA    9,E9$R01B2               SET UP                          EM025020
         L     7,RPPX                   LOAD R7 FOR RETURN              EM025030
         BR    7                        RETURN                          EM025040
E9$RBAR  EQU   *                                                        EM025050
         ST    7,RPPX                   STORE REG 7 TEMP                EM025060
         L     9,E9$RXBUF               LOAD CURRENT BUFF POINTER       EM025070
         LA    9,1(,9)                  INCREMENT R9 BY 1               EM025080
         TM    E9$RXS2,X'20'            CHK FOR DOUBLE BUF              EM025090
         BO    *+12                                                     EM025100
         TM    PRINTCCB+2,X'80'         TST COMP                        EM025110
         BNO   *-4                                                      EM025120
         TM    PRINTCCB+2,X'08'        OVFL SET                         EM025130
         BO    E9$RFOV                                                  EM025140
         ST    9,PRINTBCW               STORE R9 TO BCW                 EM025150
         L     9,E9$RXBUF                                               EM025160
         MVC   PRINTBCW(1),0(9)         SET UP FUNCTION CODE            EM025170
         TM    E9$RXS2,X'02'            48 CHAR RD SET                  EM025180
         BNO   E9$RTR63                                                 EM025190
         LA    8,E9$TR48                                                EM025200
         NI    E9$RXS2,X'FB'            ERASE BIT IF SET                EM025210
         B     E9$TRNS1                                                 EM025220
E9$RTR63 EQU   *                                                        EM025230
         LA    8,E9$TR63                                                EM025240
E9$TRNS1 EQU   *                                                        EM025250
         L     7,PRINTBCW+4             LD PRNT BUFF SIZE               EM025260
         BCTR  7,0                      DECR BY 1                       EM025270
         STC   7,E9$TTRNS+1             STORE INTO TRANS INSTR          EM025280
         L     7,PRINTBCW+4             RELOAD SIZE                     EM025290
E9$ERAS  EQU   *                                                        EM025300
         LA    9,1(,9)                  INCR R9 BY 1                    EM025310
         NI    0(9),X'3F'               ERASE MSB                       EM025320
         BCT   7,E9$ERAS                DO NO OF TIMES REQ              EM025330
         L     9,E9$RXBUF               RELOAD BUFF ADDR                EM025340
         LA    9,1(,9)                  INCR BY 1                       EM025350
E9$TTRNS TR    0(0,9),0(8)                                              EM025360
E9$RPXT  EXCP  PRINTCCB                                                 EM025370
         TM    E9$RXS2,X'20'            CHECK FOR DOUBLE BUFF           EM025380
         BNO   *+12                                                     EM025390
         TM    PRINTCCB+2,X'80'         TST COMP                        EM025400
         BNO   *-4                                                      EM025410
         LA    9,E9$RPRB1               LOAD R9 W/ PRINT BUFF ADDR 1    EM025420
         L     7,E9$RXBUF               LD 7 W/ LAST BUFF USED          EM025430
         CR    7,9                      COMPARE                         EM025440
         BNE   *+8                      IF NOT EQUAL BUFF 1 IS NEXT     EM025450
         LA    9,E9$RPRB2               IF EQUAL LD BUFF 2 NEXT         EM025460
         L     7,RPPX                   LOAD R7 FOR RETURN              EM025470
         BR    7                        BRANCH.                         EM025480
E9$RSER  EQU   *                                                        EM025490
         ST    7,RPPX                   STORE REG 7 TEMP                EM025500
         L     9,E9$RXBUF               LD CURRENT BUFF                 EM025510
         LA    9,1(,9)                  INCREMENT R9 BY 1               EM025520
         TM    E9$RXS2,X'20'            CHK FOR DOUBLE BUFF             EM025530
         BO    *+12                     BYPASS IF NOT                   EM025540
         TM    PUNCHCCB+2,X'80'         TEST LAST COMPLETION            EM025550
         BNO   *-4                      BR BACK TILL COMP               EM025560
         ST    9,PUNCHBCW               STORE NEXT BUFF                 EM025570
         L     9,E9$RXBUF                                               EM025580
         MVC   PUNCHBCW(1),0(9)         SETUP NEXT FUNCT                EM025590
         L     7,E9$RXRBF               LD CURRENT READ BUFF PUNCH      EM025600
         LA    7,1(,7)                 INCREMENT R7 BY 1                EM025610
         ST    7,PUNCHBCW+8             SETUP BUFF                      EM025620
         NI    PUNCHBCW+8,X'FF'         ERASE LEAD BYTE                 EM025630
         EXCP  PUNCHCCB                                                 EM025640
         TM    E9$RXS2,X'20'            CHK FOR DOUBLE BUFF             EM025650
         BNO   *+12                     BYPASS IF NOT                   EM025660
         TM    PUNCHCCB+2,X'80'         CHK FOR COMP                    EM025670
         BNO   *-4                      LOOP BACK                       EM025680
         LA    9,E9$RP0B1               LOAD BUFF1                      EM025690
         L     7,E9$RXBUF               LOAD CURRENT BUFF               EM025700
         CR    7,9                      COMP FOR EQUAL                  EM025710
         BNE   *+8                      BYPASS                          EM025720
         LA    9,E9$RP0B2               LOAD NEXT BUFF                  EM025730
         LA    8,E9$RRPB1                                               EM025740
         L     7,E9$RXRBF                                               EM025750
         CR    7,8                      COMP                            EM025760
         BNE   *+8                      BR IF NOT EQUAL                 EM025770
         LA    8,E9$RRPB2               SETUP NEW BUFF                  EM025780
         L     7,RPPX                   LOAD R7 FOR RETURN              EM025790
         BR    7                        RETURN                          EM025800
*********************************************************************** EM025810
READCCB  CCB   READER-14,READBCW,,X'20'                                 EM025820
PRINTCCB CCB   PRINTER-14,PRINTBCW,,X'20'                               EM025830
PUNCHCCB CCB   PUNCH-14,PUNCHBCW,,X'20'                                 EM025840
READBCW  BCW   0,E9$R01B1+1,,80,E9$R01B1+1,,80                          EM025850
PRINTBCW BCW   0,E9$RPRB1+1,,120                                        EM025860
PUNCHBCW BCW   0,E9$RP0B1+1,,80,E9$RRPB1+1,,80                          EM025870
         CNOP  0,4                                                      EM025880
READER   DC    XL2'0000'                READER PUB POINTER              EM025890
PRINTER  DC    XL2'0000'                PRINTER PUB POINTER             EM025900
PUNCH    DC    XL2'0000'                PUNCH PUB POINTER               EM025910
         DC    F'0'                     ALIGN TO FULLWORD -1            EM025920
         ORG   *-1                                                      EM025930
E9$R01B1 DC    XL81'0'                  READER BUFFER 1                 EM025940
         DC    F'0'                     ALIGN TO FULLWORD -1            EM025950
         ORG   *-1                                                      EM025960
E9$R01B2 DC    XL81'0'                  READER BUFFER 2                 EM025970
         DC    F'0'                     ALIGN TO FULLWORD -1            EM025980
         ORG   *-1                                                      EM025990
E9$RPRB1 DC    XL145'0'                 PRINTER BUFFER 1                EM026000
         DC    F'0'                     ALIGN TO FULLWORD -1            EM026010
         ORG   *-1                                                      EM026020
E9$RPRB2 DC    XL145'0'                 PRINTER BUFFER 2                EM026030
         DC    F'0'                    ALIGN TO FULLWORD-1              EM026040
         ORG   *-1                                                      EM026050
E9$RP0B1 DC    XL81'0'                  PUNCH BUFFER 1                  EM026060
         DC    F'0'                     ALIGN TO FULLWORD -1            EM026070
         ORG   *-1                                                      EM026080
E9$RP0B2 DC    XL81'0'                  PUNCH BUFFER 2                  EM026090
         DC    F'0'                     ALIGN TO FULLWORD -1            EM026100
         ORG   *-1                                                      EM026110
E9$RRPB1 DC    XL81'0'                 RD/PCH RDBUFF1                   EM026120
         DC    F'0'                    ALIGN TO FULLWORD-1              EM026130
         ORG   *-1                                                      EM026140
E9$RRPB2 DC    XL81'0'                 RD/PCH RDBUFF2                   EM026150
         DC    F'0'                     ALIGN TO FULLWORD -1            EM026160
         B     *                                                        EM026170
         B     *                                                        EM026180
         B     *                                                        EM026190
         B     *                                                        EM026200
         B     *                                                        EM026210
         TITLE 'INVALID HANDLER'                                        EM026220
         USING *,5                                                      EM026230
E9$IVALD EQU   *                                                        EM026240
         CLI   E9$ROP,X'48'             LD HALFWORD ?                   EM026250
         BE    E9$RLHHR                                                 EM026260
         TM    E9$RAPCS+3,X'06'         SPECIFICATION EXCEPTION?        EM026270
         BNO   E9$RC1                                                   EM026280
         SR    2,2                      CLR R2                          EM026290
         LH    2,E9$RCINS+2             LD B1D1                         EM026300
         BCTR  2,0                      DECREMENT BY ONE FOR HALFWORD   EM026310
         MVC   E9$ATEPS(2),0(2)         MVE TWO BYTE AREA VALUE         EM026320
         MVC   E9$AIEX+1(1),E9$RCINS+1                                  EM026330
E9$AIEX  EQU   *                                                        EM026340
         AI    E9$ATEPS,X'00'           EXECUTE ADD IMMEDIATE           EM026350
         MVC   1(1,2),E9$ATEPS+1        RESTORE 1 BYTE VALUE TO 9300    EM026360
         NI    E9$RPSW5,X'CF'           CLR CC                          EM026370
         B     E9$REXIT                 EXIT                            EM026380
         CNOP  0,4                                                      EM026390
E9$ATEPS EQU   *                                                        EM026400
         DC    XL4'00000000'                                            EM026410
E9$RLHHR DS    0H                                                       EM026420
         TM    E9$RAPCS+3,X'06'         SPECIFICATION EXCEPTION ?       EM026430
         BNO   E9$RC1                                                   EM026440
         SR    2,2                      CLEAR R2                        EM026450
         IC    2,E9$RCINS+1             SET UP REG TO BE USED           EM026460
         SLL   2,4                      SHIFT FOUR BITS LEFT            EM026470
         IC    2,E9$RCINS+1             SET UP REG TO BE USED           EM026480
         SRL   2,4                      SHIFT FOUR BITS RIGHT           EM026490
         STC   2,E9$RCLRR+1             SET REG FOR CLEAR               EM026500
E9$RCLRR EQU   *                                                        EM026510
         SR    2,2                      CLEAR CORRESPONDING REG         EM026520
         MVC   E9$ICST1+1(3),E9$RCINS+1      SET REG & B1D1 TO IC       EM026530
         MVC   E9$ICST2+1(1),E9$RCINS+1      SET REG TO SHIFT INST      EM026540
         MVC   E9$ICST3+1(3),E9$RCINS+1      SET REG & B1D1 TO IC       EM026550
E9$ICST1 EQU   *                                                        EM026560
         IC    2,E9$RCINS+2             SET UP NON HALFWORD             EM026570
E9$ICST2 EQU   *                                                        EM026580
         SLL   2,8                      SHIFT LEFT ONE BYTE             EM026590
E9$ICST3 EQU   *                                                        EM026600
         IC    2,E9$RCINS+2             SET UP EQUIV OF 9300            EM026610
         NI    E9$RPSW5,X'CF'           CLR  CC                         EM026620
         SR    2,2                      CLR R2                          EM026630
         IC    2,E9$RCINS+1             SET UP REG TO ENACT UPON        EM026640
         SRL   2,4                      SHIFT RIGHT                     EM026650
         AR    2,2                      DOUBLE                          EM026660
         AR    2,2                      DOUBLE                          EM026670
         MVC   E9$RSTHR+1(1),E9$RCINS+1  SET UP REGISTER                EM026680
         OI    E9$RSTHR+1,X'02'                                         EM026690
E9$RSTHR STH   2,E9$RAPR0+2(2)          STORE IN SAVE REG               EM026700
         B     E9$REXIT                                                 EM026710
         B     *                                                        EM026720
         B     *                                                        EM026730
         B     *                                                        EM026740
         B     *                                                        EM026750
         B     *                                                        EM026760
         DROP  5                                                        EM026770
         TITLE '92/9300 TAPE HANDLER'                                   EM026780
         USING *,5                                                      EM026790
E9$RTAPH EQU   *                                                        EM026800
         DO    ('&N12'='')**('&N1ST'='')**('&N2ND'='')                  EM026810
         WTLD  E9$TMSG,46                                               EM026820
         B     E9$REOJE                                                 EM026830
E9$TMSG  DC    CL46'TAPE REQUEST TRAPPED IN EMULATOR WITH NO TAPES'     EM026840
         ENDO                                                           EM026850
         DO    ('&N12'>'0')++('&N1ST'>'0')++('&N2ND'>'0')               EM026860
         LR    14,15                    MVE PCKT ADDR TO R14            EM026870
E9$RCONT EQU   *                                                        EM026880
         SR    10,10                    CLR R10                         EM026890
         IC    10,9(,14)                LD R10 W/LOG UNIT CALL          EM026900
         AR    10,10                    DOUBLE R10                      EM026910
         LH    11,E9$RLUBA              LD R11 W/LOG UNIT BASE ADDR     EM026920
         AR    11,10                    POINT TO LU TABLE (2 BYTES)     EM026930
         IC    10,1(,11)                LD R10 W/BYTE DISPLACEMENT      EM026940
         AH    10,E9$RPUBA              ADD PHYS UNIT BASE ADDR         EM026950
         MVC   4(2,14),2(10)            SET MODE & DA INTO PACKET       EM026960
         NI    8(14),X'F0'              SET STATUS IND TO ZERO          EM026970
         MVC   E9$R9DA(1),5(14)         MVE DA TO LOC 43                EM026980
         MVI   6(14),X'00'              RESET COUNTS BYTE               EM026990
*********************************************************************** EM027000
*              PACKET IS SET UP,NOW A SEARCH FOR THE EQUIVALENT TAPE  * EM027010
*              DRIVE ON 90/30 WILL HAVE TO BE DONE                    * EM027020
*********************************************************************** EM027030
         SR    11,11                    CLR R11                         EM027040
         IC    11,1(,10)                LD R11 W/PU NUMBER              EM027050
         STC   11,5(14)                 SET PU INTO PACKET              EM027060
         NI    5(14),X'F0'              ERASE LSB                       EM027070
         SRL   11,4                     POSITION FOR COMPARE            EM027080
         LA    4,TPADDRS                LD TAPE ADDR TABLE              EM027090
         STC   11,E9$RWORK              STORE SHIFTED PU NUMBER         EM027100
E9$TTUNT EQU   *                                                        EM027110
         CLC   0(1,4),E9$RWORK          COMP FOR PU EQUIVALENCE         EM027120
         BE    E9$TSETP                 BR TO SETUP IF FOUND            EM027130
         LA    4,8(,4)                  IF NOT GET NEXT POINTER         EM027140
         CLI   0(4),X'FF'               COMP FOR END OF TABLE           EM027150
         BNE   E9$TTUNT                 BR BACK IF NOT EQUAL            EM027160
*********************************************************************** EM027170
*              A MATCH WAS NOT FOUND FOR THE PHYSICAL UNIT REQUESTED  * EM027180
*              THEREFORE DISPLAY STOP                                 * EM027190
*********************************************************************** EM027200
         STC   11,E9$TOIC+1                                             EM027210
E9$TOIC  OI    E9$TWAL+20,X'00'                                         EM027220
         WTLD  E9$TWAL,48                                               EM027230
         B     E9$REOJE                                                 EM027240
E9$TWAL  DC    CL48'HALT 600E TAPE UNIT 0 INVALID EMULATOR CANCELLED'   EM027250
         CNOP  0,4                                                      EM027260
*********************************************************************** EM027270
*              OPCOM INTERFACE FOR ERRORS OTHER THAN NORMAL             EM027280
*********************************************************************** EM027290
E9$TCMPT EQU   *                                                        EM027300
         MVC   E9$RAHIB(2),E9$RMSRP     SET UP VALUE                    EM027310
         SR    11,11                    CLR R11                         EM027320
         STH   11,E9$RAHIB+2            ZEROIZE 2 BYTES                 EM027330
         LA    11,E9$REOJE              LD EOJ EXIT                     EM027340
         ST    11,E9$RAHIB+4            SET UP EXIT                     EM027350
         SVC   E9$RCOMT                 CALL IN OPCOMP                  EM027360
*********************************************************************** EM027370
         CNOP  0,4                                                      EM027380
E9$RMSRP DC    XL2'6000'                                                EM027390
*********************************************************************** EM027400
         CNOP  0,4                                                      EM027410
E9$RWORK DC    XL4'00'                  TEMP STORAGE &WORK AREA         EM027420
*********************************************************************** EM027430
E9$RBCWL EQU   64                                                       EM027440
E9$RSUPH EQU   364                                                      EM027450
*********************************************************************** EM027460
*              A MATCH WAS FOUND IN THE TABLE AND REG 4 IS POINTING   * EM027470
*              TO THE MATCHUP                                         * EM027480
*********************************************************************** EM027490
E9$TSETP EQU   *                                                        EM027500
         LA    7,TAPETBL                LD TAPE I/O TABLE               EM027510
TESTTBL  CLC   0(8,7),TAPETTS           COMP FOR ZEROS                  EM027520
         BE    STORPTR                  IF ZEROS STORE PTR              EM027530
         LA    7,8(,7)                  INCREMENT                       EM027540
         B     TESTTBL                  GO BACK FOR NEXT SPACE AVAIL    EM027550
STORPTR  EQU   *                                                        EM027560
         ST    14,0(7)                  STORE PACKET PTR                EM027570
         L     1,4(,4)                  SET UP CCB PTR                  EM027580
         ST    1,4(7)                   STORE TO CCB POS                EM027590
         TM    E9$RIOII,X'80'           TASK BIT SET                    EM027600
         BNO   TAPEIO                   BR AROUND                       EM027610
         TM    TAPEECB+2,X'80'                                          EM027620
         BNO   *-4                                                      EM027630
         AWAKE TAPEECB                                                  EM027640
         B     E9$REXIT                                                 EM027650
TAPEIO   EQU   *                                                        EM027660
         LA    7,TAPETBL                LD CURRENT TABLE                EM027670
         CLC   0(8,7),TAPETTS           IS IT ZEROS                     EM027680
         BE    BYPTSK1                  GO TO END                       EM027690
*                                                                       EM027700
*                                                                       EM027710
*                                                                       EM027720
BYPTSK2  EQU   *                                                        EM027730
         L     1,TAPETBL+4              SETUP REG 1                     EM027740
         L     14,TAPETBL               SETUP REG 14                    EM027750
         MVC   IOTBCW+6(2),0(14)        MVE BCW COUNT/DIRECTION INFO    EM027760
         NI    IOTBCW+6,X'20'           ERASE ALL BITS                  EM027770
         MVI   IOTBCW+7,X'01'           SET BLK COUNT READ              EM027780
         MVC   IOTBCW+4(2),0(14)        SET UP READ BYTE CNT            EM027790
         NI    IOTBCW+4,X'1F'           ERASE BITS 0 TO 2               EM027800
         MVC   IOTBCW+2(2),2(14)        SET UP DATA ADDRESS AREA        EM027810
         CLI   7(14),X'03'              WAS REQ FOR SENSE               EM027820
         BNE   E9$NOSEN                                                 EM027830
         MVI   IOTBCW+5,X'05'           SETUP BYTE CNT                  EM027840
         LA    7,20(1)                  LD ADDR OF SENSE BYTE PNTR      EM027850
         ST    7,IOTBCW                 STOR CCB POINTER                EM027860
         MVI   IOTBCW,X'04'             SETUP SENSE REQ                 EM027870
         B     E9$ISSEN                                                 EM027880
E9$NOSEN EQU   *                                                        EM027890
         MVC   IOTBCW(1),7(14)          SET FUNCTION CODE TO BCW        EM027900
E9$ISSEN EQU   *                                                        EM027910
E9$ISSUE EQU   *                                                        EM027920
         EXCP  (1)                                                      EM027930
         TM    E9$RIOII,X'80'           IS TASK BIT SET                 EM027940
         BNO   BYPTSK3                  IF NOT BYPASS                   EM027950
         WAIT  (1)                                                      EM027960
         B     E9$BYPT4                                                 EM027970
BYPTSK3  EQU   *                                                        EM027980
         TM    2(1),X'80'               TST COMPLETION                  EM027990
         BNO   *-4                                                      EM028000
E9$BYPT4 EQU   *                                                        EM028010
         TM    2(1),X'20'              UNIQUE BIT SET ?                 EM028020
         BO    E9$ISSUE                REISSUE COMMAND                  EM028030
E9$TCOT  EQU   *                                                        EM028040
*********************************************************************** EM028050
*              9300 PACKET MUST BE MARKED AND THE CORRESPONDING 9300  * EM028060
*              BCW SETUP ACCORDINGLY                                  * EM028070
*********************************************************************** EM028080
         CLI   7(14),X'03'              WAS REQ FOR SENSE               EM028090
         BNE   E9$NOTSN                                                 EM028100
         MVC   10(2,14),20(1)           MOVE FIRST TWO SEN BYTES        EM028110
         B     E9$RSETF                                                 EM028120
E9$NOTSN EQU   *                                                        EM028130
         TM    IOTBCW,X'07'             CONTROL FUNCTION                EM028140
         BO    E9$TMTST                                                 EM028150
         SR    3,3                      CLR REG 3                       EM028160
         MVC   E9$RWORK(1),3(10)        MVE CHNL AND PU INTO WORK       EM028170
         NI    E9$RWORK,X'7F'                                           EM028180
         IC    3,E9$RWORK               LD VALUE TO R3                  EM028190
         SRL   3,3                      SHIFT RIGHT LOG 3 BITS          EM028200
         AR    3,3                      DOUBLE                          EM028210
         AR    3,3                      DOUBLE                          EM028220
         MVC   E9$RBCWL(2,3),10(1)      RESIDUAL TO 9300 BCW            EM028230
         LH    2,10(,1)                 LD RESIDUAL TO R2 FROM CCB      EM028240
         LH    11,IOTBCW+4              LD R11 W/ ORIG CNT              EM028250
         SR    11,2                     SUBTRACT TO FIND CNT            EM028260
         LH    2,IOTBCW+2               LD AREA ADDR                    EM028270
         CLI   IOTBCW,X'0C'             BACKWARD READ?                  EM028280
         BNE   E9$ADDCT                 IF NOT ADD CT                   EM028290
         SR    2,11                     SUB IF BACK                     EM028300
         B     E9$SUBCT                                                 EM028310
E9$ADDCT EQU   *                                                        EM028320
         AR    2,11                     ADD CNT AND DEVLOPLST BYTE      EM028330
E9$SUBCT EQU   *                                                        EM028340
         STH   2,10(,14)                LAST BYTE ADDR TO PCKT          EM028350
         STH   2,E9$RBCWL+2(3)          LAST BYTE ADDR TO 9300 BCW      EM028360
         CLI   IOTBCW,X'01'             WAS IT A WRITE FUNC ?           EM028370
         BNE   E9$TMEOT                                                 EM028380
         TM    26(1),X'05'              DE & UE SET                     EM028390
         BNO   E9$TMEOT                 IF NOT SET CONT                 EM028400
         MVI   8(14),X'03'              SET EOF                         EM028410
         B     E9$WASTM                                                 EM028420
E9$TMEOT EQU   *                                                        EM028430
         CLI   IOTBCW,X'02'             READ FUNCT?                     EM028440
         BE    E9$TMTST                                                 EM028450
         CLI   IOTBCW,X'0C'             READ BACK?                      EM028460
         BNE   E9$NOTRD                                                 EM028470
E9$TMTST EQU   *                                                        EM028480
         TM    2(1),X'08'               CHK UNIT EXEC ON READ           EM028490
         BNO   E9$NOTRD                 BR IF NOT SET                   EM028500
         MVI   8(14),X'03'              SET TO TM FOUND                 EM028510
         B     E9$WASTM                                                 EM028520
E9$NOTRD EQU   *                                                        EM028530
         TM    IOTBCW,X'01'             READ ?                          EM028540
         BO    E9$RSETF                                                 EM028550
         CLC   E9$RBCWL(2,3),E9$ZERO                                    EM028560
         BE    E9$RSETF                                                 EM028570
         MVI   8(14),X'08'              SET WRONG LENGTH                EM028580
         B     E9$WASTM                                                 EM028590
E9$RSETF EQU   *                                                        EM028600
         MVI   8(14),X'0F'             SET COMP BITS                    EM028610
E9$WASTM EQU   *                                                        EM028620
         MVC   E9$R9DS(1),26(1)         MVE DEV STA TO 42               EM028630
BYPTSK1  EQU   *                                                        EM028640
         MVC   TAPETBL(24),TAPETBL+8    SHIFT TABLE DOWN                EM028650
         MVC   TAPETBL+24(8),TAPETTS    CLR LAST POSITION               EM028660
         TM    E9$RIOII,X'80'           TASK BIT SET ?                  EM028670
         BNO   E9$REXIT                 EXIT IF NOT                     EM028680
         CLC   TAPETBL(8),TAPETTS       ZEROS?                          EM028690
         BNE   TAPEIO                   GO PROCESS NEXT I/O             EM028700
         TYIELD                                                         EM028710
         B     TAPEIO                                                   EM028720
         CNOP  0,4                                                      EM028730
E9$ZERO  DC    XL4'00000000'                                            EM028740
         CNOP  0,4                                                      EM028750
TAPETBL  DC    8F'0'                    TAPE TABLE                      EM028760
TAPETTS  DC    2F'0'                    TST CLR                         EM028770
TAPETSK  DC    A(TAPEIO)                                                EM028780
         DC    A(TAPEECB)                                               EM028790
TAPEECB  ECB                                                            EM028800
&L$13    SET   0                                                        EM028810
         DO    &L$13<&L$10                                              EM028820
         TITLE '92/9300 TAPE DRIVE 0'                                   EM028830
TP0      CCB   E2$TAPE0,IOTBCW,,X'28'                                   EM028840
E2$TAPE0 PIOCB                                                          EM028850
&L$13    SET   &L$13+1                                                  EM028860
         GOTO  .TT0                                                     EM028870
         ENDO                                                           EM028880
.TT0     LABEL                                                          EM028890
         DO    &L$13<&L$10                                              EM028900
         TITLE '92/9300 TAPE DRIVE 1'                                   EM028910
TP1      CCB   E2$TAPE1,IOTBCW,,X'28'                                   EM028920
E2$TAPE1 PIOCB                                                          EM028930
&L$13    SET   &L$13+1                                                  EM028940
         GOTO  .TT1                                                     EM028950
         ENDO                                                           EM028960
.TT1     LABEL                                                          EM028970
         DO    &L$13<&L$10                                              EM028980
         TITLE '92/9300 TAPE DRIVE 2'                                   EM028990
TP2      CCB   E2$TAPE2,IOTBCW,,X'28'                                   EM029000
E2$TAPE2 PIOCB                                                          EM029010
&L$13    SET   &L$13+1                                                  EM029020
         GOTO  .TT2                                                     EM029030
         ENDO                                                           EM029040
.TT2     LABEL                                                          EM029050
         DO    &L$13<&L$10                                              EM029060
         TITLE '92/9300 TAPE DRIVE 3'                                   EM029070
TP3      CCB   E2$TAPE3,IOTBCW,,X'28'                                   EM029080
E2$TAPE3 PIOCB                                                          EM029090
&L$13    SET   &L$13+1                                                  EM029100
         GOTO  .TT3                                                     EM029110
         ENDO                                                           EM029120
.TT3     LABEL                                                          EM029130
         DO    &L$13<&L$10                                              EM029140
         TITLE '92/9300 TAPE DRIVE 4'                                   EM029150
TP4      CCB   E2$TAPE4,IOTBCW,,X'28'                                   EM029160
E2$TAPE4 PIOCB                                                          EM029170
&L$13    SET   &L$13+1                                                  EM029180
         GOTO  .TT4                                                     EM029190
         ENDO                                                           EM029200
.TT4     LABEL                                                          EM029210
         DO    &L$13<&L$10                                              EM029220
         TITLE '92/9300 TAPE DRIVE 5'                                   EM029230
TP5      CCB   E2$TAPE5,IOTBCW,,X'28'                                   EM029240
E2$TAPE5 PIOCB                                                          EM029250
&L$13    SET   &L$13+1                                                  EM029260
         GOTO  .TT5                                                     EM029270
         ENDO                                                           EM029280
.TT5     LABEL                                                          EM029290
         DO    &L$13<&L$10                                              EM029300
         TITLE '92/9300 TAPE DRIVE 6'                                   EM029310
TP6      CCB   E2$TAPE6,IOTBCW,,X'28'                                   EM029320
E2$TAPE6 PIOCB                                                          EM029330
&L$13    SET   &L$13+1                                                  EM029340
         GOTO  .TT6                                                     EM029350
         ENDO                                                           EM029360
.TT6     LABEL                                                          EM029370
         DO    &L$13<&L$10                                              EM029380
         TITLE '92/9300 TAPE DRIVE 7'                                   EM029390
TP7      CCB   E2$TAPE7,IOTBCW,,X'28'                                   EM029400
E2$TAPE7 PIOCB                                                          EM029410
         GOTO  .TT7                                                     EM029420
         ENDO                                                           EM029430
.TT7     LABEL                                                          EM029440
*********************************************************************** EM029450
         CNOP 0,8                                                       EM029460
IOTBCW   DC    4F'0'                                                    EM029470
*********************************************************************** EM029480
         B     *                                                        EM029490
         B     *                                                        EM029500
         B     *                                                        EM029510
         B     *                                                        EM029520
         B     *                                                        EM029530
         B     *                                                        EM029540
         B     *                                                        EM029550
         B     *                                                        EM029560
         B     *                                                        EM029570
         B     *                                                        EM029580
         B     *                                                        EM029590
         B     *                                                        EM029600
         B     *                                                        EM029610
         B     *                                                        EM029620
         B     *                                                        EM029630
         B     *                                                        EM029640
         B     *                                                        EM029650
         B     *                                                        EM029660
         ENDO                                                           EM029670
E9$RELLD EQU   *                                                        EM029680
         TITLE 'SNAP ROUTINE'                                           EM029690
E9$SNAP  EQU   *                                                        EM029700
         ST    1,RTEMP                                                  EM029710
         SNAP  E9$R9MEM,E9$RELLD                                        EM029720
         L     1,RTEMP                                                  EM029730
         BR    7                                                        EM029740
         CNOP  0,4                                                      EM029750
RTEMP    DC    XL4'00'                                                  EM029760
         DROP  5                                                        EM029770
**********************************************************************  EM029780
         TITLE '8410 I/O HANDLER'                                       EM029790
         USING *,5                                                      EM029800
*********************************************************************** EM029810
*                                                                     * EM029820
*        8410 DISC DISPATCHER EMULATION                               * EM029830
*                                                                     * EM029840
*********************************************************************** EM029850
         SPACE 1                                                        EM029860
E9$K10   DS    0H                  ENTRY                                EM029870
         DO    '&N10'=''                                                EM029880
         WTLD  E9$KMSG,46                                               EM029890
         B     E9$REOJE                                                 EM029900
E9$KMSG  DC    CL46'8410 REQUEST TRAPPED IN EMULATOR WITH NO 8410 '     EM029910
         ENDO                                                           EM029920
         DO    '&N10'>'0'                                               EM029930
         USING E9$K$,9                                                  EM029940
         ST    8,E9$KSV8           SAVE R8                              EM029950
         LR    8,15                R8 = PACKET ADDR                     EM029960
         LA    13,E9$KSAVE         LD R13 W/SAVE AREA ADDR              EM029970
E9$K101  DS    0H                                                       EM029980
         TM    4(8),X'01'          CHAINED ?                            EM029990
         BO    E9$KCHND            IF YES, BRANCH TO E9$KCHND           EM030000
         MVC   8(2,8),E9$KFF       SET FFFF IN CHAIN ADDR               EM030010
E9$KCHND TM    E9$KIIPL,1          DURING IPL                           EM030020
         BO    E9$KSPC             BR TO E9$KSPC IF YES                 EM030030
         SR    10,10               CLR R10                              EM030040
         IC    10,7(,8)            LD R10 W/LOG UNIT                    EM030050
         AR    10,10               DOUBLE R10                           EM030060
         LH    11,E9$RLUBA         LD R11 W/LOG UNIT BASE ADDR          EM030070
         AR    11,10               POINT TO LU TABLE (2BYTES)           EM030080
         IC    10,1(,11)           GET PU POINTER                       EM030090
         AH    10,E9$RPUBA         ADD PHYS UNIT BASE ADDR              EM030100
         MVC   E9$KPU,1(10)        SAVE PU #                            EM030110
         NI    E9$KPU,X'F0'        ISOLATE PU # BIT 0-3                 EM030120
         MVI   6(8),0              SET STATUS IND TO 00                 EM030130
         MVC   E9$R9DA(1),3(10)    MOVE DA TO LOC 43                    EM030140
*********************************************************************** EM030150
*              PACKET IS SET UP, NOW A SEARCH FOR THE EQUIVALENT DISC * EM030160
*              FILE ON 90/30 WILL HAVE TO BE DONE                     * EM030170
*********************************************************************** EM030180
         LH    11,2(,8)            LD R11 W/DATA ADDR                   EM030190
         MVC   0(1,11),3(10)       MOVE DA TO DATA AREA                 EM030200
         NI    0(11),X'07'         CARRY ONLY PU                        EM030210
         LA    9,E9$KT10           LD R9 W/8410 DEVICE TABLE            EM030220
E9$KSCH  CLC   E9$K$DVC(1),0(11)   MATCH ?                              EM030230
         BE    E9$KMCH             IF MATCH, BRANCH TO E9$KMCH          EM030240
         LA    9,E9$K$L(9)         UPDATE POINTER FOR NEXT              EM030250
         CLI   E9$K$DVC,X'FF'      LAST ?                               EM030260
         BNE   E9$KSCH             IF NO, BRANCH TO E9$KSCH             EM030270
E9$KERA  MVI   6(8),X'70'          SET STATUS IND TO 70                 EM030280
         SR    7,7                                                      EM030290
         IC    7,E9$KPU                                                 EM030300
         SRL   7,4                                                      EM030310
         STC   7,E9$KOI+1                                               EM030320
E9$KOI   OI    E9$KGAN+7,X'00'                                          EM030330
         WTLD  E9$KGAN,50                                               EM030340
         B     E9$REOJE                                                 EM030350
E9$KGAN  DC    CL50'HALT 670F INVALID UNIT OR FILE EMULATOR CANCELLED ' EM030360
         CNOP  0,4                                                      EM030370
E9$KMSRP DC    X'670F0000'         MSG : 67UF                           EM030380
E9$KSPC  ST    14,E9$KIPRT         SAVE RETURN ADDR                     EM030390
         LH    11,2(,8)            LD R11 W/DATA ADDR                   EM030400
E9$KMCH  LM    0,2,E9$K$PCA        LD R0=PCA, R1=DTF, R2=DATA ADDR      EM030410
         TM    E9$K$FLG,X'40'      FILE EXIST ?                         EM030420
         BZ    E9$KERA             IF NO, BRANCH TO E9$KERA             EM030430
E9$KSKO  CLI   5(8),X'01'          SEEK ?                               EM030440
         BE    E9$KSEEK            IF YES, BRANCH TO E9$KSEEK           EM030450
         CLI   5(8),X'11'          WRITE ?                              EM030460
         BE    E9$KWRT             IF YES, BRANCH TO E9$KWRT            EM030470
         CLI   5(8),X'31'          SEARCH EQUAL ?                       EM030480
         BE    E9$KSCEQ            IF YES, BRANCH TO E9$KSCEQ           EM030490
         CLI   5(8),X'51'          WRITE & CHECK ?                      EM030500
         BE    E9$KWRT             IF YES, GO TO E9$KWRT                EM030510
         CLI   5(8),X'61'          READ ?                               EM030520
         BE    E9$KREAD            IF YES, BRANCH TO E9$KREAD           EM030530
         CLI   5(8),X'71'          SEARCH MAGNITUDE ?                   EM030540
         BE    E9$KSCMG            IF YES, BRANCH TO E9$KSCMG           EM030550
         MVI   6(8),X'80'          SET STATUS IND TO 80                 EM030560
         B     E9$KNSET            BRANCH TO E9$KNSET                   EM030570
         SPACE 3                                                        EM030580
*********************************************************************** EM030590
*        FUNCTION SIMULATION (READ)                                   * EM030600
*********************************************************************** EM030610
         SPACE 1                                                        EM030620
E9$KREAD DS    0H                  READ                                 EM030630
         BAL   7,E9$KSK            SET SEEK TABLE                       EM030640
         BAL   7,E9$KCV            CONVERT TO SAT ADDR                  EM030650
         LR    15,0                                                     EM030660
         ST    10,0(15)            MVE REC NO INTO PCA                  EM030670
         GET   (1),(0)             READ SAT FILE                        EM030680
         TM    2(1),X'80'          TEST COMPLETION ?                    EM030690
         BZ    *-4                 BR BACK IF NOT                       EM030700
         MVC   0(5,2),0(11)                                             EM030710
         IC    10,1(8)                                                  EM030720
         BCTR  10,0                                                     EM030730
         EX    10,E9$KMV1          MVE DATA INTO USER AREA              EM030740
         B     E9$KSET             BRANCH TO E9$KSET                    EM030750
         SPACE 3                                                        EM030760
*********************************************************************** EM030770
*        FUNCTION SIMULATION (WRITE, WRITE AND CHECK)                 * EM030780
*********************************************************************** EM030790
         SPACE 1                                                        EM030800
E9$KWRT  DS    0H                  WRITE                                EM030810
*                                                                       EM030820
*                                                                       EM030830
*                                                                       EM030840
         XC    5(160,2),5(2)       CLR                                  EM030850
         IC    10,1(8)                                                  EM030860
         BCTR  10,0                                                     EM030870
         EX    10,E9$KMV2          MVE DATA INTO SAT AREA               EM030880
         BAL   7,E9$KSK            SET SEEK TABLE                       EM030890
         BAL   7,E9$KCV            CONVERT TO SAT ADDR                  EM030900
         LR    15,0                                                     EM030910
         ST    10,0(15)            MVE REC NO INTO PCA                  EM030920
         PUT   (1),(0)             WRITE SAT FILE                       EM030930
         TM    2(1),X'80'          TEST COMPLETION ?                    EM030940
         BZ    *-4                 BR BACK IF NOT                       EM030950
         B     E9$KSET             BRANCH TO E9$KSET                    EM030960
         SPACE 3                                                        EM030970
*********************************************************************** EM030980
*        FUNCTION SIMULATION (SEEK)                                   * EM030990
*********************************************************************** EM031000
         SPACE 1                                                        EM031010
E9$KSEEK DS    0H                  SEEK                                 EM031020
         BAL   7,E9$KSK            SET SEEK TABLE                       EM031030
         B     E9$KSET             BRANCH TO E9$KSET                    EM031040
         SPACE 3                                                        EM031050
*********************************************************************** EM031060
*        FUNCTION SIMULATION (SEARCH MAGNITUDE)                       * EM031070
*********************************************************************** EM031080
         SPACE 1                                                        EM031090
E9$KSCMG DS    0H                  SEARCH MAGNITUDE                     EM031100
         MVI   E9$KSCF,0           RESET SCF (SEARCH FLAG)              EM031110
         BAL   7,E9$KGEN           GENERATE COMPARE INSTRUCTION         EM031120
         BAL   7,E9$KCVS                                                EM031130
         GET   (1),(0)             READ SAT FILE                        EM031140
         TM    2(1),X'80'          TEST COMPLETION ?                    EM031150
         BZ    *-4                 BR BACK IF NOT                       EM031160
         EX    0,E9$KCMP           COMPARE KEY                          EM031170
         BL    E9$KMGA                  IF LOW BRANCH                   EM031180
         MVI   E9$KSCF,1           SET SCF                              EM031190
E9$KMGA  L     15,E9$K$PCA                                              EM031200
         MVC   2(2,15),E9$KBGN     SET REC NO                           EM031210
E9$KMGC  LM    0,1,E9$K$PCA        LD R0=PCA, R1=DTF ADDR               EM031220
         GET   (1),(0)             READ SAT FILE                        EM031230
         TM    2(1),X'80'          TEST COMPLETION ?                    EM031240
         BZ    *-4                 BR BACK IF NOT                       EM031250
         EX    0,E9$KCMP           COMPARE KEY                          EM031260
         BL    E9$KMGD                  IF LOW BRANCH                   EM031270
         MVI   E9$KSCF,1           SET SCF                              EM031280
         B     E9$KMGB                  BR TO SCF CHECK                 EM031281
E9$KMGD  L     15,E9$K$PCA                                              EM031290
         AI    2(15),1             INCR REC NO BY 1                     EM031300
         CLC   2(2,15),E9$KLST     END OF TRACK ?                       EM031310
         BNH   E9$KMGC             IF NO, BRANCH TO E9$KMGC             EM031320
         MVI   6(8),X'40'          SET STATUS IND TO 40                 EM031330
         B     E9$KNSET            BRANCH TO E9$KNSET                   EM031340
E9$KMGB  CLI   E9$KSCF,1           SCF SET                              EM031350
         BNE   E9$KMGD             IF NO, BRANCH TO E9$KMGD             EM031360
         BAL   7,E9$KCVI           GET TTSS FROM REC NO                 EM031370
         B     E9$KSET             BRANCH TO E9$KSET                    EM031380
         SPACE 3                                                        EM031390
*********************************************************************** EM031400
*        FUNCTION SIMULATION (SEARCH EQUAL)                           * EM031410
*********************************************************************** EM031420
         SPACE 1                                                        EM031430
E9$KSCEQ DS    0H                  SEARCH EQUAL                         EM031440
         BAL   7,E9$KCVS                                                EM031450
         BAL   7,E9$KGEN           GENERATE COMPARE INSTRUCTION         EM031460
         L     15,E9$K$PCA                                              EM031470
         MVC   2(2,15),E9$KBGN     SET REC NO                           EM031480
E9$KEQB  LM    0,1,E9$K$PCA        LD R0=PCA, R1=DTF ADDR               EM031490
         GET (1),(0)               READ SAT FILE                        EM031500
         TM    2(1),X'80'          TEST COMPLETION ?                    EM031510
         BZ    *-4                 BR BACK IF NOT                       EM031520
         EX    0,E9$KCMP           COMPARE KEY                          EM031530
         BE    E9$KEQA             IF EQUAL, BRANCH TO E9$KEQA          EM031540
         L     15,E9$K$PCA                                              EM031550
         AI    2(15),1             INCR REC NO BY 1                     EM031560
         CLC   2(2,15),E9$KLST     END OF TRACK ?                       EM031570
         BNH   E9$KEQB             IF NO, BRANCH TO E9$KEQB             EM031580
         MVI   6(8),X'40'          SET STATUS IND TO 40                 EM031590
         B     E9$KNSET            BRANCH E9$KNSET                      EM031600
E9$KEQA  BAL   7,E9$KCVI           GET TTSS FROM REC NO                 EM031610
         MVC   5(160,11),5(2)      MVE DATA INTO USER AREA              EM031620
         B     E9$KSET             BRANCH TO E9$KSET                    EM031630
E9$KSET  MVI   6(8),X'FF'          SET STATUS IND TO FF                 EM031640
E9$KNSET MVC   0(1,11),E9$KPU      MOVE PU TO BYTE 0 OF DA              EM031650
         TM    E9$KIIPL,1          DURING IPL                           EM031660
         BZ    E9$KNPRC            BR TO E9$KNPRC IF NO                 EM031670
         L     14,E9$KIPRT         RELOAD RETURN ADDR                   EM031680
         L     8,E9$KSV8           RELOAD R8                            EM031690
         BR    14                  EXIT                                 EM031700
E9$KNPRC DS    0H                                                       EM031710
         SR    11,11               CLR R11                              EM031720
         IC    11,E9$SR289                                              EM031730
         AR    11,11               4 TIMES OF CHNL#                     EM031740
         CLI   5(8),X'01'          SEEK ?                               EM031750
         BE    E9$KSTSK            BR TO E9$KSTSK IF YES                EM031760
         SR    10,10               CLR R10                              EM031770
         IC    10,1(8)             LD R10 W/DATA LENGTH                 EM031780
         CLI   1(8),165            GREATER THAN 165                     EM031790
         BNH   E9$KNCGL            BR TO E9$KNCGL IF NO                 EM031800
         LA    10,165              SET R10 TO 165                       EM031810
E9$KNCGL MVC   E9$KFWTM(4),0(8)    FOR BOUNDARY                         EM031820
         A     10,E9$KFWTM                                              EM031830
         ST    10,E9$KBCWL(11)     STORE CHANGED BCW                    EM031840
         NC    E9$KBCWL(2,11),E9$KXC80 ERASE LENGTH FIELD               EM031850
         MVI   E9$R9DS,X'0C'       SET DEV STA                          EM031860
         NI    4(8),X'7F'                                               EM031870
         LH    8,8(8)              LOAD NEXT PACKET ADDR INTO R8        EM031880
         C     8,E9$KFF            CHAIN END ?                          EM031890
         BNE   E9$K101             IF NO, BRANCH TO E9$K101             EM031900
         B     E9$REXIT            BRANCH TO E9$REXIT                   EM031910
E9$KSTSK LA    10,5                SET R10 TO 5                         EM031920
         B     E9$KNCGL            BR TO E9$KNCGL                       EM031930
E9$KINV  DS    0H                                                       EM031940
         MVI   6(8),X'50'               SET CATASTROPHIC FAILURE        EM031950
         B     E9$KNSET                                                 EM031960
E9$KSK   DS    0H                  SEEK SUBROUTINE                      EM031970
         MVI   E9$KFL,0            RESET FLAG                           EM031980
         TM    1(11),X'10'         FASTBAND ?                           EM031990
         BOR   7                   IF YES, EXIT                         EM032000
         MVC   E9$KWK(4),1(11)                                          EM032010
         NC    E9$KWK(4),E9$KCC                                         EM032020
         CLC   E9$KWK(4),1(11)     UPPER 4-BIT ZERO ?                   EM032030
         BNER  7                   IF NO, EXIT                          EM032040
         TR    E9$KWK(4),E9$KCHT                                        EM032050
         CLC   E9$KWK(4),E9$KCHC   NUMERIC ?                            EM032060
         BNER  7                   IF NO, EXIT                          EM032070
         MVC   E9$K$SK(2),1(11)    MOVE TRACK #                         EM032080
         MVI   E9$KFL,1            SET FLAG                             EM032090
         BR    7                   EXIT                                 EM032100
E9$KCV   DS    0H                  DISC ADDR CONVERSION SUBROUTINE      EM032110
         TM    1(11),X'10'         FASTBAND ?                           EM032120
         BO    E9$KCVF             IF YES, BRANCH TO E9$KCVF            EM032130
         CLI   E9$KFL,0            LEGAL ADDR ?                         EM032140
         BE    E9$KINV             IF NO, BRANCH TO E9$KINV             EM032150
         PACK  E9$KDBL+5(3),1(4,11) CONVERT TO PACKED DECIMAL           EM032160
         MVN   E9$KDBL+7(1),E9$KPLUS MOVE PLUS SIGN                     EM032170
         CVB   10,E9$KDBL          CONVERT TO BINARY                    EM032180
         LA    10,1(10)            INCREMENT REC NO BY 1                EM032190
         BR    7                   EXIT                                 EM032200
E9$KCVF  MVC   E9$KWK(2),3(11)                                          EM032210
         NC    E9$KWK(2),E9$KCC                                         EM032220
         CLC   E9$KWK(2),3(11)     UPPER 4-BIT ZERO                     EM032230
         BNE   E9$KINV             IF NO, BRANCH TO E9$KINV             EM032240
         TR    E9$KWK(2),E9$KCHT                                        EM032250
         CLC   E9$KWK(2),E9$KCHC   NUMERIC ?                            EM032260
         BNE   E9$KINV             IF NO, BRANCH TO E9$KINV             EM032270
         CLC   3(2,11),E9$KLFB     BEYOND FASTBAND LIMIT ?              EM032280
         BH    E9$KINV             IF YES, BRANCH TO E9$KINV            EM032290
         PACK  E9$KDBL+5(3),3(2,11) CONVERT TO PACKED DECIMAL           EM032300
         MVN   E9$KDBL+7(1),E9$KPLUS MOVE PLUS SIGN                     EM032310
         CVB   10,E9$KDBL          CONVERT TO BINARY                    EM032320
         AH    10,E9$KCTF          INCREMENT REC NO BY 10001            EM032330
         BR    7                   EXIT                                 EM032340
E9$KCVS  DS    0H                                                       EM032350
         TM    1(11),X'10'         FASTBAND ?                           EM032360
         BO    E9$KCVSA            IF YES, BRANCH TO E9$KCVSA           EM032370
         PACK  E9$KDBL+5(3),E9$K$SK(4)                                  EM032380
         MVN   E9$KDBL+7(1),E9$KPLUS                                    EM032390
         CVB   10,E9$KDBL          CONVERT TO BINARY                    EM032400
         CLI   3(11),5             HEAD 2 ?                             EM032410
         BE    E9$KCVSB            IF YES, BRANCH TO E9$KCVSB           EM032420
         STH   10,E9$KBGN          STORE IN E9$KBGN                     EM032430
         LA    10,54(10)           INCR R10 BY 54                       EM032440
E9$KCVSC STH   10,E9$KLST          STORE IN E9$KLST                     EM032450
E9$KCVSD L     15,E9$K$PCA                                              EM032460
         ST    10,0(15)            SET REC NO FOR NEXT READ             EM032470
         BR    7                   EXIT                                 EM032480
E9$KCVSB LA    10,55(10)           INCR R10 BY 55                       EM032490
         STH   10,E9$KBGN          STORE IN E9$KBGN                     EM032500
         LA    10,44(10)           INCR R10 BY 44                       EM032510
         B     E9$KCVSC            BRANCH TO E9$KCVSC                   EM032520
E9$KCVSA MVC   E9$KBGN(4),E9$KCTF  SET (E9$KBGN & E9$KLST)              EM032530
         LH    10,E9$KLST          SET REC NO FOR NEXT READ             EM032540
         B     E9$KCVSD            BRANCH TO E9$KCVSD                   EM032550
E9$KGEN  DS    0H                                                       EM032560
         LA    14,5(11)            LD R14 W/DATA ADDR                   EM032570
         LA    12,160              SET R12 = 160                        EM032580
         SR    15,15               CLR R15                              EM032590
E9$KGEB  CLI   0(14),X'FF'         FF ?                                 EM032600
         BNE   E9$KGEA             IF NO, BRANCH TO E9$KGEA             EM032610
         LA    14,1(14)            INCR R14 BY 1                        EM032620
         BCT   12,E9$KGEB          DECR R12 BY 1. IF NOT 0, TO E9$KGEB  EM032630
         MVI   6(8),X'40'          SET STATUS IND TO 40                 EM032640
         B     E9$KNSET            BR TO E9$KNSET                       EM032650
E9$KGEA  LR    4,14                                                     EM032660
         SR    4,11                                                     EM032670
         STC   4,E9$KCMP+3              SET OP1 OF E9$KCMP              EM032680
         STC   4,E9$KCMP+5              SET OP2 OF E9$KCMP              EM032690
E9$KGEE  LA    14,1(14)            INCR R14 BY 1                        EM032700
         BCT   12,E9$KGEC          DECR R12 BY 1. IF NOT 0, TO E9$KGEC  EM032710
E9$KGED  STC   15,E9$KCMP+1        SET LNGTH OF E9$KCMP                 EM032720
         BR    7                   EXIT                                 EM032730
E9$KGEC  CLI   0(14),X'FF'         FF ?                                 EM032740
         BE    E9$KGED             IF YES, BRANCH TO E9$KGED            EM032750
         LA    15,1(15)            INCR R15 BY 1                        EM032760
         B     E9$KGEE             BRANCH TO E9$KGEE                    EM032770
E9$KCMP  CLC   0(1,2),0(11)        FOR EX INSTRUCTION                   EM032780
E9$KCVI  DS    0H                  CONVERT (SAT ADDR TO 8410 ADDR)      EM032790
         L     15,E9$K$PCA                                              EM032800
         L     1,0(15)             LOAD SAT ADDR IN R1                  EM032810
         CH    1,E9$KCTF           GREATER THAN 10001                   EM032820
         BNL   E9$KCIA             IF NOT LOW, BRANCH TO E9$KCIA        EM032830
         BCTR  1,0                 DECREMENT R1 BY 1                    EM032840
         CVD   1,E9$KDBL           CONVERT TO DECIMAL                   EM032850
         UNPK  1(4,11),E9$KDBL+5(3)                                     EM032860
         NC    1(4,11),E9$KCC      GET TTSS                             EM032870
         BR    7                   EXIT                                 EM032880
E9$KCIA  SH    1,E9$KCTF           SUBTRACT 10001 FROM R1               EM032890
         CVD   1,E9$KDBL           CONVERT TO DECIMAL                   EM032900
         UNPK  1(4,11),E9$KDBL+5(3)                                     EM032910
         NC    1(4,11),E9$KCC      GET TTSS                             EM032920
         OI    1(11),X'10'         SET FASTBAND                         EM032930
         BR    7                   EXIT                                 EM032940
         EJECT                                                          EM032950
         DROP  5                                                        EM032960
*********************************************************************** EM032970
*        FOR  MOUNT COMMAND                                           * EM032980
*********************************************************************** EM032990
         SPACE 1                                                        EM033000
E9$KMNT  DS    0H                  ENTRY FOR MOUNT OPERATION            EM033010
         USING *,15                                                     EM033020
         L     5,E9$AK10                                                EM033030
         LA    13,E9$KSAVE         LD R13 W/SAVE AREA                   EM033040
         DROP  15                                                       EM033050
         USING E9$K10,5                                                 EM033060
         LA    9,E9$KT10                                                EM033070
         MVN   E9$KMNCN(1),E9$RAKAR+13                                  EM033080
E9$KMN05 CLI  E9$K$DVC,X'FF'       SENTINEL                             EM033090
         BE    E9$KMN99            BR TO E9$KMN99 IF YES                EM033100
         CLC   E9$KMNCN(1),E9$K$DVC MATCH ?                             EM033110
         BE    E9$KMN10            BR TO E9$KMN10 IF YES                EM033120
         LA    9,E9$K$L(9)         UPDATE POINTER FOR NEXT ENTRY        EM033130
         B     E9$KMN05            BR TO E9$KMN05                       EM033140
E9$KMN10 CLI   E9$RAKAR+16,C'D'    DISPLAY ?                            EM033150
         BNE   E9$KMN15            BR TO E9$KMN15 IF NO                 EM033160
         TM    E9$K$FLG,X'40'      OPENED ?                             EM033170
         BZ    E9$KMN11            BR TO E9$KMN11 IF NO                 EM033180
         MVC   E9$KMNM1(4),=C'MNT ' MOVE CNSTNT FOR MESSAGE             EM033190
         MVC   E9$KMNM1+4(2),E9$K$MNT MOVE NMT# INTO MSG                EM033200
         B     E9$KMN12            BR TO E9$KMN12                       EM033210
E9$KMN11 MVC   E9$KMNM1(6),=C'CLOSED' MOVE CNSTNT FOR MSG               EM033220
E9$KMN12 WTLD  E9$KMNM1,6          WTLD                                 EM033230
         B     E9$KEXOC            BR TO E9$KEXOC                       EM033240
E9$KMN15 TM    E9$K$FLG,X'40'      OPENED ?                             EM033250
         BNO   E9$KMN20            BR TO E9$KMN20 IF NO                 EM033260
         L     1,E9$K$SAT                                               EM033270
         CLOSE (1)                 CLOSE SAT FILE                       EM033280
         NI    E9$K$FLG,X'BF'      ERASE OPEN-BIT                       EM033290
E9$KMN20 CLI   E9$RAKAR+16,C'C'    CLOSE ?'                             EM033300
         BE    E9$KEXOC            BR TO E9$KEXOC IF YES                EM033310
         CLI   E9$RAKAR+16,C'N'    NEXT ?                               EM033320
         BNE   E9$KMN25            BR TO E9$KMN25 IF NO                 EM033330
         PACK  E9$KMNC1(2),E9$K$MNT  INCREMENT MNT# FOR NEXT PACK       EM033340
         AP    E9$KMNC1(2),=P'1'                                        EM033350
         UNPK  E9$K$MNT(2),E9$KMNC1                                     EM033360
         OI    E9$K$MNT+1,X'F0'                                         EM033370
         B     E9$KMN30            BR TO E9$KMN30                       EM033380
E9$KMN25 MVC   E9$K$MNT(2),E9$RAKAR+16  SET NEW MNT#                    EM033390
E9$KMN30 L     1,E9$KSCPT               LOAD GETCS PTR                  EM033400
         SETCS (1),R                                                    EM033410
E9$KMN40 GETCS E9$KMNCS            GETCS                                EM033420
         CLI   E9$KMNCS+79,C'B'    B-CARD ?                             EM033430
         BNE   E9$KMN35            BR TO E9$KMN35 IF NO                 EM033440
         NI    E9$KMNCS+13,X'0F'   ERASE ZONE                           EM033450
         CLC   E9$K$DVC(1),E9$KMNCS+13  MATCH ?                         EM033460
         BNE   E9$KMN40            BR TO E9$KMN40 IF NO                 EM033470
         CLC   E9$K$MNT(2),E9$KMNCS+3 MOUNT THIS DRIVE ?                EM033480
         BNE   E9$KMN40            BR TO E9$KMN40 IF NO                 EM033490
         MVC   E9$KDYYY+5(3),E9$KMNCS                                   EM033500
         L     11,E9$K$BUF                                              EM033510
         LA    11,5(11)                 INCREMENT OFFSET                EM033520
         MVC   0(8,11),E9$KDYYY    SET PIOCB                            EM033530
         MVC   8(2,11),=H'256'          SET FCB LENGTH                  EM033540
         LR    1,11                                                     EM033550
         RDFCB (1)                 READ FCB                             EM033560
         MVC   76(18,11),E9$KMNCS+24 MOVE PACK-NAME                     EM033570
         MVC   30(26,11),E9$KMNCS+42                                    EM033580
         MVC   118(6,11),E9$KMNCS+5 MOVE VSN                            EM033590
         L     1,E9$K$SAT                                               EM033600
         MVC   33(3,1),E9$KMNCS    SET LFD NAME IN SAT                  EM033610
         OI    37(1),X'04'         SET FCB IN CORE                      EM033620
         OPEN  (1)                 OPEN SAT FILE                        EM033630
         NI    37(1),X'FB'         CLEAR FCB IN CORE                    EM033640
         TM    36(1),X'80'         OPEN-FLAG ON ?                       EM033650
         BZ    E9$KMN50            BR TO E9$KMN50 IF NO                 EM033660
         OI    E9$K$FLG,X'40'      SET OPEN-BIT                         EM033670
E9$KMN50 B     E9$KEXOC            BR TO E9$KEXOC                       EM033680
E9$KMN99 MVC   E9$RAPCN(4),=X'5B00FE40'                                 EM033690
         B     E9$KMN95                                                 EM033700
E9$KMN35 MVC   E9$RAPCN(4),=X'5B00FF40'                                 EM033710
E9$KMN95 WTLD  E9$RAPCN,22         WTLD                                 EM033720
E9$KEXOC EXIT  OC                  EXIT OC                              EM033730
         EJECT                                                          EM033740
         DROP  5                                                        EM033750
*********************************************************************** EM033760
*                                                                     * EM033770
*        FOR CLOSE BEFORE EOJ OPERATION                               * EM033780
*                                                                     * EM033790
*********************************************************************** EM033800
         SPACE 1                                                        EM033810
E9$KCLS  DS    0H                  ENTRY                                EM033820
         USING *,15                                                     EM033830
         L     5,E9$AK10           LD R5 W/8410 ROUTINE                 EM033840
         DROP  15                                                       EM033850
         USING E9$K10,5                                                 EM033860
         LR    12,14               SAVE RETURN ADDR IN R12              EM033870
         LA    13,E9$KSAVE         LD R13 W/SAVE AREA ADDR              EM033880
         LA    9,E9$KT10                                                EM033890
E9$KCL30 CLI   E9$K$DVC,X'FF'      SENTINEL ?                           EM033900
         BER   12                  RETURN TO CALLER                     EM033910
         TM    E9$K$FLG,X'40'      FILE OPENED ?                        EM033920
         BZ    E9$KCL20            BR TO E9$KCL20 IF NO                 EM033930
         NI    E9$K$FLG,X'BF'      ERASE OPEN BIT                       EM033940
         L     1,E9$K$SAT          LD R1 W/SAT ADDR                     EM033950
         CLOSE (1)                 CLOSE SAT FILE                       EM033960
E9$KCL20 LA    9,E9$K$L(9)         UPDATE POINTER FOR NEXT ENTRY        EM033970
         B     E9$KCL30            BR TO E9$KCL30                       EM033980
         EJECT                                                          EM033990
*********************************************************************** EM034000
*                                                                     * EM034010
*        WORK AREAS AND CONSTANTS FOR 8410 SIMULATION                 * EM034020
*                                                                     * EM034030
*********************************************************************** EM034040
         SPACE 1                                                        EM034050
E9$KBCWL EQU   64                                                       EM034060
E9$KSV8  DS    F                   R8 SAVE AREA (FOR IPL)               EM034070
E9$KXC80 DC    X'8000'             ERASER OF LENGTH                     EM034080
E9$KINC  DC    F'10001'            INCR VALUE FOR FASTBAND              EM034090
E9$KLFB  DC    X'0501'             LIMIT TTSS FOR FASTBAND              EM034100
E9$KIIPL DC    X'0'                FLAG FOR IPL OPERATION               EM034110
E9$KFL   DC    X'0'                FLAG                                 EM034120
         CNOP  0,8                                                      EM034130
E9$KDBL  DC    XL8'0'              WORK AREA                            EM034140
E9$KPLUS DC    X'0C'               PLUS SIGN                            EM034150
E9$KWK   DS    CL4                 WORK AREA                            EM034160
E9$KCC   DC    X'0F0F0F0F'         ERASE UPPER 4-BIT                    EM034170
E9$KCHT  DC    C'LLLLLLLLLLIIIIII' TABLE FOR NUMERIC CHECK              EM034180
E9$KCHC  DC    C'LLLL'             CONST. (LEGAL)                       EM034190
E9$KFF   DC    F'-1'               ALL ONE                              EM034200
E9$KFWTM DS    F                   WORK AREA (FULL WORD)                EM034210
E9$KMNCN DC    X'00'                                                    EM034220
E9$KMNM1 DS    CL6                 MSG AREA                             EM034230
E9$KMNC1 DS    CL2                 WORK AREA                            EM034240
E9$KMNCS DS    CL80                GETCS AREA                           EM034250
E9$KDYYY DC    C'E9$KDYYY'         FOR LFD                              EM034260
E9$KCSPT DS    F                   GETCS POINTER SAVE AREA              EM034270
E9$KSCPT DS    F                                                        EM034280
E9$KBGN  DS    H                   SEARCH START ADDR                    EM034290
E9$KLST  DS    H                   SEARCH END ADDR                      EM034300
E9$KCTF  DC    H'10001'            VALUE FOR E9$KBGN (FOR FASTBAND)     EM034310
         DC    H'10051'                 VALUE OF E9$KLST FOR FB         EM034320
E9$KPU   DS    CL1                 PU # SAVE AREA                       EM034330
E9$KSCF  DS    CL1                 SEARCH FLAG                          EM034340
E9$KMV1  MVC   0(1,11),0(2)        FOR EXECUTE                          EM034350
E9$KMV2  MVC   0(1,2),0(11)        FOR EXECUTE                          EM034360
E9$KT10  DS    0A                  TABLES FOR 8410 DISCS                EM034370
&K$01    SET   0                                                        EM034380
         DO    &N10                                                     EM034390
         DC    AL1(&K$01)                                               EM034400
         DC    X'00'                                                    EM034410
         DC    C'00'                                                    EM034420
&K$02    SET   'E9$KPCA'.'&K$01'                                        EM034430
         DC    A(&K$02)                                                 EM034440
&K$02    SET   'E9$KDSC'.'&K$01'                                        EM034450
         DC    A(&K$02)                                                 EM034460
         DC    A(E9$KDBUF-5)                                            EM034470
         DC    A(1)                                                     EM034480
&K$01    SET   &K$01+1                                                  EM034490
         ENDO                                                           EM034500
         DC    X'FF'               SENTINEL                             EM034510
         EJECT                                                          EM034520
&K$01    SET   0                                                        EM034530
         DO    &K$01<&N10                                               EM034540
E9$KDSC0 DTFPF PCA1=E9$KPCA0,EXTENTS=1                                  EM034550
E9$KPCA0 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034560
         EJECT                                                          EM034570
&K$01    SET   &K$01+1                                                  EM034580
         GOTO  .KK1                                                     EM034590
         ENDO                                                           EM034600
.KK1     LABEL                                                          EM034610
         DO    &K$01<&N10                                               EM034620
E9$KDSC1 DTFPF PCA1=E9$KPCA1,EXTENTS=1                                  EM034630
E9$KPCA1 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034640
         EJECT                                                          EM034650
&K$01    SET   &K$01+1                                                  EM034660
         GOTO  .KK2                                                     EM034670
         ENDO                                                           EM034680
.KK2     LABEL                                                          EM034690
         DO    &K$01<&N10                                               EM034700
E9$KDSC2 DTFPF PCA1=E9$KPCA2,EXTENTS=1                                  EM034710
E9$KPCA2 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034720
         EJECT                                                          EM034730
&K$01    SET   &K$01+1                                                  EM034740
         GOTO  .KK3                                                     EM034750
         ENDO                                                           EM034760
.KK3     LABEL                                                          EM034770
         DO    &K$01<&N10                                               EM034780
E9$KDSC3 DTFPF PCA1=E9$KPCA3,EXTENTS=1                                  EM034790
E9$KPCA3 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034800
         EJECT                                                          EM034810
&K$01    SET   &K$01+1                                                  EM034820
         GOTO  .KK4                                                     EM034830
         ENDO                                                           EM034840
.KK4     LABEL                                                          EM034850
         DO    &K$01<&N10                                               EM034860
E9$KDSC4 DTFPF PCA1=E9$KPCA4,EXTENTS=1                                  EM034870
E9$KPCA4 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034880
         EJECT                                                          EM034890
&K$01    SET   &K$01+1                                                  EM034900
         GOTO  .KK5                                                     EM034910
         ENDO                                                           EM034920
.KK5     LABEL                                                          EM034930
         DO    &K$01<&N10                                               EM034940
E9$KDSC5 DTFPF PCA1=E9$KPCA5,EXTENTS=1                                  EM034950
E9$KPCA5 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM034960
         EJECT                                                          EM034970
&K$01    SET   &K$01+1                                                  EM034980
         GOTO  .KK6                                                     EM034990
         ENDO                                                           EM035000
.KK6     LABEL                                                          EM035010
         DO    &K$01<&N10                                               EM035020
E9$KDSC6 DTFPF PCA1=E9$KPCA6,EXTENTS=1                                  EM035030
E9$KPCA6 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM035040
         EJECT                                                          EM035050
&K$01    SET   &K$01+1                                                  EM035060
         GOTO  .KK7                                                     EM035070
         ENDO                                                           EM035080
.KK7     LABEL                                                          EM035090
         DO    &K$01<&N10                                               EM035100
E9$KDSC7 DTFPF PCA1=E9$KPCA7,EXTENTS=1                                  EM035110
E9$KPCA7 PCA   BLKSIZE=160,IOAREA1=E9$KDBUF,SIZE=100                    EM035120
         EJECT                                                          EM035130
&K$01    SET   &K$01+1                                                  EM035140
         GOTO  .KK8                                                     EM035150
         ENDO                                                           EM035160
.KK8     LABEL                                                          EM035170
         EJECT                                                          EM035180
         DC    3H'0'                                                    EM035190
E9$KDBUF DC    XL256'0'            IO BUFFER FOR SAT FILE               EM035200
E9$KSAVE DS    18F                 SAVE AREA FOR SAT                    EM035210
E9$KIPRT DS    F                   R14 SAVE AREA                        EM035220
E9$KSNAP DS    0H                                                       EM035230
         ST    1,E9$KTEMP                                               EM035240
         SNAP  E9$R9MEM,E9$KEND                                         EM035250
         L     1,E9$KTEMP                                               EM035260
         BR    7                                                        EM035270
E9$KTEMP DS    F                                                        EM035280
         B     *                                                        EM035290
         B     *                                                        EM035300
         B     *                                                        EM035310
         B     *                                                        EM035320
         B     *                                                        EM035330
         B     *                                                        EM035340
         B     *                                                        EM035350
         B     *                                                        EM035360
         B     *                                                        EM035370
         B     *                                                        EM035380
         B     *                                                        EM035390
         B     *                                                        EM035400
         B     *                                                        EM035410
         B     *                                                        EM035420
         B     *                                                        EM035430
E9$KEND  DS    0H                      ALIGNMENT ONLY                   EM035440
E9$K$    DSECT                                                          EM035450
         USING *,9                                                      EM035460
E9$K$DVC DS    CL1                 PU                                   EM035470
E9$K$FLG DS    CL1                 FLAG                                 EM035480
E9$K$MNT DS    CL2                 MOUNT #                              EM035490
E9$K$PCA DS    F                   PCA ADDR                             EM035500
E9$K$SAT DS    F                   SAT ADDR                             EM035510
E9$K$BUF DS    F                   BUFFER ADDR                          EM035520
E9$K$SK  DS    F                   SEEK TABLE                           EM035530
E9$K$L   EQU   *-E9$K$                                                  EM035540
         CSECT                                                          EM035550
         DROP  9                                                        EM035560
         ENDO                                                           EM035570
*********************************************************************** EM035580
         DROP  5                                                        EM035590
         DO    ('&N11'='')**('&N14'='')                                 EM035600
*********************************************************************** EM035610
         USING *,5                                                      EM035620
*********************************************************************** EM035630
E9$D11   EQU   *                                                        EM035640
         WTLD  E9$D11MS,51                                              EM035650
         EOJ                                                            EM035660
E9$D11MS DC    C'8411/14 REQUEST TRAPPED IN EMULATOR WITHOUT DISC'      EM035670
         DROP  5                                                        EM035680
*********************************************************************** EM035690
         ENDO                                                           EM035700
         CNOP  0,4                                                      EM035710
         DO    ('&N11'>'0')++('&N14'>'0')                               EM035720
         TITLE '8411/8414 DISC DISPATCHER '                             EM035730
*********************************************************************** EM035740
*                                                                     * EM035750
* THIS ROUTINE IS ACTIVATED ON DETECTING 9300'S SRC 0,42.             * EM035760
*                                                                     * EM035770
*  FUNCTIONS OF 8411/8414 DISPATCHER IN EMULATOR                      * EM035780
*   1. OBTAIN INFORMATION FROM REQUEST PACKET OF 9300.                * EM035790
*   2. ALLOCATE ALL CCW'S IN CHAIN ON DOUBLE WORD BOUNDARY.           * EM035800
*   3. CONVERT 9300 CCW FORMAT TO 90/30'S AS FOLLOWS;                 * EM035810
*        IF BIT 2 IN BYTE 4 OF 9300'S IS 1,SET BYTE COUNT 0 IN 90/30'S* EM035820
*        IF BIT 3 IN BYTE 4 OF 9300'S IS 1,SET SLI BIT TO 1 IN 90/30'S* EM035830
*                                                                     * EM035840
*   4. BUILD SEEK CCW IF REQUIRED BY 9300'S PACKET, SEEK ADDR IS IN   * EM035850
*      PACKET.                                                        * EM035860
*   5. 9300 CCW'S ARE TRANSFERED INTO CCW-POOL (E9$DPOOL).            * EM035870
*   6. ISSUE EXCP TO OS/3 SUPERVISOR.                                 * EM035880
*   7. WAIT FOR COMPLETION BY TESTING CCB.                            * EM035890
*   8. SET APPOPRIATE INTERRUPT CODE IN 9300'S REQUEST PACKET.        * EM035900
*   9. FULLFIL PACKET WITH INFORMATION OF 10 COMPLETION.              * EM035910
*                                                                     * EM035920
E9$RENTY EQU   274                 9300 REENTRY ADDRESS               * EM035930
*                                                                     * EM035940
*********************************************************************** EM035950
         SPACE 4                                                        EM035960
*********************************************************************** EM035970
*                                                                       EM035980
*        REGISTER CONVENTION                                            EM035990
*                                                                       EM036000
*        REGISTER 5 AND 6 ARE USED AS COVERING REGISTERS                EM036010
RCCB     EQU   1              CURRENT CCB ADDRESS                       EM036020
RZ       EQU   7              BINARY ZERO                               EM036030
RPKT     EQU   15             9300 DISC REQUEST PACKET                  EM036040
RL       EQU   8              SUBROUTINE LINKAGE                        EM036050
RDP      EQU   13             CCW POOL POINTER                          EM036060
*                                                                       EM036070
RA       EQU   10                                                       EM036080
RB       EQU   11                                                       EM036090
RC       EQU   12                                                       EM036100
RD       EQU   13                                                       EM036110
RE       EQU   14                                                       EM036120
RF       EQU   15                                                       EM036130
*********************************************************************** EM036140
         EJECT                                                          EM036150
E9$DPKT  DSECT                                                          EM036160
         USING *,RPKT                                                   EM036170
*********************************************************************** EM036180
E9$DP0   DC    Y(0)           COMMAND ADDRESS WORD (CAW)                EM036190
E9$DP2   DC    Y(0)           NEXT CCW ADDRESS                          EM036200
E9$DP3   EQU   E9$DP2+1,1          DEVICE ADDRESS                       EM036210
E9$DP4   DC    YL1(0)         PHYSICAL UNIT NUMBER                      EM036220
E9$DP5   DC    YL1(0)         CYLINDER ADDRESS                          EM036230
E9$DP6   DC    YL1(0)         AUTOMATIC REISSUE COUNT                   EM036240
E9$DP7   DC    YL1(0)         HEAD ADDRESS                              EM036250
E9$DP8   DC    YL1(0)         STATUS INDICATORS                         EM036260
E9$DP80  EQU   B'00000000'       NOT USED                               EM036270
E9$DP81  EQU   B'00000001'       SOFTWARE ERROR                         EM036280
E9$DP82  EQU   B'00000010'       HARDWARE ERROR                         EM036290
E9$DP83  EQU   B'00000011'       END OF FILE                            EM036300
E9$DP84  EQU   B'00000100'       NO FIND ON SEARCH                      EM036310
E9$DP88  EQU   B'000001000'      WRONG LENGTH                           EM036320
E9$DP8F  EQU   B'00001111'       SUCCESSFUL COMPLETION                  EM036330
E9$DP9   DC    YL1(0)         LOGICAL UNIT NUMBER                       EM036340
E9$DPA   DC    Y(0)           CHAIN OR LAST BYTE ADDRESS                EM036350
*********************************************************************** EM036360
         EJECT                                                          EM036370
         CSECT                                                          EM036380
*********************************************************************** EM036390
*                                                                     * EM036400
E9$D11   DS    0H                  8411/8414 DISC DISPATCHER            EM036410
*                                                                     * EM036420
*********************************************************************** EM036430
         USING *,R5                                                     EM036440
         USING IC$CCB,RCCB                                              EM036450
         USING E9$DPKT,RPKT                                             EM036460
         USING E9$RAPCS,R6                                              EM036470
         L     R6,E9$D11C2                                              EM036480
         L     RPKT,E9$RAPRF       9300 PACKET ADDR TO R15              EM036490
         TM    E9$RIOII+1,X'04'         I/O MODE BIT ON?                EM036500
         BNO   E9$D1102            IF NOT GO TO D1102                   EM036510
         L     RPKT,E9$RAPRE       PACKET ADDRESS TO R15                EM036520
E9$D1102 DS    0H                                                       EM036530
         LA    7,DISCTBL                LD DISC TBL ADDR                EM036540
TESTDTBL CLC   0(4,7),DISCTTS           COMP FOR ZEROS                  EM036550
         BE    STORDPTR                 IF EQUAL STOR POINTER           EM036560
         LA    7,4(,7)                  INCREMENT NEXT SLOT             EM036570
         B     TESTDTBL                 GO BACK                         EM036580
STORDPTR ST    15,0(7)                                                  EM036590
         TM    E9$RIOII+1,X'80'                                         EM036600
         BNO   DISCIO                                                   EM036610
*                                       OPEN SLOT                       EM036620
*                                       OPEN SLOT                       EM036630
         AWAKE DISCECB                                                  EM036640
         B     E9$DNOSP                                                 EM036650
DISCIO   DS    0H                                                       EM036660
         LA    7,DISCTBL                LD POINTER                      EM036670
         CLC   0(4,7),DISCTTS           COMP FOR ZEROS                  EM036680
         BE    BYDTSK1                 BYPASS IF SET                    EM036690
         L     RPKT,DISCTBL                                             EM036700
         SR    RZ,RZ               BINARY ZERO TO RZ                    EM036710
         STC   RZ,E9$DP2           CLEAR BYTE 2 OF PACKET               EM036720
         STC   RZ,E9$DP6           CLEAR BYTE 6 OF PACKET               EM036730
         NI    E9$DP8,X'F0'        CLEAR RIGHT MOST 4 BITS IN BYTE 8    EM036740
*                                                                       EM036750
*                                                                       EM036760
*                                                                       EM036770
         SR    R9,R9               CLEAR R9                             EM036780
         SR    RA,RA               BINARY ZERO TO RA                    EM036790
         IC    RA,E9$DP9           LU NUMBER TO RA                      EM036800
         AR    RA,RA               DOUBLE LU NUMBER                     EM036810
         AH    RA,E9$RLUBA         ADD LU TABLE BASE ADDRESS            EM036820
         IC    R9,1(RA)            PU POINTER TO R9                     EM036830
         AH    R9,E9$RPUBA         POINT R9 AT PU TABLE ADDRESS         EM036840
         CLI   0(R9),X'07'         DISK DEVICE ?                        EM036850
         BNE   E9$DER1                                                  EM036860
         IC    RA,3(R9)            DEVICE ADDR TO 9300 PACKET           EM036870
         STC   RA,E9$DP3                                                EM036880
         STC   RA,E9$R9DA               SET DA TO 43                    EM036890
         IC    RA,1(R9)            PU NUMBER TO USER PACKET             EM036900
         LA    RB,X'F0'                                                 EM036910
         NR    RA,RB               CLEAR RIGHT MOST 4 BITS              EM036920
         STC   RA,E9$DP4           STORE INTO PACKET                    EM036930
         SRL   RA,1                RA CONTAINS (PU#)*8                  EM036940
         L     RCCB,E9$DTCCB(RA)   CURRENT CCB ADDR TO RCCB             EM036950
         LA    RA,E9$DTCCB(RA)                                          EM036960
         TM    5(RA),X'80'         THIS DEVICE IS PREPARED ?            EM036970
         BZ    E9$D11E3            YES,  NO GO TO DISPLAY AND CANCEL    EM036980
         CLC   4(1,RA),E9$DP3      DEVICE ADDR MATCH?                   EM036990
         BNE   E9$D11E3            YES,  NO ERROR 3                     EM037000
*********************************************************************** EM037010
*                                                                     * EM037020
*    CHECK USER REQUEST FOR AUTOMATIC SEEK BY TESTING BYTE 8          * EM037030
*                                                                     * EM037040
*        BIT 1.......... 0 AUTO SEEK,   1 USER CCW ONLY               * EM037050
*        BIT 2.......... 0 CHAINED CCW 1 SEEK ONY                     * EM037060
*                                                                     * EM037070
*********************************************************************** EM037080
         LA    RDP,E9$DPOOL        CCW POOL BASE ADDR TO RDP            EM037090
         LA    RC,8                BINARY 8 TO RC                       EM037100
         LH    R4,E9$DP0           9300 1ST CCW ADDR TO R4              EM037110
         TM    E9$DP8,X'40'        AUTO SEEK REQUIRED ?                 EM037120
         BO    E9$D1120            YES, NO E9$D1120                     EM037130
         MVC   E9$DSZ+3(3),E9$DP5  SET DISC ADDR (00CCHH) TO SEEK DATA  EM037140
         MVI   E9$DSEEK+4,X'60' SET CHAIN & SLI TO BE 1'S               EM037150
         LM    RA,RB,E9$DSEEK      SEEK CCW TO CCW POOL                 EM037160
         STM   RA,RB,0(RDP)                                             EM037170
         OI    E9$D002X,X'01'           SET AUTO SEEK ADDED TO CHAIN    EM037180
         AR    RDP,RC              UP DATE CCW POOL POINTER             EM037190
         TM    E9$DP8,X'20'        CHAIN REQUIRED ?                     EM037200
         BZ    E9$D1120            NO, YES E9$D1120                     EM037210
         NI    E9$DPOOL+4,X'9F'         SET CHAIN TO ZERO               EM037220
         B     E9$DEXCP                                                 EM037230
E9$D002X DC    XL2'0000'                                                EM037240
         EJECT                                                          EM037250
*********************************************************************** EM037260
*                                                                     * EM037270
E9$D1120 DS    0H                  CCW CONVESION                        EM037280
*                                                                     * EM037290
*********************************************************************** EM037300
         SR    R0,R0               CLEAR R0                             EM037310
         MVI   E9$DPREV,0          CLEAR PREVIOUS COMMAND INDICATOR     EM037320
         IC    R0,0(R4)            COMMAND CODE TO R0                   EM037330
         STH   RZ,E9$D11H2         CLEAR UNSOLVED TIC COUNTER           EM037340
         LA    RA,E9$DADD          BASE ADDR OF CCW ADDR TABLE          EM037350
         LA    RE,E9$DCCW          BASE ADDR OF POOL AREA               EM037360
         LH    R9,4(,RE)           LOAD SIZE OF CCW POOL                EM037370
         B     E9$D1131            GO TO E9$D1131                       EM037380
*                                                                       EM037390
*                                                                       EM037400
E9$D1130 IC    R0,0(R4)            COMMAND CODE TO R0                   EM037410
*                                                                       EM037420
E9$D1131 DS    0H                                                       EM037430
         MVC   0(8,RDP),0(R4)      9300 CCW TO CCW POOL                 EM037440
         CR    R0,RC               TIC COMMAND?                         EM037450
         BE    E9$D11T0            NO, YES E9$D11T0                     EM037460
         TM    4(R4),X'20'         CHECK T FLAG IN 9300 CCW             EM037470
         BZ    E9$D1132            IF T=0 GO TO E9$D1132                EM037480
         ST    RZ,4(,RDP)          CLEAR T BIT AND BYTE COUNT           EM037490
E9$D1132 MVI   4(RDP),X'60'        SET SLI & CHAIN FLAG TO BE 1         EM037500
         TM    4(R4),X'10'              IS 9300 SLI SET                 EM037501
         BO    E9$D113A                 BR AROUND                       EM037502
         NI    4(RDP),X'DF'             SET SLI OFF                     EM037503
E9$D113A EQU   *                                                        EM037504
E9$D1133 TM    4(R4),X'40'         CCW IN CHAIN?                        EM037510
         BO    E9$D1134            NO, YES E9$D1134                     EM037520
         NI    4(RDP),X'FF'-X'40'  SET CHAIN BIT TO BE ZERO             EM037530
         CLI   E9$DPREV,C'S'       PREVIOUS COMMAND IS SEARCH           EM037540
         BNE   E9$D1137            YES,  NO TEST UNSOLVED TIC           EM037550
E9$D1134 BAL   RL,E9$D11SE         UP DATE POINTERS                     EM037560
E9$D1135 STC   R0,E9$DPREV         CURRENT COMMAND TO PREV              EM037570
         NI    E9$DPREV,X'7F'      CLEAR M BIT IN COMMAND CODE          EM037580
         CLI   E9$DPREV,X'25'      SEARCH COMMAND?                      EM037590
         BL    E9$D1136                                                 EM037600
         TM    E9$DPREV,X'01'                                           EM037610
         BZ    E9$D1136                                                 EM037620
         MVI   E9$DPREV,C'S'       SEARCH FLAG TO PREV                  EM037630
E9$D1136 BCT   R9,E9$D1130         END OF TABLE ? YES, NO CONTINUE      EM037640
         B     E9$D11ER            GO TO ABNORMAL PROCESS               EM037650
*                                                                       EM037660
*                                                                       EM037670
*                                                                       EM037680
E9$D1137 BAL   RL,E9$D11SE         UPDATE POINTER                       EM037690
*                                                                       EM037700
*                                                                       EM037710
E9$D1139 CH    RZ,E9$D11H2         UNSOLVED TIC COUNTER = 0?            EM037720
         BNE   E9$D11TF            YES, NO CONTINUE TIC PROCESS         EM037730
E9$D11TE STH   R4,0(RA)            SAVE ADDR IN CCW ADDR TABLE          EM037740
         B     E9$DEXCP            ISSUE DISC I/O REQUEST               EM037750
*                                                                       EM037760
*                                                                       EM037770
E9$D11T0 DS    0H                  TIC COMMAND PROCESSOR                EM037780
*                                                                       EM037790
*                                                                       EM037800
         STH   R4,0(RA)            SAVE ADDR IN CCW ADDR TABLE          EM037810
         LA    R2,E9$DADD          BASE ADDR OF CCW ADDR TABLE          EM037820
         LR    R3,RA               CURRENT CCW LIST                     EM037830
E9$D11T1 CR    R2,R3               CURRENT POSITION EQUAL TO START?     EM037840
         BE    E9$D11T2            NO,YES TO E9$D11T2                   EM037850
         SH    R3,E9$D11Z3         POINT R3 AT PREVIOUS 9300 CCW ADDR   EM037860
         CLC   2(2,RDP),0(R3)      TIC POINTS AT THIS CCW?              EM037870
         BNE   E9$D11T1            YES, NO  TEST NEXT ONE               EM037880
         SR    R3,R2               CALCULATE ADDR FIELD OF TIC          EM037890
         AR    R3,R3               TIC POINTS CCW IN POOL               EM037900
         AR    R3,R3                                                    EM037910
         LA    R3,E9$DPOOL(R3)                                          EM037920
         TM    E9$DP8,X'40'        AUTO SEEK REQUIRED?                  EM037930
         BO    E9$D11T4            YES ,   NO D11T4                     EM037940
         AR    R3,RC               INCREMENT R3 BY 8                    EM037950
E9$D11T4 ST    R3,0(,RDP)          STORE INTO TIC ADDR FIELD            EM037960
         MVI   0(RDP),X'08'        TIC COMMAND CODE TO CCW              EM037970
         BAL   RL,E9$D11SE         UP DATE POINTERS                     EM037980
         CLI   E9$DPREV,C'S'       PREVIOUS COMMAND IS SEARCH?          EM037990
         BE    E9$D1135            NO, YES E9$D1135                     EM038000
         B     E9$D1139            GO TO E9$D1139                       EM038010
*                                                                       EM038020
E9$D11T2 CLI   E9$DPREV,C'S'       PREVIOUS COMMAND IS SEARCH?          EM038030
         BNE   E9$D11T3            YES, NO E9$D11T3                     EM038040
         MVI   0(RDP),X'FE'        PUT UNSOLVED TIC FLAG IN CCW         EM038050
         AI    E9$D11H2,1          ADD 1 TO UNSOLVED TIC COUNTER        EM038060
         BAL   RL,E9$D11SE         UP DATE POINTERS                     EM038070
         B     E9$D1135            GO TO  E9$D1135                      EM038080
*                                                                       EM038090
E9$D11T3 LA    R3,8(,RDP)          NEXT CCW ADDR IN POOL TO WORK        EM038100
         ST    R3,0(,RDP)          THIS CCW POINTS AT NEXT ONE IN POOL  EM038110
         MVI   0(RDP),X'08'        PUT TIC COMMAND CODE                 EM038120
         LH    R4,2(,R4)           NEXT CCW ADDR ON 9300 TIC TO R4      EM038130
         BAL   RL,E9$D11SF         UP DATE POINTERS                     EM038140
         B     E9$D1135            GO TO E9$D1135                       EM038150
*                                                                       EM038160
*                                                                       EM038170
E9$D11TF AI    E9$D11H2,-1         DECREMENT UNSOLVED TIC COUNT BY 1    EM038180
E9$D11SA CLI   0(R2),X'FE'         UNSOLVED TIC ?                       EM038190
         BE    E9$D11SB            NO, YES E9$D11SB                     EM038200
         AR    R2,RC               NEXT CCW ADDR TO R2                  EM038210
         CR    R2,RDP              THIS CCW IS ON CCW POOL CURR ADDR?   EM038220
         BL    E9$D11SA            YES, NO CONTINUE                     EM038230
E9$D11SB L     RB,E9$D11H1         9300 CCW ADDR LIST BASE ADDR TO RB   EM038240
         CLC   2(2,R2),0(RB)       TIC POINTS THIS CCW?                 EM038250
         BE    E9$D11SD            NO, YES E9$D11SD                     EM038260
         LA    RB,2(,RB)           INCREMENT RB BY 2                    EM038270
         CR    RB,RA               LIST END?                            EM038280
         BL    E9$D11SB            YES, NO E9$D11SB                     EM038290
E9$D11SC LH    R4,2(,R2)           DATA ADDR OF CCW TO R4               EM038300
         ST    RDP,0(,R2)          THIS TIC POINTS OWNSELF              EM038310
         MVI   0(RDP),X'08'        PUT COMMAND CODE                     EM038320
         B     E9$D1130            GO TO E9$D1130                       EM038330
*                                                                       EM038340
*                                                                       EM038350
E9$D11SD S     RB,E9$D11H1         DECREMENT BY BASE ADDR OF CCW TABLE  EM038360
         AR    RB,RB               DOUBLE                               EM038370
         AR    RB,RB               QUADRAPLE                            EM038380
         ST    RB,0(,R2)           STORE ADDR TO TIC                    EM038390
         MVI   0(R2),X'08'         PUT COMMAND CODE                     EM038400
         MVI   E9$DPREV,0          PREVIOUS COMMAND CODE 0 TO PREV      EM038410
         B     E9$D1139            GO TO E9$D1139                       EM038420
*                                                                       EM038430
*                                                                       EM038440
E9$D11SE STH   R4,0(,RA)           9300 CCW ADDR TO CCW LIST            EM038450
         AR    R4,RC               INCREMENT R4 BY 8                    EM038460
E9$D11SF AR    RDP,RC              INCREMENT RDP BY 8                   EM038470
         LA    RA,2(,RA)           INCREMENT RA BY2                     EM038480
         BR    RL                  EXIT                                 EM038490
         EJECT                                                          EM038500
*********************************************************************** EM038510
*                                                                     * EM038520
*    REQUEST FOR CHANNEL PROGRAM TO SUPERVISOR                        * EM038530
*                                                                     * EM038540
*********************************************************************** EM038550
E9$DEXCP DS    0H                                                       EM038560
         OI    3(1),X'80'               SET USER ERROR RECOVERY         EM038561
E9$DXCP2 DS    0H                                                       EM038562
         EXCP  1                                                        EM038570
*********************************************************************** EM038580
*                                                                     * EM038590
*    WAIT FOR I/O EXECUTION COMPLETION                                * EM038600
         TM    E9$RIOII+1,X'80'         IS TASKING SET                  EM038610
         BNO   BYDTSK3                  BR AROUND IF NOT                EM038620
         WAIT  (1)                                                      EM038630
         B     BYDTSK4                                                  EM038640
BYDTSK3  EQU   *                                                        EM038650
*********************************************************************** EM038660
E9$DINT  DS    0H                                                       EM038670
         TM    IC$T,BC$TRAFF**X'FF' IO COMPLETION ?                     EM038680
         BNO   E9$DINT              YES, NO WAIT FOR COMPLETION         EM038690
BYDTSK4  EQU   *                                                        EM038700
         TM    3(1),X'80'               USER OWN CODE SET?              EM038710
         BNO   E9$D114A                 GO CHK FURTHER ERROR            EM038715
         NI    3(1),X'7F'               RESET USER OWN CODE             EM038720
         TM    26(1),X'02'              UNIT CHK?                       EM038725
         BO    E9$DXCP2                 REISSUE                         EM038730
         TM    26(1),X'01'              UNIT EXCEPTION                  EM038735
         BNO   E9$D114B                 BR AROUND                       EM038740
         OI    2(1),X'08'               SET UNIT EXCEPTION              EM038745
         B     E9$D114A                                                 EM038750
E9$D114B DS    0H                                                       EM038755
         TM    27(1),X'BF'              ANY CHANNEL ERRORS              EM038760
         BNZ   E9$DXCP2                 REISSUE                         EM038765
         TM    27(1),X'40'              WRONG LENGTH ?                  EM038770
         BNO   E9$D114A                 GO CHK FURTHER                  EM038775
         MVI   E9$DP8,E9$DP88           SET WRONG LENGTH TO USER        EM038780
         B     E9$D1141                 GO TO CALCULUTE                 EM038785
E9$D114A DS    0H                                                       EM038790
         TM    IC$T,X'7F'               CHK FOR POSSIBLE ERRORS         EM038800
         BNZ   E9$D1150                 CONTINUE CHK                    EM038810
E9$D1140 MVI   E9$DP8,E9$DP8F       SET SUCCESSFUL COMPLETION INDICATOR EM038820
E9$D1141 EQU   *                                                        EM038830
         L     RB,IC$BCW                POINT RB AT NEXT CCW ADDR       EM038840
         SR    RB,RC                    SUB 8 POINT TO LAST CCW         EM038850
         LH    RA,6(,RB)                INIT BYTE CNT TO RA             EM038860
         SH    RA,IC$RBC+2              RA CONTAINS INCR VALUE          EM038870
         L     RB,0(,RB)                DATA ADDR TO RB                 EM038880
         AR    RB,RA                    NEXT DATA ADDR TO RB            EM038890
         STH   RB,E9$DPA                NEXT DATA ADDR TO 93 PKT        EM038900
E9$D1142 EQU   *                                                        EM038910
         LH    7,6(1)                   LAST CCW EXEC TO R7             EM038920
         TM    E9$D002X,X'01'           CHK FOR AUTO SEEK SET           EM038930
         BNO   E9$DISBY                 BR AROUND IF NO AUTO SEEK       EM038940
         SR    7,RC                     DECREMENT BY 8                  EM038950
         NI    E9$D002X,X'FE'           RESET AUTO SEEK BIT             EM038960
E9$DISBY EQU   *                        CONTINUE                        EM038970
         L     RB,12(,1)                LD CCW POOL ADDR                EM038980
         SR    7,RB                     SUBTRACT FROM LAST CCW ADDR     EM038990
         SRL   7,2                      SHIFT RIGHT 2 BITS = DIV BY 4   EM039000
         LA    RB,E9$DADD               LD R11 W/9300 CCW ADD           EM039010
         AR    7,RB                                                     EM039020
         LH    RB,0(7)                                                  EM039030
         STH   RB,E9$DP2                                                EM039031
*                                                                       EM039040
*********************************************************************** EM039050
*                                                                     * EM039060
E9$DEXIT DS    0H                       EXIT PC ISLAND CODE             EM039070
         MVC   E9$R9DS(1),26(1)         SET DS STATUS                   EM039080
BYDTSK1  EQU   *                                                        EM039090
         MVC   DISCTBL(24),DISCTBL+4    SHIFT TABLE DOWN                EM039100
         MVC   DISCTBL+28(4),DISCTTS    LD LAST POS W/ZEROS             EM039110
         TM    E9$RIOII+1,X'80'         IS TASKING SET                  EM039120
         BNO   BYDTSK2                 BR AROUND IF SET                 EM039130
         CLC   DISCTBL(4),DISCTTS       ZEROS ?                         EM039140
         BNE   DISCIO                   GO PROCESS NEXT                 EM039150
         TYIELD                                                         EM039160
         B     DISCIO                   GO TO PROCESS                   EM039170
BYDTSK2  EQU   *                                                        EM039180
*                                                                       EM039190
         TM    E9$D002X+1,X'01'         SNAP SET ?                      EM039200
         BNO   E9$DNOSP                                                 EM039210
         BAL   7,E9$DSNAP                                               EM039220
E9$DNOSP EQU   *                                                        EM039230
         TM    E9$RIOII+1,X'04'         I/O MODE BIT ON?                EM039240
         BNO   E9$REXIT                 EXIT PC IF NOT                  EM039250
         LH    R7,E9$RENTY         REENTRY ADDRESS TO R7                EM039260
         STH   R7,E9$RPSW7                                              EM039270
         NI    E9$RPSW5,X'CF'           CLR 90/30 PSW CC                EM039280
         B     E9$REXIT                                                 EM039290
*                                                                       EM039300
E9$D1150 TM    IC$T,(BC$NOREC**X'FF')++(BC$CYEND**X'FF')                EM039310
         BZ    E9$D1151                                                 EM039320
         MVI   E9$DP8,E9$DP84          NO RECORD FOUND                  EM039330
         MVC   E9$DPA(2),20(1)          SET SENSE BYTES TO PACKET       EM039340
         B     E9$D1142                                                 EM039350
*                                                                       EM039360
E9$D1151 TM    IC$T,BC$UNTEX**X'FF'    UNIT EXCEPTION ?                 EM039370
         BZ    E9$D1152                YES,   NO D1152                  EM039380
         MVI   E9$DP8,E9$DP83          END-OF-FILE                      EM039390
         B     E9$D1141                                                 EM039400
*                                                                       EM039410
E9$D1152 TM    IC$T,BC$TKEND**X'FF'    TRACK END ?                      EM039420
         BZ    E9$D1153                                                 EM039430
         MVI   E9$DP8,E9$DP81          SOFTWARE ERROR                   EM039440
         B     E9$D001X                                                 EM039450
*                                                                       EM039460
E9$D1153 MVI   E9$DP8,E9$DP82          HARDWARE ERROR                   EM039470
E9$D001X MVC   E9$DPA(2),20(1)          SET SENSE BYTES TO PACKET       EM039480
         B     E9$D1142                                                 EM039490
*********************************************************************** EM039500
*                                                                     * EM039510
*   9300 DISC DISPATCHER DISPLAY ROUTINE                              * EM039520
*                                                                     * EM039530
*********************************************************************** EM039540
E9$DER1  DS    0H                                                       EM039550
*                                                                       EM039560
         IC    RB,E9$DP9                                                EM039570
         STC   RB,E9$DMSG5+7                                            EM039580
         OI    E9$DMSG5+7,X'F0'                                         EM039590
         LA    R1,E9$DMSG5                                              EM039600
         B     E9$DISP1                                                 EM039610
*                                                                       EM039620
E9$DMSG5 DC    CL40'HALT 6906 NO DISC DVC EMULATOR CANCELLED'           EM039630
*                                                                       EM039640
*                                                                       EM039650
*                                                                       EM039660
*                                                                       EM039670
*                                                                       EM039680
E9$D11ER MVC   E9$DMSGA,E9$DMSG1                                        EM039690
*                                                                       EM039700
E9$DISP  DS    0H                  ERROR MESSAGE AND CANCEL             EM039710
         LA    R1,E9$DMSG                                               EM039720
E9$DISP1 WTLD  (1),40                                                   EM039730
         CANCEL                                                         EM039740
*                                                                       EM039750
E9$D11E3 MVC   E9$DMSGA,E9$DMSG0                                        EM039760
         PACK  E9$D11WK(1),4(1,RA) 9300 DVC ADDR TO MSG AREA            EM039770
         MVC   E9$D11WK+1(1),4(RA)                                      EM039780
         OI    E9$D11WK,X'F0'                                           EM039790
         OI    E9$D11WK+1,X'F0'                                         EM039800
         MVC   E9$DMSGA+7(2),E9$D11WK                                   EM039810
         B     E9$DISP                                                  EM039820
DISCTBL  DS    0H                       DISC TABLE                      EM039830
         DC    8F'0'                                                    EM039840
DISCTTS  DC    2F'0'                    TST/CLEAR                       EM039850
DISCTSK  DC    A(DISCIO)                                                EM039860
         DC    A(DISCECB)                                               EM039870
DISCECB  ECB                                                            EM039880
         EJECT                                                          EM039890
* STORAGE AND CONSTANT                                                  EM039900
*                                                                       EM039910
*                                                                       EM039920
E9$DSEEK DS    0D                  SEEK CCW                             EM039930
         DC    X'07'               COMMAND CODE                         EM039940
         DC    AL3(E9$DSZ)         DATA ADDRESS                         EM039950
         DC    X'00'               FLAG BYTE                            EM039960
         DC    X'00'               UNUSED                               EM039970
         DC    Y(6)                BYTE COUNT                           EM039980
E9$D11C2 DC    A(E9$RAPCS)                                              EM039990
E9$D11H1 DC    A(E9$DADD)                                               EM040000
E9$D11H2 DC    Y(0)                UNSOLVED TIC COUNTER                 EM040010
E9$DPREV DC    Y(0)                PREVIOUS COMMAND SAVE AREA           EM040020
E9$D11Z3 DC    Y(2)                BINARY 2                             EM040030
E9$D11TC DC    Y(8)                TIC COMMAND                          EM040040
*                                                                       EM040050
E9$DTCCB DS    0A                  CCB ADDRESS TABLE                    EM040060
*                                                                       EM040070
         DO    '&N11'>'0'                                               EM040080
&L$D1    SET   '&N11'                                                   EM040090
         GOTO  .DS1                                                     EM040100
         ENDO                                                           EM040110
&L$D1    SET   0                                                        EM040120
.DS1     LABEL                                                          EM040130
         DO    '&N14'>'0'                                               EM040140
&L$D2    SET   '&N14'                                                   EM040150
         GOTO  .DS2                                                     EM040160
         ENDO                                                           EM040170
&L$D2    SET   0                                                        EM040180
.DS2     LABEL                                                          EM040190
&L$D3    SET   &L$D1+&L$D2                                              EM040200
         DO    &L$D3>8                                                  EM040210
&L$D3    SET   8                                                        EM040220
         ENDO                                                           EM040230
&L$D0    DO    &L$D3                                                    EM040240
&L$D     SET   &L$D0-1                                                  EM040250
E9$DTC&L$D  DS   0H                                                     EM040260
         DC    A(E9$DCCB&L$D)                                           EM040270
         DC    AL1(&L$D.+X'30')                                         EM040280
         DC    AL3(0)                                                   EM040290
         ENDO                                                           EM040300
*                                                                       EM040310
*                                                                       EM040320
*                                                                       EM040330
*        MEANNING OF ERROR RECOVERY FLAG ON CCB.                        EM040340
*        IF OTHER THAN UNIQUE ERROR OCCURS, PIOCS MESSAGE WITH          EM040350
*        RECOVERY R & U WILL APPEAR.                                    EM040360
*        IF U REPLY,  GOES BACK TO 9300                                 EM040370
*        IF R REPLY,  GOES BACK TO OS/3 PIOCS                           EM040380
*                                                                       EM040390
*                                                                       EM040400
&L$D3    SET   &L$D1+&L$D2                                              EM040410
*                                                                       EM040420
&L$D0    DO    &L$D3                                                    EM040430
&L$D     SET   &L$D0-1                                                  EM040440
E9$DCCB&L$D CCB  E9$DISC&L$D,E9$DPOOL,,X'60'                            EM040450
*                                                                       EM040460
E9$DISC&L$D PIOCB                                                       EM040470
*                                                                       EM040480
         ENDO                                                           EM040490
*                                                                       EM040500
E9$DSZ   DC    6X'00'              DATA FOR AUTO-SEEK                   EM040510
*                                                                       EM040520
*                                                                       EM040530
E9$DMSG  DC    C'92/9300 EMULATOR ... '                                 EM040540
E9$DMSGA DS    CL19                                                     EM040550
E9$DMSG0 DC    C'DEVICE XX NOT FOUND'                                   EM040560
E9$DMSG1 DC    C'CCW POOL FULFILLED '                                   EM040570
E9$D11CF DC    X'FFFF'                                                  EM040580
         DO    '&NCCW'>'0'                                              EM040590
&L$CC    SET   &NCCW                                                    EM040600
         GOTO  .PTW                                                     EM040610
         ENDO                                                           EM040620
&L$CC    SET   90                                                       EM040630
.PTW     LABEL                                                          EM040640
         DS    0D                  CCW POOL & ADDRESS SAVE AREA         EM040650
*                                                                       EM040660
E9$DCCW  DC    A(0)                RESERVED                             EM040670
         DC    Y(&L$CC)                                                 EM040680
         DC    Y(0)                                                     EM040690
E9$DPOOL DS    &L$CC.CL8                CCW POOL                        EM040700
E9$DADD  DS    &L$CC.CL2                9300 CCW ADDR SAVE AREA         EM040710
E9$D11WK DS    CL2                                                      EM040720
*                                                                       EM040730
E9$DSNAP DS    0H                                                       EM040740
         ST    1,DTEMP                                                  EM040750
         SNAP  E9$R9MEM,E9$DSNAP                                        EM040760
         L     1,DTEMP                                                  EM040770
         BR    7                                                        EM040780
         CNOP  0,4                                                      EM040790
DTEMP    DC    XL4'0'                                                   EM040800
         B     *                                                        EM040810
         B     *                                                        EM040820
         B     *                                                        EM040830
         B     *                                                        EM040831
         B     *                                                        EM040832
         B     *                                                        EM040833
         DROP  R1,RF                                                    EM040840
         DROP  5                                                        EM040850
         ENDO                                                           EM040860
         TITLE 'MULTIPLEXOR DIRECTOR'                                   EM040870
*********************************************************************** EM040880
*        MULTIPLEXOR HANDLER XIO DIRECTOR                             * EM040890
*********************************************************************** EM040900
         USING *,5                                                      EM040910
E9$RCOV5 EQU   *                                                        EM040920
E9$MUXH  EQU   *                                                        EM040930
E9$RMUX  EQU   *                                                        EM040940
         LA    9,E9$REXIT               LOAD EXIT ADDR                  EM040950
         TM    E9$RDA,X'80'             SHARED BIT ON                   EM040960
         BNO   E9$MSTDA                                                 EM040970
         SR    2,2                                                      EM040980
         IC    2,E9$RDA                                                 EM040990
         SLL   2,25                                                     EM041000
         SRL   2,28                                                     EM041010
         STC   2,E9$MCKDA                                               EM041020
         CLI   E9$MCKDA,X'04'                                           EM041030
         BL    E9$MSTDA                                                 EM041040
         STC   2,E9$RDA                                                 EM041050
E9$MSTDA EQU   *                                                        EM041060
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM041070
         CLI   E9$RDA,&L$C04       1004 ISSUED ?                        EM041080
         BE    E9$Y04              BR TO E9$Y04 IF YES                  EM041090
         ENDO                                                           EM041100
         DO    '&PUNCH5'='ROW'                                          EM041110
         CLI   E9$RDA,&L$C3                                             EM041120
         BE    E9$PT                                                    EM041130
         ENDO                                                           EM041140
         DO    '&PRTDRUM'>'0'                                           EM041150
         CLI   E9$RDA,&L$C2                                             EM041160
         BE    E9$RDRMP                                                 EM041170
         ENDO                                                           EM041180
         DO    '&CR0716'>'0'                                            EM041190
         CLI   E9$RDA,&L$C1                                             EM041200
         BE    E9$0716                                                  EM041210
         ENDO                                                           EM041220
         DO    '&CR1001'>'0'                                            EM041230
         CLI   E9$RDA,&L$CC1                                            EM041240
         BE    E9$W                                                     EM041250
         ENDO                                                           EM041260
         DO    '&ODR'>'0'                                               EM041270
         CLI   E9$RDA,&L$OD1                                            EM041280
         BE    E9$ODR                                                   EM041290
         ENDO                                                           EM041300
         DO    '&PTAPE'>'0'                                             EM041310
         CLI   E9$RDA,&L$PT1                                            EM041320
         BE    E9$PPTP                                                  EM041330
         ENDO                                                           EM041340
         B     E9$RCANL                                                 EM041350
         CNOP  0,4                                                      EM041360
E9$MCKDA DC    XL4'0'                                                   EM041370
         TITLE 'ERR TO OPCOM'                                           EM041380
         TITLE 'RELOAD ROUTINE'                                         EM041390
*********************************************************************** EM041400
         TITLE 'BCW-SETUP/CLEAR/SCAN ROUTINE'                           EM041410
*********************************************************************** EM041420
*       THE FOLLOWING ROUTINE WILL INCREMENT & DECREMENT THE BUFFER   * EM041430
*       CONTROL WORD FOR THE MULTIPLEXOR CHANNEL SPECIFIED            * EM041440
*********************************************************************** EM041450
E9$RDIBW EQU   *                                                        EM041460
         SR    2,2                      CLR R2                          EM041470
         SR    3,3                      CLR R3                          EM041480
         IC    3,E9$RXBCW               LD R7 WITH BCW ADDRESS          EM041490
         IC    2,1(3)                   LD SIZE BCW INTO REG 2          EM041500
         MVC   E9$RXENT+2(2),2(3)       STORE THE AREA TEMPORARILY      EM041510
         STC   2,E9$RXPSZ               STORE BCW COUNT INTO PUT SIZE   EM041520
         AH    2,2(,3)                  ADJUST BCW LOC IN 9300          EM041530
         STH   2,2(,3)                  STORE BACK INCREMENTED IN 9300  EM041540
         MVI   1(3),X'00'               SET COUNT TO ZERO IN 9300       EM041550
         OI    0(3),X'20'               SET TERMINATION BIT IN 9300     EM041560
         BR    7                                                        EM041570
*********************************************************************** EM041580
*********************************************************************** EM041590
*        THIS ROUTINE WILL CLEAR THE BUFFER FOR IMAGES RECEIVED OR    * EM041600
*        IMAGES SENT REG 3 MUST CONTAIN THE BUFF TO BE CLEARED        * EM041610
*********************************************************************** EM041620
E9$RBFCR EQU   *                                                        EM041630
         SR    2,2                      CLR R2                          EM041640
         IC    2,E9$RXMSZ               LD MAXSIZE INTO R2              EM041650
         TM    E9$RXS2,X'04'                                            EM041660
         BNO   *+12                     BR AROUND IF NOT                EM041670
         MVI   E9$RCLBT+1,X'40'         MOVE SPACE FOR CLR BYTE         EM041680
         B     E9$RSTSZ                                                 EM041690
         TM    E9$RXS3,X'04'            TRANSLATE REQ ?                 EM041700
         BO    E9$RSTSZ                 BRANCH AROUND                   EM041710
         AR    2,2                      DOUBLE R2 (IMAGE MODE)          EM041720
E9$RSTSZ STC   2,E9$RCLRM+1             STORE INTO MOVE                 EM041730
         AI    E9$RCLRM,X'00'           DECREMENT MVE SIZE BY ONE       EM041740
         ORG   *-3                                                      EM041750
         DC    XL1'FE'                                                  EM041760
         ORG   *+2                                                      EM041770
E9$RCLBT MVI   1(3),X'00'               SET UP CLR BYTE                 EM041780
E9$RCLRM MVC   2(,3),1(3)               CLEAR                           EM041790
         MVI   E9$RCLBT+1,X'00'         RESET TO ZEROS                  EM041800
         BR    7                        RETURN TO REQUESTOR             EM041810
*********************************************************************** EM041820
*        SCAN ROUTINE FOR TABLE POINTER                               * EM041830
*********************************************************************** EM041840
E9$MSCAN EQU   *                                                        EM041850
         L     4,E9$RALUT                                               EM041860
E9$RCKF  CLC   E9$RDA(1),0(4)                                           EM041870
         BER   7                                                        EM041880
         CLI   0(4),X'FF'                                               EM041890
         BE    E9$RCANL                                                 EM041900
         LA    4,36(,4)                                                 EM041910
         B     E9$RCKF                  BRANCH TO CHECK FURTHER         EM041920
E9$RCANL EQU   *                                                        EM041930
         CLI   E9$RDA,X'80'             CHK OP REQ PERMIT/INHIBIT       EM041940
         BE    E9$RCHFC                 IF EQU GO CHK FUNCTION          EM041950
         CLI   E9$RDA,X'88'             LT SUMMARY ?                    EM041960
         BER   9                        EXIT                            EM041970
         CLI   E9$RDA,X'90'             ONE SECOND DELAY                EM041980
         BER   9                        EXIT                            EM041990
         OI    E9$RPSW5,X'30'           SET REJECT TO CC                EM042000
         BR    9                        EXIT                            EM042010
E9$RCHFC EQU   *                                                        EM042020
         CLI   E9$RFC,X'23'             OP REQ PERMIT                   EM042030
         BE    E9$ROREQ                 SET TO ON REQ                   EM042040
         CLI   E9$RFC,X'13'             OP REQ INHIBIT                  EM042050
         BE    E9$RFREQ                 SET TO OFF REQ                  EM042060
         BR    9                        EXIT                            EM042070
E9$ROREQ EQU   *                                                        EM042080
         OI    E9$RIOII+1,X'01'         SET BIT OP REQ TO PERMIT        EM042090
         BR    9                                                        EM042100
E9$RFREQ EQU   *                                                        EM042110
         NI    E9$RIOII+1,X'FE'         SET BIT OP REQ TO OFF           EM042120
         BR    9                                                        EM042130
*********************************************************************** EM042140
         DO    ('&PUNCH6'='TEN4')++('&PRTTEN4'>'0')++('&CR1004'>'0')    EM042150
         TITLE '1004 HANDLER SIMULATION'                                EM042160
*********************************************************************** EM042170
*                                                                     * EM042180
E9$Y04   DS    0H                                                       EM042190
*                                                                     * EM042200
*********************************************************************** EM042210
         SPACE 1                                                        EM042220
         LA    4,E9$YLUT           LD R4 W/LUT ADDR                     EM042230
         CLI   E9$RFC,X'01'        PREAMBLE ?                           EM042240
         BNE   E9$YNPR             BR TO E9$YNPR IF NO                  EM042250
E9$YBCW3 EQU   64+&L$C04*4                                              EM042260
         LH    2,E9$YBCW3+2        LD R2 W/DATA ADDR                    EM042270
         CLI   0(2),1              READER ?                             EM042280
         BE    E9$YSRDR            BR TO E9$YSRDR IF YES                EM042290
         CLI   0(2),2              PRINTER ?                            EM042300
         BE    E9$YSPRT            BR TO E9$YSPRT IF YES                EM042310
         CLI   0(2),3              PUNCH ?                              EM042320
         BE    E9$YSPCH            BR TO E9$YSPCH IF YES                EM042330
E9$YTRAP DC    H'00'               TRAP  *** WILL BE CHANGED ***        EM042340
E9$YSRDR MVC   E9$YCRTN,E9$YARDR   SET FOR READER RTN                   EM042350
         B     E9$YCOM                                                  EM042360
E9$YSPRT MVC   E9$YCRTN,E9$YAPRT   SET FOR PRINTER RTN                  EM042370
         B     E9$YCOM                                                  EM042380
E9$YSPCH MVC   E9$YCRTN,E9$YAPCH   SET FOR PUNCH RTN                    EM042390
E9$YCOM  MVC   E9$YPRMB,0(2)       SAVE PREAMBLE                        EM042400
E9$YDA   EQU   &L$C04*8+X'80'                                           EM042410
E9$YCOMY TM    E9$RIOII+2,X'04'     LOAD MODE ?                         EM042420
         BO    E9$YCOMX            BR TO E9$YCOMX IF YES                EM042430
         MVI   E9$R9DA,E9$YDA      SET DEVICE ADDR                      EM042440
         MVI   E9$R9DS,X'0C'       SET DEVICE STATUS                    EM042450
E9$YCOMX OI    E9$RXS1,X'18'       SET INT/STATUS PEND                  EM042460
         NI    E9$RPSW5,X'CF'      SET CC TO ZERO                       EM042470
         B     E9$REXIT            BR TO E9$REXIT                       EM042480
E9$YNPR  CLI   E9$RFC,X'04'        SENSE ?                              EM042490
         BE    E9$YSNS             BR TO E9$YSNS IF YES                 EM042500
         CLI   E9$RFC,X'06'        READ SENSE DATA ?                    EM042510
         BE    E9$YRDS             BR TO E9$YRDS IF YES                 EM042520
         L     3,E9$YCRTN                                               EM042530
         BR    3                                                        EM042540
E9$Y4RDR DS    0H                                                       EM042550
         LA    1,E9$YRCCB                                               EM042560
         LA    3,E9$YRBCW          LD R3 W/BCW ADDR                     EM042570
         CLI   E9$RFC,10           COMPRESS ?                           EM042580
         BNE   E9$Y4BIN            BR TO E9$Y4BIN IF NO                 EM042590
         MVI   0(3),X'02'                                               EM042600
E9$Y4B   MVC   6(2,3),E9$YBCW3     SET 90/30 BCW                        EM042610
         MVC   2(2,3),E9$YBCW3+2                                        EM042620
         MVI   1(3),0                                                   EM042630
         EXCP  (1)                 EXCP                                 EM042640
         TM    2(1),X'80'          TEST COMPLETION                      EM042650
         BNO   *-4                 BR BACK IF NO                        EM042660
         CLI   0(3),X'02'          READ COMPRESS                        EM042670
         BNE   E9$Y4C              BR TO E9$Y4C IF NO                   EM042680
         LH    2,E9$YBCW3+2        LD R2 W/DATA ADDR                    EM042690
         TR    0(80,2),E9$RTBPU    TR TO COMPRESS                       EM042700
         TM    E9$RIOII+2,X'04'    CHECK IF IN LD MODE                  EM042710
         BNO   E9$Y4C              BR TO E9$Y4C IF NO                   EM042720
         CLC   0(2,2),E9$RTEND     TRANSFER CARD ?                      EM042730
         BNE   E9$Y4C              BR TO E9$Y4C IF NO                   EM042740
         NI    E9$RIOII+2,X'FB'    TURN OFF LOAD MODE                   EM042750
E9$Y4C   DS    0H                                                       EM042760
         LH    2,10(1)             LD RESIDUAL TO R2                    EM042770
         LH    11,6(3)             LD ORIGINAL COUNT                    EM042780
         SLL   11,19                                                    EM042790
         SRL   11,19                                                    EM042800
         SR    11,2                                                     EM042810
         LH    2,2(3)                                                   EM042820
         AR    2,11                                                     EM042830
         STH   2,E9$YBCW3+2                                             EM042840
         MVC   E9$YBCW3(2),10(1)   SET RESIDUAL BYTE COUNT              EM042850
         CLC   10(2,1),E9$YCZR     ZERO ?                               EM042860
         BNE   E9$Y4A                                                   EM042870
         OI    E9$YBCW3,X'20'                                           EM042880
E9$Y4A   TM    6(3),X'80'                                               EM042890
         BNO   *+8                                                      EM042900
         OI    E9$YBCW3,X'80'                                           EM042910
         TM    E9$RIOII+2,X'04'    LOAD MODE ?                          EM042920
         BO    E9$YCOMX            BR TO E9$YCOMX IF YES                EM042930
         MVI   E9$R9DA,E9$YDA      SET DEVICE ADDR                      EM042940
         MVC   E9$R9DS(1),26(1)    SET DEVICE STATUS                    EM042950
         B     E9$YCOMX            BR TO E9$YCOMX                       EM042960
E9$Y4BIN CLI   E9$RFC,14           BINARY READ ?                        EM042970
         BNE   E9$YTRAP            BR TO E9$YTRAP IF NO                 EM042980
         MVI   0(3),X'06'          SET COMMAND                          EM042990
         B     E9$Y4B              BR TO E9$Y4B                         EM043000
E9$Y4PCH DS    0H                  PUNCH                                EM043010
         LA    1,E9$YPCCB                                               EM043020
         LA    3,E9$YPBCW          LD R3 W/BCW ADDR                     EM043030
         CLI   E9$RFC,9            VALID COMMAND ?                      EM043040
         BNE   E9$YTRAP            BR TO E9$YTRAP IF NO                 EM043050
         MVI   0(3),X'05'          SET COMMAND                          EM043060
         B     E9$Y4B              BR TO E9$Y4B                         EM043070
E9$Y4PRT DS    0H                  PRINTER                              EM043080
         LA    1,E9$YLCCB                                               EM043090
         LA    3,E9$YLBCW          LD R3 W/BCW ADDR                     EM043100
         CLI   E9$RFC,9            VALID COMMAND ?                      EM043110
         BNE   E9$YTRAP            BR TO E9$YTRAP IF NO                 EM043120
         TM    26(1),X'01'         FOV ?                                EM043130
         BZ    E9$Y4PRA            BR TO E9$Y4PRA IF NO                 EM043140
         MVI   E9$YSSD+2,X'08'     SET SENSE DATA                       EM043150
         MVI   E9$R9DA,E9$YDA      SET DVC ADDR                         EM043160
         MVI   E9$R9DS,X'0E'       SET DVC STATUS                       EM043170
         NI    26(1),X'FE'         CLEAR FOV                            EM043180
         B     E9$YCOMX            BR TO E9$YCOMX                       EM043190
E9$Y4PRA DS    0H                                                       EM043200
         SR    12,12                                                    EM043210
         IC    12,E9$YPRMB+2                                            EM043220
         SLL   12,3                                                     EM043230
         TM    E9$YPRMB+2,X'08'                                         EM043240
         BZ    E9$YNSKP                                                 EM043250
         LA    12,X'40'(12)                                             EM043260
E9$YNSKP CLI   E9$YPRMB+3,0        DATA TRANSFER ?                      EM043270
         BNE   E9$YSKOL            BR TO E9$YSKOL IF NO                 EM043280
         LA    12,1(12)            SET COMMAND                          EM043290
         STC   12,0(3)             SET COMMAND                          EM043300
         SR    12,12               CLR R12                              EM043310
         IC    12,E9$YBCW3+1                                            EM043320
         BCTR  12,0                DECR R12 BY 1                        EM043330
         LH    11,E9$YBCW3+2       LD R11 W/DATA ADDR                   EM043340
         EX    12,E9$YEXTR         X3 TO EBCDIC                         EM043350
         B     E9$Y4B              BR TO E9$Y4B                         EM043360
E9$YSKOL LA    12,7(12)            SET COMMAND                          EM043370
         STC   12,0(3)                                                  EM043380
         B     E9$Y4B              BR TO E9$Y4B                         EM043390
E9$YEXTR TR    0(1,11),E9$RX3TE                                         EM043400
E9$YSNS  LH    2,E9$YBCW3+2        LD R2 W/DATA ADDR                    EM043410
         MVI   0(2),X'40'          SET INTV REQ                         EM043420
         AI    E9$YBCW3+2,1        SET BCW                              EM043430
         MVI   E9$YBCW3+1,0                                             EM043440
         B     E9$YCOMY            BR TO E9$YCOMY                       EM043450
E9$YRDS  LH    2,E9$YBCW3+2                                             EM043460
         MVC   0(3,2),E9$YSSD      MOVE SENSE DATA INTO 9300 MEM        EM043470
         AI    E9$YBCW3+2,3        SET BCW                              EM043480
         MVI   E9$YBCW3+1,0                                             EM043490
         XC    E9$YSSD(3),E9$YSSD  CLEAR E9$YSSD                        EM043500
         B     E9$YCOMY            BR TO E9$YCOMY                       EM043510
         DO    '&CR1004'>'0'                                            EM043520
         DO    '&RES'='1004'                                            EM043530
         SPACE 3                                                        EM043540
*********************************************************************** EM043550
*        1004 RE-IPL ROUTINE                                          * EM043560
*********************************************************************** EM043570
         SPACE 1                                                        EM043580
E9$YRIPL DS    0H                                                       EM043590
         L     5,E9$COV            LD R5 W/COV REG                      EM043600
         LA    1,E9$YRCCB          LD R1 W/CCB ADDR                     EM043610
         LA    3,E9$YRBCW          LD R3 W/BCW ADDR                     EM043620
         MVC   0(8,3),E9$YWK1A                                          EM043630
         EXCP  (1)                 READ 1ST CARD                        EM043640
         TM    2(1),X'80'          TEST COMPLETION ?                    EM043650
         BZ    *-4                 BR BACK IF NO                        EM043660
         MVC   0(8,3),E9$YWK2A                                          EM043670
         EXCP  (1)                 READ 2ND CARD                        EM043680
         TM    2(1),X'80'          TEST COMPLETION ?                    EM043690
         BZ    *-4                 BR BACK IF NO                        EM043700
         TR    0(160),E9$RTBPU     TR TO COMPRESS                       EM043710
         XC    E9$RSRG8(32),E9$RSRG8                                    EM043720
         LA    3,E9$RIR8           LD I/O 9300 REG 8 VALUE              EM043730
         LA    2,8                                                      EM043740
         LA    4,E9$RSVRG                                               EM043750
E9$YLDR  MVC   0(2,4),0(3)                                              EM043760
         LA    3,2(3)              INCR R3 BY 2                         EM043770
         LA    4,4(4)              INCR R4 BY 4                         EM043780
         BCT   2,E9$YLDR                                                EM043790
         LM    8,15,E9$RSRG8                                            EM043800
         OI    E9$RASW3,X'01'                                           EM043810
         LA    2,E9$RSTTL                                               EM043820
         ST    2,E9$RAOPS+4                                             EM043830
         EXIT  OC                  FREE ISLAND CODE                     EM043840
E9$YWK1A DC    X'0200005000000050' FOR 1ST CARD                         EM043850
E9$YWK2A DC    X'0200000000000050' FOR 2ND CARD                         EM043860
         ENDO                                                           EM043870
         ENDO                                                           EM043880
E9$YARDR DC    A(E9$Y4RDR)         READER ENTRY                         EM043890
E9$YAPRT DC    A(E9$Y4PRT)         PRINTER ENTRY                        EM043900
E9$YAPCH DC    A(E9$Y4PCH)         PUNCH ENTRY                          EM043910
E9$YAERR DC    A(E9$YTRAP)         ERROR ENTRY                          EM043920
E9$YCRTN DC    A(0)                CURRENT ROUTINE ENTRY                EM043930
E9$YPRMB DC    A(0)                PREAMBLE SAVE AREA                   EM043940
E9$YRTP  DC    3H'0'                                                    EM043950
E9$YLTP  DC    3H'0'                                                    EM043960
E9$YPTP  DC    3H'0'                                                    EM043970
E9$YRCCB CCB   E9$YRTP-10,E9$YRBCW,,X'20'                               EM043980
E9$YLCCB CCB   E9$YLTP-10,E9$YLBCW,,X'20'                               EM043990
E9$YPCCB CCB   E9$YPTP-10,E9$YPBCW,,X'20'                               EM044000
E9$YRBCW DC    4A(0)               READER BCW                           EM044010
E9$YLBCW DC    4A(0)               PRINTER BCW                          EM044020
E9$YPBCW DC    4A(0)               PUNCH BCW                            EM044030
E9$YCZR  DC    XL2'0'              CONSTANT ZERO                        EM044040
E9$YSSD  DC    XL3'0'              SENSE DATA AREA                      EM044050
         ENDO                                                           EM044060
         DO    '&CR1001'>'0'                                            EM044070
         TITLE 'MULTIPLEXOR HANDLER 1001'                               EM044080
*********************************************************************** EM044090
*                                                                     * EM044100
*  THIS ROUTINE SIMULATES 1001 CARD READ FUNCTIONS.                   * EM044110
*                                                                     * EM044120
*  USER IS REQUIRED TO CHOSE ONE OF FOLLOWING COMBINATIONS.           * EM044130
*                                                                     * EM044140
*     1. PRIMARY READ FROM GETCS  AND SECONDARY FROM 0717, AND        * EM044150
*     2.                          VICE VERSA.                         * EM044160
*     3. PRIMARY READ FROM GETCS  AND SECONDARY FROM 0716, AND        * EM044170
*      4.                         VICE VERSA.                         * EM044180
*     5. PRIMARY READ FROM 0716   AND SECONDARY FROM 0717, AND        * EM044190
*     6.                          VICE VERSA.                         * EM044200
*                                                                     * EM044210
*  HOWEVER;                                                           * EM044220
*     . BINARY READ FROM GETCS IS NOT ALLOWED.                        * EM044230
*     . NO STACKER SELECT FUNCTIONS ARE SUPPORTED.                    * EM044240
*                                                                     * EM044250
E9$WDA   EQU   &L$CC1*8+X'80' 1001 DEVICE ADDRESS                       EM044260
E9$WASN  DS    CL1                 ASSIGNMENT TABLE                     EM044270
*  LEFT MOST 4 BITS FOR PRIMARY; BIT 3 FOR GETCS & BIT 2 FOR READER   * EM044280
* RIGHT MOST 4 BITS FOR SECOND'; BIT 7 FOR GETCS & BIT 6 FOR READER   * EM044290
E9$WGTCS EQU   X'11'               GETCS IS ASSIGNED                    EM044300
E9$WRDR  EQU   X'22'               READER IS ASSIGNED                   EM044310
*                                                                     * EM044320
*********************************************************************** EM044330
         USING IC$CCB,R1                                                EM044340
         SPACE 4                                                        EM044350
*********************************************************************** EM044360
*                                                                     * EM044370
*    REGISTER USAGE                                                   * EM044380
*                                                                     * EM044390
* . REGISTER  0.......... NOT USED                                    * EM044400
* . REGISTER  1.......... CCB ADDRESS                                 * EM044410
* . REGISTER  2.......... WORK                                        * EM044420
* . REGISTER  3.......... WORK                                        * EM044430
* . REGISTER  4.......... EMULATOR LU TABLE ADDRESS                   * EM044440
* . REGISTER  5.......... COVERING                                    * EM044450
* . REGISTER  6.......... COVERING                                    * EM044460
* . REGISTER  7.......... SUBROUTINE LINKAGE                          * EM044470
* . REGISTER  8.......... WORK                                        * EM044480
* . REGISTER  9.......... WORK                                        * EM044490
* . REGISTER 10.......... 9300 BCW DATA ADDRESS                       * EM044500
* . REGISTER 11.......... 90/30 BCW ADDRESS                           * EM044510
* . REGISTER 12.......... 9300  BCW ADDRESS                           * EM044520
* . REGISTER 13 - 15 .... NOT USED                                    * EM044530
*                                                                     * EM044540
*********************************************************************** EM044550
         EJECT                                                          EM044560
*********************************************************************** EM044570
*                                                                       EM044580
*   1001 SENSE BYTE                                                     EM044590
*                                                                       EM044600
*      . SENSE DATA IS UPDATED DYNAMICALLY. ALL DATA ARE CLEARED EXCEPT EM044610
*        INHIBIT STATUS BIT WHEN NEXT COMMAND IS ACCEPTED, IF THE COM-  EM044620
*        MAND IS NOT SENSE OR TEST I/O.                                 EM044630
*                                                                       EM044640
*                                                                       EM044650
E9$WSENS DS    CL1                                                      EM044660
*                                                                       EM044670
E9$WSN80 EQU   B'10000000'         COMMAND REJECT                       EM044680
E9$WSN40 EQU   B'01000000'         INTERVENTION REQUIRED                EM044690
E9$WSN20 EQU   B'00100000'         BUS OUT CHECK                        EM044700
E9$WSN10 EQU   B'00010000'         RUN OFF                              EM044710
E9$WSN08 EQU   B'00001000'         UNUSED                               EM044720
E9$WSN04 EQU   B'00000100'         UNUSED                               EM044730
E9$WSN02 EQU   B'00000010'         INHIBIT STATUS                       EM044740
E9$WSN01 EQU   B'00000001'         UNDEFINED                            EM044750
*                                                                       EM044760
*********************************************************************** EM044770
         SPACE 4                                                        EM044780
*********************************************************************** EM044790
*                                                                     * EM044800
*    READ FUNCTION SIMULATION ;                                       * EM044810
*                                                                     * EM044820
*        MEANNING OF FUNCTION MESSAGE ( THRU FUNC KEYWORD IN DTFCC )  * EM044830
*                                                                     * EM044840
*        BIT                                                          * EM044850
*        0 - 3 .......... ZEROS                                       * EM044860
*        4  ............. READ OPERATION                              * EM044870
*        5  ............. TRANSMIT 161 BYTES IN BINARY CODE           * EM044880
*        6  ............. TRANSMIT 160 BYTES IN XS3 CODE(BOTH ENTRIES)* EM044890
*        7  ............. 0 PRIMARY                                   * EM044900
*                         1 SECONDARY                                 * EM044910
*                                                                     * EM044920
*        BIT 7 IS AFFECTED BY XIOF FUNCTION CODE AS FOLLOWS;          * EM044930
*          FUNCION CODE X'06' ---- TRAANMIT 161 BYTES IN BINARY       * EM044940
*                       X'02' ---- TRANSMIT  80 BYTES IN COMPRESSED   * EM044950
*                                                                     * EM044960
*              FUNCTION CODE IS SAVED IN E9$WFUNC                     * EM044970
*                                                                     * EM044980
*********************************************************************** EM044990
         EJECT                                                          EM045000
*********************************************************************** EM045010
*                                                                     * EM045020
E9$W     DS    0H                  1001 HANDLER                         EM045030
*                                                                     * EM045040
*********************************************************************** EM045050
         SPACE 2                                                        EM045060
         BAL   R7,E9$MSCAN         INITIALIZE LOGICAL UNIT TABLE        EM045070
         IC    R8,E9$RFC           XIOF FUNCTION CODE TO R8             EM045080
         STC   R8,E9$WW0+1         SAVE IN WORKING AREA                 EM045090
         NI    E9$WW0+1,X'07'      CLEAR UPPER 5 BITS                   EM045100
         CLI   E9$RFC,X'04'        SENSE COMMAND?                       EM045110
         BE    E9$W0               NO,  YES E9$W0                       EM045120
         NI    E9$WSENS,E9$WSN02   INITIALIZE SENSE DATA                EM045130
E9$W0    NI    E9$RPSW5,X'CF'      00 TO 90/30 PSW CONDTION CODE        EM045140
         LA    R11,E9$WBCW         90/30 BCW ADDR TO R11                EM045150
         SR    R12,R12                                                  EM045160
         IC    R12,E9$RXBCW        9300 BCW ADDR TO R12                 EM045170
         LH    R10,2(,R12)         9300 USER DATA ADDR TO R10           EM045180
*                                                                       EM045190
*                                                                       EM045200
         LH    R8,E9$WW0           FUNCTION CODE TO R8                  EM045210
         AR    R8,R8               QUADRAPLE                            EM045220
         AR    R8,R8                                                    EM045230
*                                                                       EM045240
         B     *+4(R8)             GO TO APROPREATE ROUTINE             EM045250
         B     E9$W00         +0   SET/RESET INHIBIT STATUS             EM045260
         B     E9$W01         +1   WRITE                                EM045270
         B     E9$W02         +2   READ                                 EM045280
         B     E9$WINVL       +3   INVALID                              EM045290
         B     E9$W04         +4   SENSE                                EM045300
         B     E9$W01         +5   WRITE                                EM045310
         B     E9$W02         +6   READ                                 EM045320
         B     E9$WINVL       +7   INVALID                              EM045330
         SPACE 2                                                        EM045340
*********************************************************************** EM045350
*                                                                     * EM045360
E9$W00   DS    0H        SET/RESET INHIBIT STATUS COMMAND SIMULATION    EM045370
*                                                                     * EM045380
*********************************************************************** EM045390
         TM    E9$RFC,X'08'        INVALID COMMAND ?                    EM045400
         BO    E9$WINVL            NO, YES GO TO INVALID COMMAND ROUTIN EM045410
         TM    E9$RFC,X'10'        SET INHIBIT STATUS ?                 EM045420
         BO    E9$W0010            NO, YES W0010                        EM045430
         TM    E9$RFC,X'20'        RESET INHIBIT STATUS ?               EM045440
         BO    E9$W0020            NO, YES  W0020                       EM045450
*                                                                       EM045460
*        TEST I/O COMMAND                                               EM045470
*                                                                       EM045480
         B     E9$WEXT0            GO TO EXIT                           EM045490
*                                                                       EM045500
*        SET INHIBIT STATUS                                             EM045510
*                                                                       EM045520
E9$W0010 NI    E9$RXS1,X'F7'       ERASE INTERRUPT PERMIT BIT           EM045530
         OI    E9$WSENS,E9$WSN02   INHIBIT STATUS BIT TO BE 1 ON SENSE  EM045540
         B     E9$WEXT0            GO TO EXIT                           EM045550
*                                                                       EM045560
*        RESET INHIBIT STATUS                                           EM045570
*                                                                       EM045580
E9$W0020 OI    E9$RXS1,X'08'       SET INTERRUPT PERMIT BIT TO BE 1     EM045590
         NI    E9$WSENS,X'FF'-E9$WSN02 ERASE INHIBIT STATUS BIT         EM045600
         B     E9$WEXT0            GO TO EXIT                           EM045610
         SPACE 2                                                        EM045620
*********************************************************************** EM045630
*                                                                     * EM045640
E9$W01   DS    0H        WRITE COMMAND SIMULATION                       EM045650
*                                                                     * EM045660
*********************************************************************** EM045670
         MVC   E9$WFUNC,0(R10)     SAVE FUNCTION CODE                   EM045680
         CLI   E9$WFUNC,X'24'      SPECIAL FUNCTION ?                   EM045690
         BE    E9$WINVL            NO, YES NON-SUPPORTED                EM045700
         CLI   E9$WFUNC,X'34'                                           EM045710
         BE    E9$WINVL                                                 EM045720
         B     E9$WEXIT            GO TO EXIT                           EM045730
         SPACE 2                                                        EM045740
*********************************************************************** EM045750
*                                                                     * EM045760
E9$W04   DS    0H        SENSE COMMAND SIMULATION                       EM045770
*                                                                     * EM045780
*********************************************************************** EM045790
         MVC   0(1,R10),E9$WSENS   SEND SENSE DATA TO 9300              EM045800
         B     E9$WEXIT            GO TO EXIT                           EM045810
         EJECT                                                          EM045820
*********************************************************************** EM045830
*                                                                     * EM045840
E9$W02   DS    0H                  READ COMMAND SIMULATION              EM045850
*                                                                     * EM045860
*********************************************************************** EM045870
         SR    R8,R8               ZERO TO WORK REGISTER 8              EM045880
         IC    R8,1(,R12)          9300 BYTE COUNT TO R8                EM045890
         LA    R9,E9$WBUFF         BUFFER ADDRESS TO R9                 EM045900
         TM    E9$WFUNC,X'01'      SECONDARY READ ?                     EM045910
         BZ    E9$W0200            YES, NO W0200                        EM045920
         LA    R9,80(R9)           SECONDARY BUFFER ADDR TO R9          EM045930
E9$W0200 ST    R9,E9$WBCW          DATA ADDR TO 90/30 BCW               EM045940
         EX    R8,E9$WMOVE         MOVE DATA TO 9300 USER AREA          EM045950
         TM    E9$RIOII+2,X'04'    LOAD MODE?                           EM045960
         BNO   E9$W020             YES,   NO  W020                      EM045970
         CLC   0(2,R10),E9$RTEND   TRANSFER RECORD?                     EM045980
         BNE   E9$W020             YES,   NO W020                       EM045990
         NI    E9$RIOII+2,X'FB'    SET LOAD MODE TO BE 0                EM046000
E9$W020  CLI   E9$RFC,X'06'        READ 161 BYTES IN BINARY MODE?       EM046010
         BNE   E9$W022             YES,  NO E9$W022                     EM046020
         MVI   E9$WBCWB+1,160      BYTE COUNT 160 TO 90/30 BCW          EM046030
         MVI   E9$WBCW,X'06'       BINARY READ FUNCTION CODE TO BCW     EM046040
*                                                                       EM046050
E9$W0201 TM    E9$WFUNC,X'08'      READ FUNCTION REQUIRED?              EM046060
         BZ    E9$WEXIT            YES, NO GO TO EXIT                   EM046070
         BAL   R7,E9$WREAD         READ ONE DATA                        EM046080
         TM    E9$WFUNC,X'02'      SECONDARY READ IS NEEDED?            EM046090
         BZ    E9$WEXIT            YES, NO GO TO EXIT                   EM046100
         LA    R9,80(R9)                                                EM046110
         ST    R9,E9$WBCW                                               EM046120
         MVI   E9$WBCW,X'02'       FUNCTION CODE TO BCW                 EM046130
         OI    E9$WFUNC,X'01'      SECONDARY READ FLAG TO BE ONE        EM046140
         BAL   R7,E9$WREAD         READ SECONDARY                       EM046150
         NI    E9$WFUNC,X'FE'      SET FLAG TO BE ZERO                  EM046160
         TR    E9$WBUFF(160),E9$ETRX   TRANSLATE TO XS-3 CODE           EM046170
         B     E9$WEXIT            GO TO EXIT                           EM046180
*                                                                       EM046190
E9$WMOVE MVC   0(,R10),0(R9)       TRANSFER DATA TO 9300                EM046200
*                                                                       EM046210
*                                                                       EM046220
E9$W022  MVI   E9$WBCW,X'02'            READ FUNCTION TO 90/30 BCW      EM046230
         MVI   E9$WBCWB+1,80       BYTE COUNT  80 TO 90/30 BCW          EM046240
         B     E9$W0201            GO TO E9$W0201                       EM046250
*                                                                       EM046260
E9$WREAD DS    0H                                                       EM046270
         TM    E9$WASN,E9$WGTCS    GETCS?                               EM046280
         BNZ   E9$WRCS             NO,   YES  WRCS                      EM046290
         LA    R1,E9$WCCB1         CCB ADDR TO R1                       EM046300
         TM    E9$WFUNC,X'01'      SECONDARY READ?                      EM046310
         BZ    E9$WR02             YES,    NO, ISSUE IO FUNCTION        EM046320
         LA    R1,E9$WCCB2         CCB FOR SECONDARY                    EM046330
E9$WR02  EXCP  1                                                        EM046340
         TM    IC$T,BC$TRAFF**X'FF'    IO COMPLETE ?                    EM046350
         BZ    *-4                 YES,NO WAIT FOR COMPLETION           EM046360
E9$WR03  CLI   E9$RFC,X'06'        TRANSLATION REQUIRED?                EM046370
         BER   R7                  YES,   NO BACK TO CALLER             EM046380
         TR    0(80,R9),E9$RTBPU   EBCDIC TO COMPRESSED CODE TRANSLATE  EM046390
         BR    R7                  GO TO CALLER                         EM046400
*                                                                       EM046410
*                                                                       EM046420
E9$WRCS  LR    R1,R9               BUFFER ADDRESS TO R1                 EM046430
         GETCS (1)                                                      EM046440
         B     E9$WR03             GO TO E9$WR03                        EM046450
*                                                                       EM046460
*                                                                       EM046470
*                                                                       EM046480
*                                                                       EM046490
E9$WINVL DS    0H                  INVALID FUNCTION                     EM046500
*                                                                       EM046510
*                                                                       EM046520
         MVI   E9$R9DS,X'02'       SET UNIT CHECK BIT 1 ON DVC STATUS   EM046530
         OI    E9$RPSW5,X'10'      SET CC = 01                          EM046540
         OI    E9$WSENS,E9$WSN80   COMMAND REJET BIT = 1 ON SENSE BYTE  EM046550
         B     E9$WEXT0                                                 EM046560
*                                                                       EM046570
*                                                                       EM046580
*                                                                       EM046590
*                                                                       EM046600
E9$WEXIT DS    0H                                                       EM046610
*                                                                       EM046620
*                                                                       EM046630
         LH    R8,0(,R12)          BYTE COUNT TO R8                     EM046640
         LH    R9,2(,R12)          USER DATA ADDR TO R8                 EM046650
         AR    R8,R9                                                    EM046660
         STH   R8,2(,R12)          NEXT DATA ADDR TO 9300 BCW           EM046670
         XC    0(2,R12),0(R12)     ZERO TO BYTE COUNT IN 9300 BCW       EM046680
E9$WEXT0 TM    E9$RIOII+2,X'04'    LOAD MODE?                           EM046690
         BO    E9$WEXT2            NO,   YES  EXT2                      EM046700
         MVI   E9$R9DS,X'0C'       SET DVC END + CHNL END ON 9300       EM046710
         OI    0(R12),X'20'        SET T-BIT TO 1 ON 9300 BCW           EM046720
*                                                                       EM046730
E9$WEXT1 MVI   E9$R9DA,E9$WDA      DEVICE ADDRESS TO 9300 MEMORY        EM046740
E9$WEXT2 OI    E9$RXS1,X'10'       SET STATUS PENDING BIT TO BE 1       EM046750
         B     E9$REXIT            GO TO COMMON EXIT                    EM046760
*                                                                       EM046770
*        STORAGE AND CONSTANT                                           EM046780
*                                                                       EM046790
E9$CCP   PIOCB                                                          EM046800
E9$CCS   PIOCB                                                          EM046810
E9$WCCB1 CCB   E9$CCP,E9$WBCW,,X'20'                                    EM046820
E9$WCCB2 CCB   E9$CCS,E9$WBCW,,X'20'                                    EM046830
*                                                                       EM046840
E9$WBCW  DS    0D                  BCW FOR 90/30                        EM046850
         DC    X'02'               COMMAND CODE                         EM046860
         DC    AL3(E9$WBUFF)       BUFFER ADDRESS                       EM046870
         DC    Y(0)                                                     EM046880
E9$WBCWB DC    Y(0)                BYTE COUNT (A)                       EM046890
         DC    A(0)                                                     EM046900
         DC    A(0)                                                     EM046910
*                                                                       EM046920
E9$WW0   DS    H                                                        EM046930
E9$WBUFF DC    2XL80'00'                                                EM046940
         DROP  R1                                                       EM046950
E9$ETRX  EQU   *                                                        EM046960
         DC    XL16'0'                                                  EM046970
         DC    XL16'0'                                                  EM046980
         DC    XL16'0'                                                  EM046990
         DC    XL16'0'                                                  EM047000
         DC    X'0000000000000000000000123D0F1E1F'                      EM047010
         DC    X'10000000000000000000002221010E2F'                      EM047020
         DC    X'0234000000000000000000323120003F'                      EM047030
         DC    X'00000000000000000000331D2E113E20'                      EM047040
         DC    XL16'0'                                                  EM047050
         DC    XL16'0'                                                  EM047060
         DC    XL16'0'                                                  EM047070
         DC    XL16'0'                                                  EM047080
         DC    X'131415161718191A1B1C000000000000'                      EM047090
         DC    X'232425262728292A2B2C000000000000'                      EM047100
         DC    X'300035363738393A3B3C000000000000'                      EM047110
         DC    X'030405060708090A0B0C000000000000'                      EM047120
E9$WFUNC DS    H                   FUNCTION CODE SAVE AREA              EM047130
         EJECT                                                          EM047140
         DO    '&RES'='1001'                                            EM047150
*********************************************************************** EM047160
*                                                                     * EM047170
*    'LOAD' OPERATOR COMMAND PROCESSING ROUTINE FOR 1001              * EM047180
*                                                                     * EM047190
*********************************************************************** EM047200
         SPACE 2                                                        EM047210
E9$YRIPL DS    0H                                                       EM047220
         L     R5,E9$COV           MUX CHANNEL HANDLER COVER            EM047230
         L     R1,E9$RXDTF         DTF INFORMATION FOR SAT IN IGET      EM047240
         LA    R2,0                RECEIVE-AREA OF 1001, FOR IGET       EM047250
         L     R3,E9$RXBUF         BUFFER ADDRESS FOR IGET ROUTINE      EM047260
         OI    E9$RXS3,X'04'       TRANSLATION BIT                      EM047270
         OI    E9$RIOII+2,X'40'    FOR RETURN                           EM047280
         BAL   R10,E9$RIGET        GET ONE CARD IMMAGE                  EM047290
         L     R1,E9$RXDTF         DTF INFORMATION FOR SAT IN IGET      EM047300
         LA    R2,80                                                    EM047310
         L     R3,E9$RXBUF         BUFFER ADDRESS FOR IGET ROUTINE      EM047320
         OI    E9$RXS3,X'04'       TRANSLATION BIT                      EM047330
         OI    E9$RIOII+2,X'40'    FOR RETURN                           EM047340
         BAL   R10,E9$RIGET        GET ONE CARD IMMAGE                  EM047350
         L     R1,E9$RXDTF         DTF INFORMATION FOR SAT IN IGET      EM047360
         LA    R2,E9$WBUFF                                              EM047370
         L     R3,E9$RXBUF         BUFFER ADDRESS FOR IGET ROUTINE      EM047380
         OI    E9$RIOII+2,X'40'    FOR RETURN                           EM047390
         BAL   R10,E9$RIGET        GET ONE CARD IMMAGE                  EM047400
         XC    E9$RSRG8(32),E9$RSRG8   CLEAR 9300 REGISTERS             EM047410
         LA    R3,E9$RIR8                                               EM047420
         LA    R2,8                                                     EM047430
         LA    R4,E9$RSVRG                                              EM047440
E9$WLDR  MVC   0(2,R4),0(R3)       CONTENTS OF REGISTER SAVE AREA       EM047450
         LA    R3,2(R3)            OF OP COM TO 9300 LOW ORDER          EM047460
         LA    R4,4(R4)            MEMORY                               EM047470
         BCT   R2,E9$WLDR                                               EM047480
         LM    R8,R15,E9$RSRG8                                          EM047490
         OI    E9$RASW3,X'01'                                           EM047500
         LA    R2,E9$RSTTL                                              EM047510
         ST    R2,E9$RAOPS+4                                            EM047520
         EXIT  OC                                                       EM047530
         ENDO                                                           EM047540
         ENDO                                                           EM047550
         TITLE 'MULTIPLEXOR HANDLER ROW PUNCH'                          EM047560
*********************************************************************** EM047570
E9$PT    DS    0H                                                       EM047580
         DO    '&PUNCH5'='ROW'                                          EM047590
         BAL   7,E9$MSCAN                                               EM047600
         TM    E9$RFC,X'03'             CONTROL FUNC                    EM047610
         BO    E9$PFCI3                                                 EM047620
         TM    E9$RFC,X'01'             LOAD FUNC                       EM047630
         BO    E9$PFCI2                                                 EM047640
         TM    E9$RFC,X'02'             UNLOAD FUNC                     EM047650
         BO    E9$PFCI2                                                 EM047660
         TM    E9$RFC,X'30'                                             EM047670
         BO    E9$DVST                                                  EM047680
         TM    E9$RFC,X'10'             SET INH STATUS                  EM047690
         BO    E9$PSTIH                                                 EM047700
         TM    E9$RFC,X'20'             RESET INH STATUS                EM047710
         BO    E9$PESIH                                                 EM047720
         TM    E9$RFC,X'04'             SENSE I/O                       EM047730
         BO    E9$PFCI2                                                 EM047740
         OI    E9$RPSW5,X'30'                                           EM047750
         B     E9$DVST                                                  EM047760
E9$PSTIH EQU   *                                                        EM047770
         NI    E9$RXS1,X'F7'            ERASE INT PERMIT                EM047780
         B     E9$PIOT                                                  EM047790
E9$PESIH EQU   *                                                        EM047800
         OI    E9$RXS1,X'08'            SET INT PERMIT                  EM047810
E9$PIOT  EQU   *                                                        EM047820
         OI    E9$RXS1,X'10'            SET STATUS PENDING              EM047830
         NI    E9$RPSW5,X'CF'           CLEAR CC                        EM047840
         B     E9$REXIT                                                 EM047850
E9$PFCI3 EQU   *                                                        EM047860
         LA    3,E9$PBCW                                                EM047870
         MVC   0(1,3),E9$RFC                                            EM047880
         B     E9$PI14                                                  EM047890
E9$PFCI2 EQU   *                                                        EM047900
         LA    3,E9$PBCW                L 3 W/BCW                       EM047910
         SR    2,2                      CLR R2                          EM047920
         IC    2,E9$RXBCW               LD 9300 BCW VALUE               EM047930
         MVC   6(2,3),0(2)              SET WMT BITS LENGTH             EM047940
         MVC   2(2,3),2(2)              SET LOC TO 90/30                EM047950
         MVC   0(1,3),E9$RFC            SET FUNCTION TO COMMAND         EM047960
         MVI   1(3),X'00'               CLR SECOND BYTE BCW             EM047970
E9$PI14  EQU   *                                                        EM047980
         TM    PCHSWIT,X'01'            IS SWITCH SET FOR OTHER PCH     EM047990
         BNO   E9$PIO4                                                  EM048000
         TM    E9$PBCW,X'03'            CONTROL FUNCTION                EM048010
         BNO   E9$PIO5                                                  EM048020
E9$PIO6  MVI   E9$PCCB+26,X'0C'         SET DUMMY CE DE                 EM048030
         B     E9$DVST                                                  EM048040
E9$PIO5  EQU   *                                                        EM048050
         TM    E9$PBCW,X'01'            LOAD ?                          EM048060
         BO    E9$PIO7                                                  EM048070
         B     E9$PIO6                                                  EM048080
E9$PIO7  EQU   *                                                        EM048090
         SR    8,8                                                      EM048100
         IC    8,7(3)                                                   EM048110
         BCTR  8,0                                                      EM048120
         STC   8,E9$PIO8+1                                              EM048130
         STC   8,E9$PIO9+1                                              EM048140
         LH    8,2(3)                                                   EM048150
E9$PIO8  MVC   E9$PBRWP(80),0(8)                                        EM048160
         TM    E9$PBCW,X'40'            IS IMAGE MODE SET               EM048161
         BO    *+10                     BYPAS IF SET                    EM048162
E9$PIO9  TR    E9$PBRWP(80),E9$RTBRD   TRANSLATE                        EM048170
         LA    8,E9$PBRWP              SET UP BUFF ADDR                 EM048180
         STH   8,E9$PBCW+2             STOR IN BCW                      EM048190
E9$PIO4  EQU   *                                                        EM048200
         BAL   7,E9$PIOR                                                EM048210
         TM    E9$PBCW,X'03'                                            EM048220
         BO    E9$DVST                                                  EM048230
         LH    2,10(,1)                 LD RESIDUAL TO R2               EM048240
         LH    11,E9$PBCW+6             LD ORIGINAL COUNT               EM048250
         SLL   11,19                                                    EM048260
         SRL   11,19                                                    EM048270
         SR    11,2                                                     EM048280
         SR    3,3                                                      EM048290
         IC    3,E9$RXBCW                                               EM048300
         LH    2,2(3)                                                   EM048310
         TM    E9$PBCW+6,X'40'          CHK DECENDING BIT ON            EM048320
         BNO   E9$PADD                                                  EM048330
         SR    2,11                     SUBTRACT IF DECENDING           EM048340
         B     E9$PSUB                                                  EM048350
E9$PADD  EQU   *                                                        EM048360
         AR    2,11                     ADD IF ASCENDING                EM048370
E9$PSUB  EQU   *                                                        EM048380
         SR    3,3                                                      EM048390
         IC    3,E9$RXBCW               LD 9300 BCW INTO R3             EM048400
         STH   2,2(3)                                                   EM048410
         MVC   0(2,3),10(1)             STORE RESIDUAL INTO 9300 BCW    EM048420
         CLC   0(2,3),E9$PWORK                                          EM048430
         BNE   E9$PNSTB                                                 EM048440
         OI    0(3),X'20'                                               EM048450
E9$PNSTB EQU   *                                                        EM048460
         LA    2,E9$PBCW                                                EM048470
         TM    6(2),X'80'                                               EM048480
         BNO   *+8                                                      EM048490
         OI    0(3),X'80'                                               EM048500
         TM    6(2),X'40'                                               EM048510
         BNO   *+8                                                      EM048520
         OI    0(3),X'40'                                               EM048530
E9$DVST  EQU   *                                                        EM048540
         L     1,E9$RXDTF                                               EM048550
         MVC   E9$R9DA(1),E9$RDA        SET DA TO 43                    EM048560
         MVC   E9$R9DS(1),26(1)         SET DS TO 42                    EM048570
         B     E9$PIOT                                                  EM048580
PRWX     DC    F'0'                                                     EM048590
E9$PIOR  EQU   *                                                        EM048600
         ST    7,PRWX                                                   EM048610
         L     1,E9$RXDTF                                               EM048620
         EXCP  (1)                                                      EM048630
         TM    E9$PCCB+2,X'80'                                          EM048640
         BNO   *-4                                                      EM048650
         TM    PCHSWIT,X'01'                                            EM048660
         BNO   E9$PBSST                                                 EM048670
         MVI   E9$PCCB+26,X'04'                                         EM048680
E9$PBSST EQU   *                                                        EM048690
         L     7,PRWX                                                   EM048700
         BR    7                                                        EM048710
         CNOP  0,4                                                      EM048720
E9$PWORK DC    XL4'00000000'                                            EM048730
E9$PCCB  CCB   PUNCH041,E9$PBCW,,X'20'                                  EM048740
PUNCH041 PIOCB                                                          EM048750
E9$PBCW  DC    4F'0'                                                    EM048760
PCHSWIT  DC    F'0'                                                     EM048770
E9$PBRWP DS    0F                                                       EM048780
         DC    XL160'0'                                                 EM048790
         B     *                                                        EM048800
         B     *                                                        EM048810
         B     *                                                        EM048820
         B     *                                                        EM048830
         B     *                                                        EM048840
         B     *                                                        EM048850
         B     *                                                        EM048860
         B     *                                                        EM048870
         B     *                                                        EM048880
         B     *                                                        EM048890
         B     *                                                        EM048900
         ENDO                                                           EM048910
         TITLE 'MULTIPLEXOR HANDLER DRUM PRINTER'                       EM048920
*********************************************************************** EM048930
*       CHECK FOR TYPE OF FUNCTION ISSUED TO DRUM PRINTER             * EM048940
*********************************************************************** EM048950
E9$RDRMP DS    0H                                                       EM048960
         DO    '&PRTDRUM'>'0'                                           EM048970
         BAL   7,E9$MSCAN               FIND TABLE FOR DRUM PRINTER     EM048980
         CLI   E9$RFC,X'FB'             IS COMMAND A LD CODE            EM048990
         BNE   E9$FRCKF                                                 EM049000
         TM    DSWITCH,X'C0'            IS 0770 OR 0773 SWITCH SET?     EM049010
         BZ    E9$RDDDA                                                 EM049020
         MVI   E9$R9DS,X'0C'            SET DUM CE DE                   EM049030
         B     E9$RDVST                                                 EM049040
E9$RDDDA EQU   *                                                        EM049050
         L     2,E9$RXDTF                                               EM049060
         OI    3(2),X'40'                                               EM049070
         B     E9$RDIC                                                  EM049080
E9$FRCKF EQU   *                                                        EM049090
         CLI   E9$RFC,X'04'             IS COMMAND A SENSE              EM049100
         BE    E9$RDIC                                                  EM049110
         TM    E9$RFC,X'03'             CONTROL/READ/WRITE COMMAND      EM049120
         BO    E9$RDIC                                                  EM049130
         TM    E9$RFC,X'01'                                             EM049140
         BO    E9$RDIC                                                  EM049150
*       FUNCTION MUST BE EITHER A SET/RESET OR TEST COMMAND             EM049160
         TM    E9$RFC,X'30'             TEST I/O BITS SET               EM049170
         BO    E9$RDVST                                                 EM049180
         TM    E9$RFC,X'20'             IS RESET INH STATUS BIT SET     EM049190
         BO    E9$RDIHR                 GOTO RESET DRUM INH STATUS      EM049200
         TM    E9$RFC,X'10'             IS SET INH STATUS BIT SET       EM049210
         BO    E9$RSDIH                 GOTO SET INH STATUS             EM049220
*       FUNCTION MUST BE A ALL ZERO TIO                                 EM049230
         B     E9$RDVST                                                 EM049240
E9$RSDIH EQU   *                                                        EM049250
         NI    E9$RXS1,X'F7'            ERASE INTERRUPT PERMIT(INHIB)   EM049260
         B     E9$RIO                                                   EM049270
E9$RDIHR EQU   *                                                        EM049280
         OI    E9$RXS1,X'08'            SET INTERRUPT PERMIT            EM049290
E9$RIO   EQU   *                                                        EM049300
         OI    E9$RXS1,X'10'            SET STATUS PENDING              EM049310
         NI    E9$RPSW5,X'CF'           SET CC TO ZERO                  EM049320
         B     E9$REXIT                 EXIT TO PROGRAM                 EM049330
E9$RDIC  EQU   *                                                        EM049340
         L     2,E9$RXDTF               LD CCB ADDR                     EM049350
         L     3,12(2)                  LD BCW ADDR                     EM049360
         L     2,E9$RXBUF                                               EM049370
         STH   2,2(3)                                                   EM049380
         SR    2,2                                                      EM049390
         IC    2,E9$RXBCW                                               EM049400
         MVC   7(1,3),1(2)              SET SIZE TO BCW                 EM049410
         L     9,E9$RXBUF               LD R9 WITH BUFFER ADDRESS       EM049420
         SR    7,7                      CLR R7                          EM049430
         IC    7,1(2)                   LD NO OF CHARACTERS             EM049440
         BCTR  7,0                      DECREMENT NO OF CHARACTER       EM049450
         STC   7,E9$LDBUF+1             STORE NUMBER MINUS 1            EM049460
         LH    7,2(2)                   LD R7 W/ 9300 BUFF              EM049470
E9$LDBUF MVC   0(90,9),0(7)             MVE 9300 BUFF TO 90/30 BUFF     EM049480
         MVC   0(1,3),E9$RFC            SET FUNCTION CODE TO BCW        EM049490
         MVI   1(3),X'00'               CLR SECOND BYTE BCW             EM049500
         TM    DSWITCH,X'C0'            CHK FOR 770 773 SET             EM049510
         BZ    E9$PRNTC                                                 EM049520
         TM    0(3),X'03'               IS FUNCTION SKIP ADVANCE        EM049530
         BNO   E9$PRNTA                                                 EM049540
         OI    0(3),X'04'               SET BIT FOR 773/770 FUNC        EM049550
E9$PRNTB TM    0(3),X'60'               IS ADV/SKIP SET                 EM049560
         BM    E9$SASKP                                                 EM049570
         TM    0(3),X'18'               CHK 3 CODE                      EM049580
         BNO   E9$PRNTC                 IF NOT BYPASS                   EM049590
         TM    DSWITCH+1,X'01'          A PRINTER                       EM049600
         BNO   E9$PRNTC                                                 EM049610
E9$SASKP OI    0(3),X'80'               SET ADVANCE                     EM049620
         B     E9$PRNTC                 GO TO ISSUE                     EM049630
E9$PRNTA TM    0(3),X'01'               WAS IT PRINT ADV                EM049640
         BNO   E9$PRNTC                 GO TO ISSUE IF NOT              EM049650
         B     E9$PRNTB                 CHK ADVANCE/SKIP                EM049660
E9$PRNTC EQU   *                                                        EM049670
         BAL   7,E9$RDRUM                                               EM049680
E9$PRTCC EQU   *                                                        EM049690
         TM    0(3),X'03'                                               EM049700
         BO    E9$RDVST                                                 EM049710
         LH    2,10(,1)                 LD RESIDUAL TO R2               EM049720
         LH    11,6(3)                  LD ORIGINAL COUNT               EM049730
         SLL   11,19                    ELIMINATE WMT BITS              EM049740
         SRL   11,19                    REPOSITION                      EM049750
         SR    11,2                     SUB RESIDUAL FROM ORIGINAL      EM049760
         SR    7,7                      CLR R7                          EM049770
         IC    7,E9$RXBCW                                               EM049780
         LH    2,2(7)                                                   EM049790
         TM    6(3),X'40'                                               EM049800
         BNO   E9$RPADD                                                 EM049810
         SR    2,11                                                     EM049820
         B     E9$RPSUB                 SUB IF DECENDING                EM049830
E9$RPADD EQU   *                                                        EM049840
         AR    2,11                     ADD IF ASCENDING                EM049850
E9$RPSUB EQU   *                                                        EM049860
         SR    3,3                      CLR R3                          EM049870
         IC    3,E9$RXBCW               LD 9300 BCW INTO R3             EM049880
         STH   2,2(3)                                                   EM049890
         MVC   0(2,3),10(1)                                             EM049900
         CLC   0(2,3),E9$RDWRK                                          EM049910
         BNE   E9$RDSTB                                                 EM049920
         OI    0(3),X'20'               IF ZEROS SET TERMINATE BIT      EM049930
E9$RDSTB EQU   *                                                        EM049940
         L     2,12(1)                  LD BCW ADDR.                    EM049950
         TM    6(2),X'80'                                               EM049960
         BNO   *+8                                                      EM049970
         OI    0(3),X'80'                                               EM049980
         TM    6(2),X'40'                                               EM049990
         BNO   *+8                                                      EM050000
         OI    0(3),X'40'                                               EM050010
E9$RDVST EQU   *                                                        EM050020
         MVC   E9$R9DA(1),E9$RDA        SET DA TO 43                    EM050030
*                                                                       EM050040
         B     E9$RIO                                                   EM050050
         CNOP  0,4                                                      EM050060
E9$RDWRK DC    XL4'00000000'                                            EM050070
DSWITCH  DC    F'0'                                                     EM050080
*********************************************************************** EM050090
*********************************************************************** EM050100
*        DRUM PRINTER OUTPUT ISSUANCE ROUTINE                         * EM050110
*********************************************************************** EM050120
DPX      DC    F'0'                                                     EM050130
E9$RDRUM EQU   *                                                        EM050140
         ST    7,DPX                                                    EM050150
         L     1,DPSAVECB               LD LAST CCB ISSUED              EM050160
         TM    2(1),X'80'               CURRENT CCB COMPLETED           EM050170
         BNO   *-4                      BR BACK IF NOT                  EM050180
         TM    26(1),X'01'              TST FOV                         EM050190
         BO    E9$RDFOV                 IF SET GO TO FOV                EM050200
         L     1,E9$RXDTF               LD NEXT CCB                     EM050210
         EXCP  (1)                                                      EM050220
         TM    DSWITCH,X'C0'            IS OTHER SET                    EM050230
         BNZ   E9$RPIRT                                                 EM050240
         CLI   0(3),X'FB'                                               EM050250
         BNE   E9$RPIRT                 UNIT CHECK SET                  EM050260
         TM    2(1),X'80'               CCB COMPLETED                   EM050270
         BNO   *-4                      GO BACK                         EM050280
         TM    26(1),X'02'              UNIT CHECK SET                  EM050290
         BNO   E9$RDSST                 NO BRANCH, YES CONTINUE         EM050300
         TM    20(1),X'80'              COMMAND REJECT ?                EM050310
         BNO   E9$RDSST                 NO BRANCH, YES CONTINUE         EM050320
         TM    23(1),X'10'              REASON SPOOLING?                EM050330
         BNO   E9$RDSST                 NO BRANCH, YES CONTINUE         EM050340
         MVI   E9$R9DS,X'0C'            SET DUMMY CE DE.                EM050350
         NI    3(1),X'BF'               ERASE UNRECOV ACCEPT            EM050360
         B     E9$RDVST                 GO BACK                         EM050370
E9$RDSST EQU   *                                                        EM050380
         NI    3(1),X'BF'               RESET UNRECOVERABLE             EM050390
E9$RPIRT EQU   *                                                        EM050400
         MVI   E9$R9DS,X'0C'            SET CE & DE                     EM050410
         LA    9,DRUMBUF1               LD BUFFER ADDRESS               EM050420
         L     7,E9$RXBUF               LD CURRENT BEING EXECUTED       EM050430
         CR    7,9                      COMP                            EM050440
         BNE   E9$DNOSW                 IF NOT EQUAL                    EM050450
         LA    9,DRUMBUF2                                               EM050460
         ST    9,E9$RXBUF                                               EM050470
         LA    9,DRUMPCC1                                               EM050480
         ST    9,E9$RXDTF                                               EM050490
         LA    1,DRUMPCCB               SET UP ADDR                     EM050500
         B     EXITPT                                                   EM050510
E9$DNOSW EQU   *                                                        EM050520
         ST    9,E9$RXBUF                                               EM050530
         LA    7,DRUMPCCB                                               EM050540
         ST    7,E9$RXDTF                                               EM050550
         LA    1,DRUMPCC1                                               EM050560
EXITPT   EQU   *                                                        EM050570
         ST    1,DPSAVECB               SAVE CURRENT CCB POINTER        EM050580
         L     7,DPX                    RETURN SETUP                    EM050590
         BR    7                        RETURN                          EM050600
*********************************************************************** EM050610
*        DRUM PRINT OVERFLOW ENCOUNTERED ROUTINE                      * EM050620
*********************************************************************** EM050630
E9$RDFOV EQU   *                                                        EM050640
         MVI   26(1),X'0C'              CLEAR OVFL                      EM050650
         TM    DSWITCH,X'C0'            IF 770/773 BYPASS               EM050660
         BNZ   E9$RPRID                                                 EM050670
         EXCP  (1)                                                      EM050680
E9$RPRID EQU   *                                                        EM050690
         MVI   E9$R9DS,X'05'            SET DE /OVFL                    EM050700
         MVC   E9$R9DA(1),E9$RDA        SET DA                          EM050710
         TM    E9$RXS1,X'08'            TEST INHIBIT                    EM050720
         BNO   *+8                                                      EM050730
         OI    E9$RXS1,X'02'            SET IF INHIBIT                  EM050740
         B     E9$RIO                                                   EM050750
         B     *                                                        EM050760
         B     *                                                        EM050770
         B     *                                                        EM050780
*********************************************************************** EM050790
DRUMPCCB CCB   PRNTR681,DRUMPBCW,,X'20'                                 EM050800
DRUMPCC1 CCB   PRNTR681,DRUMPBC1,,X'20'                                 EM050810
PRNTR681 PIOCB                                                          EM050820
DRUMPBCW DC    4F'0'                                                    EM050830
DRUMPBC1 DC    4F'0'                                                    EM050840
DPSAVECB DC    A(DRUMPCCB)                                              EM050850
DRUMBUF1 DS    0F                                                       EM050860
         DC    XL136'0'                                                 EM050870
DRUMBUF2 DS    0F                                                       EM050880
         DC    XL136'0'                                                 EM050890
         ENDO                                                           EM050900
         DO    '&CR0716'>'0'                                            EM050910
         TITLE 'MULTIPLEXOR HANDLER 0716'                               EM050920
E9$0716  DS    0H                                                       EM050930
         BAL   7,E9$MSCAN                                               EM050940
         TM    E9$RFC,X'03'             CONTROL FUNCTION FEED?          EM050950
         BO    E9$AFCI2                                                 EM050960
         TM    E9$RFC,X'02'             READ COMMAND?                   EM050970
         BO    E9$AFCI2                                                 EM050980
         TM    E9$RFC,X'01'             DIAGNOSTIC WRITE ?              EM050990
         BO    E9$AFCI2                                                 EM051000
         TM    E9$RFC,X'04'             SENSE COMMAND?                  EM051010
         BO    E9$AFCI2                                                 EM051020
*        CHECK FOR SET/RESET INHIBIT STATUS                             EM051030
         TM    E9$RFC,X'10'             SET INHIBIT STATUS?             EM051040
         BO    E9$ASTIH                                                 EM051050
         TM    E9$RFC,X'20'             RESET INHIBIT STATUS            EM051060
         BO    E9$AESIH                                                 EM051070
         OI    E9$RPSW5,X'30'           SET CC TO REJECT                EM051080
         B     E9$ADVST                                                 EM051090
E9$ASTIH EQU   *                                                        EM051100
         NI    E9$RXS1,X'F7'            ERASE INTERRUPT PERMIT          EM051110
         B     E9$AIO                                                   EM051120
E9$AESIH EQU   *                                                        EM051130
         OI    E9$RXS1,X'08'            SET INTERRUPT PERMIT            EM051140
E9$AIO   EQU   *                                                        EM051150
         OI    E9$RXS1,X'10'            SET INT/STATUS PEND             EM051160
         NI    E9$RPSW5,X'CF'           SET CC TO ZERO                  EM051170
         B     E9$REXIT                                                 EM051180
E9$AFCI2 EQU   *                                                        EM051190
         LA    3,RDBCW716                                               EM051200
         SR    2,2                      CLR R2                          EM051210
         IC    2,E9$RXBCW                                               EM051220
         MVC   6(2,3),0(2)              SET WMT BITS & SIZE TO BCW      EM051230
         MVC   2(2,3),2(2)              SET AREA TO BCW                 EM051240
         MVI   1(3),X'00'               CLR SECOND BYTE BCW             EM051250
         MVC   0(1,3),E9$RFC            SET FUNCTION CODE TO BCW        EM051260
         BAL   7,E9$A1000                                               EM051270
         TM    RDBCW716,X'03'           WAS IT CONTROL FUNCTION         EM051280
         BO    E9$ADVST                                                 EM051290
         LH    2,10(,1)                 LD RESIDUAL TO R2               EM051300
         LH    11,RDBCW716+6            LD ORIGINAL COUNT               EM051310
         SLL   11,19                    SHIFT LEFT                      EM051320
         SRL   11,19                    SHIFT RIGHT REPOSITION          EM051330
         SR    11,2                     SUBTRACT                        EM051340
         LH    2,RDBCW716+2                                             EM051350
         TM    RDBCW716+6,X'40'         CHK DECENDING BIT ON            EM051360
         BNO   E9$AADD                                                  EM051370
         SR    2,11                     SUBTRACT IF DECENDING           EM051380
         B     E9$ASUB                                                  EM051390
E9$AADD  EQU   *                                                        EM051400
         AR    2,11                     ADD IF ASCENDING                EM051410
E9$ASUB  EQU   *                                                        EM051420
         SR    3,3                      CLR R3                          EM051430
         IC    3,E9$RXBCW               LD 9300 BCW TO R3               EM051440
         STH   2,2(3)                                                   EM051450
         MVC   0(2,3),10(1)             STORE RESIDUAL INTO 9300 BCW    EM051460
         CLC   0(2,3),E9$AWOK                                           EM051470
         BNE   E9$ANSTB                                                 EM051480
         OI    0(3),X'20'                                               EM051490
E9$ANSTB EQU   *                                                        EM051500
         LA    2,RDBCW716                                               EM051510
         TM    6(2),X'80'                                               EM051520
         BNO   *+8                                                      EM051530
         OI    0(3),X'80'                                               EM051540
         TM    6(2),X'40'                                               EM051550
         BNO   *+8                                                      EM051560
         OI    0(3),X'40'                                               EM051570
E9$ADVST EQU   *                                                        EM051580
         MVC   E9$R9DA(1),E9$RDA        SET DA TO 43                    EM051590
         MVC   E9$R9DS(1),26(1)         SET DS TO 42                    EM051600
         B     E9$AIO                                                   EM051610
APX      DC    F'0'                                                     EM051620
E9$A1000 EQU   *                                                        EM051630
         ST    7,APX                                                    EM051640
         L     1,E9$RXDTF               LOAD R1 W/CCB POINTER           EM051650
         EXCP  (1)                                                      EM051660
         TM    RDCCB716+2,X'80'         TEST COMPLETION                 EM051670
         BNO   *-4                                                      EM051680
         L     7,APX                                                    EM051690
         BR    7                                                        EM051700
         CNOP  0,4                                                      EM051710
E9$AWOK  DC    XL4'00000000'                                            EM051720
RDCCB716 CCB   READ161,RDBCW716,,X'20'                                  EM051730
READ161  PIOCB                                                          EM051740
RDBCW716 DC    4F'0'                                                    EM051750
         ENDO                                                           EM051760
         DO    '&ODR'>'0'                                               EM051770
         TITLE 'HANDLER 2703 READER'                                    EM051780
E9$ODR   DS    0H                                                       EM051790
*                                                                       EM051800
*                                                                       EM051810
*                                                                       EM051820
*                                                                       EM051830
*                                                                       EM051840
*                                                                       EM051850
*                                                                       EM051860
*                                                                       EM051870
*                                                                       EM051880
*                                                                       EM051890
*                                                                       EM051900
*                                                                       EM051910
*                                                                       EM051920
*                                                                       EM051930
*                                                                       EM051940
*                                                                       EM051950
*                                                                       EM051960
*                                                                       EM051970
*                                                                       EM051980
*                                                                       EM051990
         ENDO                                                           EM052000
         DO    '&PTAPE'>'0'                                             EM052010
         TITLE 'HANDLER 0920 PPT'                                       EM052020
E9$PPTP  DS    0H                                                       EM052030
*                                                                       EM052040
*                                                                       EM052050
*                                                                       EM052060
*                                                                       EM052070
*                                                                       EM052080
*                                                                       EM052090
*                                                                       EM052100
*                                                                       EM052110
*                                                                       EM052120
*                                                                       EM052130
*                                                                       EM052140
*                                                                       EM052150
*                                                                       EM052160
*                                                                       EM052170
*                                                                       EM052180
*                                                                       EM052190
*                                                                       EM052200
*                                                                       EM052210
*                                                                       EM052220
*                                                                       EM052230
*                                                                       EM052240
         ENDO                                                           EM052250
         DROP  5                                                        EM052260
         DO    '&TRANS'=''                                              EM052270
         TITLE 'INLINE LPSC SRC'                                        EM052280
         USING *,5                                                      EM052290
*   LPSC SRC INLINE HANDLER                                             EM052300
E9$TLPSC DS    0H                                                       EM052310
         CLI   E9$ROP,X'A4'             COMP FOR XIOF                   EM052320
         BE    E9$XXIOF                                                 EM052330
         CLI   E9$ROP,X'A1'             COMP FOR SRC                    EM052340
         BE    E9$TSRC                  GO TO SRC                       EM052350
         CLI   E9$ROP,X'A8'             COMP FOR LPSC                   EM052360
         BNE   E9$TTOVL                                                 EM052370
         LH    8,E9$RB1D1                                               EM052380
E9$TLPS1 TM    E9$RDA,X'08'             CHK ALTER/DISPLAY RESTRICTION   EM052390
         BO    E9$TLPS2                 IF A MATCH CHK FOR DUAL SET     EM052400
E9$TLPS3 TM    E9$RDA,X'04'             CHK MOVE RESTRICTION            EM052410
         BNO   E9$TLPS4                 NOT ONES IGNORE ALTER/DISPLAY   EM052420
         NI    E9$RIOII+2,X'7F'         SET BIT OFF                     EM052430
         BC    15,E9$TLPS4              CONT ON DO NOT SET              EM052440
E9$TLPS2 TM    E9$RDA,X'04'             CHK FOR DUAL SET                EM052450
         BO    E9$TLPS4                 IF DUAL SET IGNORE              EM052460
         OI    E9$RIOII+2,X'80'         SET BIT TO RESTRICTED LOC 4     EM052470
E9$TLPS4 EQU   *                                                        EM052480
         TM    E9$RIOII+1,X'04'         TST CUR MODE TO I/O SETTING     EM052490
         BNO   E9$TLP4                  IF NOT I/O / THEN IT IS PROC    EM052500
E9$TLP1  TM    E9$RDA,X'20'             I/O MODE (MOD OR LD I/O ?)      EM052510
         BNO   E9$TLP5                  IF NOT TO ACT ON I/O, DO PROC   EM052520
E9$TLP2  TM    E9$RDA,X'40'             I/O MODE (LD PSC SET ?)         EM052530
         BO    E9$TLP6                  IF NOT SET (CHK FOR CONTROL)    EM052540
E9$TLP3  TM    E9$RDA,X'10'             I/O MODE (TEST FOR CONTROL)     EM052550
         BNO   E9$TL7                   I/O TO PROC-LD I/O WITH B1D1    EM052560
E9$TL8   EQU   *                                                        EM052570
         B     E9$TRLSE                                                 EM052580
E9$TLP4  TM    E9$RDA,X'20'             PROC MODE (MOD OR LD I/O ?)     EM052590
         BNO   E9$TLPA                  GO TO CHK LD PSC SET            EM052600
E9$TLP7  TM    E9$RDA,X'40'             PROC MODE (LD PSC SET ?)        EM052610
         BNO   E9$TLPB                  GO TO CHK (CONTROL)             EM052620
E9$TLP9  TM    E9$RDA,X'10'             PROC MODE (CHECK FOR CONTROL)   EM052630
         BNO   E9$TL2                   IF NOT-LD I/O W/B1D1,CONT PROC  EM052640
         BC    15,E9$TL1                LD & SWITCH TO I/O MODE         EM052650
E9$TLP5  TM    E9$RDA,X'40'             I/O MODE (LD PSC SET ?)         EM052660
         BNO   E9$TLP3                  IF NOT CHK FOR CONTROL          EM052670
E9$TLP8  TM    E9$RDA,X'10'             I/O MODE (CONTROL SET ?)        EM052680
         BNO   E9$TL3                   STORE PSW LD & SWITCH TO PROC   EM052690
         BC    15,E9$TL4                GO TO LD B1D1 CONT IN I/O       EM052700
E9$TLP6  TM    E9$RDA,X'10'             I/O MODE (CONTROL SET ?)        EM052710
         BNO   E9$TL6                   LD I/O W/B1D1 LD & SW TO PROC   EM052720
         BC    15,E9$TL5                LD PSW W/B1D1 CONT IN I/O       EM052730
E9$TLPA  TM    E9$RDA,X'40'             PROC MODE (LD PSC SET)          EM052740
         BNO   E9$TLPB                  GO CHK FOR CNTL                 EM052750
E9$TLPC  TM    E9$RDA,X'10'             PROC MODE (CNTL SET FOR PROC?)  EM052760
         BNO   E9$TL9                   LD PSW W/B1D1 CONT IN PROC      EM052770
         BC    15,E9$TLA                LD PROC PSC W/B1D1 LD & SW I/O  EM052780
E9$TLPB  TM    E9$RDA,X'10'             PROC MODE (CNTL SET FOR I/O ?)  EM052790
         BNO   E9$TRLSE                                                 EM052800
         BC    15,E9$TLB                STOR PSW IN PROC LD/SW TO I/O   EM052810
E9$TCHPR LA    3,E9$RPR8               LOAD PROC REG 8 ADDRESS          EM052820
         BC    15,E9$TSTLD                                              EM052830
E9$TCHIO LA    3,E9$RIR8                LOAD IO REG 8 ADDRESS           EM052840
E9$TSTLD ST    2,E9$TTEMP               STORE REG 1                     EM052850
         SR    2,2                                                      EM052860
         LA    2,8(,2)                                                  EM052870
         LA    4,E9$RSVRG               LOAD SAVE REG ADDRESS OF PSW    EM052880
E9$TSTOR MVC   0(2,3),0(4)              STORE REGISTERS                 EM052890
         LA    3,2(,3)                  INCREMENT REG 3 POSITION BY 2   EM052900
         LA    4,4(,4)                  INCREMENT REG 4 POSITION BY 4   EM052910
         BCT   2,E9$TSTOR                                               EM052920
         L     2,E9$TTEMP                                               EM052930
         MVI   E9$TSTOR+2,X'30'         RESET MOVE                      EM052940
         MVI   E9$TSTOR+4,X'40'         RESET MOVE                      EM052950
         BR    7                                                        EM052960
E9$TTAGG MVI   E9$TSTOR+2,X'40'         SET POSITION FOR REG 4          EM052970
         MVI   E9$TSTOR+4,X'30'         SET POSITION FOR REG 3          EM052980
E9$TSWIT BC    15,E9$TCHPR              SWITCH FOR PROC OR I/O          EM052990
         MVI   E9$TSWIT+1,X'F0'         RESET                           EM053000
         BC    15,E9$TCHIO              BRANCH TO LOAD I/O              EM053010
         CNOP  0,4                                                      EM053020
E9$TTEMP DC    XL8'0000000000000000'                                    EM053030
E9$TCCCH EQU   *                                                        EM053040
E9$TCCCK CH    6,E9$RPSW7               COMP FOR B1D1 EXCEEDING MEM     EM053050
         BNH   E9$TTOVL                                                 EM053060
         OI    E9$RPSW5,X'20'           SET BIT POS 34 ON (PSW          EM053070
         TM    0(3),X'80'               COMP FOR 9300 CC BEING SET      EM053080
         BO    *+8                      IF SET BYPASS                   EM053090
         NI    E9$RPSW5,X'DF'                                           EM053100
         OI    E9$RPSW5,X'10'           SET BIT POSITION 35 ON          EM053110
         TM    0(3),X'40'               COMP FOR 9300 CC POS BEING SET  EM053120
         BO    *+8                      IF SET BYPASS                   EM053130
         NI    E9$RPSW5,X'EF'           IF NOT ERASE                    EM053140
         BR    7                        RETURN                          EM053150
E9$TL1   EQU   *                                                        EM053160
         MVC   E9$RPFAP(2),E9$RPSW7     MOVE VALUE OF PSW TO PROC FAP   EM053170
         LA    3,E9$RPPSC               SET UP PROC STORAGE ADDRESS     EM053180
         BAL   7,E9$TCC93                                               EM053190
         MVC   E9$RPSW7(2),2(8)         MVE VALUE TO PSW SAVE           EM053200
         BAL   7,E9$TCHPR               BAL TO STORE REG INTO 9300      EM053210
         MVI   E9$TSWIT+1,X'00'         SET SWITCH FOR IO REG           EM053220
         BAL   7,E9$TTAGG               GO TO LOAD IO REG               EM053230
         LR    3,8                                                      EM053240
         BAL   7,E9$TCCCK                                               EM053250
         OI    E9$RIOII+1,X'04'         SET CURRENT MODE BIT ON         EM053260
         B     E9$TRLSE                                                 EM053270
E9$TL2   EQU   *                                                        EM053280
         MVC   E9$RIPSC(4),0(8)         MVE CONTENTS TO I/O PSC         EM053290
         B     E9$TRLSE                                                 EM053300
E9$TL3   EQU   *                                                        EM053310
         MVC   E9$RIFAP(2),E9$RPSW7     MOVE PSW SAVE TO I/O FAP        EM053320
         LA    3,E9$RIPSC               SET UP I/O STORAGE ADDRESS      EM053330
         BAL   7,E9$TCC93                                               EM053340
         MVC   E9$RPSW7(2),2(8)         MVE VALUE TO PSW SAVE           EM053350
         BAL   7,E9$TCHIO               GO TO STORE SAVE REG IN I/O     EM053360
         BAL   7,E9$TTAGG               LOAD PROC REG TO SAVE           EM053370
         LR    3,8                                                      EM053380
         BAL   7,E9$TCCCK                                               EM053390
         NI    E9$RIOII+1,X'FB'         ERASE MODE SET INDICATOR        EM053400
         BC    15,E9$TIPAR              GO TO INTERRUPT ANALYZER        EM053410
E9$TL4   EQU   *                                                        EM053420
         MVC   E9$RPPSC(4),0(8)         MVE CONTENTS TO PROC PSC        EM053430
         B     E9$TRLSE                                                 EM053440
E9$TL5   EQU   *                                                        EM053450
         MVC   E9$RPSW7(2),2(8)         MVE VALUE TO PSW SAVE           EM053460
         LR    3,8                                                      EM053470
         BAL   7,E9$TCCCK                                               EM053480
         B     E9$TRLSE                                                 EM053490
E9$TL6   EQU   *                                                        EM053500
         MVC   E9$RIPSC(4),0(8)         MVE CONTENTS TO I/O PSC         EM053510
         B     E9$TL71                  PROCESS PROC FAP TO 90/30 PSW   EM053520
E9$TL7   EQU   *                                                        EM053530
         MVC   E9$RIFAP(2),E9$RPSW7     MOVE PSW TO I/O PSC             EM053540
         LA    3,E9$RIPSC               SET UP I/O STORAGE ADDRESS      EM053550
         BAL   7,E9$TCC93                                               EM053560
E9$TL71  MVC   E9$RPSW7(2),E9$RPFAP     MOVE PROC FAP TO 90/30 PSW SAVE EM053570
         LA    3,E9$RPPSC               LOAD ADDRESS OF PROC PSC        EM053580
         BAL   7,E9$TCCCK               CHECK CC & BOUNDARY SIZE        EM053590
         BAL   7,E9$TCHIO               GO TO STORE REG IN I/O          EM053600
         BAL   7,E9$TTAGG               GO TO LOAD PROC REG INTO PSW    EM053610
         NI    E9$RIOII+1,X'FB'         ERASE MODE SET INDICATOR        EM053620
         BC    15,E9$TIPAR              GO TO INTERRUPT ANALYZER        EM053630
E9$TL9   EQU   *                                                        EM053640
         MVC   E9$RPSW7(2),2(8)         MVE VALUE TO PSW SAVE           EM053650
         LR    3,8                                                      EM053660
         BAL   7,E9$TCCCK               CHK CC & BOUNDARY SIZE          EM053670
         B     E9$TRLSE                                                 EM053680
E9$TLA   EQU   *                                                        EM053690
         MVC   E9$RPPSC(4),0(8)         MVE CONTENTS TO PROC PSC        EM053700
         B     E9$TLB1                  PROCESS I/O FAP TO 90/30 PSW    EM053710
E9$TLB   EQU   *                                                        EM053720
         MVC   E9$RPFAP(2),E9$RPSW7     MOVE PSW SAVE TO PROC LOC       EM053730
         LA    3,E9$RPPSC               SET UP PROC STORAGE ADDRESS     EM053740
         BAL   7,E9$TCC93                                               EM053750
E9$TLB1  MVC   E9$RPSW7(2),E9$RIFAP     I/O FAP TO 90/30 SAVE PSW       EM053760
         LA    3,E9$RIPSC               LOAD VALUE OF I/O PSC           EM053770
         BAL   7,E9$TCCCK               CHK CC & BOUNDARY SIZE          EM053780
         BAL   7,E9$TCHPR               STORE REG INTO PROC PARTITION   EM053790
         MVI   E9$TSWIT+1,X'00'         SET SWITCH FOR I/O LOAD         EM053800
         BAL   7,E9$TTAGG               BAL TO LOAD I/O REG             EM053810
         OI    E9$RIOII+1,X'04'         MARK FOR I/O MODE               EM053820
         B     E9$TRLSE                                                 EM053830
E9$TIPAR DS    0H                                                       EM053840
         L     4,E9$RALUT                                               EM053850
E9$TCT2  EQU   *                                                        EM053860
         CLI   0(4),X'FF'               END OF TBL?                     EM053870
         BE    E9$TRLSE                                                 EM053880
E9$TCT1  TM    E9$RXS1,X'18'            INT PENDING AND INTERRUPT       EM053890
         BO    E9$TIHCK                 BRCH IF MATCH TO INTER HNDLR    EM053900
         LA    4,36(,4)                INCREMENT DISPLACEMENT           EM053910
         B     E9$TCT2                  GO BACK FOR FURTHER CHECK       EM053920
E9$TIHCK NI    E9$RXS1,X'EF'            ERASE INT PEND                  EM053930
         SR    3,3                      CLR REG 3                       EM053940
         ST    4,E9$TTEMP+4                                             EM053950
         TM    E9$RTYPE,X'70'           CHK FOR EXEC 2,MOS,NCOS?        EM053960
         BZ    E9$TNSUP                                                 EM053970
*                                                                       EM053980
         IC    3,E9$RXSRC               LD VALUE TO R3                  EM053990
         AH    3,E9$RINIT               ADD INT ADDR                    EM054000
         LH    3,0(,3)                  LD VALUE OF TABLE               EM054010
         CH    3,E9$T0                                                  EM054020
         BE    E9$TIVAL                 IF ZEROS GO TO INVALID ENTRY    EM054030
         STH   3,E9$RIFAP               SET VALUE TO IFAP               EM054040
E9$TNSUP EQU   *                                                        EM054050
         MVC   E9$R9DA(1),E9$RXDA       SET 1 BYTE VALUE TO LOC 43      EM054060
         MVC   E9$RPSW7(2),E9$RIFAP     I/O VALUE TO PSW                EM054070
         LA    3,E9$RIPSC               SET UP I/O STORAGE ADDRESS      EM054080
         BAL   7,E9$TCCCK               CHECK CC & BOUNDARY SIZE        EM054090
         MVC   E9$RIR15+1(1),E9$R9DA    SET MEM W/ BYTE VALUE OF DEVA   EM054100
         MVI   E9$TSWIT+1,X'00'         SET SWITCH TO LD I/O REG        EM054110
         BAL   7,E9$TTAGG                                               EM054120
         OI    E9$RIOII+1,X'04'         SET MODE TO I/O                 EM054130
         L     4,E9$TTEMP+4                                             EM054140
         CLI   0(4),X'04'                                               EM054150
         BH    *+8                                                      EM054160
         MVI   E9$R9DS,X'00'            SET TO INTERNAL STATUS          EM054170
         B     E9$TRLSE                                                 EM054180
E9$TIVAL MVC   E9$ROP(4),E9$TSP                                         EM054190
         B     E9$TTOVL                                                 EM054200
         CNOP  0,4                                                      EM054210
E9$T0    DC    XL2'0000'                                                EM054220
E9$TSP   DC    XL4'A900413F'                                            EM054230
         CNOP  0,4                                                      EM054240
E9$TSSRC EQU   *                                                        EM054250
E9$RSSRC EQU   *                                                        EM054260
         CLC   E9$RDA(1),1(4)           COMP FOR SRC VALUE              EM054270
         BC    8,0(,7)                  EQ ? BRANCH BACK                EM054280
         CLI   0(4),X'FF'               COMP FOR END OF TBL             EM054290
         BE    E9$TMMC                  BR TO MSG MACRO CHK             EM054300
         LA    4,36(,4)                INCREMENT DISPLACEMENT           EM054310
         BC    15,E9$RSSRC              BRANCH BACK FOR NEXT COMP       EM054320
E9$TMMC  EQU   *                                                        EM054330
         CLI   E9$RDA,X'08'             COMP FOR SRC MSG MACRO          EM054340
         BNE   E9$TRST                  GO TST FOR RESTART SRC          EM054350
         B     E9$TTOVL                                                 EM054360
E9$TRST  CLI   E9$RDA,X'00'             RESTART MACRO ?                 EM054370
         BNE   E9$TCANL                 GO CHK FOR CANCEL MACRO         EM054380
         BR    7                                                        EM054390
E9$TCANL CLI   E9$RDA,X'1A'             CANCEL MACRO REQ?               EM054400
         BR    7                                                        EM054410
E9$TSRC  DS    0H                                                       EM054420
E9$RSRC  EQU   *                                                        EM054430
         TM    E9$RIOII+1,X'04'         TEST CURRENT MODE SET           EM054440
         BO    E9$TRLSE                                                 EM054450
         L     4,E9$RALUT                                               EM054460
         BAL   7,E9$RSSRC               GO CHK SRC VALUE                EM054470
         SR    3,3                                                      EM054480
         TM    E9$RTYPE,X'70'           CHK FOR EXEC 2,MOS,NCOS         EM054490
         BZ    E9$TNEXC                                                 EM054500
*                                                                       EM054510
         IC    3,E9$RDA                                                 EM054520
         AH    3,E9$RSRCT                                               EM054530
         LH    3,0(,3)                  LD VALUE OF TABLE               EM054540
         CH    3,E9$T0                                                  EM054550
         BE    E9$TIVAL                                                 EM054560
         STH   3,E9$RIFAP               SET VALUE TO IFAP               EM054570
E9$TNEXC EQU   *                                                        EM054580
         BAL   7,E9$TCHPR                                               EM054590
         MVI   E9$TSWIT+1,X'00'         SET SWITCH                      EM054600
         BAL   7,E9$TTAGG                                               EM054610
         MVC   E9$RPPSC+2(2),E9$RPSW7   STOR PSW TO PROC PSC            EM054620
         OI    E9$RIOII+1,X'04'         SET I/O MODE                    EM054630
         MVC   E9$RIPSC+1(1),E9$RDA     MOVE 1 BYTE SRC VALUE           EM054640
         MVC   E9$RPSW7(2),E9$RIFAP                                     EM054650
         LA    3,E9$RIPSC               LD I/O PSC VALUE                EM054660
         BAL   7,E9$TCCCH                                               EM054670
         NI    E9$RPSW5,X'CF'           ERASE CURRENT CC SETTING        EM054680
         B     E9$TRLSE                                                 EM054690
E9$TCC93 OI    0(3),X'80'               SET CC POS ON                   EM054700
         TM    E9$RPSW5,X'20'                                           EM054710
         BO    *+8                                                      EM054720
         NI    0(3),X'7F'                                               EM054730
         OI    0(3),X'40'                                               EM054740
         TM    E9$RPSW5,X'10'                                           EM054750
         BO    *+8                                                      EM054760
         NI    0(3),X'BF'                                               EM054770
         BR    7                                                        EM054780
         CNOP  0,4                                                      EM054790
E9$TTOVL EQU   *                                                        EM054800
         OI    E9$RIOII+2,X'02'         SET BIT TO CALL IN OPCOM        EM054810
         B     E9$TTRLS                                                 EM054820
         CNOP  0,4                                                      EM054830
E9$TRLSE EQU   *                                                        EM054840
E9$TTRLS EQU   *                                                        EM054850
         B     E9$REXIT                                                 EM054860
         TITLE 'INLINE INTERNAL'                                        EM054870
E9$XXIOF DS    0H                                                       EM054880
         CLI   E9$ROP,X'A4'             COMP BYTE FOR XIOF              EM054890
         BE    E9$XXIO                                                  EM054900
         BC    15,E9$XTOVL                                              EM054910
E9$XXIO EQU    *                                                        EM054920
         BAL   7,E9$XSCAN               GO FIND ADDRESS IN TABLE        EM054930
         CLC   E9$RLXIO(4),E9$RCFST     COMP FOR OVERLAY CALLED IN      EM054940
         BNE   *+12                     BRANCH AROUND IF NOT SET        EM054950
         OI    E9$RIOII+2,X'04'         SET LD MODE SWITCH              EM054960
         OI    E9$RXS2,X'08'            SET GETCS                       EM054970
         TM    E9$RXS1,X'10'            CHK LAST XIOF COMPLETED         EM054980
         BNO   *+12                                                     EM054990
         OI    E9$RPSW5,X'30'                                           EM055000
         B     E9$REXIT                                                 EM055010
         MVC   E9$RXFC(1),E9$RFC        SET UP FUNC CODE FOR ANALYSIS   EM055020
         OI    E9$RXS1,X'08'            SET INTERRUPT PERMIT IN X10 TBL EM055030
         TM    E9$RXFC,X'10'            IS INHIBIT BIT SET              EM055040
         BNO   *+8                      BRANCH IF NO                    EM055050
         NI    E9$RXS1,X'F7'            SET INHIBIT INTERRUPT X10 TBL   EM055060
         NI    E9$RXS1,X'BF'            RESET STACKER SEL  X10 TBL      EM055070
         TM    E9$RXFC,X'08'            CHK FOR STACKER SELECT SET      EM055080
         BNO   *+8                      IF NOT SET BRANCH               EM055090
         OI    E9$RXS1,X'40'            SET STACKER SELECT X10 TBL      EM055100
E9$XJUMP NI    E9$RXFC,X'07'            ERASE PRINT BAR SETTINGS,STACKR EM055110
         LA    9,E9$RGET                                                EM055120
         NI    E9$RXS1,X'7F'            SET BIT TO GET CODE             EM055130
         CLI   E9$RXFC,X'00'            CHECK FOR VALIDITY              EM055140
         BNE   E9$XICKF                                                 EM055150
         NI    E9$RPSW5,X'CF'                                           EM055160
         B     E9$XREJX                                                 EM055170
E9$XICKF EQU   *                                                        EM055180
         L     10,E9$XXDBW                                              EM055190
E9$XN1   CLC   E9$RXFC(1),E9$RXFN1      COMP FOR READ FUNCTION          EM055200
         BNE   E9$XN2                   NO MATCH-CONT CHK- BRCH BY      EM055210
         OI    E9$RXS3,X'04'            SET UP TRANSLATE BIT            EM055220
         B     E9$XN21                  GO TEST FOR PUNCH UNIT          EM055230
E9$XN2   CLC   E9$RXFC(1),E9$RXFN2      COMP FOR READ IMAGE NO TRANS    EM055240
         BNE   E9$XN3                   GO TO PUT CHECKING              EM055250
         NI    E9$RXS3,X'FB'            ERASE TRANSLATE BIT SETTING     EM055260
E9$XN21  TM    E9$RXS3,X'08'            COMPARE FOR BEING PUNCH UNIT    EM055270
         BNOR  10                                                       EM055280
         OI    E9$RXS3,X'40'            SET THE READ ON PUNCH UNIT BIT  EM055290
         LA    9,E9$RPUT                                                EM055300
         OI    E9$RXS1,X'80'            SET BIT FOR PUT CODE            EM055310
         BR    10                                                       EM055320
E9$XN3   LA    9,E9$RPUT                                                EM055330
         OI    E9$RXS1,X'80'            SET BIT TO PUT CODE             EM055340
         CLC   E9$RXFC(1),E9$RXFN3      COMP FOR PUNCH OR PRINT/SPACE   EM055350
         BNE   E9$XN4                   IN NO MATCH CONT CHKING         EM055360
         TM    E9$RXS3,X'20'            CHK FOR PRINTER                 EM055370
         BOR   10                                                       EM055380
         OI    E9$RXS3,X'04'            SET TRANSLATE BIT FOR PUNCH     EM055390
         BR    10                                                       EM055400
E9$XN4   CLC   E9$RXFC(1),E9$RXFN4      CHK FOR PCH IMAGE/PRNT SPCE     EM055410
         BNE   E9$XN5                   NOT EQUAL CONT CHKING           EM055420
         TM    E9$RXS3,X'20'            CHK FOR PRNTR/ASSUM PCH IF NOT  EM055430
         BOR   10                                                       EM055440
         NI    E9$RXS3,X'FB'            ERASE TRANSLATE BIT             EM055450
         BR    10                                                       EM055460
E9$XN5   CLC   E9$RXFC(1),E9$RXFN5      CHK FOR PUNCH/READ W/TRANS      EM055470
         BNE   E9$XN6                   CONT CHKING IF NO MATCH         EM055480
         OI    E9$RXS3,X'05'            SET RD/PCH BITS W/TRANS         EM055490
         BR    10                                                       EM055500
E9$XN6   CLC   E9$RXFC(1),E9$RXFN6      COMP FOR PCH/READ(NO TRANS)     EM055510
         BNE   E9$XREJT                 IF NOT EQU REJ XIOF             EM055520
         NI    E9$RXS3,X'FB'            ERASE TRANSLATE BIT             EM055530
         OI    E9$RXS3,X'41'            SET THE READ & PUNCH BITS       EM055540
E9$XIDBW EQU   *                                                        EM055550
         TM    E9$RXS3,X'20'            TST FOR PRINTER                 EM055560
         BO    E9$XPRNT                 GO TO PRNT SETUP                EM055570
         TM    E9$RXS3,X'10'            INTERNAL READER                 EM055580
         BO    E9$XSET3                 GO TO SWITCH 3                  EM055590
         TM    E9$RXS3,X'01'            COMP FOR RD-PCH SET             EM055600
         BO    E9$XSET1                 GO TO SWITCH 1                  EM055610
         TM    E9$RXS3,X'40'            READ ONLY ON PUNCH              EM055620
         BO    E9$XSET2                                                 EM055630
         MVI   E9$XICD5+1,X'00'         MUST BE PUNCH ONLY              EM055640
         BC    15,E9$XICD1                                              EM055650
E9$XSET1 MVI   E9$XICD3+1,X'00'                                         EM055660
E9$XSET2 MVI   E9$XICD4+1,X'FC'                                         EM055670
E9$XSET3 MVI   E9$XICD2+1,X'00'                                         EM055680
E9$XICD1 SR    3,3                                                      EM055690
         SR    2,2                                                      EM055700
         SR    7,7                                                      EM055710
         IC    3,E9$RXBCW               LD 1 BYTE VALUE                 EM055720
E9$XICD4 AI    E9$RXMSZ,X'00'           ADD FOR POSSIBLE DISPLACEMENT   EM055730
         MVI   E9$XICD4+1,X'00'         RESET THE ADD IMMEDIATE VALUE   EM055740
         IC    7,E9$RXBCW               LD VALUE OF BCW CALCULATED LOC  EM055750
         IC    2,1(7)                                                   EM055760
E9$XICD2 BC    15,E9$XICD5                                              EM055770
         MVI   E9$XICD2+1,X'F0'         RESET SWITCH                    EM055780
         MVC   E9$RXENT(2),2(7)         MOVE CURRENT LOC VALUE          EM055790
         STC   2,E9$RXGSZ               MOVE SIZE TO STORAGE            EM055800
E9$XICD5 BC    15,E9$XICD6                                              EM055810
         MVI   E9$XICD5+1,X'F0'         RESET SWITCH                    EM055820
         MVC   E9$RXENT+2(2),2(7)                                       EM055830
         STC   2,E9$RXPSZ                                               EM055840
E9$XICD6 AH    2,2(,7)                                                  EM055850
         STH   2,2(,7)                                                  EM055860
         MVI   1(7),X'00'                                               EM055870
         STC   3,E9$RXBCW                                               EM055880
E9$XICD3 BC    15,E9$XGTPT                                              EM055890
         MVI   E9$XICD3+1,X'F0'                                         EM055900
         MVI   E9$XICD2+1,X'F0'                                         EM055910
         MVI   E9$XICD5+1,X'00'                                         EM055920
         BC    15,E9$XICD1                                              EM055930
E9$XPRNT EQU   *                        PRNT SETUP ROUTINE              EM055940
         SR    3,3                      CLEAR REG 3                     EM055950
         IC    3,E9$RXBCW               LD PRINT BCW START LOC          EM055960
         CLI   E9$RXFC,X'03'            IS IT SPACE ONLY                EM055970
         BNE   *+8                      IF NOT BYPASS NEXT INSTR        EM055980
         OI    E9$RXFC,X'04'            SET BIT FOR 9-3 FUNCTION        EM055990
         TM    0(3),X'08'               COMP BIT FOR SKIP SETTING       EM056000
         BNO   *+8                      IF NOT BYPASS                   EM056010
         OI    E9$RXFC,X'80'            YES, SET  CORRESPONDING BIT ON  EM056020
         TM    0(3),X'04'               CHECK BIT 5 OF 9300 FC          EM056030
         BNO   *+8                      NOT SET BYPASS                  EM056040
         OI    E9$RXFC,X'20'            SET? ON BIT 2 OF 9-3 FC         EM056050
         TM    0(3),X'02'               CHECK BIT 6 OF 9300 FC          EM056060
         BNO   *+8                      IF NOT BYPASS                   EM056070
         OI    E9$RXFC,X'10'            SET? ON BIT 3 OF 9-3 FC         EM056080
         TM    0(3),X'01'               CHECK BIT 7 OF 9300 FC          EM056090
         BNO   *+8                      IF NOT BYPASS                   EM056100
         OI    E9$RXFC,X'08'            SET? ON BIT 4 OF 9-3 FC         EM056110
E9$XGTPT EQU   *                                                        EM056120
         L     3,E9$RXBUF               LD BUFFER ADDRESS               EM056130
         MVC   0(1,3),E9$RXFC           SET FUNCTION CODE INTO BUFFER   EM056140
         TM    E9$RXS1,X'80'            CHK BIT FOR GET OR PUT          EM056150
         BNO   E9$XGSET                                                 EM056160
         BAL   7,E9$XCLRB               GO TO CLR BUF ROUTINE           EM056170
         TM    E9$RXS3,X'41'            CHK IF RD/REQ ON PUNCH          EM056180
         BNZ   E9$XRDPH                 IF READ REQ GO TO RD/PCH SETUP  EM056190
E9$XRPST EQU   *                                                        EM056200
         TM    E9$RXS3,X'20'            TST FOR BAR PRNTR               EM056210
         BNO   E9$XNPR                                                  EM056220
         SR    2,2                                                      EM056230
         LA    2,X'80'(,2)              SET UP BUF VALUE                EM056240
         B     E9$XNPR+4                                                EM056250
E9$XNPR  LH    2,E9$RXENT+2             LD BUF VALUE TO R2              EM056260
         SR    7,7                      CLR REG 7                       EM056270
         IC    7,E9$RXPSZ               LD R7 WITH PUT SIZE             EM056280
         TM    E9$RXS3,X'20'            TST FOR PRINTER                 EM056290
         BO    E9$XSPSZ                 BYPASS IF PRINTER               EM056300
         TM    E9$RXS3,X'04'            COMP FOR IMAGE MODE             EM056310
         BO    E9$XSPSZ                                                 EM056320
         AR    7,7                                                      EM056330
E9$XSPSZ STC   7,E9$XPTMV+1                                             EM056340
         AI    E9$XPTMV,0                                               EM056350
         ORG   *-3                                                      EM056360
         DC    XL1'FF'                                                  EM056370
         ORG   *+2                                                      EM056380
E9$XPTMV MVC   1(,3),0(2)               LOAD BUFFER WITH DATA           EM056390
         TM    E9$RXS3,X'04'            CHK FOR TRANSLATE               EM056400
         BNO   E9$XTTEB+6                                               EM056410
         MVC   E9$XTTEB+1(1),E9$XPTMV+1                                 EM056420
         L     10,E9$RTRTB                                              EM056430
E9$XTTEB TR    1(,3),0(10)              TRANSLATE TO EBCIDIC            EM056440
         TM    E9$RXS3,X'20'            TST FOR PRINTER                 EM056450
         BO    E9$XNT                                                   EM056460
         TM    E9$RXPSZ,X'01'           TST FOR ADJUSTMENT              EM056470
         BNO   E9$XSTUP                                                 EM056480
         TM    E9$RXS3,X'04'            TEST FOR TRANSLATE              EM056490
         BO    E9$XI1                                                   EM056500
         B     E9$XSTUP                                                 EM056510
E9$XI1   LA    7,1(,7)                  INCREMENT BY ONE                EM056520
E9$XSTUP L     8,E9$RXWCB               SET UP BCW                      EM056530
         STC   7,7(,8)                                                  EM056540
E9$XNT   BC    15,E9$XLDDF                                              EM056550
E9$XRDPH EQU   *                                                        EM056560
         SR    2,2                      CLR R2                          EM056570
         L     3,E9$RXRBF               L R3 WITH PUNCH READ BUFFER     EM056580
         BAL   7,E9$XCLRB               GO TO CLR BUFFER                EM056590
         L     8,E9$RXWCB               LD BCW 90/30 ADDR               EM056600
         SR    7,7                      CLR R7                          EM056610
         IC    7,E9$RXGSZ               LD R7 W/SIZE                    EM056620
         TM    E9$RXS3,X'04'            TEST FOR TRANS                  EM056630
         BO    E9$XGSOC                 IF,BYPASS                       EM056640
         AR    7,7                      DOUBLE                          EM056650
         B     E9$XGEX                  GO TO STORE COUNT               EM056660
E9$XGSOC TM    E9$RXGSZ,X'01'           CHK IF ODD                      EM056670
         BNO   *+8                      BYPASS IF NOT                   EM056680
         L     7,1(,7)                  ADD 1 IF IT WAS                 EM056690
E9$XGEX  STC   7,5(,8)                  ST CNT IN REP CNT               EM056700
         LH    2,E9$RXENT               SETUP REG                       EM056710
         L     3,E9$RXRBF                                               EM056720
         TM    E9$RXS3,X'40'            RD ONLY ON PUNCH ?              EM056730
         BO    E9$XLDDF                 GO TO SET DTF ADDR              EM056740
         L     3,E9$RXBUF               IF NOT RELOAD XBUF              EM056750
         B     E9$XRPST                 CONT WHERE LEFT OFF             EM056760
E9$XCLRB EQU   *                        CLEAR BUFFER ROUTINE            EM056770
         SR    2,2                      CLR R2                          EM056780
         IC    2,E9$RXMSZ               LD MAXSIZE                      EM056790
         TM    E9$RXS3,X'20'            TST FOR PRINTER                 EM056800
         BNO   *+12                     BR IF NOT                       EM056810
         MVI   E9$XCLBY+1,X'40'         MOVE SPACE FOR CLEAR BYTE       EM056820
         B     E9$XSTSZ                                                 EM056830
         TM    E9$RXS3,X'04'                                            EM056840
         BO    *+6                                                      EM056850
         AR    2,2                      DOUBLE                          EM056860
E9$XSTSZ STC   2,E9$XCLRM+1             SET UP CLEAR BYTE SIZE          EM056870
         AI    E9$XCLRM,X'00'           DECREMENT MVE SIZE              EM056880
         ORG   *-3                                                      EM056890
         DC    XL1'FE'                                                  EM056900
         ORG   *+2                                                      EM056910
E9$XCLBY MVI   1(3),X'00'                                               EM056920
E9$XCLRM MVC   2(,3),1(3)                                               EM056930
         MVI   E9$XCLBY+1,X'00'                                         EM056940
         BR    7                        GO BACK TO USER                 EM056950
E9$XGSET EQU   *                                                        EM056960
         SR    7,7                      CLR R7                          EM056970
         L     8,E9$RXWCB               LD 90/30 BCW POS                EM056980
         IC    7,E9$RXGSZ               LD R7 WITH SIZE                 EM056990
         CLI   E9$RXGSZ,X'33'           IS STUB RD 51 COL REQ       R4  EM056991
         BNE   *+8                      BR AROUND IF NOT            R4  EM056992
         OI    0(3),X'08'               SET FUNCTION FOR 51 COL     R4  EM056993
         CLI   E9$RXGSZ,X'42'           IS STUB RD 66 COL REQ       R4  EM056994
         BNE   *+8                      BR AROUND IF NOT            R4  EM056995
         OI    0(3),X'18'               SET FUNCTION FOR 66 COL     R4  EM056996
         TM    E9$RXS3,X'04'            CHK FOR TRANS                   EM057000
         BO    E9$XGSOT                 BR IF NOT                       EM057010
         AR    7,7                      DOUBLE IF IMAGE                 EM057020
         B     E9$XGEZ                  GO TO STOR                      EM057030
E9$XGSOT TM    E9$RXGSZ,X'01'           CHK IF ODD COUNT                EM057040
         BNO   *+8                      BR IF NOT                       EM057050
         L     7,1(,7)                  INCREMENT BY ONE IF ODD         EM057060
E9$XGEZ  STC   7,7(,8)                  STORE COUNT                     EM057070
         LH    2,E9$RXENT               LOAD BCW RECEIVE FIELD          EM057080
         L     3,E9$RXBUF                                               EM057090
E9$XLDDF L     1,E9$RXDTF                                               EM057100
         OI    E9$RXS1,X'10'            SET INT & STATUS PENDING BIT    EM057110
         NI    E9$RPSW5,X'CF'           SET THE CC BITS TO ZERO         EM057120
         BR    9                                                        EM057130
E9$XREJT EQU   *                                                        EM057140
         OI    E9$RPSW5,X'30'           SET PSW CC TO REJECTED STATUS   EM057150
         B     E9$XTOVL                                                 EM057160
E9$XTCAS DC    XL4'0'                   TEMP STORAGE FOR TCB ADDRESS    EM057170
E9$XSCAN EQU   *                        SCAN PHY/LOG TBL-RETURN REG 7   EM057180
         L     4,E9$RALUT                                               EM057190
E9$XA    CLC   E9$RDA(1),0(4)                                           EM057200
         BER   7                                                        EM057210
         CLI   0(4),X'FF'               COMP FOR END OF TABLE           EM057220
         BE    E9$XCNSL                                                 EM057230
         LA    4,36(,4)                INCREMENT DISPLACEMENT           EM057240
         B     E9$XA                                                    EM057250
E9$XCNSL EQU   *                                                        EM057260
E9$XTOVL EQU   *                                                        EM057270
         OI    E9$RIOII+2,X'02'         SET BIT TO CALL IN OPCOM        EM057280
E9$XREJX B     E9$REXIT                                                 EM057290
E9$XTRLS EQU   *                                                        EM057300
E9$XRLSE EQU   *                                                        EM057310
         BR    9                                                        EM057320
         CNOP  0,4                                                      EM057330
E9$XXDBW DC    A(E9$XIDBW)                                              EM057340
         DROP  5                                                        EM057350
         ENDO                                                           EM057360
         EJECT                                                          EM057370
E9$RX4TB DSECT                                                          EM057380
         USING *,4                                                      EM057390
E9$RXDA  EQU   *                                                        EM057400
         DS    CL1                      DEVISE ADD FOR 92/93 XIO/TIO    EM057410
E9$RXSRC EQU   *                                                        EM057420
         DS    CL1                      SRC VALUE                       EM057430
E9$RXMSZ EQU   *                                                        EM057440
         DS    CL1                      SIZE OF MAXIMUM MOVE            EM057450
E9$RXBCW EQU   *                                                        EM057460
         DS    CL1                      BCW ADDRESS(IF RD/PH)-4         EM057470
E9$RXENT EQU   *                                                        EM057480
         DS    CL4                      ENTR SRC INTERCEPTED/BCW ADDR   EM057490
E9$RXDTF EQU   *                                                        EM057500
         DS    CL4                      SAT FILE TABLE ADDRESS          EM057510
E9$RXBUF EQU   *                                                        EM057520
         DS    CL4                      SAT BUFFER ADDRESS              EM057530
E9$RXRBF EQU   *                                                        EM057540
         DS    CL4                     SAT BUFF ADD RD/PCH RD BUFF      EM057550
E9$RXFN1 EQU   *                                                        EM057560
         DS    CL1                      92/93 FUNCTION                  EM057570
E9$RXFN2 EQU   *                                                        EM057580
         DS    CL1                      92/93 FUNCTION                  EM057590
E9$RXFN3 EQU   *                                                        EM057600
         DS    CL1                      92/93 FUNCTION                  EM057610
E9$RXFN4 EQU   *                                                        EM057620
         DS    CL1                      92/93 FUNCTION                  EM057630
E9$RXFN5 EQU   *                                                        EM057640
         DS    CL1                      92/93 FUNCTION                  EM057650
E9$RXFN6 EQU   *                                                        EM057660
         DS    CL1                      92/93 FUNCTION                  EM057670
E9$RXS1  EQU   *                                                        EM057680
         DS    CL1                      BIT SETTINGS                    EM057690
E9$RXS2  EQU   *                                                        EM057700
         DS    CL1                      BIT SETTINGS                    EM057710
E9$RXS3  EQU   *                                                        EM057720
         DS    CL1                      BIT SETTINGS                    EM057730
E9$RXFC  EQU   *                                                        EM057740
         DS    CL1                      FUNCTION CODE                   EM057750
E9$RXGSZ EQU   *                                                        EM057760
         DS    CL1                      GET SIZE OF BUFFER              EM057770
E9$RXPSZ EQU   *                                                        EM057780
         DS    CL1                      PUT SIZE OF BUFFER              EM057790
E9$RXWCB EQU   *                                                        EM057800
         DS    CL4                      BCW  90/30 POSITION             EM057810
         DROP  4                                                        EM057820
         EJECT                                                          EM057830
E9$TAPPK DSECT                                                          EM057840
         USING *,14                                                     EM057850
E9$TBCWS EQU   *                        BUFFER CONTROL WORD SPECIFI     EM057860
         DS    CL4                                                      EM057870
E9$TMODE EQU   *                        MODE SPECIFICATION              EM057880
         DS    CL1                                                      EM057890
E9$TDAPU EQU   *                        DEVISE ADDRESS/PHYSICAL UNIT    EM057900
         DS    CL1                                                      EM057910
E9$TCNTS EQU   *                        COUNTS                          EM057920
         DS    CL1                                                      EM057930
E9$TFUNC EQU   *                        FUNCTION SPECIFICATION          EM057940
         DS    CL1                                                      EM057950
E9$TSIND EQU   *                        STATUS INDICATOR                EM057960
         DS    CL1                                                      EM057970
E9$TLOGU EQU   *                        LOGICAL UNIT NUMBER             EM057980
         DS    CL1                                                      EM057990
E9$TLBYA EQU   *                        LAST BYTE ADDRESS               EM058000
         DS    CL2                                                      EM058010
         DROP  14                                                       EM058020
         END   STEM92                                                   EM058030
